ebook-manager/backend/src/Server.hs

46 lines
1.7 KiB
Haskell
Raw Normal View History

2018-11-12 21:32:42 +02:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
2018-08-02 22:11:11 +03:00
module Server where
2019-01-22 16:16:36 +02:00
import qualified API
2018-11-12 21:32:42 +02:00
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)
2019-01-22 16:16:36 +02:00
import Server.Auth (SafeUser, authCheck)
2018-11-12 21:32:42 +02:00
import Types
2018-08-02 22:11:11 +03:00
2018-11-12 21:32:42 +02:00
type API = API.API
2019-01-22 16:16:36 +02:00
:<|> "api" :> "help" :> Get '[PlainText, HTML] String
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
2019-01-22 16:16:36 +02:00
server app = serveWithContext api cfg (hoistServerWithContext (Proxy @ API.API) (Proxy @ Ctx) server' API.handler :<|> serveDocs)
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
2019-01-22 16:16:36 +02:00
server' = Handler . ExceptT . try . (`runReaderT` app) . runFileLoggingT "logs/server.log"
2018-08-02 22:11:11 +03:00
api :: Proxy API
api = Proxy