feat(apis): integrate servant

messages/uniworx/de-de-formal.msg

@@ -923,7 +923,7 @@ CommCourseSubject: Kursmitteilung
 MailSubjectLecturerInvitation tid@TermId ssh@SchoolId csh@CourseShorthand: [#{tid}-#{ssh}-#{csh}] Einladung zum Kursverwalter
 InvitationAcceptDecline: Einladung annehmen/ablehnen
 InvitationFromTip displayName@Text: Sie erhalten diese Einladung, weil #{displayName} ihren Versand in Uni2work ausgelöst hat.
-InvitationUniWorXTip: Uni2work ist ein webbasiertes Lehrverwaltungssystem der LMU München.
+InvitationUniWorXTip: Uni2work ist ein Lehrverwaltungssystem, welches an der Ludwig-Maximilians-Universität München entwickelt und eingesetzt wird.
 
 MailSubjectParticipantInvitation tid@TermId ssh@SchoolId csh@CourseShorthand: [#{tid}-#{ssh}-#{csh}] Einladung zur Kursteilnahme
 
@@ -1293,6 +1293,8 @@ BreadcrumbAllocationUsers: Bewerber
 BreadcrumbAllocationPriorities: Zentrale Dringlichkeiten
 BreadcrumbAllocationCompute: Platzvergabe berechnen
 BreadcrumbAllocationAccept: Platzvergabe akzeptieren
+BreadcrumbExternalApis: Externe APIs
+BreadcrumbSwagger: API Dokumentation
 
 ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
 ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}

messages/uniworx/en-eu.msg

@@ -923,7 +923,7 @@ CommCourseSubject: Course message
 MailSubjectLecturerInvitation tid ssh csh: [#{tid}-#{ssh}-#{csh}] Invitation to be a course administrator
 InvitationAcceptDecline: Accept/Decline invitation
 InvitationFromTip displayName: You are receiving this invitation because #{displayName} has caused it to be sent from within Uni2work.
-InvitationUniWorXTip: Uni2work is a web based teaching management system at LMU Munich.
+InvitationUniWorXTip: Uni2work is a teaching management system, developed and deployed at Ludwig-Maximilians-Universität München.
 
 MailSubjectParticipantInvitation tid ssh csh: [#{tid}-#{ssh}-#{csh}] Invitation to be a course participant
 
@@ -1292,6 +1292,8 @@ BreadcrumbAllocationUsers: Applicants
 BreadcrumbAllocationPriorities: Central priorities
 BreadcrumbAllocationCompute: Compute allocation
 BreadcrumbAllocationAccept: Accept allocation
+BreadcrumbExternalApis: External APIs
+BreadcrumbSwagger: API documentation
 
 ExternalExamEdit coursen examn: Edit: #{coursen}, #{examn}
 ExternalExamGrades coursen examn: Exam achievements: #{coursen}, #{examn}

package.yaml

@@ -142,6 +142,12 @@ dependencies:
   - extended-reals
   - rfc5051
   - pandoc
+  - servant
+  - servant-server
+  - servant-swagger
+  - swagger2
+  - haskell-src-meta
+  - network-uri
 
 other-extensions:
   - GeneralizedNewtypeDeriving

routes

@@ -67,6 +67,8 @@
 
 /help                         HelpR            GET POST        !free
 
+/external-apis ExternalApisR ServantApiExternalApis getServantApiExternalApis
+
 /user                      ProfileR            GET POST        !free
 /user/profile              ProfileDataR        GET             !free
 /user/authpreds            AuthPredsR          GET POST        !free
@@ -227,4 +229,6 @@
 !/#UUID CryptoUUIDDispatchR GET                               !free -- just redirect
 -- !/*{CI FilePath} CryptoFileNameDispatchR GET                  !free -- Disabled until preliminary check for valid cID exists
 
+/swagger.json  SwaggerR              GET      !free
+
 !/*WellKnownFileName WellKnownR GET !free

src/Application.hs

@@ -117,6 +117,9 @@ import Handler.Metrics
 import Handler.ExternalExam
 import Handler.Participants
 import Handler.StorageKey
+import Handler.Swagger
+
+import ServantApi
 
 
 -- This line actually creates our YesodDispatch instance. It is the second half

src/Foundation.hs

@@ -1280,30 +1280,13 @@ authTagSpecificity = comparing $ NTop . flip findIndex eqClasses . elem
       , [ AuthOwner, AuthRated ] -- Submission wide
       ]
 
-defaultAuthDNF :: AuthDNF
-defaultAuthDNF = PredDNF $ Set.fromList
-  [ impureNonNull . Set.singleton $ PLVariable AuthAdmin
-  , impureNonNull . Set.singleton $ PLVariable AuthToken
-  ]
-
 routeAuthTags :: Route UniWorX -> Either InvalidAuthTag AuthDNF
 -- ^ DNF up to entailment:
 --
 -- > (A_1 && A_2 && ...) OR' B OR' ...
 --
 -- > A OR' B := ((A |- B) ==> A) && (A || B)
-routeAuthTags = fmap (PredDNF . Set.mapMonotonic impureNonNull) . ofoldM partition' (Set.mapMonotonic toNullable $ dnfTerms defaultAuthDNF) . routeAttrs
-  where
-    partition' :: Set (Set AuthLiteral) -> Text -> Either InvalidAuthTag (Set (Set AuthLiteral))
-    partition' prev t
-      | Just (Set.fromList . toNullable -> authTags) <- fromNullable =<< mapM fromPathPiece (Text.splitOn "AND" t)
-        = if
-           | oany (authTags `Set.isSubsetOf`) prev
-             -> Right prev
-           | otherwise
-             -> Right . Set.insert authTags $ Set.filter (not . (`Set.isSubsetOf` authTags)) prev
-      | otherwise
-        = Left $ InvalidAuthTag t
+routeAuthTags = left InvalidAuthTag . parsePredDNF defaultAuthDNF . Set.toList . routeAttrs
 
 evalAuthTags :: forall m. MonadAP m => AuthTagActive -> AuthDNF -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> WriterT (Set AuthTag) m AuthResult
 -- ^ `tell`s disabled predicates, identified as pivots
@@ -2231,6 +2214,9 @@ instance YesodBreadcrumbs UniWorX where
     EEUsersR -> i18nCrumb MsgBreadcrumbExternalExamUsers . Just $ EExamR tid ssh coursen examn EEShowR
     EEGradesR -> i18nCrumb MsgBreadcrumbExternalExamGrades . Just $ EExamR tid ssh coursen examn EEShowR 
     EEStaffInviteR -> i18nCrumb MsgBreadcrumbExternalExamStaffInvite . Just $ EExamR tid ssh coursen examn EEShowR 
+
+  breadcrumb (ExternalApisR _) = i18nCrumb MsgBreadcrumbExternalApis Nothing
+  breadcrumb SwaggerR = i18nCrumb MsgBreadcrumbSwagger Nothing
   
   -- breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
 

src/Foundation/Routes.hs

@@ -11,6 +11,8 @@ import Foundation.Type
 
 import Foundation.Routes.Definitions
 
+import ServantApi
+
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
 -- http://www.yesodweb.com/book/routing-and-handlers
@@ -43,6 +45,7 @@ deriving instance Generic (Route UniWorX)
 data RouteChildren
 type instance Children RouteChildren a = ChildrenRouteChildren a
 type family ChildrenRouteChildren a where
+  ChildrenRouteChildren (Route ServantApiExternalApis) = '[]
   ChildrenRouteChildren (Route EmbeddedStatic) = '[]
   ChildrenRouteChildren (Route Auth) = '[]
   ChildrenRouteChildren UUID = '[]

src/Handler/Swagger.hs

@@ -0,0 +1,67 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Handler.Swagger
+  ( getSwaggerR
+  ) where
+
+import Import hiding (host)
+import ServantApi
+
+import Data.Swagger
+import Servant.Swagger
+  
+import qualified Data.Aeson.Encode.Pretty as Aeson
+import qualified Data.Text.Lazy.Builder as Builder
+
+import Development.GitRev
+
+import Network.URI
+
+import Text.Read (readMaybe)
+
+
+
+instance ToContent Swagger where
+  toContent = toContent . Builder.toLazyText . Aeson.encodePrettyToTextBuilder
+
+instance ToTypedContent Swagger where
+  toTypedContent = TypedContent <$> getContentType . (return @Proxy) <*> toContent
+
+instance HasContentType Swagger where
+  getContentType _ = typeJson
+
+  
+getSwaggerR :: Handler Swagger
+getSwaggerR = do
+  app <- getYesod
+  let docMR = renderMessage app . otoList $ selectLanguages appLanguages ["en"]
+  root <- getApprootText approot app <$> waiRequest
+  let applyApproot = do
+        URI{..} <- fmap rectify . parseURIReference $ unpack root
+        let mbScheme = do
+              str <- assertM (not . null) $ stripSuffix ":" uriScheme
+              case str of
+                "https" -> return Https
+                "http"  -> return Http
+                _other  -> mzero
+            applyAuthority = do
+              URIAuth{..} <- uriAuthority
+              let mbPort = readMaybe . fromMaybe "" $ stripPrefix ":" uriPort
+              return $
+                host ?~ Host uriRegName mbPort
+        return $ \x -> x
+          & fromMaybe id applyAuthority
+          & schemes .~ fmap pure mbScheme
+          & basePath ?~ bool id (ensurePrefix "/") (is _Just mbScheme || is _Just uriAuthority) uriPath
+        
+
+  tos <- toTextUrl $ LegalR :#: ("terms-of-use" :: Text)
+  c <- toTextUrl HelpR
+  
+  return $ toSwagger uniworxApi
+    & info.title .~ docMR MsgLogo
+    & info.description ?~ docMR MsgInvitationUniWorXTip
+    & info.termsOfService ?~ tos
+    & info.contact ?~ Contact Nothing (Just $ URL c) Nothing
+    & info.version .~ $gitDescribe
+    & fromMaybe id applyApproot

src/Handler/Term.hs

@@ -197,14 +197,14 @@ data TermFormTemplate = TermFormTemplate
 
 -- | TermFormTemplates form a pointwise-left biased Semigroup
 instance Semigroup TermFormTemplate where
-  left <> right = TermFormTemplate
-    { tftName         = tftName         left <|> tftName         right
-    , tftStart        = tftStart        left <|> tftStart        right
-    , tftEnd          = tftEnd          left <|> tftEnd          right
-    , tftHolidays     = tftHolidays     left <|> tftHolidays     right
-    , tftLectureStart = tftLectureStart left <|> tftLectureStart right
-    , tftLectureEnd   = tftLectureEnd   left <|> tftLectureEnd   right
-    , tftActive       = tftActive       left <|> tftActive       right
+  l <> r = TermFormTemplate
+    { tftName         = tftName         l <|> tftName         r
+    , tftStart        = tftStart        l <|> tftStart        r
+    , tftEnd          = tftEnd          l <|> tftEnd          r
+    , tftHolidays     = tftHolidays     l <|> tftHolidays     r
+    , tftLectureStart = tftLectureStart l <|> tftLectureStart r
+    , tftLectureEnd   = tftLectureEnd   l <|> tftLectureEnd   r
+    , tftActive       = tftActive       l <|> tftActive       r
     }
 
 instance Monoid TermFormTemplate where

src/Import/NoModel.hs

@@ -27,6 +27,8 @@ import Model.Types.TH.Wordlist as Import
 
 import Mail                   as Import
 
+import ServantApi.Definition  as Import
+
 import Yesod.Auth             as Import
 import Yesod.Core.Types       as Import (loggerSet)
 import Yesod.Default.Config2  as Import
@@ -165,7 +167,7 @@ import Control.Lens as Import
 import Control.Lens.Extras as Import (is)
 import Data.Set.Lens as Import
 
-import Control.Arrow as Import (Kleisli(..))
+import Control.Arrow as Import (left, right, Kleisli(..))
 
 import Data.Encoding as Import (DynEncoding, decodeLazyByteString, encodeLazyByteString)
 import Data.Encoding.UTF8 as Import (UTF8(UTF8))

src/Import/Servant.hs

@@ -0,0 +1,18 @@
+module Import.Servant
+  ( module Import
+  ) where
+
+import Import.NoFoundation as Import hiding
+  ( Context
+  , Authorized, Unauthorized
+  , ServerError
+  , Header
+  , Strict
+  , Headers
+  , addHeader
+  )
+
+import Foundation.Type as Import
+
+import Servant.API as Import
+import Servant.Server as Import

src/Model/Types/Security.hs

@@ -9,7 +9,19 @@ module Model.Types.Security
   ( module Model.Types.Security
   ) where
 
-import Import.NoModel
+import ClassyPrelude
+
+import Data.Aeson
+import Data.Aeson.TH
+import Utils.PathPiece
+import Model.Types.TH.JSON
+import Data.Universe
+import Data.Universe.Instances.Reverse ()
+import Data.Default
+import Web.PathPieces
+import Data.Proxy
+
+import qualified Data.Set as Set
 
 import qualified Data.Text as Text
 
@@ -17,9 +29,14 @@ import qualified Data.HashMap.Strict as HashMap
 
 import qualified Data.Aeson.Types as Aeson
 
+import Data.Binary (Binary)
 import qualified Data.Binary as Binary
 
+import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
+import Data.CaseInsensitive.Instances ()
+
+import Data.NonNull.Instances ()
 
 import Model.Types.TH.PathPiece
 import Database.Persist.Sql
@@ -138,6 +155,21 @@ newtype PredDNF a = PredDNF { dnfTerms :: Set (NonNull (Set (PredLiteral a))) }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
   deriving newtype (Semigroup, Monoid)
 
+parsePredDNF :: forall a. (Ord a, PathPiece a) => PredDNF a -> [Text] -> Either Text (PredDNF a)
+parsePredDNF start = fmap (PredDNF . Set.mapMonotonic impureNonNull) . ofoldM partition' (Set.mapMonotonic toNullable $ dnfTerms start)
+  where
+    partition' :: Set (Set (PredLiteral a)) -> Text -> Either Text (Set (Set (PredLiteral a)))
+    partition' prev t
+      | Just (Set.fromList . toNullable -> authTags) <- fromNullable =<< mapM fromPathPiece (Text.splitOn "AND" t)
+        = if
+           | oany (authTags `Set.isSubsetOf`) prev
+             -> Right prev
+           | otherwise
+             -> Right . Set.insert authTags $ Set.filter (not . (`Set.isSubsetOf` authTags)) prev
+      | otherwise
+        = Left t
+
+
 $(return [])
 
 instance ToJSON a => ToJSON (PredDNF a) where
@@ -153,6 +185,13 @@ type AuthLiteral = PredLiteral AuthTag
 
 type AuthDNF = PredDNF AuthTag
 
+defaultAuthDNF :: AuthDNF
+defaultAuthDNF = PredDNF $ Set.fromList
+  [ impureNonNull . Set.singleton $ PLVariable AuthAdmin
+  , impureNonNull . Set.singleton $ PLVariable AuthToken
+  ]
+
+
 
 data UserGroupName
   = UserGroupMetrics

src/ServantApi.hs

@@ -0,0 +1,15 @@
+module ServantApi
+  ( module ServantApi
+  ) where
+
+import Import.Servant
+import Foundation.Routes.Definitions
+
+
+import ServantApi.ExternalApis as ServantApi
+
+
+mkYesodApi ''UniWorX uniworxRoutes
+
+uniworxApi :: Proxy UniWorXApi
+uniworxApi = Proxy

src/ServantApi/Definition.hs

@@ -0,0 +1,189 @@
+module ServantApi.Definition
+  ( ServantApi(..)
+  , servantApiLink
+  , mkYesodApi
+  , PathPieceHttpApiData(..)
+  , BearerAuth, SessionAuth
+  ) where
+
+import ClassyPrelude hiding (Handler, fromList)
+import Control.Lens hiding (Context)
+
+import Utils
+import Model.Types.Security
+
+import Yesod.Core ( RenderRoute(..), ParseRoute(..)
+                  , YesodSubDispatch(..)
+                  , WaiSubsiteWithAuth(..)
+                  , PathPiece(..)
+                  )
+import Yesod.Core.Types ( YesodRunnerEnv(..)
+                        , YesodSubRunnerEnv(..)
+                        , Route(WaiSubsiteWithAuthRoute)
+                        )
+
+import Servant.Links
+import Servant.API
+import Servant.Server
+
+import Data.Proxy
+
+import Network.Wai (Request)
+
+import Language.Haskell.TH
+import Language.Haskell.Meta.Parse (parseType)
+import Yesod.Routes.TH.Types
+
+import Control.Monad.Fail (MonadFail(..))
+
+import Data.Data (Data)
+import GHC.Exts (IsList(..))
+  
+import Servant.Swagger
+import Data.Swagger
+
+import qualified Data.Set as Set
+
+import Network.URI
+import Network.HTTP.Types.URI
+
+
+data ServantApi api where
+  ServantApi :: forall (context :: [*]) (api :: *) (m :: * -> *).
+                HasServer api context
+             => { servantContext :: Request -> IO (Context context)
+                , servantHoist   :: Request -> Context context -> (forall a. m a -> Handler a)
+                , servantServer  :: ServerT api m
+                }
+             -> ServantApi api
+
+instance RenderRoute (ServantApi api) where
+  data Route (ServantApi api) = ServantApiRoute [Text] [(Text,Text)]
+       deriving (Show, Eq, Read, Ord)
+  renderRoute (ServantApiRoute ps qs) = (ps,qs)
+
+instance ParseRoute (ServantApi api) where
+  parseRoute (ps, qs) = Just $ ServantApiRoute ps qs
+
+instance YesodSubDispatch (ServantApi api) master where
+  yesodSubDispatch YesodSubRunnerEnv{..} = case ysreGetSub $ yreSite ysreParentEnv of
+    ServantApi{ servantContext = (servantContext :: Request -> IO (Context context)), .. }
+      -> let subEnv' :: YesodSubRunnerEnv WaiSubsiteWithAuth master
+             subEnv' = YesodSubRunnerEnv
+               { ysreGetSub = \_ -> WaiSubsiteWithAuth $ \req respond -> do
+                   ctx <- servantContext req
+                   let server' = hoistServerWithContext (Proxy @api) (Proxy @context) (servantHoist req ctx) servantServer
+                   serveWithContext (Proxy @api) ctx server' req respond
+               , ysreToParentRoute = ysreToParentRoute . (\(WaiSubsiteWithAuthRoute ps qs) -> ServantApiRoute ps qs)
+               , ..
+               }
+          in yesodSubDispatch subEnv'
+
+servantApiLink :: forall p1 p2 api endpoint.
+                  ( IsElem endpoint api, HasLink endpoint )
+               => p1 api
+               -> p2 endpoint
+               -> MkLink endpoint (Route (ServantApi api))
+servantApiLink _ _ = safeLink' mkRoute (Proxy @api) (Proxy @endpoint)
+  where
+    mkRoute :: Link -> Route (ServantApi api)
+    mkRoute (linkURI -> uri@URI{..}) = ServantApiRoute
+      (map pack $ pathSegments uri)
+      (over (mapped . _2) (fromMaybe mempty) . parseQueryText . encodeUtf8 $ pack uriQuery)
+
+
+newtype PathPieceHttpApiData a = PathPieceHttpApiData { unPathPieceHttpApiData :: a }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable, Data)
+  deriving newtype (PathPiece, ToParamSchema)
+instance PathPiece a => FromHttpApiData (PathPieceHttpApiData a) where
+  parseUrlPiece = maybe (Left "Could not convert from HttpApiData via PathPiece") Right . fromPathPiece
+instance PathPiece a => ToHttpApiData (PathPieceHttpApiData a) where
+  toUrlPiece = toPathPiece
+
+
+data BearerAuth
+data SessionAuth
+
+instance HasSwagger sub => HasSwagger (BearerAuth :> sub) where
+  toSwagger _ = toSwagger (Proxy @(SessionAuth :> sub))
+    & securityDefinitions <>~ fromList [(defnKey, defn)]
+    & allOperations . security <>~ [SecurityRequirement $ fromList [(defnKey, [])]]
+    where defnKey :: Text
+          defnKey = "bearer"
+          defn = SecurityScheme
+            { _securitySchemeType
+                 = SecuritySchemeApiKey ApiKeyParams
+                     { _apiKeyName = "Authorization"
+                     , _apiKeyIn = ApiKeyHeader
+                     }
+            , _securitySchemeDescription = Just
+                "JSON Web Token-based API key"
+            }
+
+instance HasSwagger sub => HasSwagger (SessionAuth :> sub) where
+  toSwagger _ = toSwagger (Proxy @sub)
+    & securityDefinitions <>~ fromList [(defnKey, defn)]
+    & allOperations . security <>~ [SecurityRequirement $ fromList [(defnKey, [])]]
+    where defnKey :: Text
+          defnKey = "session"
+          defn = SecurityScheme
+            { _securitySchemeType
+                 = SecuritySchemeApiKey ApiKeyParams
+                     { _apiKeyName = "Cookie"
+                     , _apiKeyIn = ApiKeyHeader
+                     }
+            , _securitySchemeDescription = Just
+                "JSON Web Token-based session identification as provided be the web interface"
+            }
+
+instance HasLink sub => HasLink (BearerAuth :> sub) where
+  type MkLink (BearerAuth :> sub) a = MkLink sub a
+  toLink  toA _ = toLink toA (Proxy @sub)
+
+instance HasLink sub => HasLink (SessionAuth :> sub) where
+  type MkLink (SessionAuth :> sub) a = MkLink sub a
+  toLink toA _ = toLink toA (Proxy @sub)
+
+  
+
+mkYesodApi :: Name -> [ResourceTree String] -> DecsQ
+mkYesodApi (nameBase -> masterN) ress = do
+  let toPiecesApi :: [Piece String]
+                  -> ResourceTree String
+                  -> MaybeT Q [([Piece String], Type, [Text])]
+      toPiecesApi ps (ResourceLeaf Resource{..}) = do
+        Subsite{..} <- pure resourceDispatch
+        Just tn <- lift $ lookupTypeName subsiteType
+        TyConI (TySynD _ [] (ConT conN `AppT` apiT)) <- lift $ reify tn
+        guard $ conN == ''ServantApi
+        return $ pure (ps <> resourcePieces, apiT, map pack resourceAttrs)
+      toPiecesApi ps (ResourceParent _ _ ps' cs)
+        = lift . fmap concat $ mapMaybeM (toPiecesApi (ps <> ps')) cs
+  apiRess <- concat <$> mapMaybeM (toPiecesApi []) ress
+
+  let apiType
+        | Just apiRess' <- fromNullable $ map apiEndpoint apiRess
+        = ofoldr1 (\e acc -> conT ''(:<|>) `appT` e `appT` acc) apiRess'
+        | otherwise
+        = conT ''EmptyAPI
+
+      apiEndpoint (pieces, apiT, attrs) = withAuth attrs $
+        foldr (\p acc -> conT ''(:>) `appT` apiPiece p `appT` acc) (return apiT) pieces
+
+      withAuth attrs typ = case authDNF of
+        Left t
+          -> fail $ "Invalid auth tag: " <> unpack t
+        Right PredDNF{..} | (impureNonNull . Set.singleton $ PLVariable AuthFree) `Set.member` dnfTerms
+          -> typ
+        Right PredDNF{..} | (impureNonNull . Set.singleton $ PLVariable AuthToken) `Set.member` dnfTerms
+          -> conT ''(:>) `appT` conT ''BearerAuth `appT` typ
+        Right _
+          -> conT ''(:>) `appT` conT ''SessionAuth `appT` typ
+        where authDNF = parsePredDNF defaultAuthDNF attrs
+
+      apiPiece (Static str) = litT $ strTyLit str
+      apiPiece (Dynamic str) = conT ''PathPieceHttpApiData `appT` either fail return (parseType str)
+
+  sequence
+    [ tySynD (mkName $ masterN <> "Api") [] apiType
+    ]

src/ServantApi/ExternalApis.hs

@@ -0,0 +1,20 @@
+module ServantApi.ExternalApis
+  ( ExternalApis
+  , ServantApiExternalApis
+  , getServantApiExternalApis
+  ) where
+
+import Import.Servant
+
+
+type ExternalApis = EmptyAPI
+
+type ServantApiExternalApis = ServantApi ExternalApis
+
+
+getServantApiExternalApis :: UniWorX -> ServantApiExternalApis
+getServantApiExternalApis _ = ServantApi
+  { servantContext = \_ -> return EmptyContext
+  , servantHoist   = \_ _ -> id
+  , servantServer  = emptyServer
+  }