うならぼ

申し訳程度のアフィリエイトとか広告とか解析とかは/aboutを参照

F#のIEventに求められる「標準のデリゲート型」の定義、もしくはdelegate制約の話

C#などで書かれたクラスにF#からアクセスする際、EventHandler デリゲートと互換性のあるイベントは IEvent<'Delegate,'Args> としてアクセスすることができます。

互換性のないデリゲート型を IEvent<'Delegate,'Args'>'Delegate 型引数に指定するとコンパイルエラーになります。互換性といっても、AssemblyLoadEventHandler のように EventHandler<'T> にキャストできないような型でもいいのですから、継承関係では判断することができません。どうやって検証しているのでしょうか。

ソースコードを探検する

リファレンス には次のような定義が書かれています。

type IEvent<'Delegate,'Args when 'Delegate : delegate<'Args,unit> and 'Delegate :> System.Delegate> =
interface
inherit IObservable<'Args>
inherit IDelegateEvent<'Delegate>
end

when 'Delegate : delegate<'Args,unit> という型制約が気になりますね。言語リファレンスを読んでみましょう。

Delegate Constraint : delegate<tuple-parameter-type, return-type>

The provided type must be a delegate type that has the specified arguments and return value; not intended for common use.

https://docs.microsoft.com/en-us/dotnet/articles/fsharp/language-reference/generics/constraints

デリゲートを構成する型で制約をかけられるように見えますが、件のデリゲートは 'Args -> unit ではなく obj * 'Args -> unit のはずです。どういうことでしょうか。

次のコードもコンパイルエラーになってしまいます。

let test (value:'T when 'T : delegate<int,unit> and 'T :> Delegate) = ()
type Foo = delegate of int -> unit

test (new Foo(fun x -> () ))
// error FS0001: 型 'Foo' には標準ではないデリゲート型があります

delegate制約の挙動を掘り下げる必要がありそうです。いざソースコードへ。

fsharp/ConstraintSolver.fs at 8dcf06f949dc9d05d35aa6bab0fbbd4911d480f3 · fsharp/fsharp · GitHub

and SolveTypIsDelegate (csenv:ConstraintSolverEnv) ndeep m2 trace ty aty bty =
    trackErrors {
        let g = csenv.g
        let m = csenv.m
        let denv = csenv.DisplayEnv
        if isTyparTy g ty then 
            return! AddConstraint csenv ndeep m2 trace (destTyparTy g ty) (TyparConstraint.IsDelegate(aty,bty,m))
        elif isDelegateTy g ty then 
            match TryDestStandardDelegateTyp csenv.InfoReader m AccessibleFromSomewhere ty with 
            | Some (tupledArgTy,rty) ->
                do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace aty tupledArgTy 
                do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace bty rty 
            | None ->
                return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalStringOfType denv ty),m,m2))
        else 
            return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalStringOfType denv ty),m,m2))
    }

delegate制約の tuple-parameter-typeatyreturn-typebty に対応します。そしてこれらが対象の型である ty と比較されているのか追っかけてみると、TryDestStandardDelegateTyp という関数に行きつきます。もう答えがほとんど見えていますが、この実装も確認してみます。

fsharp/InfoReader.fs at 35d22f8d2b4b39744060709d20528afa31737ae7 · fsharp/fsharp · GitHub

/// Try and interpret a delegate type as a "standard" .NET delegate type associated with an event, with a "sender" parameter.
let TryDestStandardDelegateTyp (infoReader:InfoReader) m ad delTy =
    let g = infoReader.g
    let (SigOfFunctionForDelegate(_,compiledViewOfDelArgTys,delRetTy,_)) = GetSigOfFunctionForDelegate infoReader delTy m ad
    match compiledViewOfDelArgTys with 
    | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys)  -> Some(mkTupledTy g argTys,delRetTy)
    | _ -> None

基準に沿っていることを確認したうえで、最初の引数を除いて返しています。そしてこれがdelegate制約の tuple-parameter-type と比較されるわけですね。

まとめ

  • IEventのような「標準のデリゲート型」の判定は型引数のdelegate制約によって行われている
  • delegate制約に指定するデリゲート引数の型は、最初のsenderを除いて、複数あればタプル型として指定する
  • 「標準のデリゲート型」の基準は、最初の引数が obj 型であり、残りの引数にref引数がないこと

第二引数はEventArgsを継承してなくてもいいんだ?

F#には Handler<'T> というデリゲートがあり、これは EventHandler<'T>'T がEventArgsじゃなくてもいい版です。

type Foo() =
    let event1 = new Event<int*int>()
    
    [<CLIEvent>]
    member this.Event1 = event1.Publish
    
    member this.Trigger(x, y) =
        event1.Trigger(x,y)

let foo = new Foo()
foo.Event1.Add(fun (x, y) -> printfn "%d,%d" x y)
foo.Event1.AddHandler <| new Handler<_>(fun sender (x, y) -> printfn "%d,%d" x y)
foo.Trigger(1,2)

タプルじゃなくて3引数以上のデリゲートでもいいんだよね?

DelegateEvent<'Delegate> を使えばそういうイベントも作れますし公開できます。

type FooDelegate = delegate of obj * int * int -> unit
type Foo() =
    let event1 = new DelegateEvent<FooDelegate>()
    
    [<CLIEvent>]
    member this.Event1 = event1.Publish
    
    member this.Trigger(x, y) =
        event1.Trigger([| obj(); x; y |])

let foo = new Foo()
foo.Event1.Add(fun (x, y) -> printfn "%d,%d" x y)
foo.Event1.AddHandler <| new FooDelegate(fun sender x y -> printfn "%d,%d" x y)
foo.Trigger(1,2)

でも第一引数にsenderは必須なんだ?

前述の TryDestStandardDelegateTyp の実装の近くにこんなコメントがあります。

In the F# design, we take advantage of the following idiom to simplify away the bogus "object" parameter of the of the "Add" methods associated with events. If you want to access it you can use AddHandler instead.

ハンドラ側でsenderを省略できるようにするうえで、デリゲート側には必ず存在するものとしておきたかった、というところなのかなと。

F#からFiddlerCoreを触る

リセマラ用にキャッシュプロキシでも作ってみようかと思ったんだ。

結局そこまで高速化はできなくて、そもそもリセマラ面倒になったよね。

SAZの読み書きを実装してみる

FiddlerではセッションをSAZという形式で保存することができます。FiddlerCoreでもこれを読み書きすることはできるのですが、Zipアーカイブの処理は自分で実装する必要があります。

例によってろくなドキュメントがないので、SampleAppのSAZ-DotNetZip.csを参考に実装していきます。その名の通りサンプルはDotNetZipを使っていますが、今回はSystem.IO.Compression.ZipFileを使います。

open System
open Fiddler
open System.IO
open System.IO.Compression

type SAZWriter(zipname) =
    let zip = ZipFile.Open(zipname, ZipArchiveMode.Create)
    interface ISAZWriter with
        member self.Filename = zipname
        member self.Comment with set(v) = () // これは必ず呼ばれるので例外を投げられない
        member self.EncryptionMethod = raise <| NotSupportedException()
        member self.EncryptionStrength = raise <| NotSupportedException()
        member self.SetPassword(password) = raise <| NotSupportedException()
        member self.AddFile(filename, writer) =
            use stream = zip.CreateEntry(filename).Open()
            writer.Invoke(stream)
        member self.CompleteArchive() =
            zip.Dispose()
            true

type SAZReader(zipname) = 
    let zip = ZipFile.OpenRead(zipname)
    interface ISAZReader with
        member self.Filename = zipname
        member self.Comment = raise <| NotSupportedException()
        member self.EncryptionMethod = raise <| NotSupportedException()
        member self.EncryptionStrength = raise <| NotSupportedException()
        member self.Close() =
            zip.Dispose()
        member self.GetRequestFileList() =
            seq { for x in zip.Entries -> x.FullName }
            |> Seq.filter (fun x -> x.StartsWith("raw/") && x.EndsWith("_c.txt"))
            |> Seq.toArray
        member self.GetFileStream(filename) =
            zip.GetEntry(filename).Open()
        member self.GetFileBytes(filename) =
            use src = zip.GetEntry(filename).Open()
            use buf = new MemoryStream()
            src.CopyTo(buf)
            buf.ToArray()

type SAZProvider() =
    interface ISAZProvider with
        member self.BufferLocally = false
        member self.SupportsEncryption = false
        member self.CreateSAZ(zipname) =
            new SAZWriter(zipname) :> ISAZWriter
        member self.LoadSAZ(zipname) =
            new SAZReader(zipname) :> ISAZReader

[<EntryPoint>]
let main argv =
    FiddlerApplication.OnNotification.Add (fun e -> printfn "%s" e.NotifyString |> ignore)
    FiddlerApplication.oSAZProvider <- new SAZProvider()
    let sessions = Utilities.ReadSessionArchive(@"r:\archive.saz", true)
    printfn "%d sessions loaded" sessions.Length
    Utilities.WriteSessionArchive(@"r:\archive2.saz", sessions, null, true)
    0

内包表記とパイプライン演算子GetRequestFileListで内包表記やパイプライン演算子を使っていますが、内包表記ひとつで済ますこともできます。

member self.GetRequestFileList() =
    [| for x in zip.Entries do
        let name = x.FullName
        if name.StartsWith("raw/") && name.EndsWith("_c.txt") then
            yield name |]

内包表記なしでも。

member self.GetRequestFileList() =
    zip.Entries
    |> Seq.map (fun x -> x.FullName)
    |> Seq.filter (fun x -> x.StartsWith("raw/") && x.EndsWith("_c.txt"))
    |> Seq.take 1
    |> Seq.toArray

パイプライン使うのはLINQで見慣れてるし、内包表記もラムダの嵐を避けられて悪くないし・・・と思った結果がさっきのコードです。中途半端かもしれない。

もうひとつF#らしいところというと、GetFileBytesで使っているuse演算子でしょうか。C#でいうusingですが、インデントが深くならなくて素敵。

プロキシを立てる

SAZを読み込んでURLが一致するものにキャッシュから返そうかと思ったんですが、数が多いとSAZの読み書きが遅いとか、Fiddler使うの面倒とか・・・そんなわけでhttpで取得されるあらゆるファイルをURLに対応したパスにキャッシュするという雑な実装に。

open System
open Fiddler
open System.IO

let port = 1601
let cachePathBase = @"R:\response\"

let cachePathFor (session: Session) =
    let uri = new Uri(session.fullUrl)
    if uri.LocalPath.EndsWith("/") then
        None
    else
        Some(Path.Combine(cachePathBase, uri.Host, uri.LocalPath.Substring(1)))

let onBeforeRequest (sess: Session) =
    match cachePathFor sess with
    | Some cachePath ->
        if (File.Exists(cachePath)) then
            sess.Ignore()
            sess.LoadResponseFromFile(cachePath) |> ignore
            printfn "hit: %s" sess.url |> ignore
        else
            sess.Tag <- cachePath
            printfn "save: %s" sess.url |> ignore
    | None ->
        sess.Ignore()

let onBeforeResponse (sess: Session) =
    sess.SaveResponse(sess.Tag :?> string, false)
        
[<EntryPoint>]
let main argv = 
    CONFIG.IgnoreServerCertErrors <- true
    FiddlerApplication.OnNotification.Add <| fun e -> Console.WriteLine e.NotifyString
    FiddlerApplication.Prefs.SetBoolPref("fiddler.network.streaming.abortifclientaborts", true)
    
    FiddlerApplication.add_BeforeRequest <| new SessionStateHandler(onBeforeRequest)
    FiddlerApplication.add_BeforeResponse <| new SessionStateHandler(onBeforeResponse)
    
    FiddlerApplication.Startup (port, FiddlerCoreStartupFlags.Default &&& ~~~FiddlerCoreStartupFlags.RegisterAsSystemProxy &&& ~~~FiddlerCoreStartupFlags.DecryptSSL)
    printfn "Port: %d\nPress Enter to exit." port
    stdin.ReadLine() |> ignore

    0

FiddlerCoreではおなじみのBeforeRequestイベントですが、 BeforeRequest.Add (fun e -> ...) とはできません。こんなエラーが出ます。

イベント BeforeRequest が標準以外の型です。このイベントが別の CLI 言語で宣言された場合、イベントにアクセスするには、このイベントに明示的な add_BeforeRequest メソッドや remove_BeforeRequest メソッドを使用する必要があります。このイベントが F# で宣言された場合、イベントの型を IDelegateEvent<_> または IEvent<_,_>インスタンス化にします。

どうやら EventHandler<T> でないことが問題のようです。自分でSessionStateHandler型のインスタンスを作って、add_BeforeRequest に渡さないといけません。

あとはoption使ってる以外はF#らしくないというか、すごく手続き型っぽいコードですねえ。。