MasseR/ebook-manager
1
0
Fork 0
Code Issues 9 Pull Requests Releases Wiki Activity

Everything under the same path

Browse Source
This commit is contained in:
Mats Rauhala 2019-01-22 16:16:36 +02:00
parent 6ec2303b9f
commit ff231322c7
2 changed files with 6 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
backend/src/API.hs
View File

@ -1,12 +1,7 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module API (API, handler) where module API (API, handler) where
@ -20,7 +15,7 @@ import qualified API.Catalogue as Catalogue
import qualified API.Channels as Channels import qualified API.Channels as Channels
import qualified API.Users as Users import qualified API.Users as Users
type API = Users.API type API = "api" :> Users.API
:<|> "api" :> "current" :> Channels.API :<|> "api" :> "current" :> Channels.API
:<|> "api" :> "current" :> Books.API :<|> "api" :> "current" :> Books.API
:<|> "api" :> "1" :> Catalogue.VersionedAPI 1 :<|> "api" :> "1" :> Catalogue.VersionedAPI 1

16
backend/src/Server.hs
View File

@ -1,19 +1,15 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Server where module Server where
import qualified API as API import qualified API
import ClassyPrelude hiding (Handler) import ClassyPrelude hiding (Handler)
import Control.Lens import Control.Lens
import Control.Monad.Except import Control.Monad.Except
@ -24,18 +20,16 @@ import Servant.Auth.Docs ()
import Servant.Auth.Server as SAS import Servant.Auth.Server as SAS
import qualified Servant.Docs as Docs import qualified Servant.Docs as Docs
import Servant.HTML.Lucid (HTML) import Servant.HTML.Lucid (HTML)
import Server.Auth (SafeUser) import Server.Auth (SafeUser, authCheck)
import Server.Auth (authCheck)
import Types import Types
type API = API.API type API = API.API
:<|> "help" :> Get '[PlainText, HTML] String :<|> "api" :> "help" :> Get '[PlainText, HTML] String
:<|> "static" :> Raw
type Ctx = '[BasicAuthData -> IO (AuthResult SafeUser), CookieSettings, JWTSettings] type Ctx = '[BasicAuthData -> IO (AuthResult SafeUser), CookieSettings, JWTSettings]
server :: App -> Application server :: App -> Application
server app = serveWithContext api cfg (hoistServerWithContext (Proxy @ API.API) (Proxy @ Ctx) server' API.handler :<|> serveDocs :<|> serveDirectoryFileServer "static") server app = serveWithContext api cfg (hoistServerWithContext (Proxy @ API.API) (Proxy @ Ctx) server' API.handler :<|> serveDocs)
where where
apiDocs :: Docs.API apiDocs :: Docs.API
apiDocs = Docs.docs (Proxy @API.API) apiDocs = Docs.docs (Proxy @API.API)
@ -46,6 +40,6 @@ server app = serveWithContext api cfg (hoistServerWithContext (Proxy @ API.API)
cookieSettings = SAS.defaultCookieSettings{cookieIsSecure=SAS.NotSecure} cookieSettings = SAS.defaultCookieSettings{cookieIsSecure=SAS.NotSecure}
cfg = jwtCfg :. cookieSettings :. authCfg :. EmptyContext cfg = jwtCfg :. cookieSettings :. authCfg :. EmptyContext
server' :: AppM a -> Servant.Handler a server' :: AppM a -> Servant.Handler a
server' = Handler . ExceptT . try . (`runReaderT` app) . (runFileLoggingT "logs/server.log") server' = Handler . ExceptT . try . (`runReaderT` app) . runFileLoggingT "logs/server.log"
api :: Proxy API api :: Proxy API
api = Proxy api = Proxy