aesiniath · istathar · May 11, 2022 · May 10, 2022 · May 10, 2022 · May 10, 2022
diff --git a/core-webserver-servant/core-webserver-servant.cabal b/core-webserver-servant/core-webserver-servant.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           core-webserver-servant
-version:        0.1.0.0
+version:        0.1.1.0
 synopsis:       Interoperability with Servant
 description:    This is part of a library to help build command-line programs, both tools and
                 longer-running daemons.

diff --git a/core-webserver-servant/lib/Core/Webserver/Servant.hs b/core-webserver-servant/lib/Core/Webserver/Servant.hs
@@ -28,18 +28,27 @@ main = do
 -}
 module Core.Webserver.Servant (
     prepareRoutes,
+    prepareRoutesWithContext,
 ) where
 
 import Control.Monad.Except (ExceptT (..))
 import Core.Program
 import Core.System (Exception (..))
+import Core.Telemetry.Observability (clearMetrics)
 import Core.Webserver.Warp
 import Data.Proxy (Proxy)
 import GHC.Base (Type)
 import Network.Wai (Application)
-import Servant (Handler (..), ServerT)
-import Servant.Server (HasServer, hoistServer, serve)
-import Core.Telemetry.Observability (clearMetrics)
+import qualified Servant as Servant (
+    Handler (..),
+    ServerT,
+ )
+import qualified Servant.Server as Servant (
+    Context (..),
+    HasServer,
+    ServerContext,
+    serveWithContextT,
+ )
 
 data ContextNotFoundInRequest = ContextNotFoundInRequest deriving (Show)
 
@@ -65,11 +74,26 @@ logging and telemetry facilities of __core-program__ and __core-telemetry__.
 -}
 prepareRoutes ::
     forall τ (api :: Type).
-    HasServer api '[] =>
+    Servant.HasServer api '[]
8000
 =>
+    Proxy api ->
+    Servant.ServerT api (Program τ) ->
+    Program τ Application
+prepareRoutes proxy = prepareRoutesWithContext proxy Servant.EmptyContext
+
+{- |
+Prepare routes as with 'prepareRoutes' above, but providing a __servant__
+'Servant.Server.Context' in order to give detailed control of the setup.
+
+@since 0.1.1
+-}
+prepareRoutesWithContext ::
+    forall τ (api :: Type) context.
+    (Servant.HasServer api context, Servant.ServerContext context) =>
     Proxy api ->
-    ServerT api (Program τ) ->
+    Servant.Context context ->
+    Servant.ServerT api (Program τ) ->
    Program τ Application
-prepareRoutes proxy (routes :: ServerT api (Program τ)) =
+prepareRoutesWithContext proxy sContext (routes :: Servant.ServerT api (Program τ)) =
     pure application
   where
     application :: Application
@@ -85,17 +109,19 @@ prepareRoutes proxy (routes :: ServerT api (Program τ)) =
         context <- case contextFromRequest @τ request of
             Just context' -> pure context'
             Nothing -> throw ContextNotFoundInRequest
-        serve
+        Servant.serveWithContextT
             proxy
-            (hoistServer proxy (transformProgram context) routes)
+            sContext
+            (transformProgram context)
+            routes
             request
             sendResponse
 
-    transformProgram :: Context τ -> Program τ α -> Handler α
+    transformProgram :: Context τ -> Program τ α -> Servant.Handler α
     transformProgram context program =
         let output =
                 try $
                     subProgram context $ do
                         clearMetrics
                         program
-         in Handler (ExceptT output)
+         in Servant.Handler (ExceptT output)
diff --git a/core-webserver-servant/package.yaml b/core-webserver-servant/package.yaml
@@ -1,5 +1,5 @@
 name: core-webserver-servant
-version: 0.1.0.0
+version: 0.1.1.0
 synopsis: Interoperability with Servant
 description: |
   This is part of a library to help build command-line programs, both tools and

diff --git a/stack.yaml b/stack.yaml
@@ -8,6 +8,8 @@ packages:
  - ./core-webserver-warp
  - .
 extra-deps:
+ - hashable-1.3.5.0
  - semialign-1.2
+ - servant-0.19
+ - servant-server-0.19.1
  - time-compat-1.9.6.1
- - hashable-1.3.5.0