mig-0.2.1.0: Build lightweight and composable servers
Safe HaskellSafe-Inferred
LanguageGHC2021

Mig.Core.Server

Description

Server definition

Synopsis

Documentation

newtype Server m Source #

Server type. It is a function fron request to response. Some servers does not return valid value. We use it to find right path.

Example:

server :: Server IO
server =
  "api/v1" /.
     [ "foo" /. handleFoo
     , "bar" /. handleBar
     ]

handleFoo :: Query "name" Int -> Get IO (Resp Json Text)
handleBar :: Post Json IO Text

Note that server is monoid and it can be constructed with Monoid functions and path constructor (/.). To pass inputs for handler we can use special newtype wrappers:

  • Query - for required query parameters
  • Optional - for optional query parameters
  • QueryFlag - for boolean query flags
  • Capture - for parsing elements of URI
  • Header - for parsing headers
  • OptionalHeader - for parsing optional headers
  • Body - fot request-body input

and other request types.

To distinguish by HTTP-method we use corresponding constructors: Get, Post, Put, etc. Let's discuss the structure of the constructor. Let's take Get for example:

type Get m a = Send GET m a
newtype Send method m a = Send (m a)

Let's look at the arguments of he type

  • method - type tag of the HTTP-method (GET, POST, PUT, DELETE, etc.)
  • m - underlying server monad
  • a - response type. It should be convertible to the type of the response (see IsResp class).

Constructors

Server 

Fields

Instances

Instances details
Monoid (Server m) Source # 
Instance details

Defined in Mig.Core.Server

Methods

mempty :: Server m #

mappend :: Server m -> Server m -> Server m #

mconcat :: [Server m] -> Server m #

Semigroup (Server m) Source # 
Instance details

Defined in Mig.Core.Server

Methods

(<>) :: Server m -> Server m -> Server m #

sconcat :: NonEmpty (Server m) -> Server m #

stimes :: Integral b => b -> Server m -> Server m #

ToServer (Server m) Source # 
Instance details

Defined in Mig.Core.Class.Server

Methods

toServer :: Server m -> Server (MonadOf (Server m)) Source #

data FindRoute normalForm m Source #

API route finder strategy. The API can be transformed to some normal form for faster route lookup. So far we have two normal forms. One is plain Api type as it is. And another one is tree-structure where path switches are encoded with Map's.

Constructors

FindRoute 

Fields

treeApiStrategy :: FindRoute TreeApi m Source #

Use TreeApi normal form. Path switches are encoded as Maps.

plainApiStrategy :: FindRoute Api m Source #

Use plain api type. Just Api type as it is.

mapServerFun :: (ServerFun m -> ServerFun n) -> Server m -> Server n Source #

Applies server function to all routes

mapResponse :: Functor m => (Response -> Response) -> Server m -> Server m Source #

Mapps response of the server

fromServer :: forall m normalForm. Monad m => FindRoute normalForm m -> Server m -> ServerFun m Source #

Converts server to server function. Server function can be used to implement low-level handlers in various server-libraries.

fromServerWithCache :: forall m normalForm. MonadIO m => FindRoute normalForm m -> RouteCache m -> Server m -> ServerFun m Source #

Converts server to server function. Server function can be used to implement low-level handlers in various server-libraries. This function also uses LRU-cache to cache fetching of the routes

fillCaptures :: Api (Route m) -> Api (Route m) Source #

Substitutes all stars * for corresponding names in captures if there are more captures in the route than in the path it adds additional captures from the route to the path

addTag :: Text -> Server m -> Server m Source #

Adds tag to the route

setDescription :: Text -> Server m -> Server m Source #

Sets description of the route

setSummary :: Text -> Server m -> Server m Source #

Sets summary of the route

mapRouteInfo :: (RouteInfo -> RouteInfo) -> Server m -> Server m Source #

Maps over route API-information

staticFiles :: forall m. MonadIO m => [(FilePath, ByteString)] -> Server m Source #

Serves static files. The file path is a path to where to server the file. The media-type is derived from the extension. There is a special case if we need to server the file from the rooot of the server we can omit everything from the path but keep extension. Otherwise it is not able to derive the media type.

It is convenient to use it with function embedRecursiveDir from the library file-embed or file-embed-lzma.

describeInputs :: [(Text, Text)] -> Server m -> Server m Source #

Appends descriptiton for the inputs. It passes pairs for (input-name, input-description). special name request-body is dedicated to request body input nd raw-input is dedicated to raw input

atPath :: forall m. Path -> Server m -> Server m Source #

Sub-server for a server on given path it might be usefule to emulate links from one route to another within the server or reuse part of the server inside another server.

getServerPaths :: Server m -> [Path] Source #

Returns a list of all paths in the server

addPathLink :: Path -> Path -> Server m -> Server m Source #

Links one route of the server to another so that every call to first path is redirected to the second path