53 lines
1.4 KiB
Haskell
53 lines
1.4 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-|
|
|
Module : Server
|
|
Description : Run the http server
|
|
Copyright : (c) Mats Rauhala, 2019
|
|
License : BSD3
|
|
Maintainer : mats.rauhala@iki.fi
|
|
Stability : experimental
|
|
Portability : POSIX
|
|
|
|
|
|
-}
|
|
module Server where
|
|
|
|
import Control.Monad.Reader (MonadReader, ask, asks, runReaderT)
|
|
import Control.Monad.Trans (MonadIO, liftIO)
|
|
import Data.Aeson (FromJSON)
|
|
import Network.Wai.Handler.Warp (run)
|
|
import Servant
|
|
import Servant.Server.Generic
|
|
|
|
import API (handler)
|
|
import Data.Language (HasModel)
|
|
import Solidabis.API (HasClientEnv, HasToken)
|
|
|
|
-- | The port to run on
|
|
--
|
|
-- Should be provided within the environment
|
|
newtype Port = Port Int deriving (Show, FromJSON)
|
|
|
|
-- | Has* pattern
|
|
--
|
|
-- Locate the port within the larger environment structure
|
|
class HasPort a where
|
|
getPort :: a -> Port
|
|
setPort :: a -> Port -> a
|
|
|
|
instance HasPort Port where
|
|
getPort = id
|
|
setPort = const
|
|
|
|
-- | Convert the servant handler into wai application
|
|
app :: (HasModel r, HasClientEnv r, HasToken r) => r -> Application
|
|
app env = genericServeT (`runReaderT` env) API.handler
|
|
|
|
-- | Run the server
|
|
server
|
|
:: (HasModel r, HasClientEnv r, HasToken r, HasPort r, MonadReader r m, MonadIO m)
|
|
=> m ()
|
|
server = do
|
|
Port port <- asks getPort
|
|
ask >>= liftIO . run port . app
|