Musterentwurf für http://vimeo.com/25826340

Flussorientierte_Entwicklung.fs

open System
open System.Net.Mail
open System.Security
open System.Security.Cryptography
open System.Text

open SmtpClientExtension

type Account = { 
    User : string;
    Passwort : string;
    Email : string;
}

let asyncSendMail host port =
    (fun msg ->
        async {
            let client = new SmtpClient(host, port)
            let! t = client.AsyncSend(msg)
            return t
        })

let createMail from subject body =    
    (fun to' -> new MailMessage(from, to', subject, body))

let createConfirmationMail = 
    (fun account ->
        account.Email
        |> createMail "register@flowshow.com" "Registration confirmation" "Thank you for registering")

let registerAccount acc = 
    // do some fancy stuff :)
    acc

let hash (text:string) = 
    use hashFunction = new SHA512Managed()
    let encoding = new UnicodeEncoding()
    encoding.GetBytes text
    |> hashFunction.ComputeHash
    |> Convert.ToBase64String


let getAccountData()=
    { User = "rainer"; Passwort = "my_pw"; Email = "rainer@fakedomain.com" }

do
    let account = getAccountData()

    { account with Passwort = hash account.Passwort }
    |> registerAccount
    |> createConfirmationMail
    |> asyncSendMail  "localhost" 50505
    |> Async.Start

SmptClientExtension.fs

module SmtpClientExtension = 
    // author Mauricio Scheffer
    // from http://fssnip.net/1C
    open System
    open System.Net
    open System.Net.Mail
    open System.Threading
    
    /// from http://msdn.microsoft.com/en-us/magazine/cc163467.aspx
    type internal AsyncResultNoResult(callback: AsyncCallback, state: obj) = 
        let statePending = 0
        let stateCompletedSync = 1
        let stateCompletedAsync = 2
        let mutable completedState = statePending
        let mutable waitHandle: ManualResetEvent = null
        let mutable resultException: exn = null

        interface IAsyncResult with
            member x.AsyncState = state
            member x.AsyncWaitHandle = 
                if waitHandle = null then
                    let isDone = (x :> IAsyncResult).IsCompleted
                    let mre = new ManualResetEvent(isDone)
                    if Interlocked.CompareExchange(&waitHandle, mre, null) <> null
                        then mre.Close()
                        else
                            if not isDone && (x :> IAsyncResult).IsCompleted
                                then waitHandle.Set() |> ignore
                upcast waitHandle
            member x.CompletedSynchronously = 
                Thread.VolatileRead(&completedState) = stateCompletedSync
            member x.IsCompleted = 
                Thread.VolatileRead(&completedState) <> statePending

        member x.SetAsCompleted(e: exn, completedSynchronously: bool) = 
            resultException <- e
            let prevState = Interlocked.Exchange(&completedState, if completedSynchronously then stateCompletedSync else stateCompletedAsync)
            if prevState <> statePending
                then raise <| InvalidOperationException("You can set a result only once")
            if waitHandle <> null
                then waitHandle.Set() |> ignore
            if callback <> null
                then callback.Invoke(x)

        member x.EndInvoke() = 
            let this = x :> IAsyncResult
            if not this.IsCompleted then
                this.AsyncWaitHandle.WaitOne() |> ignore
                this.AsyncWaitHandle.Close()
                waitHandle <- null
            if resultException <> null
                then raise resultException
    
    type SmtpClient with
        member private x.GetAsyncResult(callback, state) : IAsyncResult = 
            let r = AsyncResultNoResult(callback, state)
            x.SendCompleted
            |> Event.add(fun args -> r.SetAsCompleted(args.Error, false))
            upcast r
            
        member x.BeginSend(message: MailMessage, callback, state) = 
            let r = x.GetAsyncResult(callback, state)
            x.SendAsync(message, null)
            r
    
        member x.BeginSend(from, recipients, subject, body, callback, state) = 
            let r = x.GetAsyncResult(callback, state)
            x.SendAsync(from, recipients, subject, body, null)
            r
    
        member x.EndSend(result: IAsyncResult) = 
            let result = result :?> AsyncResultNoResult
            result.EndInvoke()
    
        member x.AsyncSend(message: MailMessage) = 
            Async.FromBeginEnd((fun(iar,state) -> x.BeginSend(message, iar, state)), x.EndSend, x.SendAsyncCancel)
    
        member x.AsyncSend(from, recipients, subject, body) : Async<unit> = 
            Async.FromBeginEnd((fun(iar,state) -> x.BeginSend(from, recipients, subject, body, iar, state)), x.EndSend, x.SendAsyncCancel)
    (*
    // silly example
    async { 
        let credentials = NetworkCredential("you@gmail.com", "yourpassword")
        use smtp = new SmtpClient("smtp.gmail.com", 587, EnableSsl = true, Credentials = credentials)
        do! smtp.AsyncSend("you@gmail.com", "your.email@gmail.com", "this subject", "cucamonga")
    } |> Async.RunSynchronously
    *)