Add Location header to POST response even if resource link is skipped

src/Felicity/Operations.fs

@@ -604,17 +604,11 @@ type PostOperation<'originalCtx, 'ctx, 'entity> = internal {
 
                                                 return! handler next httpCtx
                                             else
-                                                let! doc = resp.Write httpCtx ctx req (rDef, entity1)
+                                                let! doc, selfUrlOpt = resp.Write httpCtx ctx req (rDef, entity1)
 
                                                 let setLocationHeader =
-                                                    match doc with
-                                                    | {
-                                                          data = Some { links = Include links }
-                                                      } ->
-                                                        match links.TryGetValue "self" with
-                                                        | true, { href = Some url } ->
-                                                            setHttpHeader "Location" (url.ToString())
-                                                        | _ -> fun next ctx -> next ctx
+                                                    match selfUrlOpt with
+                                                    | Some url -> setHttpHeader "Location" (url.ToString())
                                                     | _ -> fun next ctx -> next ctx
 
                                                 let! fieldTrackerHandler =
@@ -832,16 +826,11 @@ type PostCustomHelper<'ctx, 'entity>
     member this.ReturnCreatedEntity(entity: 'entity) : HttpHandler =
         fun next httpCtx ->
             task {
-                let! doc = builder.Write httpCtx ctx req (rDef, entity)
+                let! doc, selfUrlOpt = builder.Write httpCtx ctx req (rDef, entity)
 
                 let setLocationHeader =
-                    match doc with
-                    | {
-                          data = Some { links = Include links }
-                      } ->
-                        match links.TryGetValue "self" with
-                        | true, { href = Some url } -> setHttpHeader "Location" (url.ToString())
-                        | _ -> fun next ctx -> next ctx
+                    match selfUrlOpt with
+                    | Some url -> setHttpHeader "Location" (url.ToString())
                     | _ -> fun next ctx -> next ctx
 
                 let! fieldTrackerHandler =

src/Felicity/Relationships.fs

@@ -34,7 +34,7 @@ module private RelationshipHelpers =
         }
 
         resp.Write httpCtx ctx reqForIncluded (parentResDef, parentEntity)
-        |> Task.map (fun doc -> doc.included)
+        |> Task.map (fun (doc, _) -> doc.included)
 
 
 

src/Felicity/ResourceBuilder.fs

@@ -10,6 +10,14 @@ let private emptyMetaDictNeverModify = Dictionary(0)
 let emptyLinkArrayNeverModify = [||]
 
 
+let getSelfUrlOpt<'ctx> resourceModule baseUrl (resDef: ResourceDefinition<'ctx>) resId =
+    if ResourceModule.hasGetResourceOperation<'ctx> resourceModule then
+        resDef.CollectionName
+        |> Option.map (fun collName -> baseUrl + "/" + collName + "/" + resId)
+    else
+        None
+
+
 type ResourceBuilder<'ctx>
     (
         resourceModuleMap: Map<ResourceTypeName, Type>,
@@ -51,11 +59,7 @@ type ResourceBuilder<'ctx>
                 $"Framework bug: Attempted to build resource '%s{resourceDef.TypeName}', but no resource module was found"
 
     let selfUrlOpt =
-        if ResourceModule.hasGetResourceOperation<'ctx> resourceModule then
-            resourceDef.CollectionName
-            |> Option.map (fun collName -> baseUrl + "/" + collName + "/" + identifier.id)
-        else
-            None
+        getSelfUrlOpt<'ctx> resourceModule baseUrl resourceDef identifier.id
 
     let constrainedFields = ResourceModule.constrainedFields<'ctx> resourceModule
 

src/Felicity/ResponseBuilder.fs

@@ -4,7 +4,8 @@ open System.Threading.Tasks
 open Microsoft.AspNetCore.Http
 
 type internal ResponseBuilder<'ctx> =
-    abstract Write: HttpContext -> 'ctx -> Request -> (ResourceDefinition<'ctx> * 'entity) -> Task<ResourceDocument>
+    abstract Write:
+        HttpContext -> 'ctx -> Request -> (ResourceDefinition<'ctx> * 'entity) -> Task<ResourceDocument * string option>
 
     abstract WriteList:
         HttpContext -> 'ctx -> Request -> (ResourceDefinition<'ctx> * 'entity) list -> Task<ResourceCollectionDocument>

src/Felicity/RoutingOperations.fs

@@ -114,20 +114,26 @@ module internal RoutingOperations =
                         )
                         |> ResourceBuilder.buildOne (httpCtx.GetService<ILoggerFactory>())
 
-                    return {
-                        ResourceDocument.jsonapi = Skip // support later when valid use-cases arrive
-                        links = Skip // support later when valid use-cases arrive; remember to check LinkConfig
-                        meta =
-                            httpCtx.GetService<MetaGetter<'ctx>>().GetMeta ctx
-                            |> Include
-                            |> Skippable.filter (fun x -> x.Count > 0)
-                        data = Some main
-                        included =
-                            if req.Query.ContainsKey "include" then
-                                Include included
-                            else
-                                Skip
-                    }
+                    return
+                        {
+                            ResourceDocument.jsonapi = Skip // support later when valid use-cases arrive
+                            links = Skip // support later when valid use-cases arrive; remember to check LinkConfig
+                            meta =
+                                httpCtx.GetService<MetaGetter<'ctx>>().GetMeta ctx
+                                |> Include
+                                |> Skippable.filter (fun x -> x.Count > 0)
+                            data = Some main
+                            included =
+                                if req.Query.ContainsKey "include" then
+                                    Include included
+                                else
+                                    Skip
+                        },
+                        ResourceBuilder.getSelfUrlOpt<'ctx>
+                            resourceModuleMap[resourceDef.TypeName]
+                            baseUrl
+                            resourceDef
+                            (resourceDef.GetIdBoxed e)
                 }
 
             member _.WriteList httpCtx ctx req rDefsEntities =