servant-server-0.6: A family of combinators for defining webservices APIs and serving them

Safe HaskellNone
LanguageHaskell2010

Servant.Server

Contents

Description

This module lets you implement Servers for defined APIs. You'll most likely just need serve.

Synopsis

Run a wai application from an API

serve :: HasServer layout `[]` => Proxy layout -> Server layout -> Application Source

serve allows you to implement an API and produce a wai Application.

Example:

type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
        :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books

server :: Server MyApi
server = listAllBooks :<|> postBook
  where listAllBooks = ...
        postBook book = ...

myApi :: Proxy MyApi
myApi = Proxy

app :: Application
app = serve myApi server

main :: IO ()
main = Network.Wai.Handler.Warp.run 8080 app

serveWithContext :: HasServer layout context => Proxy layout -> Context context -> Server layout -> Application Source

Construct a wai Application from an API

Handlers for all standard combinators

class HasServer layout context where Source

Associated Types

type ServerT layout m :: * Source

Methods

route :: Proxy layout -> Context context -> Delayed (Server layout) -> Router Source

Instances

HasServer * Raw context Source

Just pass the request to the underlying application and serve its response.

Example:

type MyApi = "images" :> Raw

server :: Server MyApi
server = serveDirectory "/var/www/images"
(HasServer * a context, HasServer * b context) => HasServer * ((:<|>) a b) context Source

A server for a :<|> b first tries to match the request against the route represented by a and if it fails tries b. You must provide a request handler for each route.

type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
        :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books

server :: Server MyApi
server = listAllBooks :<|> postBook
  where listAllBooks = ...
        postBook book = ...
(HasContextEntry context (NamedContext name subContext), HasServer * subApi subContext) => HasServer * (WithNamedContext name subContext subApi) context Source 
(KnownSymbol realm, HasServer k api context, HasContextEntry context (BasicAuthCheck usr)) => HasServer * ((:>) * k (BasicAuth realm usr) api) context Source

Basic Authentication

HasServer k api context => HasServer * ((:>) * k HttpVersion api) context Source 
HasServer k api context => HasServer * ((:>) * k Vault api) context Source 
HasServer k api context => HasServer * ((:>) * k IsSecure api) context Source 
HasServer k api context => HasServer * ((:>) * k RemoteHost api) context Source 
(AllCTUnrender list a, HasServer k sublayout context) => HasServer * ((:>) * k (ReqBody * list a) sublayout) context Source

If you use ReqBody in one of the endpoints for your API, this automatically requires your server-side handler to be a function that takes an argument of the type specified by ReqBody. The Content-Type header is inspected, and the list provided is used to attempt deserialization. If the request does not have a Content-Type header, it is treated as application/octet-stream (as specified in RFC7231. This lets servant worry about extracting it from the request and turning it into a value of the type you specify.

All it asks is for a FromJSON instance.

Example:

type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book

server :: Server MyApi
server = postBook
  where postBook :: Book -> ExceptT ServantErr IO Book
        postBook book = ...insert into your db...
(KnownSymbol sym, HasServer k sublayout context) => HasServer * ((:>) * k (QueryFlag sym) sublayout) context Source

If you use QueryFlag "published" in one of the endpoints for your API, this automatically requires your server-side handler to be a function that takes an argument of type Bool.

Example:

type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]

server :: Server MyApi
server = getBooks
  where getBooks :: Bool -> ExceptT ServantErr IO [Book]
        getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
(KnownSymbol sym, FromHttpApiData a, HasServer k sublayout context) => HasServer * ((:>) * k (QueryParams * sym a) sublayout) context Source

If you use QueryParams "authors" Text in one of the endpoints for your API, this automatically requires your server-side handler to be a function that takes an argument of type [Text].

This lets servant worry about looking up 0 or more values in the query string associated to authors and turning each of them into a value of the type you specify.

You can control how the individual values are converted from Text to your type by simply providing an instance of FromHttpApiData for your type.

Example:

type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]

server :: Server MyApi
server = getBooksBy
  where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
        getBooksBy authors = ...return all books by these authors...
(KnownSymbol sym, FromHttpApiData a, HasServer k sublayout context) => HasServer * ((:>) * k (QueryParam * sym a) sublayout) context Source

If you use QueryParam "author" Text in one of the endpoints for your API, this automatically requires your server-side handler to be a function that takes an argument of type Maybe Text.

This lets servant worry about looking it up in the query string and turning it into a value of the type you specify, enclosed in Maybe, because it may not be there and servant would then hand you Nothing.

You can control how it'll be converted from Text to your type by simply providing an instance of FromHttpApiData for your type.

Example:

type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]

server :: Server MyApi
server = getBooksBy
  where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
        getBooksBy Nothing       = ...return all books...
        getBooksBy (Just author) = ...return books by the given author...
(KnownSymbol sym, FromHttpApiData a, HasServer k sublayout context) => HasServer * ((:>) * k (Header sym a) sublayout) context Source

If you use Header in one of the endpoints for your API, this automatically requires your server-side handler to be a function that takes an argument of the type specified by Header. This lets servant worry about extracting it from the request and turning it into a value of the type you specify.

All it asks is for a FromHttpApiData instance.

Example:

newtype Referer = Referer Text
  deriving (Eq, Show, FromHttpApiData)

           -- GET /view-my-referer
type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer

server :: Server MyApi
server = viewReferer
  where viewReferer :: Referer -> ExceptT ServantErr IO referer
        viewReferer referer = return referer
(KnownSymbol capture, FromHttpApiData a, HasServer k sublayout context) => HasServer * ((:>) * k (Capture * capture a) sublayout) context Source

If you use Capture in one of the endpoints for your API, this automatically requires your server-side handler to be a function that takes an argument of the type specified by the Capture. This lets servant worry about getting it from the URL and turning it into a value of the type you specify.

You can control how it'll be converted from Text to your type by simply providing an instance of FromHttpApiData for your type.

Example:

type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book

server :: Server MyApi
server = getBook
  where getBook :: Text -> ExceptT ServantErr IO Book
        getBook isbn = ...
(KnownSymbol path, HasServer k sublayout context) => HasServer * ((:>) Symbol k path sublayout) context Source

Make sure the incoming request starts with "/path", strip it and pass the rest of the request path to sublayout.

(AllCTRender ctypes a, ReflectMethod k method, KnownNat status, GetHeaders (Headers h a)) => HasServer * (Verb k * method status ctypes (Headers h a)) context Source 
(AllCTRender ctypes a, ReflectMethod k method, KnownNat status) => HasServer * (Verb k * method status ctypes a) context Source 

type Server layout = ServerT layout (ExceptT ServantErr IO) Source

Enter

Sometimes our cherished ExceptT monad isn't quite the type you'd like for your handlers. Maybe you want to thread some configuration in a Reader monad. Or have your types ensure that your handlers don't do any IO. Enter enter.

With enter, you can provide a function, wrapped in the `(:~>)` / Nat newtype, to convert any number of endpoints from one type constructor to another. For example

>>> import Control.Monad.Reader
>>> import qualified Control.Category as C
>>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String
>>> let readerServer = return 1797 :<|> ask :: ServerT ReaderAPI (Reader String)
>>> let mainServer = enter (generalizeNat C.. (runReaderTNat "hi")) readerServer :: Server ReaderAPI

Basic functions and datatypes

enter :: Enter typ arg ret => arg -> typ -> ret Source

newtype m :~> n Source

A natural transformation from m to n. Used to enter particular datatypes.

Constructors

Nat 

Fields

unNat :: forall a. m a -> n a
 

Instances

Enter (m a) ((:~>) m n) (n a) Source 
Category (* -> *) (:~>) Source 

Nat utilities

liftNat :: (MonadTrans t, Monad m) => m :~> t m Source

Like lift.

evalStateTLNat :: Monad m => s -> StateT s m :~> m Source

evalStateTSNat :: Monad m => s -> StateT s m :~> m Source

logWriterTLNat :: MonadIO m => (w -> IO ()) -> WriterT w m :~> m Source

Like logWriterTSNat, but for strict WriterT.

logWriterTSNat :: MonadIO m => (w -> IO ()) -> WriterT w m :~> m Source

Log the contents of WriterT with the function provided as the first argument, and return the value of the WriterT computation

Functions based on mmorph

hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> t m :~> t n Source

Like mmorph's hoist.

embedNat :: (MMonad t, Monad n) => (m :~> t n) -> t m :~> t n Source

Like mmorph's embed.

squashNat :: (Monad m, MMonad t) => t (t m) :~> t m Source

Like mmorph's squash.

tweakResponse :: (RouteResult Response -> RouteResult Response) -> Router -> Router Source

Apply a transformation to the response of a Router.

Context

data Context contextTypes where Source

Contexts are used to pass values to combinators. (They are not meant to be used to pass parameters to your handlers, i.e. they should not replace any custom ReaderT-monad-stack that you're using with enter.) If you don't use combinators that require any context entries, you can just use serve as always.

If you are using combinators that require a non-empty Context you have to use serveWithContext and pass it a Context that contains all the values your combinators need. A Context is essentially a heterogenous list and accessing the elements is being done by type (see getContextEntry). The parameter of the type Context is a type-level list reflecting the types of the contained context entries. To create a Context with entries, use the operator (:.):

>>> :type True :. () :. EmptyContext
True :. () :. EmptyContext :: Context '[Bool, ()]

Constructors

EmptyContext :: Context `[]` 
(:.) :: x -> Context xs -> Context (x : xs) infixr 5 

Instances

(Eq a, Eq (Context as)) => Eq (Context ((:) * a as)) Source 
Eq (Context ([] *)) Source 
(Show a, Show (Context as)) => Show (Context ((:) * a as)) Source 
Show (Context ([] *)) Source 

class HasContextEntry context val where Source

This class is used to access context entries in Contexts. getContextEntry returns the first value where the type matches:

>>> getContextEntry (True :. False :. EmptyContext) :: Bool
True

If the Context does not contain an entry of the requested type, you'll get an error:

>>> getContextEntry (True :. False :. EmptyContext) :: String
...
    No instance for (HasContextEntry '[] [Char])
...

Methods

getContextEntry :: Context context -> val Source

Instances

HasContextEntry ((:) * val xs) val Source 
HasContextEntry xs val => HasContextEntry ((:) * notIt xs) val Source 

NamedContext

data NamedContext name subContext Source

Normally context entries are accessed by their types. In case you need to have multiple values of the same type in your Context and need to access them, we provide NamedContext. You can think of it as sub-namespaces for Contexts.

Constructors

NamedContext (Context subContext) 

descendIntoNamedContext :: forall context name subContext. HasContextEntry context (NamedContext name subContext) => Proxy (name :: Symbol) -> Context context -> Context subContext Source

descendIntoNamedContext allows you to access NamedContexts. Usually you won't have to use it yourself but instead use a combinator like WithNamedContext.

This is how descendIntoNamedContext works:

>>> :set -XFlexibleContexts
>>> let subContext = True :. EmptyContext
>>> :type subContext
subContext :: Context '[Bool]
>>> let parentContext = False :. (NamedContext subContext :: NamedContext "subContext" '[Bool]) :. EmptyContext
>>> :type parentContext
parentContext :: Context '[Bool, NamedContext "subContext" '[Bool]]
>>> descendIntoNamedContext (Proxy :: Proxy "subContext") parentContext :: Context '[Bool]
True :. EmptyContext

Basic Authentication

newtype BasicAuthCheck usr Source

Datatype wrapping a function used to check authentication.

data BasicAuthResult usr Source

servant-server's current implementation of basic authentication is not immune to certian kinds of timing attacks. Decoding payloads does not take a fixed amount of time.

The result of authentication/authorization

General Authentication

Default error type

3XX

err300 :: ServantErr Source

err300 Multiple Choices

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err300 { errBody = "I can't choose." }

err301 :: ServantErr Source

err301 Moved Permanently

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err301

err302 :: ServantErr Source

err302 Found

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err302

err303 :: ServantErr Source

err303 See Other

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err303

err304 :: ServantErr Source

err304 Not Modified

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err304

err305 :: ServantErr Source

err305 Use Proxy

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err305

err307 :: ServantErr Source

err307 Temporary Redirect

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err307

4XX

err400 :: ServantErr Source

err400 Bad Request

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err400 { errBody = "Your request makes no sense to me." }

err401 :: ServantErr Source

err401 Unauthorized

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err401 { errBody = "Your credentials are invalid." }

err402 :: ServantErr Source

err402 Payment Required

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err402 { errBody = "You have 0 credits. Please give me $$$." }

err403 :: ServantErr Source

err403 Forbidden

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err403 { errBody = "Please login first." }

err404 :: ServantErr Source

err404 Not Found

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err404 { errBody = "(╯°□°)╯︵ ┻━┻)." }

err405 :: ServantErr Source

err405 Method Not Allowed

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err405 { errBody = "Your account privileges does not allow for this.  Please pay $$$." }

err406 :: ServantErr Source

err406 Not Acceptable

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err406

err407 :: ServantErr Source

err407 Proxy Authentication Required

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err407

err409 :: ServantErr Source

err409 Conflict

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err409 { errBody = "Transaction conflicts with 59879cb56c7c159231eeacdd503d755f7e835f74" }

err410 :: ServantErr Source

err410 Gone

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err410 { errBody = "I know it was here at some point, but.. I blame bad luck." }

err411 :: ServantErr Source

err411 Length Required

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr err411

err412 :: ServantErr Source

err412 Precondition Failed

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err412 { errBody = "Precondition fail: x < 42 && y > 57" }

err413 :: ServantErr Source

err413 Request Entity Too Large

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err413 { errBody = "Request exceeded 64k." }

err414 :: ServantErr Source

err414 Request-URI Too Large

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err414 { errBody = "Maximum length is 64." }

err415 :: ServantErr Source

err415 Unsupported Media Type

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err415 { errBody = "Supported media types:  gif, png" }

err416 :: ServantErr Source

err416 Request range not satisfiable

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err416 { errBody = "Valid range is [0, 424242]." }

err417 :: ServantErr Source

err417 Expectation Failed

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err417 { errBody = "I found a quux in the request.  This isn't going to work." }

5XX

err500 :: ServantErr Source

err500 Internal Server Error

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err500 { errBody = "Exception in module A.B.C:55.  Have a great day!" }

err501 :: ServantErr Source

err501 Not Implemented

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err501 { errBody = "/v1/foo is not supported with quux in the request." }

err502 :: ServantErr Source

err502 Bad Gateway

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err502 { errBody = "Tried gateway foo, bar, and baz.  None responded." }

err503 :: ServantErr Source

err503 Service Unavailable

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err503 { errBody = "We're rewriting in PHP." }

err504 :: ServantErr Source

err504 Gateway Time-out

Example:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err504 { errBody = "Backend foobar did not respond in 5 seconds." }

err505 :: ServantErr Source

err505 HTTP Version not supported

Example usage:

failingHandler :: ExceptT ServantErr IO ()
failingHandler = throwErr $ err505 { errBody = "I support HTTP/4.0 only." }