sydtest-wai 0.0.0.0 → 0.1.0.0

raw patch · 8 files changed

+563/−46 lines, 8 filesdep +bytestringdep +case-insensitivedep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, case-insensitive, mtl, network, pretty-show, text, time

API changes (from Hackage documentation)

Files

• src/Test/Syd/Wai.hs +73/−36
• src/Test/Syd/Wai/Client.hs +102/−0
• src/Test/Syd/Wai/Def.hs +120/−0
• src/Test/Syd/Wai/Matcher.hs +88/−0
• src/Test/Syd/Wai/Request.hs +97/−0
• sydtest-wai.cabal +13/−1
• test/Test/Syd/Wai/Example.hs +20/−2
• test/Test/Syd/WaiSpec.hs +50/−7

@@ -1,44 +1,81 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -module Test.Syd.Wai where+-- | Test a 'Wai.Application'+--+-- Example usage:+--+-- > exampleApplication :: Wai.Application+-- > exampleApplication req sendResp = do+-- >   lb <- strictRequestBody req+-- >   sendResp $ responseLBS HTTP.ok200 (requestHeaders req) lb+-- >+-- > spec :: Spec+-- > spec =+-- >   waiClientSpec exampleApplication $+-- >     describe "get" $+-- >       wit "can GET the root and get a 200" $ do+-- >         resp <- get "/"+-- >         liftIO $ responseStatus resp `shouldBe` ok200+module Test.Syd.Wai+  ( -- * Functions to run a test suite -import Network.HTTP.Client as HTTP-import Network.Wai as Wai-import Network.Wai.Handler.Warp as Warp-import Test.Syd+    -- ** A test suite that uses a running wai applications+    waiSpec,+    waiSpecWith,+    waiSpecWith',+    waiSpecWithSetupFunc, --- | Run a given 'Wai.Application' around every test.------ This provides the port on which the application is running.-waiSpec :: Wai.Application -> TestDef l Port -> TestDef l ()-waiSpec application = waiSpecWithSetupFunc $ pure application+    -- ** A test suite that uses a running wai application and calls it using the functions provided in this package+    waiClientSpec,+    waiClientSpecWith,+    waiClientSpecWithSetupFunc,+    waiClientSpecWithSetupFunc',+    wit, --- | Run a 'Wai.Application' around every test by setting it up with the given setup function.------ This provides the port on which the application is running.-waiSpecWith :: (forall r. (Application -> IO r) -> IO r) -> TestDef l Port -> TestDef l ()-waiSpecWith appFunc = waiSpecWithSetupFunc $ makeSimpleSetupFunc appFunc+    -- ** A test suite that uses a single HTTP manager accross tests+    managerSpec, --- | Run a 'Wai.Application' around every test by setting it up with the given setup function that can take an argument.--- a--- This provides the port on which the application is running.-waiSpecWith' :: (forall r. (Application -> IO r) -> (a -> IO r)) -> TestDef l Port -> TestDef l a-waiSpecWith' appFunc = waiSpecWithSetupFunc $ SetupFunc appFunc+    -- *** Setup functions+    waiClientSetupFunc,+    applicationSetupFunc, --- | Run a 'Wai.Application' around every test by setting it up with the given 'SetupFunc'.--- a--- This provides the port on which the application is running.-waiSpecWithSetupFunc :: SetupFunc a Application -> TestDef l Port -> TestDef l a-waiSpecWithSetupFunc setupFunc = setupAroundWith (setupFunc `connectSetupFunc` applicationSetupFunc)+    -- ** Core+    WaiClient (..),+    WaiClientState (..),+    WaiClientM (..),+    runWaiClientM, --- | A 'SetupFunc' to run an application and provide its port.-applicationSetupFunc :: SetupFunc Application Port-applicationSetupFunc = SetupFunc $ \func application ->-  Warp.testWithApplication (pure application) $ \p ->-    func p+    -- * Making requests+    get,+    post,+    put,+    patch,+    options,+    delete,+    request,+    performRequest, --- | Create a 'HTTP.Manager' before all tests in the given group.-managerSpec :: TestDef (HTTP.Manager ': l) a -> TestDef l a-managerSpec = beforeAll $ HTTP.newManager HTTP.defaultManagerSettings+    -- * Assertions+    ResponseMatcher (..),+    MatchHeader (..),+    MatchBody (..),+    shouldRespondWith,+    Body,+    (<:>),++    -- * Just to make sure we didn't forget any exports+    module Test.Syd.Wai.Client,+    module Test.Syd.Wai.Def,+    module Test.Syd.Wai.Request,++    -- * Reexports+    module HTTP,+  )+where++import Network.HTTP.Client as HTTP+import Network.HTTP.Types as HTTP+import Test.Syd.Wai.Client+import Test.Syd.Wai.Def+import Test.Syd.Wai.Matcher+import Test.Syd.Wai.Request

@@ -0,0 +1,102 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++module Test.Syd.Wai.Client where++import Control.Monad.Fail+import Control.Monad.Reader+import Control.Monad.State as State+import qualified Data.ByteString.Lazy as LB+import GHC.Generics (Generic)+import Network.HTTP.Client as HTTP+import Network.Socket (PortNumber)+import Test.Syd++-- | A client environment for a 'Wai.Application' with a user-defined environment as well+data WaiClient env = WaiClient+  { -- The 'HTTP.Manager' tto make the requests+    waiClientManager :: !HTTP.Manager,+    -- | The user-defined environment+    waiClientEnv :: !env,+    -- The port that the application is running on, using @warp@+    waiClientPort :: !PortNumber+  }+  deriving (Generic)++data WaiClientState = WaiClientState+  { -- | The last request and response pair+    waiClientStateLast :: !(Maybe (HTTP.Request, HTTP.Response LB.ByteString)),+    -- | The cookies to pass along+    waiClientStateCookies :: !CookieJar+  }+  deriving (Generic)++initWaiClientState :: WaiClientState+initWaiClientState =+  WaiClientState+    { waiClientStateLast = Nothing,+      waiClientStateCookies = createCookieJar []+    }++-- | A Wai testing monad that carries client state, information about how to call the application,+-- a user-defined environment, and everything necessary to show nice error messages.+newtype WaiClientM env a = WaiClientM+  { unWaiClientM :: StateT WaiClientState (ReaderT (WaiClient env) IO) a+  }+  deriving+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadReader (WaiClient env),+      MonadState WaiClientState,+      MonadFail+    )++-- | For compatibility with @hspec-wai@+type WaiSession st a = WaiClientM st a++-- | For compatibility with @hspec-wai@+type WaiExpectation st = WaiSession st ()++-- | Run a WaiClientM env using a WaiClient env+runWaiClientM :: WaiClient env -> WaiClientM env a -> IO a+runWaiClientM cenv (WaiClientM func) = runReaderT (evalStateT func initWaiClientState) cenv++-- | Get the most recently sent request.+getRequest :: WaiClientM env (Maybe HTTP.Request)+getRequest = State.gets (fmap fst . waiClientStateLast)++-- | Get the most recently received response.+getResponse :: WaiClientM env (Maybe (HTTP.Response LB.ByteString))+getResponse = State.gets (fmap snd . waiClientStateLast)++-- | Get the most recently sent request and the response to it.+getLast :: WaiClientM env (Maybe (HTTP.Request, HTTP.Response LB.ByteString))+getLast = State.gets waiClientStateLast++-- | Annotate the given test code with the last request and its response, if one has been made already.+withLastRequestContext :: WaiClientM site a -> WaiClientM site a+withLastRequestContext wfunc@(WaiClientM func) = do+  mLast <- getLast+  case mLast of+    Nothing -> wfunc+    Just (req, resp) ->+      WaiClientM $ do+        s <- get+        c <- ask+        let ctx = lastRequestResponseContext req resp+        (r, s') <- liftIO $ context ctx $ runReaderT (runStateT func s) c+        put s'+        pure r++-- | An assertion context, for 'Context', that shows the last request and response+lastRequestResponseContext :: Show respBody => HTTP.Request -> HTTP.Response respBody -> String+lastRequestResponseContext req resp =+  unlines+    [ "last request:",+      ppShow req,+      "full response:",+      ppShow resp+    ]

@@ -0,0 +1,120 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Test.Syd.Wai.Def where++import GHC.Stack (HasCallStack)+import Network.HTTP.Client as HTTP+import Network.Socket (PortNumber)+import Network.Wai as Wai+import Network.Wai.Handler.Warp as Warp+import Test.Syd+import Test.Syd.Wai.Client++-- | Run a given 'Wai.Application' around every test.+--+-- This provides a 'WaiClient ()' which contains the port of the running application.+waiClientSpec :: Wai.Application -> TestDefM (HTTP.Manager ': outers) (WaiClient ()) result -> TestDefM outers oldInner result+waiClientSpec application = waiClientSpecWith $ pure application++-- | Run a given 'Wai.Application', as built by the given action, around every test.+waiClientSpecWith :: IO Application -> TestDefM (HTTP.Manager ': outers) (WaiClient ()) result -> TestDefM outers oldInner result+waiClientSpecWith application = waiClientSpecWithSetupFunc (\_ _ -> liftIO $ (,) <$> application <*> pure ())++-- | Run a given 'Wai.Application', as built by the given 'SetupFunc', around every test.+waiClientSpecWithSetupFunc ::+  (HTTP.Manager -> oldInner -> SetupFunc (Application, env)) ->+  TestDefM (HTTP.Manager ': outers) (WaiClient env) result ->+  TestDefM outers oldInner result+waiClientSpecWithSetupFunc setupFunc = managerSpec . waiClientSpecWithSetupFunc' setupFunc++-- | Run a given 'Wai.Application', as built by the given 'SetupFunc', around every test.+--+-- This function doesn't set up the 'HTTP.Manager' like 'waiClientSpecWithSetupFunc' does.+waiClientSpecWithSetupFunc' ::+  (HTTP.Manager -> oldInner -> SetupFunc (Application, env)) ->+  TestDefM (HTTP.Manager ': outers) (WaiClient env) result ->+  TestDefM (HTTP.Manager ': outers) oldInner result+waiClientSpecWithSetupFunc' setupFunc = setupAroundWith' $ \man oldInner -> do+  (application, env) <- setupFunc man oldInner+  waiClientSetupFunc man application env++-- | A 'SetupFunc' for a 'WaiClient', given an 'Application' and user-defined @env@.+waiClientSetupFunc :: HTTP.Manager -> Application -> env -> SetupFunc (WaiClient env)+waiClientSetupFunc man application env = do+  p <- applicationSetupFunc application+  let client =+        WaiClient+          { waiClientManager = man,+            waiClientEnv = env,+            waiClientPort = p+          }+  pure client++-- | Define a test in the 'WaiClientM site' monad instead of 'IO'.+--+-- Example usage:+--+-- > waiClientSpec exampleApplication $ do+-- >   describe "/" $ do+-- >     wit "works with a get" $+-- >       get "/" `shouldRespondWith` 200+-- >     wit "works with a post" $+-- >       post "/" `shouldRespondWith` ""+wit ::+  forall env e outers.+  ( HasCallStack,+    IsTest (WaiClient env -> IO e),+    Arg1 (WaiClient env -> IO e) ~ (),+    Arg2 (WaiClient env -> IO e) ~ WaiClient env+  ) =>+  String ->+  WaiClientM env e ->+  TestDefM outers (WaiClient env) ()+wit s f = it s ((\cenv -> runWaiClientM cenv f) :: WaiClient env -> IO e)++-- | Run a given 'Wai.Application' around every test.+--+-- This provides the port on which the application is running.+waiSpec :: Wai.Application -> TestDef outers PortNumber -> TestDef outers ()+waiSpec application = waiSpecWithSetupFunc $ pure application++-- | Run a 'Wai.Application' around every test by setting it up with the given setup function.+--+-- This provides the port on which the application is running.+waiSpecWith :: (forall r. (Application -> IO r) -> IO r) -> TestDef outers PortNumber -> TestDef outers ()+waiSpecWith appFunc = waiSpecWithSetupFunc $ SetupFunc $ \takeApp -> appFunc takeApp++-- | Run a 'Wai.Application' around every test by setting it up with the given setup function that can take an argument.+-- a+-- This provides the port on which the application is running.+waiSpecWith' :: (forall r. (Application -> IO r) -> (inner -> IO r)) -> TestDef outers PortNumber -> TestDef outers inner+waiSpecWith' appFunc = waiSpecWithSetupFunc' $ \inner -> SetupFunc $ \takeApp -> appFunc takeApp inner++-- | Run a 'Wai.Application' around every test by setting it up with the given 'SetupFunc'.+-- a+-- This provides the port on which the application is running.+waiSpecWithSetupFunc :: SetupFunc Application -> TestDef outers PortNumber -> TestDef outers ()+waiSpecWithSetupFunc setupFunc = waiSpecWithSetupFunc' $ \() -> setupFunc++-- | Run a 'Wai.Application' around every test by setting it up with the given 'SetupFunc' and inner resource.+-- a+-- This provides the port on which the application is running.+waiSpecWithSetupFunc' :: (inner -> SetupFunc Application) -> TestDef outers PortNumber -> TestDef outers inner+waiSpecWithSetupFunc' setupFunc = setupAroundWith $ \inner -> do+  application <- setupFunc inner+  applicationSetupFunc application++-- | A 'SetupFunc' to run an application and provide its port.+applicationSetupFunc :: Application -> SetupFunc PortNumber+applicationSetupFunc application = SetupFunc $ \func ->+  Warp.testWithApplication (pure application) $ \p ->+    func (fromIntegral p) -- Hopefully safe, because 'testWithApplication' should give us sensible port numbers++-- | Create a 'HTTP.Manager' before all tests in the given group.+managerSpec :: TestDefM (HTTP.Manager ': outers) inner result -> TestDefM outers inner result+managerSpec = beforeAll $ HTTP.newManager HTTP.defaultManagerSettings

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- | This entire module only serves to be backwards compatible with Test.Hspec.Wai.Matcher+--+-- This approach of asserting what the response looks like is obsolete because of the way sydtest does things.+-- You should use `shouldBe` instead.+module Test.Syd.Wai.Matcher where++import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as LB+import qualified Data.CaseInsensitive as CI+import Data.Char as Char (isPrint, isSpace)+import Data.Maybe+import Data.String+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.HTTP.Types as HTTP++type Body = LB.ByteString++data ResponseMatcher = ResponseMatcher+  { matchStatus :: Int,+    matchHeaders :: [MatchHeader],+    matchBody :: MatchBody+  }++data MatchHeader = MatchHeader ([Header] -> Body -> Maybe String)++data MatchBody = MatchBody ([Header] -> Body -> Maybe String)++bodyEquals :: Body -> MatchBody+bodyEquals body = MatchBody (\_ actual -> bodyMatcher actual body)+  where+    bodyMatcher :: Body -> Body -> Maybe String+    bodyMatcher (LB.toStrict -> actual) (LB.toStrict -> expected) = actualExpected "body mismatch:" actual_ expected_ <$ guard (actual /= expected)+      where+        (actual_, expected_) = case (safeToString actual, safeToString expected) of+          (Just x, Just y) -> (x, y)+          _ -> (show actual, show expected)++matchAny :: MatchBody+matchAny = MatchBody (\_ _ -> Nothing)++instance IsString MatchBody where+  fromString = bodyEquals . LB.fromStrict . TE.encodeUtf8 . T.pack++instance IsString ResponseMatcher where+  fromString = ResponseMatcher 200 [] . fromString++instance Num ResponseMatcher where+  fromInteger n = ResponseMatcher (fromInteger n) [] matchAny+  (+) = error "ResponseMatcher does not support (+)"+  (-) = error "ResponseMatcher does not support (-)"+  (*) = error "ResponseMatcher does not support (*)"+  abs = error "ResponseMatcher does not support `abs`"+  signum = error "ResponseMatcher does not support `signum`"++(<:>) :: HeaderName -> ByteString -> MatchHeader+name <:> value = MatchHeader $ \headers _body ->+  guard (header `notElem` headers)+    >> (Just . unlines)+      [ "missing header:",+        formatHeader header+      ]+  where+    header = (name, value)++actualExpected :: String -> String -> String -> String+actualExpected message actual expected =+  unlines+    [ message,+      "  expected: " ++ expected,+      "  but got:  " ++ actual+    ]++formatHeader :: Header -> String+formatHeader header@(name, value) = "  " ++ fromMaybe (show header) (safeToString $ B8.concat [CI.original name, ": ", value])++safeToString :: ByteString -> Maybe String+safeToString bs = do+  str <- either (const Nothing) (Just . T.unpack) (TE.decodeUtf8' bs)+  let isSafe = not $ case str of+        [] -> True+        _ -> Char.isSpace (last str) || not (all Char.isPrint str)+  guard isSafe >> return str

@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Test.Syd.Wai.Request where++import Control.Monad.Reader+import Control.Monad.State as State+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LB+import Data.Time+import GHC.Stack (HasCallStack)+import Network.HTTP.Client as HTTP+import Network.HTTP.Client.Internal (httpRaw)+import Network.HTTP.Types as HTTP+import Test.Syd+import Test.Syd.Wai.Client+import Test.Syd.Wai.Matcher++-- | Perform a @GET@ request to the application under test.+get :: ByteString -> WaiSession st (HTTP.Response LB.ByteString)+get path = request methodGet path [] ""++-- | Perform a @POST@ request to the application under test.+post :: ByteString -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)+post path = request methodPost path []++-- | Perform a @PUT@ request to the application under test.+put :: ByteString -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)+put path = request methodPut path []++-- | Perform a @PATCH@ request to the application under test.+patch :: ByteString -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)+patch path = request methodPatch path []++-- | Perform an @OPTIONS@ request to the application under test.+options :: ByteString -> WaiSession st (HTTP.Response LB.ByteString)+options path = request methodOptions path [] ""++-- | Perform a @DELETE@ request to the application under test.+delete :: ByteString -> WaiSession st (HTTP.Response LB.ByteString)+delete path = request methodDelete path [] ""++-- | Perform a request to the application under test, with specified HTTP+-- method, request path, headers and body.+request :: Method -> ByteString -> [Header] -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)+request method path headers body = do+  port <- asks waiClientPort+  let req =+        defaultRequest+          { host = "localhost",+            port = fromIntegral port, -- Safe because it is PortNumber -> INt+            method = method,+            path = path,+            requestHeaders = headers,+            requestBody = RequestBodyLBS body+          }+  now <- liftIO getCurrentTime+  cj <- State.gets waiClientStateCookies+  let (req', cj') = insertCookiesIntoRequest req cj now+  State.modify' (\s -> s {waiClientStateCookies = cj'})+  performRequest req'++-- | Perform a bare 'HTTP.Request'.+--+-- You can use this to make a request to an application other than the one+-- under test.  This function does __not__ set the host and port of the request+-- like 'request' does, but it does share a 'CookieJar'.+performRequest :: HTTP.Request -> WaiSession st (HTTP.Response LB.ByteString)+performRequest req = do+  man <- asks waiClientManager+  resp <- liftIO $ httpRaw req man >>= traverse (fmap LB.fromChunks . brConsume)+  cj <- State.gets waiClientStateCookies+  now <- liftIO getCurrentTime+  let (cj', _) = updateCookieJar resp req now cj+  State.modify'+    ( \s ->+        s+          { waiClientStateLast = Just (req, resp),+            waiClientStateCookies = cj'+          }+    )+  pure resp++-- | Make a test assertion using a 'ResponseMatcher' on the 'HTTP.Response' produced by the given action+--+-- This function is provided for backward compatibility with wai-test but this approach has been made obsolete by the way sydtest does things.+-- You should use 'shouldBe' based on the responses that you get from functions like 'get' and 'post' instead.+shouldRespondWith :: HasCallStack => WaiSession st (HTTP.Response LB.ByteString) -> ResponseMatcher -> WaiExpectation st+shouldRespondWith action ResponseMatcher {..} = do+  response <- action+  liftIO $+    context (ppShow response) $ do+      HTTP.statusCode (responseStatus response) `shouldBe` matchStatus+      forM_ matchHeaders $ \(MatchHeader matchHeaderFunc) ->+        mapM_ expectationFailure $ matchHeaderFunc (responseHeaders response) (responseBody response)+      let (MatchBody matchBodyFunc) = matchBody+      mapM_ expectationFailure $ matchBodyFunc (responseHeaders response) (responseBody response)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sydtest-wai-version:        0.0.0.0+version:        0.1.0.0 synopsis:       A wai companion library for sydtest category:       Testing homepage:       https://github.com/NorfairKing/sydtest#readme@@ -24,14 +24,26 @@ library   exposed-modules:       Test.Syd.Wai+      Test.Syd.Wai.Client+      Test.Syd.Wai.Def+      Test.Syd.Wai.Matcher+      Test.Syd.Wai.Request   other-modules:       Paths_sydtest_wai   hs-source-dirs:       src   build-depends:       base >=4.7 && <5+    , bytestring+    , case-insensitive     , http-client+    , http-types+    , mtl+    , network+    , pretty-show     , sydtest+    , text+    , time     , wai     , warp   default-language: Haskell2010

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Test.Syd.Wai.Example where  import Network.HTTP.Types as HTTP@@ -5,5 +7,21 @@  exampleApplication :: Wai.Application exampleApplication req sendResp = do-  lb <- strictRequestBody req-  sendResp $ responseLBS HTTP.ok200 (requestHeaders req) lb+  case pathInfo req of+    ["expects-header"] -> do+      let status = case lookup "TEST_HEADER" $ requestHeaders req of+            Nothing -> HTTP.notFound404+            Just _ -> HTTP.ok200+      sendResp $ responseLBS status [] ""+    ["redirect"] ->+      sendResp $ responseLBS HTTP.seeOther303 [("Location", "/")] ""+    ["set-cookie"] ->+      sendResp $ responseLBS HTTP.ok200 [("Set-Cookie", "hello=world")] ""+    ["expects-cookie"] -> do+      let status = case lookup "Cookie" $ requestHeaders req of+            Nothing -> HTTP.notFound404+            Just _ -> HTTP.ok200+      sendResp $ responseLBS status [] ""+    _ -> do+      lb <- strictRequestBody req+      sendResp $ responseLBS HTTP.ok200 (requestHeaders req) lb

@@ -8,10 +8,53 @@ import Test.Syd.Wai.Example  spec :: Spec-spec = managerSpec $-  waiSpec exampleApplication $ do-    itWithBoth "echos this example" $ \man p -> do-      let body = "hello world"-      req <- (\r -> r {port = p, requestBody = RequestBodyLBS body}) <$> parseRequest "http://localhost"-      resp <- httpLbs req man-      responseBody resp `shouldBe` body+spec = do+  managerSpec $+    waiSpec exampleApplication $ do+      itWithBoth "echos this example" $ \man p -> do+        let body = "hello world"+        req <- (\r -> r {port = fromIntegral p, requestBody = RequestBodyLBS body}) <$> parseRequest "http://localhost"+        resp <- httpLbs req man+        responseBody resp `shouldBe` body+  waiClientSpec exampleApplication $ do+    describe "get" $ do+      wit "can GET the root and get a 200" $ do+        resp <- get "/"+        liftIO $ responseStatus resp `shouldBe` ok200+      wit "can GET the /redirect and get a 303 with a location header" $ do+        resp <- get "/redirect"+        liftIO $ case lookup "Location" $ responseHeaders resp of+          Nothing -> expectationFailure "should have found a location header"+          Just l -> l `shouldBe` "/"+      wit "carries cookies correctly" $ do+        _ <- get "/set-cookie"+        resp <- get "/expects-cookie"+        liftIO $ responseStatus resp `shouldBe` ok200+    describe "post" $+      wit "can POST the root and get a 200" $ do+        resp <- post "/" "hello world"+        liftIO $ responseStatus resp `shouldBe` ok200+        liftIO $ responseBody resp `shouldBe` "hello world"+    describe "put" $+      wit "can PUT the root and get a 200" $ do+        resp <- put "/" "hello world"+        liftIO $ responseStatus resp `shouldBe` ok200+        liftIO $ responseBody resp `shouldBe` "hello world"+    describe "patch" $+      wit "can PATCH the root and get a 200" $ do+        resp <- patch "/" "hello world"+        liftIO $ responseStatus resp `shouldBe` ok200+        liftIO $ responseBody resp `shouldBe` "hello world"+    describe "options" $+      wit "can OPTIONS the root and get a 200" $ do+        resp <- options "/"+        liftIO $ responseStatus resp `shouldBe` ok200+    describe "request" $+      wit "can make a weird request" $ do+        resp <- request "HELLO" "" [] ""+        liftIO $ responseStatus resp `shouldBe` ok200+    describe "shouldRespondWith" $ do+      wit "works with a number" $+        get "/" `shouldRespondWith` 200+      wit "works with a string" $+        get "/" `shouldRespondWith` ""