Add Suave-style cookie session primitives to the ASP.NET Core Suave adapter

src/FSharpPlus.AspNetCore.Suave/Library.fs

@@ -9,6 +9,7 @@ open System.Text
 open System
 open System.IO
 open System.Text.RegularExpressions
+open Microsoft.AspNetCore.Http.Features
 
 // setup something that reminds us of what Suave can work with
 // this is an overly simplified model of Suave in order to show how OptionT can be used
@@ -87,9 +88,15 @@ module RequestErrors=
   let FORBIDDEN s = setStatusAndContent (int HttpStatusCode.Forbidden) s
   let NOT_FOUND s = setStatusAndContent (int HttpStatusCode.NotFound) s
   let UNAUTHORIZED s = setStatusAndContent (int HttpStatusCode.Unauthorized) s
+let private tryGetSession (ctx:Context) =
+  match ctx.request.HttpContext.Features.Get<ISessionFeature>() with
+  | null -> None
+  | feature when isNull feature.Session -> None
+  | feature -> Some feature.Session
 module Filters=
   let response (method : string) = OptionT << fun (x : Context) -> async.Return (if (method = x.request.Method) then Some x else None)
   let hasFormContentType = OptionT << fun (x : Context) -> async.Return (if x.request.HasFormContentType then Some x else None)
+  let statefulForSession = OptionT << fun (x : Context) -> async.Return (if tryGetSession x |> Option.isSome then Some x else None)
 
   let GET  (x : Http.Context) =  response "GET" x
   let POST (x : Http.Context) = response "POST" x
@@ -119,6 +126,22 @@ module Request =
       | _       -> None
   module Header=
     let tryGet key (r:HttpRequest)=match r.Headers.TryGetValue key with | (true,v)->Some v | _-> None
+  module Cookie=
+    let tryGet key (r:HttpRequest)=
+      match r.Cookies.TryGetValue key with
+      | true, v -> Some v
+      | _ -> None
+
+module HttpContext=
+  let state (ctx:Context) = tryGetSession ctx
+
+module Session=
+  let tryGet key (session:ISession) =
+    match session.GetString key with
+    | null -> None
+    | value -> Some value
+  let set key value (session:ISession) =
+    session.SetString(key, value)
 
 
 
@@ -134,4 +157,3 @@ let appRun (app:WebPart<Context>) (appBuilder:IApplicationBuilder)=
     | None -> return! Task.CompletedTask
   }
   appRun runApp appBuilder
-

tests/Tests/Tests.fs

@@ -10,12 +10,13 @@
 open FSharpPlus.Data
 
 open Fleece.FSharpData
 open Fleece.FSharpData.Operators
 
 open Microsoft.AspNetCore.Builder
 open Microsoft.AspNetCore.Hosting
 open Microsoft.AspNetCore.Http
 open Microsoft.AspNetCore.TestHost
+open Microsoft.Extensions.DependencyInjection
 
 open Expecto
 
@@ -24,6 +25,10 @@
 open Notes
 
 module ``integration test using test server`` =
+  let tryParseInt (s:string) =
+    match Int32.TryParse s with
+    | true, n -> Some n
+    | _ -> None
   module TestServer=
     let fakeDb() =
       let withUserId userId = (=) userId << fst
@@ -124,3 +129,51 @@
       Expect.equal (parseJson noteJson) (Ok {id=NoteId 1;text="my next text"}) "Expected note json"
     })
   ]
+
+  [<Tests>]
+  let ``session state uses cookie`` =
+    testCase "counter is incremented across requests with same cookie" <| fun _ -> waitFor(task {
+      let sessionWebPart =
+        Filters.path "/session"
+        >=> Filters.statefulForSession
+        >=> (fun ctx ->
+          match FSharpPlus.AspNetCore.Suave.HttpContext.state ctx with
+          | Some store ->
+            let current =
+              store
+              |> FSharpPlus.AspNetCore.Suave.Session.tryGet "counter"
+              |> Option.bind tryParseInt
+              |> Option.defaultValue 0
+            store |> FSharpPlus.AspNetCore.Suave.Session.set "counter" (string (current + 1))
+            Successful.OK (sprintf "Hello %d time(s)" (current + 1)) ctx
+          | None ->
+            Successful.OK "No session available" ctx)
+
+      let builder =
+        WebHostBuilder()
+          .ConfigureServices(fun services ->
+            services.AddDistributedMemoryCache() |> ignore
+            services.AddSession() |> ignore)
+          .Configure(fun app ->
+            app.UseSession() |> ignore
+            Suave.appRun sessionWebPart app |> ignore)
+
+      use testServer = new TestServer(builder)
+      use client = testServer.CreateClient()
+
+      let! first = client.GetAsync("http://localhost/session")
+      let! firstContent = first.Content.ReadAsStringAsync()
+      let cookieHeader =
+        first.Headers.GetValues("Set-Cookie")
+        |> Seq.choose (fun cookie -> cookie.Split(';') |> Array.tryHead)
+        |> String.concat "; "
+
+      let request = new HttpRequestMessage(HttpMethod.Get, "http://localhost/session")
+      request.Headers.Add("Cookie", cookieHeader)
+
+      let! second = client.SendAsync(request)
+      let! secondContent = second.Content.ReadAsStringAsync()
+
+      Expect.equal firstContent "Hello 1 time(s)" "Expected first session response"
+      Expect.equal secondContent "Hello 2 time(s)" "Expected second session response"
+    })