{-# Language UndecidableInstances #-}
-- | Main module to write servers
--
-- Server is a function from response (Resp) to request (Req). Request is wrapped into monad.
-- Library supports IO-monad and ReaderT over IO like monads.
--
-- We can build servers from parts with flexible combinators.
-- Let's build hello-world server:
--
-- > main :: IO ()
-- > main = runServer 8080 server
-- >
-- > server :: Server IO
-- > server =
-- >   "api" /. "v1" /. "hello" /. Get @Text handleHello
-- >
-- > handleHello :: IO Text
-- > handleHello = pure "Hello World"
--
-- We can iuse monoids to combine servers and newtype-wrappers to read various inputs.
-- See readme of the repo for tutorial and docs.
module Mig
  ( -- * types
    Server (..)
  -- * DSL
  , Json
  -- ** methods
  , Get (..)
  , Post (..)
  , Put (..)
  , Delete (..)
  , Patch (..)
  , Options (..)
  -- ** path and query
  -- | Build API for routes with queries and captures.
  -- Use monoid to combine several routes together.
  , (/.)
  , Capture (..)
  , Query (..)
  , Optional (..)
  , Body (..)
  , RawBody (..)
  , Header (..)
  , FormBody (..)
  , PathInfo (..)

  -- ** response
  -- | How to modify response and attach specific info to it
  , AddHeaders (..)
  , SetStatus (..)
  , setStatus
  , addHeaders

  -- ** Errors
  -- | How to report errors
  , Error (..)
  , handleError

  -- * Run
  -- | Run server application
  , runServer
  , ServerConfig (..)
  , toApplication

  -- ** Render
  -- | Render Reader-IO monad servers to IO servers.
  , HasServer (..)
  , fromReader

  -- * Convertes
  , ToTextResp (..)
  , ToJsonResp (..)
  , ToHtmlResp (..)
  , FromText (..)
  , ToText (..)

  -- * utils
  , badRequest
  , ToServer (..)
  , withServerAction

  , module X
  ) where

import Mig.Internal.Types
import Mig.Internal.Types qualified as Resp (Resp (..))

import Web.HttpApiData as X
import Web.FormUrlEncoded as X
import Data.Bifunctor
import Data.Kind
import Data.String
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Text.Lazy qualified as TL
import Data.Aeson (ToJSON, FromJSON)
import Data.Aeson qualified as Json
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as BL
import Text.Blaze.Html (Html)
import Text.Blaze.Html (ToMarkup)
import Text.Read (readMaybe)
import Control.Monad.Reader
import Control.Monad.Except
import GHC.TypeLits
import Data.Proxy
import Data.Map.Strict qualified as Map
import Network.HTTP.Types.Status as X
import Network.HTTP.Types.Method
import Network.HTTP.Types.Header (ResponseHeaders)
import Network.Wai.Handler.Warp qualified as Warp
import Control.Exception (throw)
import Data.Typeable

-- | Path constructor (right associative). Example:
--
-- > server :: Server IO
-- > server =
-- >   "api" /. "v1" /.
-- >      mconcat
-- >        [ "foo" /. Get  @Json handleFoo
-- >        , "bar" /. Post @Json handleBar
-- >        ]
-- >
-- > handleFoo, handleBar :: IO Text
(/.) :: ToServer a => Text -> a -> Server (ServerMonad a)
/. :: forall a. ToServer a => Text -> a -> Server (ServerMonad a)
(/.) Text
path a
act = forall (m :: * -> *). Monad m => Text -> Server m -> Server m
toWithPath Text
path (forall a. ToServer a => a -> Server (ServerMonad a)
toServer a
act)
infixr 4 /.

-- | Map internal monad of the server
hoistServer :: (forall a . m a -> n a) -> Server m -> Server n
hoistServer :: forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> Server m -> Server n
hoistServer forall a. m a -> n a
f (Server Req -> m (Maybe Resp)
act) = forall (m :: * -> *). (Req -> m (Maybe Resp)) -> Server m
Server (forall a. m a -> n a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Req -> m (Maybe Resp)
act)

-- | Aything convertible from text
class FromText a where
  fromText :: Text -> Maybe a

instance FromText ByteString where
  fromText :: Text -> Maybe ByteString
fromText = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

instance FromText String where
  fromText :: Text -> Maybe String
fromText = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance FromText Text where
  fromText :: Text -> Maybe Text
fromText = forall a. a -> Maybe a
Just

instance FromText TL.Text where
  fromText :: Text -> Maybe Text
fromText = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict

instance FromText Word where
  fromText :: Text -> Maybe Word
fromText = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance FromText Int where
  fromText :: Text -> Maybe Int
fromText = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance FromText Integer where
  fromText :: Text -> Maybe Integer
fromText = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance FromText Bool where
  fromText :: Text -> Maybe Bool
fromText = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance FromText Float where
  fromText :: Text -> Maybe Float
fromText = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

newtype QueryName a = QueryName Text
  deriving (String -> QueryName a
forall a. (String -> a) -> IsString a
forall k (a :: k). String -> QueryName a
fromString :: String -> QueryName a
$cfromString :: forall k (a :: k). String -> QueryName a
IsString, QueryName a -> QueryName a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). QueryName a -> QueryName a -> Bool
/= :: QueryName a -> QueryName a -> Bool
$c/= :: forall k (a :: k). QueryName a -> QueryName a -> Bool
== :: QueryName a -> QueryName a -> Bool
$c== :: forall k (a :: k). QueryName a -> QueryName a -> Bool
Eq, QueryName a -> QueryName a -> Bool
QueryName a -> QueryName a -> Ordering
QueryName a -> QueryName a -> QueryName a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (a :: k). Eq (QueryName a)
forall k (a :: k). QueryName a -> QueryName a -> Bool
forall k (a :: k). QueryName a -> QueryName a -> Ordering
forall k (a :: k). QueryName a -> QueryName a -> QueryName a
min :: QueryName a -> QueryName a -> QueryName a
$cmin :: forall k (a :: k). QueryName a -> QueryName a -> QueryName a
max :: QueryName a -> QueryName a -> QueryName a
$cmax :: forall k (a :: k). QueryName a -> QueryName a -> QueryName a
>= :: QueryName a -> QueryName a -> Bool
$c>= :: forall k (a :: k). QueryName a -> QueryName a -> Bool
> :: QueryName a -> QueryName a -> Bool
$c> :: forall k (a :: k). QueryName a -> QueryName a -> Bool
<= :: QueryName a -> QueryName a -> Bool
$c<= :: forall k (a :: k). QueryName a -> QueryName a -> Bool
< :: QueryName a -> QueryName a -> Bool
$c< :: forall k (a :: k). QueryName a -> QueryName a -> Bool
compare :: QueryName a -> QueryName a -> Ordering
$ccompare :: forall k (a :: k). QueryName a -> QueryName a -> Ordering
Ord, Int -> QueryName a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> QueryName a -> ShowS
forall k (a :: k). [QueryName a] -> ShowS
forall k (a :: k). QueryName a -> String
showList :: [QueryName a] -> ShowS
$cshowList :: forall k (a :: k). [QueryName a] -> ShowS
show :: QueryName a -> String
$cshow :: forall k (a :: k). QueryName a -> String
showsPrec :: Int -> QueryName a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> QueryName a -> ShowS
Show)

toWithQuery :: ByteString -> (Maybe ByteString -> Server m) -> Server m
toWithQuery :: forall (m :: * -> *).
ByteString -> (Maybe ByteString -> Server m) -> Server m
toWithQuery ByteString
name Maybe ByteString -> Server m
act = forall (m :: * -> *). (Req -> m (Maybe Resp)) -> Server m
Server forall a b. (a -> b) -> a -> b
$ \Req
req ->
  forall (m :: * -> *). Server m -> Req -> m (Maybe Resp)
unServer (Maybe ByteString -> Server m
act (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
name Req
req.query)) Req
req

withQuery' :: FromHttpApiData a => QueryName a -> (Maybe a -> Server m) -> Server m
withQuery' :: forall a (m :: * -> *).
FromHttpApiData a =>
QueryName a -> (Maybe a -> Server m) -> Server m
withQuery' (QueryName Text
name) Maybe a -> Server m
act = forall (m :: * -> *).
ByteString -> (Maybe ByteString -> Server m) -> Server m
toWithQuery (Text -> ByteString
Text.encodeUtf8 Text
name) forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
mVal ->
  let
    -- TODO: do not ignore parse failure
    mArg :: Maybe a
mArg = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8') forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
mVal
  in
    Maybe a -> Server m
act Maybe a
mArg

withQuery :: (Applicative m, FromHttpApiData a) => QueryName a -> (a -> Server m) -> Server m
withQuery :: forall (m :: * -> *) a.
(Applicative m, FromHttpApiData a) =>
QueryName a -> (a -> Server m) -> Server m
withQuery (QueryName Text
name) a -> Server m
act = forall (m :: * -> *).
ByteString -> (Maybe ByteString -> Server m) -> Server m
toWithQuery (Text -> ByteString
Text.encodeUtf8 Text
name) forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
mVal ->
  let
    -- TODO: do not ignore parse failure
    mArg :: Maybe a
mArg = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8') forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
mVal
  in
    case Maybe a
mArg of
      Just a
arg -> a -> Server m
act a
arg
      Maybe a
Nothing -> forall (m :: * -> *). Functor m => m Resp -> Server m
toConst (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Resp
badRequest forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse arg: " forall a. Semigroup a => a -> a -> a
<> Text
name)

-- | Class contains types which can be converted to IO-based server to run as with WAI-interface.
--
-- We can run plain IO-servers and ReaderT over IO based servers. Readers can be wrapped in newtypes.
-- In that case we can derive automatically @HasServer@ instance.
class Monad m => HasServer m where
  type ServerResult m :: Type
  renderServer :: Server m -> ServerResult m

instance HasServer IO where
  type ServerResult IO = Server IO
  renderServer :: Server IO -> ServerResult IO
renderServer = forall a. a -> a
id

instance HasServer (ReaderT env IO) where
  type ServerResult (ReaderT env IO) = env -> IO (Server IO)
  renderServer :: Server (ReaderT env IO) -> ServerResult (ReaderT env IO)
renderServer Server (ReaderT env IO)
server env
initEnv = forall env. env -> Server (ReaderT env IO) -> IO (Server IO)
fromReader env
initEnv Server (ReaderT env IO)
server

-- | Render reader server to IO-based server
fromReader :: env -> Server (ReaderT env IO) -> IO (Server IO)
fromReader :: forall env. env -> Server (ReaderT env IO) -> IO (Server IO)
fromReader env
env Server (ReaderT env IO)
server =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT env
env forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \env
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> Server m -> Server n
hoistServer (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT env
e) Server (ReaderT env IO)
server

instance (Show a, Typeable a) => HasServer (ReaderT env (ExceptT (Error a) IO)) where
  type ServerResult (ReaderT env (ExceptT (Error a) IO)) =
    (Error a -> Server IO) -> env -> IO (Server IO)

  renderServer :: Server (ReaderT env (ExceptT (Error a) IO))
-> ServerResult (ReaderT env (ExceptT (Error a) IO))
renderServer Server (ReaderT env (ExceptT (Error a) IO))
server Error a -> Server IO
handleErr env
initEnv = forall a env.
(Show a, Typeable a) =>
(Error a -> Server IO)
-> env
-> Server (ReaderT env (ExceptT (Error a) IO))
-> IO (Server IO)
fromReaderExcept Error a -> Server IO
handleErr env
initEnv Server (ReaderT env (ExceptT (Error a) IO))
server

fromReaderExcept ::
  (Show a, Typeable a) =>
  (Error a -> Server IO) ->
  env ->
  Server (ReaderT env (ExceptT (Error a) IO)) -> IO (Server IO)
fromReaderExcept :: forall a env.
(Show a, Typeable a) =>
(Error a -> Server IO)
-> env
-> Server (ReaderT env (ExceptT (Error a) IO))
-> IO (Server IO)
fromReaderExcept Error a -> Server IO
handleErr env
env Server (ReaderT env (ExceptT (Error a) IO))
server =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a (m :: * -> *).
(Exception a, MonadCatch m) =>
(a -> Server m) -> Server m -> Server m
handleError Error a -> Server IO
handleErr) forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT env
env forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$
      \env
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> Server m -> Server n
hoistServer (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT env
e) Server (ReaderT env (ExceptT (Error a) IO))
server

-- Prim types

-- | Type tag of Json-response.
data Json

-- server DSL

-- | Class ToServer contains anything convertible to @Server m@. We use it for flexuble composition
-- of servers from functions with arbitrary number of arguments. Arguments can
-- be of specific types: Query, Body, Optional, Capture, Header, etc.
-- We use type-level strings to encode query-names.
-- Example:
--
-- > "api" /. "foo" /.
-- >     (\(Query @"argA" argA) (Optional @"argB" argB) (Body jsonRequest) -> Post @Json $ handleFoo argA argB jsonRequest)
-- >
-- > handleFoo :: Int -> Maybe Text -> FooRequest -> IO FooResponse
-- > handleFoo = ...
--
-- Note that we can use any amount of arguments. And type of the input is decoded fron newtype wrapper
-- which is used with argument of the handler function.
--
-- Also we can return pure errors with Either. Anything which can be returned from function
-- can be wrapped to @Either (Error err)@.
--
-- For example in previous case we can use function which returns errors as values:
--
-- > type ServerError = Error Text
-- >
-- > handleFoo :: Int -> Maybe Text -> FooRequest -> IO (Either ServerError FooResponse)
-- > handleFoo = ...
--
-- the result of error response is automatically matched with normal response of the server
-- and standard Error type lets us pass status to response and some details.
class Monad (ServerMonad a) => ToServer a where
  type ServerMonad a :: (Type -> Type)
  toServer :: a -> Server (ServerMonad a)

instance Monad m => ToServer (Server m) where
  type ServerMonad (Server m) = m
  toServer :: Server m -> Server (ServerMonad (Server m))
toServer = forall a. a -> a
id

-- Status

-- | Set status to response. It can be ised inside any ToXxxResp value. Example:
--
-- > "api" /. handleFoo
-- >
-- > handleFoo :: Get Text IO (SetStatus Text)
-- > handleFoo = Get $ pure $ SetStatus status500 "Bad request"
data SetStatus a = SetStatus
  { forall a. SetStatus a -> Status
status :: Status
  , forall a. SetStatus a -> a
content :: a
  }

-- | Sets status for response of the server
setStatus :: Monad m => Status -> Server m -> Server m
setStatus :: forall (m :: * -> *). Monad m => Status -> Server m -> Server m
setStatus Status
st = forall (m :: * -> *).
Monad m =>
(Resp -> Resp) -> Server m -> Server m
mapResp forall a b. (a -> b) -> a -> b
$ \Resp
resp -> Resp
resp { $sel:status:Resp :: Status
Resp.status = Status
st }

-- Headers

-- | Attach headers to response. It can be used inside any ToXxxResp value.
-- Example:
--
-- > "api" /. handleFoo
-- >
-- > handleFoo :: Get Text IO (AddHeaders Text)
-- > handleFoo = Get $ pure $ AddHeaders headers "Hello foo"
data AddHeaders a = AddHeaders
  { forall a. AddHeaders a -> ResponseHeaders
headers :: ResponseHeaders
  , forall a. AddHeaders a -> a
content :: a
  }

-- | Adds headers for response of the server
addHeaders :: Monad m => ResponseHeaders -> Server m -> Server m
addHeaders :: forall (m :: * -> *).
Monad m =>
ResponseHeaders -> Server m -> Server m
addHeaders ResponseHeaders
headers = forall (m :: * -> *).
Monad m =>
(Resp -> Resp) -> Server m -> Server m
mapResp forall a b. (a -> b) -> a -> b
$ \Resp
resp -> Resp
resp { $sel:headers:Resp :: ResponseHeaders
Resp.headers = Resp
resp.headers forall a. Semigroup a => a -> a -> a
<> ResponseHeaders
headers }

mapResp :: Monad m => (Resp -> Resp) -> Server m -> Server m
mapResp :: forall (m :: * -> *).
Monad m =>
(Resp -> Resp) -> Server m -> Server m
mapResp Resp -> Resp
f (Server Req -> m (Maybe Resp)
act) = forall (m :: * -> *). (Req -> m (Maybe Resp)) -> Server m
Server forall a b. (a -> b) -> a -> b
$ \Req
req ->
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resp -> Resp
f) forall a b. (a -> b) -> a -> b
$ Req -> m (Maybe Resp)
act Req
req

-- text response

-- | Values convertible to Text (lazy)
class ToTextResp a where
  toTextResp :: a -> Resp

instance ToTextResp Text where
  toTextResp :: Text -> Resp
toTextResp = forall a. ToText a => a -> Resp
text

instance ToTextResp TL.Text where
  toTextResp :: Text -> Resp
toTextResp = forall a. ToText a => a -> Resp
text

instance ToTextResp Int where
  toTextResp :: Int -> Resp
toTextResp = forall a. ToText a => a -> Resp
text

instance ToTextResp a => ToTextResp (AddHeaders a) where
  toTextResp :: AddHeaders a -> Resp
toTextResp (AddHeaders ResponseHeaders
headers a
content) =
    Resp
resp { $sel:headers:Resp :: ResponseHeaders
Resp.headers = Resp
resp.headers forall a. Semigroup a => a -> a -> a
<> ResponseHeaders
headers }
    where
      resp :: Resp
resp = forall a. ToTextResp a => a -> Resp
toTextResp a
content

instance ToTextResp a => ToTextResp (SetStatus a) where
  toTextResp :: SetStatus a -> Resp
toTextResp (SetStatus Status
st a
content) =
    Status -> Resp -> Resp
setRespStatus Status
st (forall a. ToTextResp a => a -> Resp
toTextResp a
content)

instance (ToText err, ToTextResp a) => ToTextResp (Either (Error err) a) where
  toTextResp :: Either (Error err) a -> Resp
toTextResp = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {r}.
(ToText a, HasField "body" r a, HasField "status" r Status) =>
r -> Resp
fromError forall a. ToTextResp a => a -> Resp
toTextResp
    where
      fromError :: r -> Resp
fromError r
err = Status -> Resp -> Resp
setRespStatus r
err.status (forall a. ToText a => a -> Resp
text r
err.body)

-- json response

-- | Values convertible to Json
class ToJsonResp a where
  toJsonResp :: a -> Resp

instance {-# OVERLAPPABLE #-} ToJSON a => ToJsonResp a where
  toJsonResp :: a -> Resp
toJsonResp = forall a. ToJSON a => a -> Resp
json

instance ToJsonResp a => ToJsonResp (AddHeaders a) where
  toJsonResp :: AddHeaders a -> Resp
toJsonResp (AddHeaders ResponseHeaders
headers a
content) =
    Resp
resp { $sel:headers:Resp :: ResponseHeaders
Resp.headers = Resp
resp.headers forall a. Semigroup a => a -> a -> a
<> ResponseHeaders
headers }
    where
      resp :: Resp
resp = forall a. ToJsonResp a => a -> Resp
toJsonResp a
content

instance ToJsonResp a => ToJsonResp (SetStatus a) where
  toJsonResp :: SetStatus a -> Resp
toJsonResp (SetStatus Status
st a
content) =
    Status -> Resp -> Resp
setRespStatus Status
st (forall a. ToJsonResp a => a -> Resp
toJsonResp a
content)

instance (ToJSON err, ToJsonResp a) => ToJsonResp (Either (Error err) a) where
  toJsonResp :: Either (Error err) a -> Resp
toJsonResp = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {resp} {r}.
(ToJSON resp, HasField "body" r resp,
 HasField "status" r Status) =>
r -> Resp
fromError forall a. ToJsonResp a => a -> Resp
toJsonResp
    where
      fromError :: r -> Resp
fromError r
err = Status -> Resp -> Resp
setRespStatus r
err.status (forall a. ToJSON a => a -> Resp
json r
err.body)

-- html response

-- | Values convertible to Html
class ToHtmlResp a where
  toHtmlResp :: a -> Resp

instance ToMarkup a => ToHtmlResp a where
  toHtmlResp :: a -> Resp
toHtmlResp = forall a. ToMarkup a => a -> Resp
html

instance ToHtmlResp a => ToHtmlResp (AddHeaders a) where
  toHtmlResp :: AddHeaders a -> Resp
toHtmlResp (AddHeaders ResponseHeaders
headers a
content) =
    Resp
resp { $sel:headers:Resp :: ResponseHeaders
Resp.headers = Resp
resp.headers forall a. Semigroup a => a -> a -> a
<> ResponseHeaders
headers }
    where
      resp :: Resp
resp = forall a. ToHtmlResp a => a -> Resp
toHtmlResp a
content

instance ToHtmlResp a => ToHtmlResp (SetStatus a) where
  toHtmlResp :: SetStatus a -> Resp
toHtmlResp (SetStatus Status
st a
content) =
    Status -> Resp -> Resp
setRespStatus Status
st (forall a. ToHtmlResp a => a -> Resp
toHtmlResp a
content)

instance (ToJSON err, ToHtmlResp a) => ToHtmlResp (Either (Error err) a) where
  toHtmlResp :: Either (Error err) a -> Resp
toHtmlResp = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {resp} {r}.
(ToJSON resp, HasField "body" r resp,
 HasField "status" r Status) =>
r -> Resp
fromError forall a. ToHtmlResp a => a -> Resp
toHtmlResp
    where
      fromError :: r -> Resp
fromError r
err = Status -> Resp -> Resp
setRespStatus r
err.status (forall a. ToJSON a => a -> Resp
json r
err.body)

-- Get

-- | Get method. Note that we can not use body input with Get-method, use Post for that.
-- So with Get we can use only URI inputs (Query, Optional, Capture)
newtype Get ty m a = Get (m a)

instance (Monad m, ToTextResp a) => ToServer (Get Text m a) where
  type ServerMonad (Get Text m a) = m
  toServer :: Get Text m a -> Server (ServerMonad (Get Text m a))
toServer (Get m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodGet (forall a. ToTextResp a => a -> Resp
toTextResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

instance (Monad m, ToJSON a) => ToServer (Get Json m a) where
  type ServerMonad (Get Json m a) = m
  toServer :: Get Json m a -> Server (ServerMonad (Get Json m a))
toServer (Get m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodGet (forall a. ToJSON a => a -> Resp
json forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

instance (Monad m, ToHtmlResp a) => ToServer (Get Html m a) where
  type ServerMonad (Get Html m a) = m
  toServer :: Get Html m a -> Server (ServerMonad (Get Html m a))
toServer (Get m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodGet (forall a. ToHtmlResp a => a -> Resp
toHtmlResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

instance (Monad m) => ToServer (Get BL.ByteString m BL.ByteString) where
  type ServerMonad (Get BL.ByteString m BL.ByteString) = m
  toServer :: Get ByteString m ByteString
-> Server (ServerMonad (Get ByteString m ByteString))
toServer (Get m ByteString
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodGet (ByteString -> Resp
raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
act)

instance (Monad m) => ToServer (Get ByteString m ByteString) where
  type ServerMonad (Get ByteString m ByteString) = m
  toServer :: Get ByteString m ByteString
-> Server (ServerMonad (Get ByteString m ByteString))
toServer (Get m ByteString
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodGet (ByteString -> Resp
raw forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
act)

-- Post

-- | Post method
newtype Post ty m a = Post (m a)

instance (Monad m, ToTextResp a) => ToServer (Post Text m a) where
  type ServerMonad (Post Text m a) = m
  toServer :: Post Text m a -> Server (ServerMonad (Post Text m a))
toServer (Post m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPost forall a b. (a -> b) -> a -> b
$ forall a. ToTextResp a => a -> Resp
toTextResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToJSON a) => ToServer (Post Json m a) where
  type ServerMonad (Post Json m a) = m
  toServer :: Post Json m a -> Server (ServerMonad (Post Json m a))
toServer (Post m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPost forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Resp
json forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToHtmlResp a) => ToServer (Post Html m a) where
  type ServerMonad (Post Html m a) = m
  toServer :: Post Html m a -> Server (ServerMonad (Post Html m a))
toServer (Post m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPost (forall a. ToHtmlResp a => a -> Resp
toHtmlResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

-- Put

-- | Put method
newtype Put ty m a = Put (m a)

instance (Monad m, ToTextResp a) => ToServer (Put Text m a) where
  type ServerMonad (Put Text m a) = m
  toServer :: Put Text m a -> Server (ServerMonad (Put Text m a))
toServer (Put m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPut forall a b. (a -> b) -> a -> b
$ forall a. ToTextResp a => a -> Resp
toTextResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToJSON a) => ToServer (Put Json m a) where
  type ServerMonad (Put Json m a) = m
  toServer :: Put Json m a -> Server (ServerMonad (Put Json m a))
toServer (Put m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPut forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Resp
json forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToHtmlResp a) => ToServer (Put Html m a) where
  type ServerMonad (Put Html m a) = m
  toServer :: Put Html m a -> Server (ServerMonad (Put Html m a))
toServer (Put m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPut (forall a. ToHtmlResp a => a -> Resp
toHtmlResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

-- Delete

-- | Delete method
newtype Delete ty m a = Delete (m a)

instance (Monad m, ToTextResp a) => ToServer (Delete Text m a) where
  type ServerMonad (Delete Text m a) = m
  toServer :: Delete Text m a -> Server (ServerMonad (Delete Text m a))
toServer (Delete m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodDelete forall a b. (a -> b) -> a -> b
$ forall a. ToTextResp a => a -> Resp
toTextResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToJSON a) => ToServer (Delete Json m a) where
  type ServerMonad (Delete Json m a) = m
  toServer :: Delete Json m a -> Server (ServerMonad (Delete Json m a))
toServer (Delete m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodDelete forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Resp
json forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToHtmlResp a) => ToServer (Delete Html m a) where
  type ServerMonad (Delete Html m a) = m
  toServer :: Delete Html m a -> Server (ServerMonad (Delete Html m a))
toServer (Delete m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodDelete (forall a. ToHtmlResp a => a -> Resp
toHtmlResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

-- Patch

-- | Patch method
newtype Patch ty m a = Patch (m a)

instance (Monad m, ToTextResp a) => ToServer (Patch Text m a) where
  type ServerMonad (Patch Text m a) = m
  toServer :: Patch Text m a -> Server (ServerMonad (Patch Text m a))
toServer (Patch m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPatch forall a b. (a -> b) -> a -> b
$ forall a. ToTextResp a => a -> Resp
toTextResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToJSON a) => ToServer (Patch Json m a) where
  type ServerMonad (Patch Json m a) = m
  toServer :: Patch Json m a -> Server (ServerMonad (Patch Json m a))
toServer (Patch m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPatch forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Resp
json forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToHtmlResp a) => ToServer (Patch Html m a) where
  type ServerMonad (Patch Html m a) = m
  toServer :: Patch Html m a -> Server (ServerMonad (Patch Html m a))
toServer (Patch m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodPatch (forall a. ToHtmlResp a => a -> Resp
toHtmlResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

-- Options

-- | Options method
newtype Options ty m a = Options (m a)

instance (Monad m, ToTextResp a) => ToServer (Options Text m a) where
  type ServerMonad (Options Text m a) = m
  toServer :: Options Text m a -> Server (ServerMonad (Options Text m a))
toServer (Options m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodOptions forall a b. (a -> b) -> a -> b
$ forall a. ToTextResp a => a -> Resp
toTextResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToJSON a) => ToServer (Options Json m a) where
  type ServerMonad (Options Json m a) = m
  toServer :: Options Json m a -> Server (ServerMonad (Options Json m a))
toServer (Options m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodOptions forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Resp
json forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act

instance (Monad m, ToHtmlResp a) => ToServer (Options Html m a) where
  type ServerMonad (Options Html m a) = m
  toServer :: Options Html m a -> Server (ServerMonad (Options Html m a))
toServer (Options m a
act) = forall (m :: * -> *). Monad m => ByteString -> m Resp -> Server m
toMethod ByteString
methodOptions (forall a. ToHtmlResp a => a -> Resp
toHtmlResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)

-- Query

-- | Mandatary query parameter. Name is encoded as type-level string. Example:
--
-- > "api" /. handleFoo
-- >
-- > handleFoo :: Query "name" Int -> Server IO
-- > handleFoo (Query arg) = ...
newtype Query (sym :: Symbol) a = Query a

instance (FromHttpApiData a, ToServer b, KnownSymbol sym) => ToServer (Query sym a -> b) where
  type ServerMonad (Query sym a -> b) = ServerMonad b
  toServer :: (Query sym a -> b) -> Server (ServerMonad (Query sym a -> b))
toServer Query sym a -> b
act = forall (m :: * -> *) a.
(Applicative m, FromHttpApiData a) =>
QueryName a -> (a -> Server m) -> Server m
withQuery (forall {k} (a :: k). Text -> QueryName a
QueryName (String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym))) (forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query sym a -> b
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. a -> Query sym a
Query)

-- Optional query

-- | Optional query parameter. Name is encoded as type-level string. Example:
--
-- > "api" /. handleFoo
-- >
-- > handleFoo :: Optional "name" -> Server IO
-- > handleFoo (Optional maybeArg) = ...
newtype Optional (sym :: Symbol) a = Optional (Maybe a)

instance (FromHttpApiData a, ToServer b, KnownSymbol sym) => ToServer (Optional sym a -> b) where
  type ServerMonad (Optional sym a -> b) = ServerMonad b
  toServer :: (Optional sym a -> b) -> Server (ServerMonad (Optional sym a -> b))
toServer Optional sym a -> b
act = forall a (m :: * -> *).
FromHttpApiData a =>
QueryName a -> (Maybe a -> Server m) -> Server m
withQuery' (forall {k} (a :: k). Text -> QueryName a
QueryName (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym))) (forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optional sym a -> b
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. Maybe a -> Optional sym a
Optional)

-- | Capture

-- Captures part of the path. Example
--
-- "api" /. "foo" /. (\(Capture n) -> handleFoo n)
--
-- It will parse the paths: "api/foo/358" and pass 358 to @handleFoo@.
newtype Capture a = Capture a

instance (FromHttpApiData a, ToServer b) => ToServer (Capture a -> b) where
  type ServerMonad (Capture a -> b) = ServerMonad b
  toServer :: (Capture a -> b) -> Server (ServerMonad (Capture a -> b))
toServer Capture a -> b
act = forall (m :: * -> *). Monad m => (Text -> Server m) -> Server m
toWithCapture forall a b. (a -> b) -> a -> b
$ \Text
txt ->
    case forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece Text
txt of
      Right a
val -> forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall a b. (a -> b) -> a -> b
$ Capture a -> b
act forall a b. (a -> b) -> a -> b
$ forall a. a -> Capture a
Capture a
val
      Left Text
err -> forall (m :: * -> *). Functor m => m Resp -> Server m
toConst forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Resp
badRequest (Text
"Failed to parse capture: " forall a. Semigroup a => a -> a -> a
<> Text
err)

-- Read Body input

-- | Reads Json body (lazy). We can limit the body size with server config. Example:
--
-- > "api" /. "search" /. (\(Body request) -> handleSearch request)
newtype Body a = Body a

instance (MonadIO (ServerMonad b), FromJSON a, ToServer b) => ToServer (Body a -> b) where
  type ServerMonad (Body a -> b) = ServerMonad b
  toServer :: (Body a -> b) -> Server (ServerMonad (Body a -> b))
toServer Body a -> b
act = forall (m :: * -> *).
MonadIO m =>
(ByteString -> Server m) -> Server m
toWithBody forall a b. (a -> b) -> a -> b
$ \ByteString
val ->
    case forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecode ByteString
val of
      Right a
v -> forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall a b. (a -> b) -> a -> b
$ Body a -> b
act forall a b. (a -> b) -> a -> b
$ forall a. a -> Body a
Body a
v
      Left String
err -> forall (m :: * -> *). Functor m => m Resp -> Server m
toConst forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Resp
badRequest forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse JSON body: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err

-- | Reads raw body as lazy bytestring. We can limit the body size with server config. Example:
--
-- > "api" /. "upload" /. (\(RawBody content) -> handleUpload content)
newtype RawBody = RawBody BL.ByteString

instance (MonadIO (ServerMonad b), ToServer b) => ToServer (RawBody -> b) where
  type ServerMonad (RawBody -> b) = ServerMonad b
  toServer :: (RawBody -> b) -> Server (ServerMonad (RawBody -> b))
toServer RawBody -> b
act = forall (m :: * -> *).
MonadIO m =>
(ByteString -> Server m) -> Server m
toWithBody forall a b. (a -> b) -> a -> b
$ forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawBody -> b
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RawBody
RawBody

-- | Reads the URL encoded Form input
newtype FormBody a = FormBody a

instance (ToServer b, MonadIO (ServerMonad b), FromForm a) => ToServer (FormBody a -> b) where
  type ServerMonad (FormBody a -> b) = ServerMonad b
  toServer :: (FormBody a -> b) -> Server (ServerMonad (FormBody a -> b))
toServer FormBody a -> b
act = forall a (m :: * -> *).
(FromForm a, MonadIO m) =>
(a -> Server m) -> Server m
toWithFormData (forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormBody a -> b
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FormBody a
FormBody)

-- Request Headers

-- | Reads input header. Example:
--
-- > "api" /. (\(Header @"Trace-Id" traceId) -> Post @Json (handleFoo traceId))
-- >
-- > handleFoo :: Maybe ByteString -> IO FooResponse
newtype Header (sym :: Symbol) a = Header (Maybe a)

instance (FromHttpApiData a, ToServer b, KnownSymbol sym) => ToServer (Header sym a -> b) where
  type ServerMonad (Header sym a -> b) = ServerMonad b
  toServer :: (Header sym a -> b) -> Server (ServerMonad (Header sym a -> b))
toServer Header sym a -> b
act = forall (m :: * -> *) a.
(Monad m, FromHttpApiData a) =>
HeaderName -> (Maybe a -> Server m) -> Server m
toWithHeader (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym)) (forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header sym a -> b
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sym :: Symbol) a. Maybe a -> Header sym a
Header)

-- | Reads current path info
newtype PathInfo = PathInfo [Text]

instance (ToServer b) => ToServer (PathInfo -> b) where
  type ServerMonad (PathInfo -> b) = ServerMonad b
  toServer :: (PathInfo -> b) -> Server (ServerMonad (PathInfo -> b))
toServer PathInfo -> b
act = forall (m :: * -> *). ([Text] -> Server m) -> Server m
toWithPathInfo (forall a. ToServer a => a -> Server (ServerMonad a)
toServer forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathInfo -> b
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> PathInfo
PathInfo)

-- | Appends action to the server
withServerAction :: Monad m => Server m -> m () -> Server m
withServerAction :: forall (m :: * -> *). Monad m => Server m -> m () -> Server m
withServerAction Server m
srv m ()
act = forall (m :: * -> *). (Req -> m (Maybe Resp)) -> Server m
Server forall a b. (a -> b) -> a -> b
$ \Req
req -> do
  m ()
act
  forall (m :: * -> *). Server m -> Req -> m (Maybe Resp)
unServer Server m
srv Req
req

-------------------------------------------------------------------------------------
-- WAI

-- | Run server on port
runServer :: Int -> Server IO -> IO ()
runServer :: Int -> Server IO -> IO ()
runServer Int
port Server IO
server =
  Int -> Application -> IO ()
Warp.run Int
port (ServerConfig -> Server IO -> Application
toApplication ServerConfig
config Server IO
server)
  where
    config :: ServerConfig
config = ServerConfig { $sel:maxBodySize:ServerConfig :: Maybe Int
maxBodySize = forall a. Maybe a
Nothing }