wrecker 1.1.0.0 → 1.1.1.0
raw patch · 5 files changed
+267/−775 lines, 5 filesdep ~aesondep ~basedep ~bytestring
Dependency ranges changed: aeson, base, bytestring, connection, http-client, immortal, network, next-ref, text, transformers, warp, wreq
Files
- examples/Client.lhs +0/−401
- examples/Main.lhs +0/−99
- examples/Server.hs +0/−213
- src/Network/Wreq/Wrecker/API.hs +264/−0
- wrecker.cabal +3/−62
− examples/Client.lhs
@@ -1,401 +0,0 @@-# Building a Profiling Client with `wrecker`--`wrecker` is intended to benchmark HTTP calls inline with other forms of-processing. This allows for complex the interactions necessary to benchmark-certain API endpoints.--## TL;DR--`wrecker` lets you build elegant API clients that you can use for profiling.--Here is the the final benchmark utlizing the typed REST client we will build.-- testScript :: Int -> ConnectionContext -> Recorder -> IO ()- testScript port cxt rec = withSession cxt rec $ \sess -> do- Root { products- , login- , checkout- } <- get sess (rootRef port)- firstProduct : _ <- get sess products- userRef <- rpc sess login- ( Credentials- { userName = "a@example.com"- , password = "password"- }- )- User { usersCart } <- get sess userRef- Cart { items } <- get sess usersCart-- insert sess items firstProduct- rpc sess checkout cart--If this doesn't make sense on inspection, that is okay. This file builds up all-the necessary utilities and documents every line.--Most of the code in this file is "generic." It is the type of boilerplate you-make once for an API client.--You don't need to make a polished typed API client to use `wrecker`;-just look at TODO_MAKE_AESON_LENS_EXAMPLE.--## Outline- - [Boring Haskell Prelude](#Boring_Haskell_Prelude)- - [Make a Somewhat Generic JSON API](#Make_a_Somewhat_Generic_JSON_API)- - [Make a Somewhat Generic REST API](#Make_a_Somewhat_Generic_REST_API)- - [The Example API](#The_Example_API)- - [Profiling Script](#Profiling_Script)--## <a name="Boring_Haskell_Prelude"> Boring Haskell Prelude--This is Haskell, so first we turn on the extensions we would like to use.--```haskell-{-# LANGUAGE NamedFieldPuns, DeriveGeneric, OverloadedStrings, CPP #-}-```--- `NamedFieldPuns` will let us destructure records conveniently. -- `DeriveAnyClass` and `DeriveGeneric` are used turned on so the compiler- can generate the JSON conversion functions for us automatically.-- `OverloadedStrings` is a here so Redditors don't yell at me for using- `String` instead of `Text`.-- `CPP`...ignore that...--```haskell-#ifndef _CLIENT_IS_MAIN_-module Client where-#endif-```-Not the drones...--### The Essence of `wrecker`--```haskell-import Wrecker (defaultMain, Environment)-```--- `defaultMain` is one of two entry points `wrecker` provides (the other is- `run`). `defaultMain` performs command line argument parsing for us, and- runs the benchmarks with the provided options.-- `Environment` contains the necessary state to record the times of- requests and it has a preallocated TLS context.--```haskell-import Data.Aeson-```-We need JSON, so of course we are using `aeson`.--```haskell-import Network.Wreq (Response)-import Network.Wreq.Wrecker (Session)-import qualified Network.Wreq.Wrecker as WW-```-`wrecker` provides a wrapped version of `Network.Wreq.Session` called-`Network.Wreq.Wrecker`. Importing is the quickest way to write a benchmark with-`wrecker`--#### Other packages you can mostly ignore-```haskell-import GHC.Generics-import Data.Text as T-import Network.HTTP.Client (responseBody)-```--## <a name="Make_a_Somewhat_Generic_JSON_API"> Make a Somewhat Generic JSON API--`wreq` is pretty easy to use for JSON APIs, but it could be easier. Here we make-a quick wrapper around `wreq`, specialized to JSON.--### The Envelope--We wrap all JSON sent to and from the server in the envelope.--The envelope is serialized to JSON with the following format-```json-{"value" : RESPONSE_SPECIFIC_OUTPUT }-```-It is represented in Haskell as-```haskell-data Envelope a = Envelope { value :: a }- deriving (Show, Eq, Generic)--instance FromJSON a => FromJSON (Envelope a)-instance ToJSON a => ToJSON (Envelope a) -```--The `Envelope` only exists to transmit data between the server and the browser.--- We wrap values going to the server in an `Envelope`.-- ```haskell- toEnvelope :: ToJSON a => a -> Value- toEnvelope = toJSON . Envelope- ```--- We unwrap values coming from the server in `Envelope`.-- ```haskell- fromEnvelope :: FromJSON a => IO (Response (Envelope a)) -> IO a- fromEnvelope x = fmap (value . responseBody) x- ```--- We wrap inputs and unwrap outputs so we can wrap a whole function.-- ```haskell- liftEnvelope :: (ToJSON a, FromJSON b)- => (Value -> IO (Response (Envelope b)))- -> (a -> IO b)- liftEnvelope f = fromEnvelope . f . toEnvelope- ```--### Hide the Envelope--We hide the `Envelope` in JSON specialized `get`'s and `post`'s.--```haskell-jsonGet :: FromJSON a => Session -> Text -> IO a-jsonGet sess url = fromEnvelope $ WW.getJSON sess (T.unpack url)--jsonPost :: (ToJSON a, FromJSON b) => Session -> Text -> a -> IO b-jsonPost sess url = liftEnvelope $ WW.postJSON sess (T.unpack url)-```--## <a name="Make_a_Somewhat_Generic_REST_API"> Make a Somewhat Generic REST API--### Resource References-Working with JSON is okay, but this is Haskell so we would rather work with-types.--We represent resource URLs using the type `Ref`.-```haskell-data Ref a = Ref { unRef :: Text }- deriving (Show, Eq)-```--`Ref` is nothing more than a `Text` wrapper (the value there is the URL). `Ref`-has a phantom type `a`, which enables us to talk about different types of resources.--`Ref a`'s `FromJSON` instance wraps a `Text` value, after scrutinizing the JSON `Value` to ensure it is `Text`.--```haskell-instance FromJSON (Ref a) where- parseJSON = withText "FromJSON (Ref a)" (return . Ref)-```--The `ToJSON` is just the reverse.--```haskell-instance ToJSON (Ref a) where- toJSON (Ref x) = toJSON x-```--In addition to resources, our API has ad-hoc RPC calls. RPC calls are also-represented as a URL.--### Adhoc RPC--```haskell-data RPC a b = RPC Text- deriving (Show, Eq)--instance FromJSON (RPC a b) where- parseJSON = withText "FromJSON (Ref a)" (return . RPC)-```--### REST API Actions--We utilize our `jsonGet` and `jsonPost` functions, and make specialized versions-for our more specific REST and RPC calls.--- `get` takes a `Ref a` and returns an `a`. The `a` could be something- like `Cart`, or it could be a list like `[Ref a]`.-- ```haskell- get :: FromJSON a => Session -> Ref a -> IO a- get sess (Ref url) = jsonGet sess url- ```--- `insert` takes a `Ref` to a list and appends an item to it. It returns the- reference that you passed in because, why not.-- ```haskell- insert :: ToJSON a => Session -> Ref [a] -> a -> IO (Ref [a])- insert sess (Ref url) = jsonPost sess url- ```--- `rpc` unpacks the URL for the RPC endpoint and `POST`s the input, returning- the output.-- ```haskell- rpc :: (ToJSON a, FromJSON b) => Session -> RPC a b -> a -> IO b- rpc sess (RPC url) = jsonPost sess url- ```--## <a name="The_Example_API"> The Example API--The API requires an initial call to the "/root" to obtain the URLs for-subsequent calls.--```haskell-rootRef :: Int -> Ref Root-rootRef port = Ref $ T.pack $ "http://localhost:" ++ show port ++ "/root"-```--### API Response Types--Calling `GET` on "/root" returns the following JSON --```json-{ "products" : "http://localhost:3000/products"-, "carts" : "http://localhost:3000/carts"-, "users" : "http://localhost:3000/users"-, "login" : "http://localhost:3000/login"-, "checkout" : "http://localhost:3000/checkout"-}-```--Which will deserialize to--```haskell -data Root = Root - { products :: Ref [Ref Product] - , carts :: Ref [Ref Cart ] - , users :: Ref [Ref User ] - , login :: RPC Credentials (Ref User)- , checkout :: RPC (Ref Cart) () - } deriving (Eq, Show, Generic)--instance FromJSON Root-```--Since the JSON is so uniform, we can use `aeson`'s generic instances.--Calling `GET` on a `Ref Product` or "/products/:id" gives--```json-{ "summary" : "shirt" }-```--Which will deserialize to--```haskell-data Product = Product - { summary :: Text - } deriving (Eq, Show, Generic)--instance FromJSON Product-```--Calling `GET` on a `Ref Cart` or "/carts/:id" gives--```json-{ "items" : ["http://localhost:3000/products/0"] }-```--...--```haskell-data Cart = Cart - { items :: Ref [Ref Product] - } deriving (Eq, Show, Generic)--instance FromJSON Cart-```-Calling `GET` on a `Ref User` or "/users/:id" gives--```json-{ "cart" : "http://localhost:3000/carts/0"-, "username" : "example"-}-```--```haskell-data User = User - { cart :: Ref Cart - , username :: Text - } deriving (Eq, Show, Generic)--instance FromJSON User-```--## RPC Types--The only additional type that we need is the input for the `login` RPC, mainly the `Credentials` type.--```json-{ "password" : "password"-, "userid" : "a@example.com"-}-```--```haskell-data Credentials = Credentials - { password :: Text - , userid :: Text - } deriving (Eq, Show, Generic)--instance ToJSON Credentials-```--## <a name="Profiling_Script"> Profiling Script--We can now easily write our first script!--```haskell-testScript :: Int -> Environment -> IO ()-testScript port = WW.withWreq $ \sess -> do-```-Bootstrap the script and get all the URLs for the endpoints. Unpack-`products`, `login` and `checkout` refs for use later down.--```haskell- Root { products- , login- , checkout- } <- get sess (rootRef port)-```-We get all products and name the first one.--```haskell- firstProduct : _ <- get sess products-```--Login and get the user's ref.--```haskell- userRef <- rpc sess login- ( Credentials- { userid = "a@example.com"- , password = "password"- }- )--```-Get the user and unpack the user's cart.--```haskell- User { cart } <- get sess userRef-```-Get the cart and unpack the items.-```haskell- Cart { items } <- get sess cart-```-Add the first product to the user's cart's items.-```haskell- insert sess items firstProduct-```-Checkout.-```haskell- rpc sess checkout cart-```--Port is hard coded to 3000 for this example.--```haskell-benchmarks :: Int -> IO [(String, Environment -> IO ())]-benchmarks port = do- -- Create a TLS context once- return [("test0", testScript port)]--main :: IO ()-main = defaultMain =<< benchmarks 3000-```
− examples/Main.lhs
@@ -1,99 +0,0 @@-## Running the Examples--- Run the whole benchmark example with `cabal run example`-- Run just the client with `cabal run example-client `-- Run just the server with `cabal run example-server`--Additionally, the examples take the standard `wrecker` command line arguments, which can be viewed with-- cabal run example -- --help--```-wrecker - HTTP stress tester and benchmarker--Usage: example [--concurrency ARG] [--bin-count ARG] ([--run-count ARG] |- [--run-timed ARG]) [--timeout-time ARG] [--display-mode ARG]- [--log-level ARG] [--match ARG] [--request-name-size ARG]- [--output-path ARG] [--silent]- Welcome to wrecker--Available options:- -h,--help Show this help text- --concurrency ARG Number of threads for concurrent requests- --bin-count ARG Number of bins for latency histogram- --run-count ARG number of times to repeat- --run-timed ARG number of seconds to repeat- --timeout-time ARG How long to wait for all requests to finish- --display-mode ARG Display results interactively- --log-level ARG Log to stderr events of criticality greater than the LOG_LEVEL- --match ARG Only run tests that match the glob- --request-name-size ARG Request name size for the terminal display- --output-path ARG Save a JSON file of the the statistics to given path- --silent Disable all output-```--Below is the source for `example`, which creates a client and server:--```haskell-{-# LANGUAGE ScopedTypeVariables #-}-import qualified Client as Client-import qualified Server as Server-import Wrecker (run)-import Wrecker.Options (runParser)-import Data.Function (fix)-import Control.Exception (handle, IOException)-import Control.Concurrent ( threadDelay- , forkIO- , newEmptyMVar- , takeMVar- , putMVar- )-import Network.Connection ( connectTo- , connectionClose- , ConnectionParams (..)- , initConnectionContext- )-import System.Environment-```--A little utility function which loops until a port is ready for connections:--```haskell-waitFor :: Int -> IO ()-waitFor port = do- cxt <- initConnectionContext- fix $ \next -> do- handle (\(_ :: IOException) -> threadDelay 100000 >> next)- (do- connection <- connectTo cxt- $ ConnectionParams "localhost"- (fromIntegral port)- Nothing- Nothing- connectionClose connection- )-```--Entry point:--```haskell-main :: IO ()-main = do- -- Start the server on it's own thread- forkIO $ withArgs [] Server.main-- -- The examples use port 3000 by default- let port = 3000-- options <- runParser- -- wait for the server to be ready- waitFor port- -- Start the client and close an MVar to signal when the thread has finished- end <- newEmptyMVar- forkIO $ do- run options =<< Client.benchmarks port- putMVar end ()-- -- Wait for the client thread to finish and then return- takeMVar end-```
− examples/Server.hs
@@ -1,213 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, TypeOperators, OverloadedStrings- #-}-{-# LANGUAGE DeriveGeneric, FlexibleInstances, QuasiQuotes #-}-{-# LANGUAGE CPP, FlexibleContexts, UndecidableInstances,- RecordWildCards #-}-{-# LANGUAGE DeriveFunctor, LambdaCase, OverloadedStrings #-}-{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}-#ifndef _SERVER_IS_MAIN_-module Server where-#endif-import Control.Concurrent-import Control.Concurrent.NextRef (NextRef)-import qualified Control.Concurrent.NextRef as NextRef-import Control.Exception-import qualified Control.Immortal as Immortal-import Control.Monad.IO.Class-import Data.Aeson hiding (json)-import Data.Aeson.QQ-import Data.Maybe (listToMaybe)-import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as T-import GHC.Generics-import Network.Socket (Socket)-import qualified Network.Socket as N-import qualified Network.Wai as Wai-import Network.Wai.Handler.Warp- (Port, defaultSettings, openFreePort)-import qualified Network.Wai.Handler.Warp as Warp-import System.Environment-import Web.Scotty (ActionM, ScottyM, json)-import qualified Web.Scotty as Scotty-import Wrecker-import Wrecker.Runner-import qualified Wrecker.Statistics as Wrecker--data Envelope a = Envelope- { value :: a- } deriving (Show, Eq, Generic)--instance ToJSON a => ToJSON (Envelope a)--rootRef :: Int -> Text-rootRef port = T.pack $ "http://localhost:" ++ show port--jsonE :: ToJSON a => a -> ActionM ()-jsonE = json . Envelope--data Root a = Root- { root :: a- , products :: a- , cartsIndex :: a- , cartsIndexItems :: a- , usersIndex :: a- , login :: a- , checkout :: a- } deriving (Show, Eq, Functor)--type RootInt = Root Int--instance Applicative Root where- pure x =- Root- { root = x- , products = x- , login = x- , usersIndex = x- , cartsIndex = x- , cartsIndexItems = x- , checkout = x- }- f <*> x =- Root- { root = root f $ root x- , products = products f $ products x- , login = login f $ login x- , usersIndex = usersIndex f $ usersIndex x- , cartsIndex = cartsIndex f $ cartsIndex x- , cartsIndexItems = cartsIndexItems f $ cartsIndexItems x- , checkout = checkout f $ checkout x- }--app :: RootInt -> Port -> ScottyM ()-app Root {..} port = do- let host = rootRef port- Scotty.get "/root" $ do- liftIO $ threadDelay root- jsonE- [aesonQQ|- { "products" : #{host <> "/products" }- , "carts" : #{host <> "/carts" }- , "users" : #{host <> "/users" }- , "login" : #{host <> "/login" }- , "checkout" : #{host <> "/checkout" }- }- |]- Scotty.get "/products" $ do- liftIO $ threadDelay products- jsonE- [aesonQQ|- [ #{host <> "/products/0"}- ]- |]- Scotty.get "/product/:id" $ do- liftIO $ threadDelay products- jsonE- [aesonQQ|- { "summary" : "shirt" }- |]- Scotty.get "/carts" $- -- sleepDist gen carts- do- jsonE- [aesonQQ|- [ #{host <> "/carts/0"}- ]- |]- Scotty.get "/carts/:id" $ do- liftIO $ threadDelay cartsIndex- jsonE- [aesonQQ|- { "items" : #{host <> "/carts/0/items"}- }- |]- Scotty.post "/carts/:id/items" $ do- liftIO $ threadDelay cartsIndexItems- jsonE- [aesonQQ|- #{host <> "/carts/0/items"}- |]- Scotty.get "/users" $- -- sleepDist gen users- do- jsonE- [aesonQQ|- [ #{host <> "/users/0"}- ]- |]- Scotty.get "/users/:id" $ do- liftIO $ threadDelay usersIndex- jsonE- [aesonQQ|- { "cart" : #{host <> "/carts/0"}- , "username" : "example"- }- |]- Scotty.post "/login" $ do- liftIO $ threadDelay login- jsonE- [aesonQQ|- #{host <> "/users/0"}- |]- Scotty.post "/checkout" $ do- liftIO $ threadDelay checkout- jsonE ()--run :: RootInt -> IO (Port, Immortal.Thread, ThreadId, NextRef AllStats)-run = start Nothing--stop :: (Port, ThreadId, NextRef AllStats) -> IO AllStats-stop (_, threadId, ref) = do- killThread threadId- NextRef.readLast ref--toKey :: Wai.Request -> String-toKey x =- case Wai.pathInfo x of- ["root"] -> "/root"- ["products"] -> "/products"- "carts":_:"items":_ -> "/carts/0/items"- "carts":_:_ -> "/carts/0"- "users":_ -> "/users/0"- ["login"] -> "/login"- ["checkout"] -> "/checkout"- _ -> error "FAIL! UNKNOWN REQUEST FOR EXAMPLE!"--recordMiddleware :: Recorder -> Wai.Application -> Wai.Application-recordMiddleware recorder waiApp req sendResponse =- record recorder (toKey req) $! waiApp req $ \res -> sendResponse res--getASocket :: Maybe Port -> IO (Port, Socket)-getASocket =- \case- Just port -> do- s <- N.socket N.AF_INET N.Stream N.defaultProtocol- localhost <- N.inet_addr "127.0.0.1"- N.bind s (N.SockAddrInet (fromIntegral port) localhost)- N.listen s 1000- return (port, s)- Nothing -> openFreePort--start :: Maybe Port -> RootInt -> IO (Port, Immortal.Thread, ThreadId, NextRef AllStats)-start mport dist = do- (port, socket) <- getASocket mport- (ref, recorderThread, recorder) <- newStandaloneRecorder- scottyApp <- Scotty.scottyApp $ app dist port- threadId <-- flip forkFinally (\_ -> N.close socket) $- Warp.runSettingsSocket defaultSettings socket $ recordMiddleware recorder $ scottyApp- return (port, recorderThread, threadId, ref)--main :: IO ()-main = do- xs <- getArgs- let delay = maybe 0 read $ listToMaybe xs- (port, socket) <- getASocket $ Just 3000- (ref, recorderThread, recorder) <- newStandaloneRecorder- scottyApp <- Scotty.scottyApp $ app (pure delay) port- (Warp.runSettingsSocket defaultSettings socket $ recordMiddleware recorder $ scottyApp) `finally`- (do N.close socket- Immortal.stop recorderThread- allStats <- NextRef.readLast ref- putStrLn $ Wrecker.pprStats Nothing Path allStats)
+ src/Network/Wreq/Wrecker/API.hs view
@@ -0,0 +1,264 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+ This module can be used to describe the operations that can be performed+ against an external API that uses JSON as its serialization format.++ It exposes functions tailored to get and post data in the JSON format and+ to unserialize the responses into types that can be converted form JSON.++ Use the 'Ref' and 'RPC' types to describe the external API operations.+-}+module Network.Wreq.Wrecker.API+ ( Ref(..)+ , RPC(..)+ -- * Interacting with an external API+ , get+ , post+ , put+ , rpc+ , delete+ -- * Network functions with Options+ , getWith+ , postWith+ , putWith+ , rpcWith+ , deleteWith+ -- * Utility functions+ , query+ ) where++import Data.Aeson (FromJSON(..), ToJSON, encode, withText)+import Data.ByteString.Lazy as LB (ByteString)+import Data.Text (Text, unpack)+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types.URI as URI+import qualified Network.Wreq as Wreq+import Network.Wreq.Types (Postable(..), Putable)++import qualified Network.Wreq.Wrecker as Wrecker++{-|+ A Ref represents an API resource whose contents can be retrieved with GET++ We use the phantom type parameter `response` so that we can use+ this information for understanding what type of data the API+ resource will return++ For example, an API endpoint returning a list of User is modelled as follows:++ > usersRef :: Ref [User]+ > usersRef = Ref "http://localhost:8080/users"+-}+data Ref response = Ref+ { unRef :: Text+ } deriving (Show, Eq)++{-|+ A Req represents an API resource whose contents can be retrieved with POST++ We use the phantom type parameter `response` so that we can use+ this information for understanding what type of data the API+ resource will return++ Similarly, the request parameter is used to know what type of data can be posted+ to the endpoint.++ For example, an API endpoint that receives a User and returns a list of Friendship is+ modelled as follows:++ > newFriendRpc :: User -> RPC [Friendship] User+ > newFriendRpc User { userID } = RPC "http://localhost:8080/users/" <> userID <> "/friendships"+-}+newtype RPC response request = RPC+ { rpcUrl :: Text+ } deriving (Show, Eq)++instance FromJSON (Ref a) where+ parseJSON = withText "FromJSON (Ref a)" (return . Ref)++instance FromJSON (RPC a b) where+ parseJSON = withText "FromJSON (Ref a)" (return . RPC)++--+-- Network functions+--+{-|+ Gets the results form an API endpoint that responds in the JSON format.++ > users <- get sess usersRef+ > mapM_ (print . userID) users+-}+get :: FromJSON a => Wrecker.Session -> Ref a -> IO a+get sess (Ref url) = fmap HTTP.responseBody (Wrecker.getJSON sess (unpack url))++{-|+ Gets the results form an API endpoint that responds in the JSON format.+ This function excepts additional options, such as custom headers++ > let opts = Network.Wreq.defaults & Network.Wreq.auth ?~ Network.Wreq.basicAuth "user" "pass"+ > users <- getWith opts sess usersRef+ > mapM_ (print . userID) users+-}+getWith :: FromJSON a => Wreq.Options -> Wrecker.Session -> Ref a -> IO a+getWith opts sess (Ref url) = fmap HTTP.responseBody (Wrecker.getJSONWith opts sess (unpack url))++{-|+ Posts some data to an API endpoint in any 'Network.Wreq.Types.Postable' format+ and gets the response in JSON format.++ > Friendships friends <- post sess (newFriendRpc user) user2+ > mapM_ (print . userID) friends+-}+post ::+ (Postable req, FromJSON res)+ => Wrecker.Session+ -> RPC res req+ -> req+ -- ^ The request payload+ -> IO res+post sess (RPC url) body = fmap HTTP.responseBody (Wrecker.postJSON sess (unpack url) body)++{-|+ Posts some data to an API endpoint in any 'Network.Wreq.Types.Postable' format+ and gets the response in JSON format.+ This function excepts additional options, such as custom headers++ > let opts = Network.Wreq.defaults & Network.Wreq.auth ?~ Network.Wreq.basicAuth "user" "pass"+ > Friendships friends <- post sess (newFriendRpc user) user2+ > mapM_ (print . userID) friends+-}+postWith ::+ (Postable req, FromJSON res)+ => Wreq.Options+ -> Wrecker.Session+ -> RPC res req+ -> req+ -- ^ The request payload+ -> IO res+postWith opts sess (RPC url) body =+ fmap HTTP.responseBody (Wrecker.postJSONWith opts sess (unpack url) body)++{-|+ Puts some data to an API endpoint in any 'Network.Wreq.Types.Putable' format+ and gets the response in JSON format.++ > Friendships friends <- put sess (newFriendRpc user) user2+ > mapM_ (print . userID) friends+-}+put :: (Putable req, FromJSON res)+ => Wrecker.Session+ -> RPC res req+ -> req+ -- ^ The request payload+ -> IO res+put sess (RPC url) body = fmap HTTP.responseBody (Wrecker.putJSON sess (unpack url) body)++{-|+ Puts some data to an API endpoint in any 'Network.Wreq.Types.Putable' format+ and gets the response in JSON format.+ This function excepts additional options, such as custom headers++ > let opts = Network.Wreq.defaults & Network.Wreq.auth ?~ Network.Wreq.basicAuth "user" "pass"+ > Friendships friends <- put sess (newFriendRpc user) user2+ > mapM_ (print . userID) friends+-}+putWith ::+ (Putable req, FromJSON res)+ => Wreq.Options+ -> Wrecker.Session+ -> RPC res req+ -> req+ -- ^ The request payload+ -> IO res+putWith opts sess (RPC url) body =+ fmap HTTP.responseBody (Wrecker.putJSONWith opts sess (unpack url) body)++{-|+ Posts some data to an API endpoint in any JSON format+ and gets the response in JSON format.++ > Friendships friends <- post sess (newFriendRpc user) user2+ > mapM_ (print . userID) friends+-}+rpc :: (ToJSON req, FromJSON res)+ => Wrecker.Session+ -> RPC res req+ -> req+ -- ^ The request payload+ -> IO res+rpc sess (RPC url) body = fmap HTTP.responseBody (Wrecker.postJSON sess (unpack url) jsonBody)+ where+ jsonBody = encode body++{-|+ Posts some data to an API endpoint in any JSON format+ and gets the response in JSON format.+ This function excepts additional options, such as custom headers++ > let opts = Network.Wreq.defaults & Network.Wreq.auth ?~ Network.Wreq.basicAuth "user" "pass"+ > Friendships friends <- post sess (newFriendRpc user) user2+ > mapM_ (print . userID) friends+-}+rpcWith ::+ (ToJSON req, FromJSON res)+ => Wreq.Options+ -> Wrecker.Session+ -> RPC res req+ -> req+ -- ^ The request payload+ -> IO res+rpcWith opts sess (RPC url) body =+ fmap HTTP.responseBody (Wrecker.postJSONWith opts sess (unpack url) jsonBody)+ where+ jsonBody = encode body++{-|+ Sends as DELETE request to an API endpoint that responds in the JSON format.++ > Status { success } <- delete sess usersDeleteRef+-}+delete :: FromJSON a => Wrecker.Session -> Ref a -> IO a+delete sess (Ref url) = fmap HTTP.responseBody (Wrecker.deleteJSON sess (unpack url))++{-|+ Sends as DELETE request to an API endpoint that responds in the JSON format.+ This function excepts additional options, such as custom headers++ > let opts = Network.Wreq.defaults & Network.Wreq.auth ?~ Network.Wreq.basicAuth "user" "pass"+ > Status { success } <- deleteWith opts sess usersDeleteRef+-}+deleteWith :: FromJSON a => Wreq.Options -> Wrecker.Session -> Ref a -> IO a+deleteWith opts sess (Ref url) =+ fmap HTTP.responseBody (Wrecker.deleteJSONWith opts sess (unpack url))++--+-- Utitily functions+--+query :: [(Text, Text)] -> Text+query parts = T.decodeUtf8 (URI.renderSimpleQuery True converted)+ where+ converted = fmap (\(k, v) -> (T.encodeUtf8 k, T.encodeUtf8 v)) parts++--+-- Orphans+--+{-|+ The form attributes are passed as tuples,+ representing key-value pairs: For example++ > postPayload [("username", "jon"), ("password", "snow")]+-}+instance Postable [(Text, Text)] where+ postPayload p = (postPayload . toFormData) p+ where+ toFormData d = fmap (\(k, v) -> (T.encodeUtf8 k, T.encodeUtf8 v)) d++{-|+ Some API endpoints are odd in that they expect a POST as a verb, but+ no request body is expected. This models such case.+-}+instance Postable () where+ postPayload _ = postPayload ("" :: ByteString)
wrecker.cabal view
@@ -1,5 +1,5 @@ name: wrecker-version: 1.1.0.0+version: 1.1.1.0 synopsis: An HTTP Performance Benchmarker description: 'wrecker' is a library and executable for creating HTTP benchmarks. It is designed for@@ -31,6 +31,7 @@ , Wrecker.Statistics , Wrecker.Logger , Network.Wreq.Wrecker+ , Network.Wreq.Wrecker.API build-depends: base >= 4.6 && < 5 , aeson >= 0.7@@ -104,7 +105,7 @@ test-suite wrecker-test type: exitcode-stdio-1.0- hs-source-dirs: test, examples+ hs-source-dirs: test main-is: Spec.hs build-depends: base , wrecker@@ -127,66 +128,6 @@ , connection , transformers ghc-options: -O2 -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg"- default-language: Haskell2010--executable example-server- hs-source-dirs: examples- main-is: Server.hs- build-depends: base- , wrecker- , scotty- , aeson-qq- , warp >= 3.2.4- , markdown-unlit- , aeson- , text- , immortal- , next-ref- , wai- , network- , transformers- cpp-options: -D_SERVER_IS_MAIN_- ghc-options: -O2 -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg"- default-language: Haskell2010--executable example-client- hs-source-dirs: examples- main-is: Client.lhs- build-depends: base- , wrecker- , wreq- , markdown-unlit- , aeson- , bytestring- , text- , http-client- , connection- cpp-options: -D_CLIENT_IS_MAIN_- ghc-options: -O2 -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg"- default-language: Haskell2010--executable example- hs-source-dirs: examples- main-is: Main.lhs- build-depends: base- , wrecker- , scotty- , aeson-qq- , warp >= 3.2.4- , wreq- , markdown-unlit- , aeson- , bytestring- , text- , http-client- , connection- , immortal- , next-ref- , wai- , network- , connection- , transformers- ghc-options: -O2 -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg" default-language: Haskell2010 source-repository head