diff --git a/examples/Client.lhs b/examples/Client.lhs
deleted file mode 100644
--- a/examples/Client.lhs
+++ /dev/null
@@ -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)
-
-## 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)
-```
-
-## 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)
-```
-
-## 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
- ```
-
-## 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
-```
-
-## 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
-```
diff --git a/examples/Main.lhs b/examples/Main.lhs
deleted file mode 100644
--- a/examples/Main.lhs
+++ /dev/null
@@ -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
-```
diff --git a/examples/Server.hs b/examples/Server.hs
deleted file mode 100644
--- a/examples/Server.hs
+++ /dev/null
@@ -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)
diff --git a/src/Network/Wreq/Wrecker/API.hs b/src/Network/Wreq/Wrecker/API.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Wreq/Wrecker/API.hs
@@ -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)
diff --git a/wrecker.cabal b/wrecker.cabal
--- a/wrecker.cabal
+++ b/wrecker.cabal
@@ -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