core-webserver-servant (empty) → 0.1.0.0

raw patch · 3 files changed

+171/−0 lines, 3 filesdep +basedep +core-programdep +core-telemetry

Dependencies added: base, core-program, core-telemetry, core-webserver-warp, mtl, safe-exceptions, servant, servant-server, vault, wai

Files

• LICENSE +19/−0
• core-webserver-servant.cabal +50/−0
• lib/Core/Webserver/Servant.hs +102/−0

@@ -0,0 +1,19 @@+Copyright © 2018-2021 Athae Eredh Siniath and Others++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER+DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,50 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           core-webserver-servant+version:        0.1.0.0+synopsis:       Interoperability with Servant+description:    This is part of a library to help build command-line programs, both tools and+                longer-running daemons.+                .+                This package in particular adds wrappers around the __servant__ library+                commonly used for exposing web services APIs and allows your handlers to+                be written in the Program monad from __core-program__.+category:       System+stability:      experimental+homepage:       https://github.com/aesiniath/unbeliever#readme+bug-reports:    https://github.com/aesiniath/unbeliever/issues+author:         Carlos D'Agostino <carlos.dagostino@gmail.com>+maintainer:     Andrew Cowie <istathar@gmail.com>+copyright:      © 2021-2022 Athae Eredh Siniath and Others+license:        MIT+license-file:   LICENSE+build-type:     Simple+tested-with:+    GHC == 8.10.7++source-repository head+  type: git+  location: https://github.com/aesiniath/unbeliever++library+  exposed-modules:+      Core.Webserver.Servant+  hs-source-dirs:+      lib+  ghc-options: -Wall -Wwarn -fwarn-tabs+  build-depends:+      base >=4.11 && <5+    , core-program+    , core-telemetry+    , core-webserver-warp+    , mtl+    , safe-exceptions+    , servant+    , servant-server+    , vault+    , wai+  default-language: Haskell2010

@@ -0,0 +1,102 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Support integrating web services created by __servant__ with handlers defined+in the 'Program' monad. This is a thin wrapper which creates an 'Application'+which can be used with 'Core.Webserver.Warp.launchWebserver'.++@+import "Core.Program"+import "Core.Webserver.Servant"+import "Core.Webserver.Warp"++import MyServer (api, routes)++main :: 'IO' ()+main = do+    'Core.Program.Execute.execute' $ do+        application <- 'prepareRoutes' api routes+        'launchWebserver' 8080 application+@+-}+module Core.Webserver.Servant (+    prepareRoutes,+) where++import Control.Exception.Safe (try)+import Control.Monad.Except (ExceptT (..))+import Core.Program+import Core.System (Exception (..), throw)+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)++data ContextNotFoundInRequest = ContextNotFoundInRequest deriving (Show)++instance Exception ContextNotFoundInRequest where+    displayException _ = "Context was not found in request. This is a serious error."++{- |+Convert a __servant__ API and set of handlers into a __warp__ 'Application'.++This 'Application' must be used with 'Core.Webserver.Warp.launchWebserver' so+that the necessary internal connections are made.++Usage is straight forward:++@+        application <- 'prepareRoutes' api routes+        'launchWebserver' 8080 application+@++This code creates an Application which has sufficient information to unlift+back to the 'Program' monad so that your handlers can be take advantage of the+logging and telemetry facilities of __core-program__ and __core-telemetry__.+-}+prepareRoutes ::+    forall τ (api :: Type).+    HasServer api '[] =>+    Proxy api ->+    ServerT api (Program τ) ->+    Program τ Application+prepareRoutes proxy (routes :: ServerT api (Program τ)) =+    pure application+  where+    application :: Application+    application = \request sendResponse -> do+        -- The type application in `contextFromRequest` is important, as+        -- otherwise the compiler cannot infer that the type of+        -- `transformProgram` is of the same `τ` as the one in `Program τ`++        -- This exception will happen in the case where this is not being run+        -- by `launchWebserver`, since we need the Context to be stashed in+        -- the request by the Middleware there.++        context <- case contextFromRequest @τ request of+            Just context' -> pure context'+            Nothing -> throw ContextNotFoundInRequest+        serve+            proxy+            (hoistServer proxy (transformProgram context) routes)+            request+            sendResponse++    transformProgram :: Context τ -> Program τ α -> Handler α+    transformProgram context program =+        let output =+                try $+                    subProgram context $ do+                        clearMetrics+                        program+         in Handler (ExceptT output)