2018-08-02 22:11:11 +03:00
|
|
|
{-# Language DataKinds #-}
|
|
|
|
{-# Language TypeFamilies #-}
|
|
|
|
{-# Language TypeOperators #-}
|
|
|
|
{-# Language NoImplicitPrelude #-}
|
|
|
|
{-# Language MultiParamTypeClasses #-}
|
|
|
|
{-# Language OverloadedStrings #-}
|
|
|
|
{-# Language TemplateHaskell #-}
|
|
|
|
{-# Language QuasiQuotes #-}
|
|
|
|
{-# Language RecordWildCards #-}
|
|
|
|
{-# Language DeriveGeneric #-}
|
|
|
|
{-# Language FlexibleInstances #-}
|
2018-08-04 23:43:26 +03:00
|
|
|
{-# Language TypeApplications #-}
|
2018-08-02 22:11:11 +03:00
|
|
|
module Server where
|
|
|
|
|
|
|
|
import qualified API as API
|
2018-08-04 23:43:26 +03:00
|
|
|
import qualified API.Users as Users
|
2018-08-02 22:11:11 +03:00
|
|
|
import Servant
|
2018-08-02 22:32:23 +03:00
|
|
|
import Types
|
|
|
|
import ClassyPrelude hiding (Handler)
|
|
|
|
import Control.Monad.Logger
|
|
|
|
import Control.Monad.Except
|
2018-08-04 23:43:26 +03:00
|
|
|
import Servant.Auth.Server
|
|
|
|
import Control.Lens
|
|
|
|
import Data.Generics.Product
|
2018-08-02 22:11:11 +03:00
|
|
|
|
|
|
|
type API = API.API :<|> "static" :> Raw
|
|
|
|
|
|
|
|
|
2018-08-02 22:32:23 +03:00
|
|
|
server :: App -> Application
|
2018-08-04 23:43:26 +03:00
|
|
|
server app = serveWithContext api cfg (enter server' API.handler :<|> serveDirectoryFileServer "static")
|
2018-08-02 22:11:11 +03:00
|
|
|
where
|
2018-08-04 23:43:26 +03:00
|
|
|
myKey = view (field @"jwk") app
|
|
|
|
jwtCfg = defaultJWTSettings myKey
|
|
|
|
authCfg = Users.authCheck app
|
|
|
|
cfg = jwtCfg :. defaultCookieSettings :. authCfg :. EmptyContext
|
2018-08-02 22:32:23 +03:00
|
|
|
server' :: AppM :~> Servant.Handler
|
|
|
|
server' = NT (Handler . ExceptT . try . (`runReaderT` app) . (runFileLoggingT "logs/server.log"))
|
2018-08-02 22:11:11 +03:00
|
|
|
api :: Proxy API
|
|
|
|
api = Proxy
|