servant-mock-0.8.6: Derive a mock server for free from your servant API types

Copyright2015 Alp Mestanogullari
LicenseBSD3
MaintainerAlp Mestanogullari <alpmestan@gmail.com>
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Servant.Mock

Contents

Description

Automatically derive a mock webserver that implements some API type, just from the said API type's definition.

Using this module couldn't be simpler. Given some API type, like:

type API = "user" :> Get '[JSON] User

that describes your web application, all you have to do is define a Proxy to it:

myAPI :: Proxy API
myAPI = Proxy

and call mock, which has the following type:

mock :: HasMock api context => Proxy api -> Proxy context -> Server api

What this says is, given some API type api that it knows it can "mock", mock hands you an implementation of the API type. It does so by having each request handler generate a random value of the appropriate type (User in our case). All you need for this to work is to provide Arbitrary instances for the data types returned as response bodies, hence appearing next to Delete, Get, Patch, Post and Put.

To put this all to work and run the mock server, just call serve on the result of mock to get an Application that you can then run with warp.

main :: IO ()
main = Network.Wai.Handler.Warp.run 8080 $
  serve myAPI (mock myAPI Proxy)
Synopsis

Documentation

class HasServer api context => HasMock api context where Source #

HasMock defines an interpretation of API types than turns them into random-response-generating request handlers, hence providing an instance for all the combinators of the core servant library.

Methods

mock :: Proxy api -> Proxy context -> Server api Source #

Calling this method creates request handlers of the right type to implement the API described by api that just generate random response values of the right type. E.g:

  type API = "user" :> Get '[JSON] User
        :| "book" :> Get '[JSON] Book

  api :: Proxy API
  api = Proxy

  -- let's say we will start with the frontend,
  -- and hence need a placeholder server
  server :: Server API
  server = mock api Proxy
  

What happens here is that Server API actually "means" 2 request handlers, of the following types:

  getUser :: Handler User
  getBook :: Handler Book
  

So under the hood, mock uses the IO bit to generate random values of type User and Book every time these endpoints are requested.

Instances
HasMock Raw context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy Raw -> Proxy context -> Server Raw Source #

HasMock EmptyAPI context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy EmptyAPI -> Proxy context -> Server EmptyAPI Source #

ReflectMethod method => HasMock (NoContentVerb method :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (NoContentVerb method) -> Proxy context -> Server (NoContentVerb method) Source #

(HasMock a context, HasMock b context) => HasMock (a :<|> b :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (a :<|> b) -> Proxy context -> Server (a :<|> b) Source #

(HasContextEntry context (NamedContext name subContext), HasMock rest subContext) => HasMock (WithNamedContext name subContext rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (WithNamedContext name subContext rest) -> Proxy context -> Server (WithNamedContext name subContext rest) Source #

HasMock rest context => HasMock (HttpVersion :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (HttpVersion :> rest) -> Proxy context -> Server (HttpVersion :> rest) Source #

(MimeUnrender ctype chunk, FramingUnrender fr, FromSourceIO chunk a, HasMock rest context) => HasMock (StreamBody' mods fr ctype a :> rest :: Type) context Source #

Since: 0.8.5

Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (StreamBody' mods fr ctype a :> rest) -> Proxy context -> Server (StreamBody' mods fr ctype a :> rest) Source #

(AllCTUnrender ctypes a, HasMock rest context, SBoolI (FoldLenient mods)) => HasMock (ReqBody' mods ctypes a :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (ReqBody' mods ctypes a :> rest) -> Proxy context -> Server (ReqBody' mods ctypes a :> rest) Source #

HasMock rest context => HasMock (RemoteHost :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (RemoteHost :> rest) -> Proxy context -> Server (RemoteHost :> rest) Source #

(KnownSymbol s, FromHttpApiData a, HasMock rest context, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)) => HasMock (QueryParam' mods s a :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (QueryParam' mods s a :> rest) -> Proxy context -> Server (QueryParam' mods s a :> rest) Source #

(KnownSymbol s, FromHttpApiData a, HasMock rest context) => HasMock (QueryParams s a :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (QueryParams s a :> rest) -> Proxy context -> Server (QueryParams s a :> rest) Source #

(KnownSymbol s, HasMock rest context) => HasMock (QueryFlag s :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (QueryFlag s :> rest) -> Proxy context -> Server (QueryFlag s :> rest) Source #

(KnownSymbol h, FromHttpApiData a, HasMock rest context, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)) => HasMock (Header' mods h a :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Header' mods h a :> rest) -> Proxy context -> Server (Header' mods h a :> rest) Source #

HasMock rest context => HasMock (IsSecure :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (IsSecure :> rest) -> Proxy context -> Server (IsSecure :> rest) Source #

HasMock api context => HasMock (Summary d :> api :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Summary d :> api) -> Proxy context -> Server (Summary d :> api) Source #

HasMock api context => HasMock (Description d :> api :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Description d :> api) -> Proxy context -> Server (Description d :> api) Source #

(KnownSymbol s, FromHttpApiData a, HasMock rest context, SBoolI (FoldLenient mods)) => HasMock (Capture' mods s a :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Capture' mods s a :> rest) -> Proxy context -> Server (Capture' mods s a :> rest) Source #

(KnownSymbol s, FromHttpApiData a, HasMock rest context) => HasMock (CaptureAll s a :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (CaptureAll s a :> rest) -> Proxy context -> Server (CaptureAll s a :> rest) Source #

HasMock rest context => HasMock (Vault :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Vault :> rest) -> Proxy context -> Server (Vault :> rest) Source #

(KnownSymbol path, HasMock rest context) => HasMock (path :> rest :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (path :> rest) -> Proxy context -> Server (path :> rest) Source #

(GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes), Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a) => HasMock (Verb method status ctypes (Headers headerTypes a) :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Verb method status ctypes (Headers headerTypes a)) -> Proxy context -> Server (Verb method status ctypes (Headers headerTypes a)) Source #

(Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a) => HasMock (Verb method status ctypes a :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Verb method status ctypes a) -> Proxy context -> Server (Verb method status ctypes a) Source #

(Arbitrary a, KnownNat status, ReflectMethod method, MimeRender ctype chunk, FramingRender fr, ToSourceIO chunk a) => HasMock (Stream method status fr ctype a :: Type) context Source # 
Instance details

Defined in Servant.Mock

Methods

mock :: Proxy (Stream method status fr ctype a) -> Proxy context -> Server (Stream method status fr ctype a) Source #

Orphan instances

Arbitrary NoContent Source # 
Instance details

(Arbitrary a, Arbitrary (HList hs)) => Arbitrary (HList (Header h a ': hs)) Source # 
Instance details

Methods

arbitrary :: Gen (HList (Header h a ': hs)) #

shrink :: HList (Header h a ': hs) -> [HList (Header h a ': hs)] #

Arbitrary (HList ([] :: [Type])) Source # 
Instance details

Methods

arbitrary :: Gen (HList []) #

shrink :: HList [] -> [HList []] #

(Arbitrary (HList ls), Arbitrary a) => Arbitrary (Headers ls a) Source # 
Instance details

Methods

arbitrary :: Gen (Headers ls a) #

shrink :: Headers ls a -> [Headers ls a] #