servant-benchmark-0.1.1.1: Generate benchmark files from a Servant API
Safe HaskellNone
LanguageHaskell2010

Servant.Benchmark

Description

A library for producing random request data from Servant APIs.

Visit the project's repository for more information.

Synopsis

Documentation

type family Generator (api :: Type) where ... Source #

A Generator provides value level interpretation of an API.

The Generator type must closely follow the structure of the Servant API.

  • Different endpoints are combined with the :|: operator
  • Different generators are combined with the :>: operator
  • Every endpoint must end with a `(Text, Word)` tuple consisting of the endpoint name and its corresponding weight. Endpoint names are only used for additional information passed to the benchmark implementations and do not have to follow specific rules. That being said, generators for extensive APIs can get rather big and hard to read, so providing sensible naming could be very beneficial.
  • The weight of an endpoint specifies the number of instances per testing run of the API. Endpoints with 0 weight will be ignored.
  • For every API combinator expecting a request value, a `Gen a` random value generator from the QuickCheck package must be provided.
  • The following combinators require a value generator:

  • For the BasicAuth combinator, see the dedicated section below

As an example, the following is a valid Generator for a contrived servant API

type API =
    "books" :> Get '[JSON] [Book]
    :| "view-my-referer" :> Header "from" Referer :> Get '[JSON] Referer
    :| "users" :> Capture "userId" Integer :> ReqBody '[JSON] User :> Put '[JSON] User
    :| "post" :> QueryParam "segments" Text :> Get '[JSON] Post
    :| Raw

generator :: Generator API
let generator =
    ("books", 1)
    :|: arbitrary :>: ("referer", 2)
    :|: pure 1001 :>: arbitrary :>: ("users endpoint", 2)
    :|: elements ["title", "contents", "post"] :>: ("post", 4)
    :|: ("raw", 0)

The first endpoint "books" does not require request data and so only the name / weight tuple is provided.

The "view-my-referer" endpoint requires a "from" header with an accompanying Referer value. Here we assume Referer has an Arbitrary instance to provide a random value. The endpoint generator finishes with the name/weight indication.

The "users" endpoint requires two different request values. An Integer capture representing a user id as well as a User value. We hard-code the user id to `1001` using the monadic pure and assume that User has an Arbitrary instance to produce a random value. We finish with the endpoint's name/weight as necessary.

The "post" endpoint requires a Text query parameter. We provide a fixed set of possible values using the elements function from the QuickCheck package. With a weight of 4, four instances of the "post" endpoint will be produced, each with a random value from the specified set.

Finally our API provides a Raw endpoint for serving static files, but we'd rather not benchmark it. Providing a 0 weight ensures that no request will be generated

Basic Auth

A generator for an endpoint using a BasicAuth combinator requires both a function to convert the requested user data type to BasicAuthData as well as a Gen value for the requested user data.

example:

type privateAPI = "private" :> BasicAuth "foo-realm" User :> PrivateAPI

toBasicAuthData :: User -> BasicAuthData
toBasicAuthData user = ...

-- assuming User has an Arbitrary instance
let generator = toBasicAuthData :>: arbitrary :>: ("basicAuth", 1)

The information will be encoded as an Authorization header.

Equations

Generator (a :<|> b) = Generator a :|: Generator b 
Generator (Verb (method :: k) (statusCode :: Nat) (contentTypes :: [Type]) (a :: Type)) = (Text, Word) 
Generator (ReqBody '[JSON] (a :: Type) :> rest) = Gen a :>: Generator rest 
Generator (ReqBody '[PlainText] (a :: Type) :> rest) = Gen a :>: Generator rest 
Generator (QueryParams params a :> rest) = Gen a :>: Generator rest 
Generator ((sym :: Symbol) :> rest) = Generator rest 
Generator (HttpVersion :> rest) = Generator rest 
Generator (QueryFlag (sym :: Symbol) :> rest) = Generator rest 
Generator (Capture (sym :: Symbol) String :> rest) = Gen String :>: Generator rest 
Generator (Capture (sym :: Symbol) (a :: Type) :> rest) = Gen a :>: Generator rest 
Generator (CaptureAll (sym :: Symbol) (a :: Type) :> rest) = Gen a :>: Generator rest 
Generator (Header (sym :: Symbol) (a :: Type) :> rest) = Gen a :>: Generator rest 
Generator (Fragment (a :: Type) :> rest) = Gen a :>: Generator rest 
Generator EmptyAPI = (Text, Word) 
Generator (RemoteHost :> rest) = Generator rest 
Generator (IsSecure :> rest) = Generator rest 
Generator (WithNamedContext (name :: Symbol) (sub :: [Type]) (api :: Type)) = Generator api 
Generator (BasicAuth (realm :: Symbol) (userData :: Type) :> rest) = (userData -> BasicAuthData) :>: (Gen userData :>: Generator rest) 
Generator (Description (sym :: Symbol) :> rest) = Generator rest 
Generator (Summary (sym :: Symbol) :> rest) = Generator rest 
Generator Raw = (Text, Word) 

Generator builders

data (a :: Type) :|: (b :: Type) infixr 3 Source #

Value level Generator combinator. Combine endpoint generators to build an API generator

example:

-- The API we want to benchmark
type API = "books" :> Get '[JSON] Book :| "authors" :> "authors" :> ReqBody '[PlainText] String :> Post '[JSON] [Author]

generator :: Generator API
generator = ("books", 1) :|: elements [Cervantes, Kant] :>: ("authors", 2)

Constructors

a :|: b infixr 3 

data (a :: Type) :>: (b :: Type) infixr 9 Source #

Value level Generator combinator. Build endpoint generators by combining Gen values with (description, weight) tuples

example:

 -- A single endpoint API
 type API = "authors" :> "authors" :> ReqBody '[PlainText] String :> Post '[JSON] [Author]

generator :: Generator API
generator = elements [Cervantes, Kant] :>: ("authors", 2)

Constructors

a :>: b infixr 9 

class HasGenerator api where Source #

HasGenerator provides combined type and value level interpretation of an API, producing corresponding Endpoint values.

Instructions on forming a Generator type can be found on the module documentation.

Methods

generate :: Proxy api -> Generator api -> IO [Endpoint] Source #

Instances

Instances details
HasEndpoint a => HasGenerator a Source # 
Instance details

Defined in Servant.Benchmark.HasGenerator

Methods

generate :: Proxy a -> Generator a -> IO [Endpoint] Source #

(HasEndpoint a, HasGenerator b) => HasGenerator (a :<|> b) Source # 
Instance details

Defined in Servant.Benchmark.HasGenerator

Methods

generate :: Proxy (a :<|> b) -> Generator (a :<|> b) -> IO [Endpoint] Source #

class HasEndpoint (api :: Type) where Source #

HasEndpoint provides type level interpretation of an API Endpoint

Methods

getEndpoint :: Proxy api -> Generator api -> IO Endpoint Source #

weight :: Proxy api -> Generator api -> Word Source #

Instances

Instances details
HasEndpoint Raw Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

HasEndpoint EmptyAPI Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

HasEndpoint api => HasEndpoint (WithNamedContext name sub api) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (WithNamedContext name sub api) -> Generator (WithNamedContext name sub api) -> IO Endpoint Source #

weight :: Proxy (WithNamedContext name sub api) -> Generator (WithNamedContext name sub api) -> Word Source #

HasEndpoint rest => HasEndpoint (HttpVersion :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

(ToJSON a, HasEndpoint rest) => HasEndpoint (ReqBody '[JSON] a :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (ReqBody '[JSON] a :> rest) -> Generator (ReqBody '[JSON] a :> rest) -> IO Endpoint Source #

weight :: Proxy (ReqBody '[JSON] a :> rest) -> Generator (ReqBody '[JSON] a :> rest) -> Word Source #

(ToText a, HasEndpoint rest) => HasEndpoint (ReqBody '[PlainText] a :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

HasEndpoint rest => HasEndpoint (RemoteHost :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

(KnownSymbol params, ToText a, HasEndpoint rest) => HasEndpoint (QueryParams params a :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (QueryParams params a :> rest) -> Generator (QueryParams params a :> rest) -> IO Endpoint Source #

weight :: Proxy (QueryParams params a :> rest) -> Generator (QueryParams params a :> rest) -> Word Source #

(KnownSymbol sym, HasEndpoint rest) => HasEndpoint (QueryFlag sym :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (QueryFlag sym :> rest) -> Generator (QueryFlag sym :> rest) -> IO Endpoint Source #

weight :: Proxy (QueryFlag sym :> rest) -> Generator (QueryFlag sym :> rest) -> Word Source #

(KnownSymbol sym, ToText a, HasEndpoint rest) => HasEndpoint (Header sym a :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (Header sym a :> rest) -> Generator (Header sym a :> rest) -> IO Endpoint Source #

weight :: Proxy (Header sym a :> rest) -> Generator (Header sym a :> rest) -> Word Source #

HasEndpoint rest => HasEndpoint (IsSecure :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

(ToText a, HasEndpoint rest) => HasEndpoint (Fragment a :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (Fragment a :> rest) -> Generator (Fragment a :> rest) -> IO Endpoint Source #

weight :: Proxy (Fragment a :> rest) -> Generator (Fragment a :> rest) -> Word Source #

HasEndpoint rest => HasEndpoint (Summary sym :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (Summary sym :> rest) -> Generator (Summary sym :> rest) -> IO Endpoint Source #

weight :: Proxy (Summary sym :> rest) -> Generator (Summary sym :> rest) -> Word Source #

HasEndpoint rest => HasEndpoint (Description sym :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (Description sym :> rest) -> Generator (Description sym :> rest) -> IO Endpoint Source #

weight :: Proxy (Description sym :> rest) -> Generator (Description sym :> rest) -> Word Source #

(ToText a, HasEndpoint rest) => HasEndpoint (Capture sym a :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (Capture sym a :> rest) -> Generator (Capture sym a :> rest) -> IO Endpoint Source #

weight :: Proxy (Capture sym a :> rest) -> Generator (Capture sym a :> rest) -> Word Source #

(ToText a, HasEndpoint rest) => HasEndpoint (CaptureAll sym a :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (CaptureAll sym a :> rest) -> Generator (CaptureAll sym a :> rest) -> IO Endpoint Source #

weight :: Proxy (CaptureAll sym a :> rest) -> Generator (CaptureAll sym a :> rest) -> Word Source #

HasEndpoint rest => HasEndpoint (BasicAuth realm userData :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (BasicAuth realm userData :> rest) -> Generator (BasicAuth realm userData :> rest) -> IO Endpoint Source #

weight :: Proxy (BasicAuth realm userData :> rest) -> Generator (BasicAuth realm userData :> rest) -> Word Source #

(KnownSymbol sym, HasEndpoint rest) => HasEndpoint (sym :> rest) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (sym :> rest) -> Generator (sym :> rest) -> IO Endpoint Source #

weight :: Proxy (sym :> rest) -> Generator (sym :> rest) -> Word Source #

ReflectMethod method => HasEndpoint (Verb method statusCode contentTypes a) Source # 
Instance details

Defined in Servant.Benchmark.HasEndpoint

Methods

getEndpoint :: Proxy (Verb method statusCode contentTypes a) -> Generator (Verb method statusCode contentTypes a) -> IO Endpoint Source #

weight :: Proxy (Verb method statusCode contentTypes a) -> Generator (Verb method statusCode contentTypes a) -> Word Source #

data Endpoint Source #

An API endpoint. -

Constructors

MkEndpoint 

Fields

  • name :: Text
     
  • path :: Text
     
  • method :: Maybe Method
     
  • body :: Maybe ByteString

    The request value, where applicable. Only the first encountered request value is taken into consideration eg. "user" :> ReqBody '[JSON] Text :> ReqBody '[JSON] Int :> Get '[JSON] User will produce only a Text based request value

  • contentType :: Maybe MediaType

    The requests content type. Only the first encountered content type is taken into consideration. If you're building an endpoint manually, you should enter the media type here rather than directly in headers. All implementations automatically include the content type header during benchmark configuration output.

  • headers :: [Header]

    The request headers

Instances

Instances details
Eq Endpoint Source # 
Instance details

Defined in Servant.Benchmark.Endpoint

Show Endpoint Source # 
Instance details

Defined in Servant.Benchmark.Endpoint

Semigroup Endpoint Source # 
Instance details

Defined in Servant.Benchmark.Endpoint

Monoid Endpoint Source # 
Instance details

Defined in Servant.Benchmark.Endpoint