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

16
backend/src/Server.hs
View File

@@ -1,19 +1,15 @@
{-# 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 #-}
module Server where
import qualified API as API
import qualified API
import ClassyPrelude hiding (Handler)
import Control.Lens
import Control.Monad.Except
@@ -24,18 +20,16 @@ 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 Server.Auth (SafeUser, authCheck)
import Types
type API = API.API
:<|> "help" :> Get '[PlainText, HTML] String
:<|> "static" :> Raw
:<|> "api" :> "help" :> Get '[PlainText, HTML] String
type Ctx = '[BasicAuthData -> IO (AuthResult SafeUser), CookieSettings, JWTSettings]
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
apiDocs :: Docs.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}
cfg = jwtCfg :. cookieSettings :. authCfg :. EmptyContext
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