Removes stringConvert, we now completely rely on giraffe to convert our route segments, which means ShortID and ShortGuid automatically work as they should, also adds quite some tests for (sub) routing

Author: NinoFloris

src/Saturn/Controller.fs

@@ -173,22 +173,22 @@ module Controller =
     member this.Run (state: ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput>) : HttpHandler =
       let siteMap = HandlerMap()
       let addToSiteMap v p = siteMap.AddPath p v
-      let keyFormat, stringConvert =
+      let keyFormat =
         match state with
-        | { Show = None; Edit = None; Update = None; Delete = None; SubControllers = [] } -> None, None
+        | { Show = None; Edit = None; Update = None; Delete = None; SubControllers = [] } -> None
         | _ ->
-          // Parameterizing `string` here so we don't constrain 'Key to SRTP ^Key when we would have used it later on
           match typeof<'Key> with
-          | k when k = typeof<bool> -> "/%b", string<bool> :> obj
-          | k when k = typeof<char> -> "/%c", string<char> :> obj
-          | k when k = typeof<string> -> "/%s", string<string> :> obj
-          | k when k = typeof<int32> -> "/%i", string<int32> :> obj
-          | k when k = typeof<int64> -> "/%d", string<int64> :> obj
-          | k when k = typeof<float> -> "/%f", string<float> :> obj
-          | k when k = typeof<Guid> -> "/%O", string<Guid> :> obj
+          | k when k = typeof<bool> -> "/%b"
+          | k when k = typeof<char> -> "/%c"
+          | k when k = typeof<string> -> "/%s"
+          | k when k = typeof<int32> -> "/%i"
+          | k when k = typeof<int64> -> "/%d"
+          | k when k = typeof<float> -> "/%f"
+          | k when k = typeof<Guid> -> "/%O"
+          | k when k = typeof<uint64> -> "/%u"
           | k -> failwithf
                   "Type %A is not a supported type for controller<'T>. Supported types include bool, char, float, guid int32, int64, and string" k
-          |> fun (keyFormat, stringConvert) -> (Some keyFormat, Some (unbox<'Key -> string> stringConvert))
+          |> Some
 
       let initialController =
         let trailingSlashHandler : HttpHandler =
@@ -261,6 +261,7 @@ module Controller =
             let addToSiteMap = addToSiteMap "DELETE"
 
             if state.DeleteAll.IsSome then
+              addToSiteMap "/"
               yield this.AddHandlerWithRoute state DeleteAll state.DeleteAll.Value trailingSlashHandler
 
             if keyFormat.IsSome then
@@ -285,20 +286,14 @@ module Controller =
       let controllerWithSubs =
         choose [
           if keyFormat.IsSome then
-            let stringConvert = stringConvert.Value
-            for (sPath, sCs) in state.SubControllers do
-              if not (sPath.StartsWith("/")) then
-                failwith (sprintf "Subcontroller route '%s' is not valid, these routes should start with a '/'." sPath)
-
-              let path = keyFormat.Value
-              let dummy = sCs (unbox<'Key> Unchecked.defaultof<'Key>)
-              siteMap.Forward (path + sPath) "" dummy
+            for (subPath, sCs) in state.SubControllers do
+              if not (subPath.StartsWith("/")) then
+                failwith (sprintf "Subcontroller route '%s' is not valid, these routes should start with a '/'." subPath)
 
-              yield routef (PrintfFormat<'Key -> obj,_,_,_,'Key> (path + sPath))
-                      (fun input -> subRoute ("/" + (stringConvert input) + sPath) (sCs (unbox<'Key> input)))
+              let fullPath = keyFormat.Value + subPath
 
-              yield routef (PrintfFormat<'Key -> string -> obj,_,_,_,'Key * string> (path + sPath + "%s"))
-                      (fun (input, _) -> subRoute ("/" + (stringConvert input) + sPath) (sCs (unbox<'Key> input)))
+              siteMap.Forward fullPath "" (sCs (Unchecked.defaultof<'Key>))
+              yield subRoutef (PrintfFormat<'Key -> obj,_,_,_,'Key> fullPath) (unbox<'Key> >> sCs)
 
           yield controllerWithErrorHandler
         ]

tests/Saturn.UnitTests/ControllerTests.fs

@@ -2,32 +2,43 @@ module ControllerTests
 
 open Expecto
 open Saturn
-open Giraffe
 open Giraffe.GiraffeViewEngine
 open FSharp.Control.Tasks.V2.ContextInsensitive
 open Microsoft.Extensions.Primitives
 open Microsoft.AspNetCore.Http
 open System
 
-let createAction =
-    fun ctx ->
-        "Create" |> Controller.text ctx
-
-let updateAction =
-    fun ctx id -> (sprintf "Update %i" id) |> Controller.text ctx
+let createAction id ctx =
+  match id with
+  | Some id -> sprintf "Create %i" id
+  | None -> "Create"
+  |> Controller.text ctx
+
+let updateAction id ctx subId =
+    match id with
+    | Some id -> sprintf "Update %i %i" id subId
+    | None -> sprintf "Update %i" subId
+    |> Controller.text ctx
+
+let testSubController (id: int) = controller {
+  create (createAction (Some id))
+  update (updateAction (Some id))
+}
 
 let testController = controller {
-    create createAction
-    update updateAction
+  subController "/sub" testSubController
+
+  create (createAction None)
+  update (updateAction None)
 }
 
 let basicTemplate =
-    html [] [
-        head [] []
-        body [] [
-            h1 [] [ encodedText "Hello, world!" ]
-        ]
-    ]
+  html [] [
+      head [] []
+      body [] [
+          h1 [] [ encodedText "Hello, world!" ]
+      ]
+  ]
 
 let implicitNodeToHtmlTestController = controller {
     index (fun _ -> task { return basicTemplate })
@@ -38,44 +49,42 @@ let explicitNodeToHtmlTestController = controller {
 }
 
 let implicitStringToHtmlTestController = controller {
-   index (fun _ -> task { return GiraffeViewEngine.renderHtmlNode basicTemplate})
+   index (fun _ -> task { return renderHtmlNode basicTemplate})
 }
 
+let responseTestCase = responseTestCase testController
+
 [<Tests>]
 let tests =
     testList "Controller Tests" [
-        testCase "create works" <|  fun _ ->
-            let ctx = getEmptyContext "POST" ""
-            let expected = "Create"
+        testCase "subController Update works" <|
+          responseTestCase "PUT" "/1/sub/2" "Update 1 2"
 
-            try
-                let result = testController next ctx |> runTask
-                match result with
-                | None -> failtestf "Result was expected to be %s, but was %A" expected result
-                | Some ctx ->
-                    Expect.equal (getBody ctx) expected "Result should be equal"
-            with ex -> failtestf "failed because %A" ex
+        testCase "subController Create trailing slash works" <|
+          responseTestCase "POST" "/1/sub/" "Create 1"
 
-        testCase "update works" <| fun _ ->
-            let ctx = getEmptyContext "PUT" "/1"
-            let expected = "Update 1"
+        testCase "subController Create no trailing slash works" <|
+          responseTestCase "POST" "/1/sub" "Create 1"
 
-            try
-                let result = testController next ctx |> runTask
-                match result with
-                | None -> failtestf "Result was expected to be %s, but was %A" expected result
-                | Some ctx ->
-                    Expect.equal (getBody ctx) expected "Result should be equal"
+        testCase "Create trailing slash works" <|
+          responseTestCase "POST" "/" "Create"
 
-            with ex -> failtestf "failed because %A" ex
+        testCase "Create no trailing slash works" <|
+          responseTestCase "POST" "" "Create"
+
+        testCase "Update POST works" <|
+          responseTestCase "POST" "/1" "Update 1"
+
+        testCase "Update PUT works" <|
+          responseTestCase "PUT" "/1" "Update 1"
 
         testCase "deleteAll works" <| fun _ ->
             let expectedStatusCode = 204
             let expectedString = "deleted"
             let mutable plugged = ""
             let deleteAll = fun (ctx: HttpContext) ->
                 task {
-                    do ctx.SetStatusCode 204
+                    ctx.Response.StatusCode <- 204
                     return (Some ctx)
                 }
             let deleteController = controller {
@@ -98,7 +107,7 @@ let tests =
             let mutable plugged = ""
             let deleteAll = fun (ctx: HttpContext) ->
                 task {
-                    do ctx.SetStatusCode 204
+                    ctx.Response.StatusCode <- 204
                     return (Some ctx)
                 }
             let deleteController = controller {
@@ -118,33 +127,27 @@ let tests =
         testCase "plugs should only fire once" <| fun _ ->
             let deleteAll = fun (ctx: HttpContext) ->
                 task {
-                    do ctx.SetStatusCode 204
+                    ctx.Response.StatusCode <- 204
                     return (Some ctx)
                 }
             let mutable count = 0
             let controllerWithPlugs =
                 controller {
-                    create createAction
-                    update updateAction
+                    create (createAction None)
+                    update (updateAction None)
                     delete_all deleteAll
                     plug [All] (fun next ctx -> count <- count + 1; next ctx)
                 }
             try
                 let postEmpty = getEmptyContext "POST" "" |> controllerWithPlugs next |> runTask
                 Expect.equal count 1 "Count should be 1"
-                match postEmpty with
-                | None -> failtestf "Result was expected to be %s, but was %A" "Create" postEmpty
-                | Some ctx ->
-                    Expect.equal (getBody ctx) "Create" "Result should be equal"
+                expectResponse "Create" postEmpty
                 getEmptyContext "POST" "/" |> controllerWithPlugs next |> runTask |> ignore
                 Expect.equal count 2 "Count should be 2"
                 getEmptyContext "POST" "/1" |> controllerWithPlugs next |> runTask |> ignore
                 Expect.equal count 3 "Count should be 3"
                 let putResult = getEmptyContext "PUT" "/1" |> controllerWithPlugs next |> runTask
-                match putResult with
-                | None -> failtestf "Result was expected to be %s, but was %A" "Create" postEmpty
-                | Some ctx ->
-                    Expect.equal (getBody ctx) "Update 1" "Result should be equal"
+                expectResponse "Update 1" putResult
                 Expect.equal count 4 "Count should be 4"
                 let deleteAllResult = getEmptyContext "DELETE" "" |> controllerWithPlugs next |> runTask
                 match deleteAllResult with

tests/Saturn.UnitTests/Helpers.fs

@@ -8,7 +8,10 @@ open System.IO
 open System.Net.Http
 open System.Text
 open NSubstitute
-
+open System.Collections.Generic
+open Microsoft.AspNetCore.Http.Features
+open Expecto.Tests
+open Expecto
 
 let getEmptyContext (method: string) (path : string) =
   let ctx = Substitute.For<HttpContext>()
@@ -20,6 +23,12 @@ let getEmptyContext (method: string) (path : string) =
   ctx.Request.Path.ReturnsForAnyArgs (PathString(path)) |> ignore
   ctx.Request.QueryString.ReturnsForAnyArgs (QueryString "") |>ignore
 
+  // Essential for Giraffe subrouting work.
+  ctx.Items.ReturnsForAnyArgs(Dictionary<_,_>()) |> ignore
+
+  // For posterity, not needed, yet.
+  ctx.Features.ReturnsForAnyArgs(FeatureCollection()) |> ignore
+
   ctx.Response.Body <- new MemoryStream()
   ctx
 
@@ -47,4 +56,18 @@ let readText (response : HttpResponseMessage) =
 
 let readBytes (response : HttpResponseMessage) =
   response.Content.ReadAsByteArrayAsync()
-  |> runTask
+  |> runTask
+
+let expectResponse expected actual =
+  match actual with
+  | None -> failtestf "Result was expected to be %s, but was %A" expected actual
+  | Some ctx ->
+      Expect.equal (getBody ctx) expected "Result should be equal"
+
+let responseTestCase handler method path expected () =
+  let ctx = getEmptyContext method path
+
+  try
+      let result = handler next ctx |> runTask
+      expectResponse expected result
+  with ex -> failtestf "failed because %A" ex