refactor(server): first step in implementing clean safe architecture, creating more cohesive modules

Author: halcwb

docs/mdr/design-history/agent-architecture.md

@@ -310,15 +310,11 @@ Each command sent to an agent is a discrete, serialisable event. Enabling an aud
 ```fsharp
 let auditedAgent innerAgent =
     Agent.createReply<Command, Response>(fun cmd ->
-        // Wrap in try/with: if postAndReply throws (e.g. timeout), we still reply
-        // so the caller is never left blocked on an unanswered reply channel.
+        // Wrap in try/with so the caller is never left blocked
+        // on an unanswered reply channel if the inner agent fails.
         try
             writeInfoMessage $"[AUDIT] {cmd |> Command.toString}"
             let response = innerAgent |> Agent.postAndReply cmd
-        // Wrap in try/with: if postAndReply throws (e.g. timeout), we still reply
-        // so the caller is never left blocked on an unanswered reply channel.
-        try
-            let response = innerAgent |> Agent.postAndReply cmd
             writeInfoMessage $"[AUDIT] response received"
             response
         with ex ->

src/Informedica.Agents.Lib/Agent.fs

@@ -286,7 +286,7 @@ module Agent =
     let postAndReply msg (agent: Agent<_>) =
         if agent.DefaultTimeout = Timeout.Infinite then
             agent
-            |> tryPostAndReply 1000 msg
+            |> tryPostAndReply 30_000 msg
             |> function
                 | Some v -> v
                 | None -> failwith "Timed out waiting for reply"

src/Informedica.Agents.Lib/Scripts/AgentFixes.fsx

@@ -0,0 +1,134 @@
+/// Phase 0: Fix Agent.fs timeout bug (Greptile finding from PR #177)
+///
+/// Problem: Agent.postAndReply falls back to tryPostAndReply with a
+/// hardcoded 1-second timeout when DefaultTimeout = Timeout.Infinite.
+/// This causes slow operations (resource loading, constraint solving)
+/// to fail with "Timed out waiting for reply".
+///
+/// Fix: Increase the fallback timeout to 30 seconds (30_000 ms).
+/// The postAndReply function already has a fast-path when DefaultTimeout
+/// is set to a specific value, so this only affects agents that haven't
+/// configured a timeout (i.e. left at Infinite).
+
+#I __SOURCE_DIRECTORY__
+
+#load "load.fsx"
+
+open System.Threading
+open Informedica.Agents.Lib
+
+
+// ============================================================
+// 1. Demonstrate the bug: 1-second timeout is too short
+// ============================================================
+
+// Create an agent that takes 2 seconds to reply (simulating slow work)
+let slowAgent =
+    Agent.createReply<string, string>(fun msg ->
+        Thread.Sleep(2000) // simulate slow operation
+        $"processed: {msg}"
+    )
+
+// This will fail with the current 1-second timeout because
+// DefaultTimeout is Timeout.Infinite by default
+printfn $"DefaultTimeout = {slowAgent |> Agent.getDefaultTimeout}"
+printfn $"Timeout.Infinite = {Timeout.Infinite}"
+
+let result1 =
+    try
+        slowAgent
+        |> Agent.postAndReply "slow-request"
+        |> Some
+    with ex ->
+        printfn $"BUG: {ex.Message}"
+        None
+
+printfn $"Result with 1s timeout (should fail): {result1}"
+
+
+// ============================================================
+// 2. Workaround: set DefaultTimeout explicitly
+// ============================================================
+
+slowAgent |> Agent.setDefaultTimeout 30_000
+
+let result2 =
+    try
+        slowAgent
+        |> Agent.postAndReply "slow-request-with-timeout"
+        |> Some
+    with ex ->
+        printfn $"Error: {ex.Message}"
+        None
+
+printfn $"Result with 30s timeout (should succeed): {result2}"
+
+slowAgent |> Agent.dispose
+
+
+// ============================================================
+// 3. Test the fix: after patching Agent.fs line 289
+//    Change: tryPostAndReply 1000 → tryPostAndReply 30_000
+// ============================================================
+
+// After the fix, this should work without setting DefaultTimeout:
+let slowAgent2 =
+    Agent.createReply<string, string>(fun msg ->
+        Thread.Sleep(2000)
+        $"processed: {msg}"
+    )
+
+let result3 =
+    try
+        slowAgent2
+        |> Agent.postAndReply "test-after-fix"
+        |> Some
+    with ex ->
+        printfn $"Still failing after fix: {ex.Message}"
+        None
+
+printfn $"Result after fix (should succeed): {result3}"
+
+slowAgent2 |> Agent.dispose
+
+
+// ============================================================
+// 4. Verify fast agents still work fine
+// ============================================================
+
+let fastAgent =
+    Agent.createReply<int, int>(fun n -> n * 2)
+
+let result4 = fastAgent |> Agent.postAndReply 21
+printfn $"Fast agent result (should be 42): {result4}"
+
+fastAgent |> Agent.dispose
+
+
+// ============================================================
+// 5. Test stateful agent with slow init
+// ============================================================
+
+let statefulAgent =
+    Agent.createStatefulReply<string, string, int>(
+        0,
+        fun state msg ->
+            Thread.Sleep(1500) // simulate moderate work
+            let newState = state + 1
+            $"call #{newState}: {msg}", newState
+    )
+
+let result5 =
+    try
+        statefulAgent
+        |> Agent.postAndReply "stateful-test"
+        |> Some
+    with ex ->
+        printfn $"Stateful agent failed: {ex.Message}"
+        None
+
+printfn $"Stateful agent result (should succeed after fix): {result5}"
+
+statefulAgent |> Agent.dispose
+
+printfn "\nAll tests complete."

src/Informedica.GenPRES.Server/Informedica.GenPRES.Server.fsproj

@@ -8,7 +8,10 @@
   </PropertyGroup>
   <ItemGroup>
     <Compile Include="Logging.fs" />
-    <Compile Include="ServerApi.fs" />    
+    <Compile Include="ServerApi.Mappers.fs" />
+    <Compile Include="ServerApi.Services.fs" />
+    <Compile Include="ServerApi.Command.fs" />
+    <Compile Include="ServerApi.ApiImpl.fs" />
     <Compile Include="Server.fs" />
     <None Include="Scripts\load.fsx" />
     <None Include="Scripts\Scripts.fsx" />

src/Informedica.GenPRES.Server/Scripts/load.fsx

@@ -17,7 +17,10 @@
 // These can be loaded all at once.
 
 #load "../Logging.fs"
-#load "../ServerApi.fs"
+#load "../ServerApi.Mappers.fs"
+#load "../ServerApi.Services.fs"
+#load "../ServerApi.Command.fs"
+#load "../ServerApi.ApiImpl.fs"
 
 fsi.AddPrinter<System.DateTime> _.ToShortDateString()
 

src/Informedica.GenPRES.Server/ServerApi.ApiImpl.fs

@@ -0,0 +1,33 @@
+namespace ServerApi
+
+
+[<AutoOpen>]
+module ApiImpl =
+
+    open Informedica.Utils.Lib.ConsoleWriter.NewLineNoTime
+    open Shared.Api
+
+
+    /// An implementation of the Shared IServerApi protocol.
+    let createServerApi provider : IServerApi =
+        {
+            processCommand =
+                fun cmd ->
+                    async {
+                        try
+                            writeInfoMessage $"Processing command: {cmd |> Command.toString}"
+                            let! result = Command.processCmd provider cmd
+                            writeInfoMessage $"Finished processing command: {cmd |> Command.toString}"
+                            return result
+                        with
+                        | ex ->
+                            writeErrorMessage $"Error processing command: {cmd |> Command.toString}\n{ex.Message}"
+                            return Error [| ex.Message |]
+                    }
+
+            testApi =
+                fun () ->
+                    async {
+                        return "Hello world!"
+                    }
+        }

src/Informedica.GenPRES.Server/ServerApi.Command.fs

@@ -0,0 +1,124 @@
+namespace ServerApi
+
+
+module Command =
+
+    open Shared.Api
+    open Informedica.GenForm.Lib
+
+    /// Check if resources are loaded. Returns Error with messages if not.
+    let requireLoaded (provider: Resources.IResourceProvider) =
+        let info = provider.GetResourceInfo()
+        if info.IsLoaded then None
+        else
+            info.Messages
+            |> Array.map (sprintf "%A")
+            |> Error
+            |> Some
+
+
+    let processCmd provider cmd =
+        let agent, logger =
+            match Logging.loggingLevel with
+            | None -> None, Informedica.GenOrder.Lib.OrderLogging.noOp
+            | Some level ->
+                let agent =
+                    Logging.getLogger level Logging.OrderLogger
+                (Some agent, agent.Logger)
+
+        match requireLoaded provider with
+        | Some err -> async { return err }
+        | None ->
+
+        match cmd with
+        | OrderContextCmd (ctxCmd, ctx) ->
+            async {
+                if agent.IsSome then
+                    do! agent.Value |> Logging.setComponentName (Some "OrderContext")
+
+                return
+                    ctx
+                    |> OrderContext.evaluate logger provider ctxCmd
+                    |> Result.map (OrderContextResult >> OrderContextResp)
+            }
+
+        | OrderPlanCmd (UpdateOrderPlan (tp, cmdOpt)) ->
+            async {
+                if agent.IsSome then
+                    do! agent.Value |> Logging.setComponentName (Some "TreatmentPlan")
+                return
+                    OrderPlan.updateOrderPlan logger provider tp cmdOpt
+                    |> OrderPlan.calculateTotals
+                    |> OrderPlanUpdated
+                    |> OrderPlanResp
+                    |> Ok
+            }
+
+        | OrderPlanCmd (FilterOrderPlan tp) ->
+            async {
+                return
+                    tp
+                    |> OrderPlan.calculateTotals
+                    |> OrderPlanFiltered
+                    |> OrderPlanResp
+                    |> Ok
+            }
+
+        | FormularyCmd form ->
+            async {
+                return
+                    form
+                    |> Formulary.get provider
+                    |> Result.map FormularyResp
+            }
+
+        | ParenteraliaCmd par ->
+            async {
+                return
+                    par
+                    |> Parenteralia.get provider
+                    |> Result.mapError Array.singleton
+                    |> Result.map ParenteraliaResp
+            }
+
+        | NutritionPlanCmd (InitNutritionPlan patient) ->
+            async {
+                return
+                    NutritionPlan.initNutritionPlan logger provider patient
+                    |> Result.map (NutritionPlanInitialised >> NutritionPlanResp)
+            }
+
+        | NutritionPlanCmd (UpdateNutritionOrderContext (plan, label, ctx)) ->
+            async {
+                return
+                    NutritionPlan.updateNutritionOrderContext logger provider (plan, label, ctx)
+                    |> Result.map (NutritionPlanUpdated >> NutritionPlanResp)
+            }
+
+        | NutritionPlanCmd (SelectNutritionOrderScenario (plan, label, ctx)) ->
+            async {
+                return
+                    NutritionPlan.selectNutritionOrderScenario logger provider (plan, label, ctx)
+                    |> Result.map (NutritionPlanUpdated >> NutritionPlanResp)
+            }
+
+        | NutritionPlanCmd (NavigateNutritionOrderContext (plan, label, ctxCmd, ctx)) ->
+            async {
+                return
+                    NutritionPlan.navigateNutritionOrderContext logger provider (plan, label, ctxCmd, ctx)
+                    |> Result.map (NutritionPlanUpdated >> NutritionPlanResp)
+            }
+
+        | NutritionPlanCmd (AddNutritionContext (plan, category)) ->
+            async {
+                return
+                    NutritionPlan.addNutritionContext logger provider (plan, category)
+                    |> Result.map (NutritionPlanUpdated >> NutritionPlanResp)
+            }
+
+        | NutritionPlanCmd (RemoveNutritionContext (plan, id)) ->
+            async {
+                return
+                    NutritionPlan.removeNutritionContext (plan, id)
+                    |> Result.map (NutritionPlanUpdated >> NutritionPlanResp)
+            }