ebook-manager/backend/src/Server.hs

52 lines
2.0 KiB
Haskell
Raw Normal View History

2018-11-12 21:32:42 +02:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
2018-08-02 22:11:11 +03:00
module Server where
2018-11-12 21:32:42 +02:00
import qualified API as API
import ClassyPrelude hiding (Handler)
import Control.Lens
import Control.Monad.Except
import Control.Monad.Logger
import Data.Generics.Product
import Servant
import Servant.Auth.Docs ()
import Servant.Auth.Server as SAS
import qualified Servant.Docs as Docs
import Servant.HTML.Lucid (HTML)
import Server.Auth (SafeUser)
import Server.Auth (authCheck)
import Types
2018-08-02 22:11:11 +03:00
2018-11-12 21:32:42 +02:00
type API = API.API
:<|> "help" :> Get '[PlainText, HTML] String
:<|> "static" :> Raw
2018-08-02 22:11:11 +03:00
2018-10-17 23:51:30 +03:00
type Ctx = '[BasicAuthData -> IO (AuthResult SafeUser), CookieSettings, JWTSettings]
2018-08-02 22:11:11 +03:00
2018-08-02 22:32:23 +03:00
server :: App -> Application
2018-11-12 21:32:42 +02:00
server app = serveWithContext api cfg (hoistServerWithContext (Proxy @ API.API) (Proxy @ Ctx) server' API.handler :<|> serveDocs :<|> serveDirectoryFileServer "static")
2018-08-02 22:11:11 +03:00
where
2018-11-12 21:32:42 +02:00
apiDocs :: Docs.API
apiDocs = Docs.docs (Proxy @API.API)
serveDocs = pure $ Docs.markdown apiDocs
2018-08-04 23:43:26 +03:00
myKey = view (field @"jwk") app
jwtCfg = defaultJWTSettings myKey
2018-08-04 23:53:40 +03:00
authCfg = authCheck app
2018-08-05 23:13:49 +03:00
cookieSettings = SAS.defaultCookieSettings{cookieIsSecure=SAS.NotSecure}
cfg = jwtCfg :. cookieSettings :. authCfg :. EmptyContext
2018-10-17 23:51:30 +03:00
server' :: AppM a -> Servant.Handler a
server' = Handler . ExceptT . try . (`runReaderT` app) . (runFileLoggingT "logs/server.log")
2018-08-02 22:11:11 +03:00
api :: Proxy API
api = Proxy