{- Temporary workaround for https://ghc.haskell.org/trac/ghc/ticket/9127 -}
{-# OPTIONS_GHC -fno-warn-unused-binds  #-}

{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE Rank2Types                 #-}

module Snap.Internal.Test.RequestBuilder
  ( RequestBuilder
  , MultipartParams
  , MultipartParam(..)
  , FileData      (..)
  , RequestType   (..)
  , addHeader
  , buildRequest
  , delete
  , evalHandler
  , evalHandlerM
  , get
  , head
  , postMultipart
  , postRaw
  , postUrlEncoded
  , put
  , requestToString
  , responseToString
  , runHandler
  , runHandlerM
  , setContentType
  , setHeader
  , addCookies
  , setHttpVersion
  , setQueryString
  , setQueryStringRaw
  , setRequestPath
  , setRequestType
  , setSecure
  ) where

------------------------------------------------------------------------------
import           Control.Monad              (liftM, replicateM, void)
import           Control.Monad.State.Strict (MonadIO (..), MonadState, MonadTrans, StateT, execStateT, modify)
import qualified Control.Monad.State.Strict as State
import           Data.Bits                  (Bits ((.&.), unsafeShiftR))
import qualified Data.ByteString            as S8
import           Data.ByteString.Builder    (Builder, byteString, char8, stringUtf8, toLazyByteString, word8)
import           Data.ByteString.Char8      (ByteString)
import qualified Data.ByteString.Char8      as S
import qualified Data.ByteString.Lazy.Char8 as L
import           Data.CaseInsensitive       (CI, original)
import qualified Data.Map                   as Map
import qualified Data.Vector                as V
import           Data.Word                  (Word8)
import           Prelude                    hiding (head)
import           Snap.Core                  (Cookie (Cookie), Method (DELETE, GET, HEAD, POST, PUT), MonadSnap, Params, Request (rqContentLength, rqContextPath, rqCookies, rqHeaders, rqHostName, rqIsSecure, rqMethod, rqParams, rqPathInfo, rqPostParams, rqQueryParams, rqQueryString, rqURI, rqVersion), Response, Snap, deleteHeader, formatHttpTime, getHeader, parseUrlEncoded, printUrlEncoded, runSnap)
import           Snap.Internal.Core         (evalSnap, fixupResponse)
import           Snap.Internal.Http.Types   (Request (Request, rqBody), Response (rspBody, rspContentLength), rspBodyToEnum)
import qualified Snap.Internal.Http.Types   as H
import qualified Snap.Types.Headers         as H
import qualified System.IO.Streams          as Streams
import           System.PosixCompat.Time    (epochTime)
import           System.Random              (randomIO)
import           Text.Printf                (printf)
#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative        (Applicative)
import           Data.Monoid                (Monoid (mappend, mconcat, mempty))
#endif
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | RequestBuilder is a monad transformer that allows you to conveniently
-- build a snap 'Request' for testing.
newtype RequestBuilder m a = RequestBuilder (StateT Request m a)
  deriving ( Functor (RequestBuilder m)
a -> RequestBuilder m a
Functor (RequestBuilder m)
-> (forall a. a -> RequestBuilder m a)
-> (forall a b.
    RequestBuilder m (a -> b)
    -> RequestBuilder m a -> RequestBuilder m b)
-> (forall a b c.
    (a -> b -> c)
    -> RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m c)
-> (forall a b.
    RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b)
-> (forall a b.
    RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m a)
-> Applicative (RequestBuilder m)
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m a
RequestBuilder m (a -> b)
-> RequestBuilder m a -> RequestBuilder m b
(a -> b -> c)
-> RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m c
forall a. a -> RequestBuilder m a
forall a b.
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m a
forall a b.
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
forall a b.
RequestBuilder m (a -> b)
-> RequestBuilder m a -> RequestBuilder m b
forall a b c.
(a -> b -> c)
-> RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m c
forall (m :: * -> *). Monad m => Functor (RequestBuilder m)
forall (m :: * -> *) a. Monad m => a -> RequestBuilder m a
forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m a
forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m (a -> b)
-> RequestBuilder m a -> RequestBuilder m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m a
*> :: RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
liftA2 :: (a -> b -> c)
-> RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m c
<*> :: RequestBuilder m (a -> b)
-> RequestBuilder m a -> RequestBuilder m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m (a -> b)
-> RequestBuilder m a -> RequestBuilder m b
pure :: a -> RequestBuilder m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> RequestBuilder m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (RequestBuilder m)
Applicative
           , a -> RequestBuilder m b -> RequestBuilder m a
(a -> b) -> RequestBuilder m a -> RequestBuilder m b
(forall a b. (a -> b) -> RequestBuilder m a -> RequestBuilder m b)
-> (forall a b. a -> RequestBuilder m b -> RequestBuilder m a)
-> Functor (RequestBuilder m)
forall a b. a -> RequestBuilder m b -> RequestBuilder m a
forall a b. (a -> b) -> RequestBuilder m a -> RequestBuilder m b
forall (m :: * -> *) a b.
Functor m =>
a -> RequestBuilder m b -> RequestBuilder m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RequestBuilder m a -> RequestBuilder m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RequestBuilder m b -> RequestBuilder m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RequestBuilder m b -> RequestBuilder m a
fmap :: (a -> b) -> RequestBuilder m a -> RequestBuilder m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RequestBuilder m a -> RequestBuilder m b
Functor
           , Applicative (RequestBuilder m)
a -> RequestBuilder m a
Applicative (RequestBuilder m)
-> (forall a b.
    RequestBuilder m a
    -> (a -> RequestBuilder m b) -> RequestBuilder m b)
-> (forall a b.
    RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b)
-> (forall a. a -> RequestBuilder m a)
-> Monad (RequestBuilder m)
RequestBuilder m a
-> (a -> RequestBuilder m b) -> RequestBuilder m b
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
forall a. a -> RequestBuilder m a
forall a b.
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
forall a b.
RequestBuilder m a
-> (a -> RequestBuilder m b) -> RequestBuilder m b
forall (m :: * -> *). Monad m => Applicative (RequestBuilder m)
forall (m :: * -> *) a. Monad m => a -> RequestBuilder m a
forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a
-> (a -> RequestBuilder m b) -> RequestBuilder m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> RequestBuilder m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> RequestBuilder m a
>> :: RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a -> RequestBuilder m b -> RequestBuilder m b
>>= :: RequestBuilder m a
-> (a -> RequestBuilder m b) -> RequestBuilder m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
RequestBuilder m a
-> (a -> RequestBuilder m b) -> RequestBuilder m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (RequestBuilder m)
Monad
#if MIN_VERSION_base(4,13,0)
           , Monad (RequestBuilder m)
Monad (RequestBuilder m)
-> (forall a. String -> RequestBuilder m a)
-> MonadFail (RequestBuilder m)
String -> RequestBuilder m a
forall a. String -> RequestBuilder m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (RequestBuilder m)
forall (m :: * -> *) a. MonadFail m => String -> RequestBuilder m a
fail :: String -> RequestBuilder m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> RequestBuilder m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (RequestBuilder m)
MonadFail
#endif
           , Monad (RequestBuilder m)
Monad (RequestBuilder m)
-> (forall a. IO a -> RequestBuilder m a)
-> MonadIO (RequestBuilder m)
IO a -> RequestBuilder m a
forall a. IO a -> RequestBuilder m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (RequestBuilder m)
forall (m :: * -> *) a. MonadIO m => IO a -> RequestBuilder m a
liftIO :: IO a -> RequestBuilder m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> RequestBuilder m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (RequestBuilder m)
MonadIO
           , MonadState Request
           , m a -> RequestBuilder m a
(forall (m :: * -> *) a. Monad m => m a -> RequestBuilder m a)
-> MonadTrans RequestBuilder
forall (m :: * -> *) a. Monad m => m a -> RequestBuilder m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> RequestBuilder m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> RequestBuilder m a
MonadTrans
           )


------------------------------------------------------------------------------
mkDefaultRequest :: IO Request
mkDefaultRequest :: IO Request
mkDefaultRequest = do
    InputStream ByteString
b <- [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList ([ByteString] -> IO (InputStream ByteString))
-> [ByteString] -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! []
    Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> Int
-> ByteString
-> Int
-> ByteString
-> Bool
-> Headers
-> InputStream ByteString
-> Maybe Word64
-> Method
-> HttpVersion
-> [Cookie]
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Params
-> Params
-> Params
-> Request
Request ByteString
"localhost"
                     ByteString
"127.0.0.1"
                     Int
60000
                     ByteString
"127.0.0.1"
                     Int
8080
                     ByteString
"localhost"
                     Bool
False
                     Headers
H.empty
                     InputStream ByteString
b
                     Maybe Word64
forall a. Maybe a
Nothing
                     Method
GET
                     (Int
1,Int
1)
                     []
                     ByteString
""
                     ByteString
"/"
                     ByteString
"/"
                     ByteString
""
                     Params
forall k a. Map k a
Map.empty
                     Params
forall k a. Map k a
Map.empty
                     Params
forall k a. Map k a
Map.empty


------------------------------------------------------------------------------
-- | Runs a 'RequestBuilder', producing the desired 'Request'.
--
-- N.B. /please/ don't use the request you get here in a real Snap application;
-- things will probably break. Don't say you weren't warned :-)
--
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'get' \"\/foo\/bar\" M.empty
-- GET \/foo\/bar HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- @
buildRequest :: MonadIO m => RequestBuilder m () -> m Request
buildRequest :: RequestBuilder m () -> m Request
buildRequest RequestBuilder m ()
mm = do
    let (RequestBuilder StateT Request m ()
m) = (RequestBuilder m ()
mm RequestBuilder m () -> RequestBuilder m () -> RequestBuilder m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RequestBuilder m ()
fixup)
    Request
rq0 <- IO Request -> m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Request
mkDefaultRequest
    StateT Request m () -> Request -> m Request
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT Request m ()
m Request
rq0

  where
    fixup :: RequestBuilder m ()
fixup = do
        RequestBuilder m ()
forall (m :: * -> *). Monad m => RequestBuilder m ()
fixupURI
        RequestBuilder m ()
fixupMethod
        RequestBuilder m ()
fixupCL
        RequestBuilder m ()
fixupParams
        RequestBuilder m ()
fixupHost

    fixupMethod :: RequestBuilder m ()
fixupMethod = do
        Request
rq <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
        if (Request -> Method
rqMethod Request
rq Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
GET Bool -> Bool -> Bool
|| Request -> Method
rqMethod Request
rq Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
DELETE Bool -> Bool -> Bool
||
            Request -> Method
rqMethod Request
rq Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
HEAD)
          then do
              -- drain the old request body and replace it with a new one
              ![ByteString]
_ <- IO [ByteString] -> RequestBuilder m [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ByteString] -> RequestBuilder m [ByteString])
-> IO [ByteString] -> RequestBuilder m [ByteString]
forall a b. (a -> b) -> a -> b
$ InputStream ByteString -> IO [ByteString]
forall a. InputStream a -> IO [a]
Streams.toList (InputStream ByteString -> IO [ByteString])
-> InputStream ByteString -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ Request -> InputStream ByteString
rqBody Request
rq
              !InputStream ByteString
b <- IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InputStream ByteString)
 -> RequestBuilder m (InputStream ByteString))
-> IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList ([ByteString] -> IO (InputStream ByteString))
-> [ByteString] -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! []
              -- These requests are not permitted to have bodies
              let rq' :: Request
rq' = CI ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> a -> a
deleteHeader CI ByteString
"Content-Type" (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
                        Request
rq { rqBody :: InputStream ByteString
rqBody = InputStream ByteString
b }
              Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq' { rqContentLength :: Maybe Word64
rqContentLength = Maybe Word64
forall a. Maybe a
Nothing }
          else () -> RequestBuilder m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> RequestBuilder m ()) -> () -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$! ()

    fixupCL :: RequestBuilder m ()
fixupCL = do
        Request
rq <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
        RequestBuilder m ()
-> (Word64 -> RequestBuilder m ())
-> Maybe Word64
-> RequestBuilder m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ CI ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> a -> a
deleteHeader CI ByteString
"Content-Length" Request
rq)
              (\Word64
cl -> Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Content-Length"
                                         (String -> ByteString
S.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
cl)) Request
rq)
              (Request -> Maybe Word64
rqContentLength Request
rq)

    fixupParams :: RequestBuilder m ()
fixupParams = do
        Request
rq <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
        let !query :: ByteString
query       = Request -> ByteString
rqQueryString Request
rq
        -- force the stuff from mkDefaultRequest that we just overwrite
        let !Params
_           = Request -> Params
rqPostParams Request
rq
        let !Params
_           = Request -> Params
rqParams Request
rq
        let !Params
_           = Request -> Params
rqQueryParams Request
rq
        let !queryParams :: Params
queryParams = ByteString -> Params
parseUrlEncoded ByteString
query
        let !mbCT :: Maybe ByteString
mbCT        = CI ByteString -> Request -> Maybe ByteString
forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
getHeader CI ByteString
"Content-Type" Request
rq

        (!Params
postParams, Request
rq') <-
            if Maybe ByteString
mbCT Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"application/x-www-form-urlencoded"
              then IO (Params, Request) -> RequestBuilder m (Params, Request)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Params, Request) -> RequestBuilder m (Params, Request))
-> IO (Params, Request) -> RequestBuilder m (Params, Request)
forall a b. (a -> b) -> a -> b
$ do
                  ![ByteString]
l <- InputStream ByteString -> IO [ByteString]
forall a. InputStream a -> IO [a]
Streams.toList (InputStream ByteString -> IO [ByteString])
-> InputStream ByteString -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ Request -> InputStream ByteString
rqBody Request
rq
                  -- snap-server regurgitates the parsed form body
                  !InputStream ByteString
b <- [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList [ByteString]
l
                  (Params, Request) -> IO (Params, Request)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Params
parseUrlEncoded ([ByteString] -> ByteString
S.concat [ByteString]
l), Request
rq { rqBody :: InputStream ByteString
rqBody = InputStream ByteString
b })
              else (Params, Request) -> RequestBuilder m (Params, Request)
forall (m :: * -> *) a. Monad m => a -> m a
return (Params
forall k a. Map k a
Map.empty, Request
rq)
        let !newParams :: Params
newParams = ([ByteString] -> [ByteString] -> [ByteString])
-> Params -> Params -> Params
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (([ByteString] -> [ByteString] -> [ByteString])
-> [ByteString] -> [ByteString] -> [ByteString]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
(++)) Params
queryParams Params
postParams

        Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq' { rqParams :: Params
rqParams      = Params
newParams
                   , rqPostParams :: Params
rqPostParams  = Params
postParams
                   , rqQueryParams :: Params
rqQueryParams = Params
queryParams }

    fixupHost :: RequestBuilder m ()
fixupHost = do
        Request
rq <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
        case CI ByteString -> Request -> Maybe ByteString
forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
H.getHeader CI ByteString
"Host" Request
rq of
          Maybe ByteString
Nothing -> do
            let !hn :: ByteString
hn = Request -> ByteString
rqHostName Request
rq
            Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Host" ByteString
hn Request
rq
          Just ByteString
hn ->
            Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqHostName :: ByteString
rqHostName = ByteString
hn }


------------------------------------------------------------------------------
-- | A request body of type \"@multipart/form-data@\" consists of a set of
-- named form parameters, each of which can by either a list of regular form
-- values or a set of file uploads.
type MultipartParams = [(ByteString, MultipartParam)]


------------------------------------------------------------------------------
-- | A single \"@multipart/form-data@\" form parameter: either a list of regular
-- form values or a set of file uploads.
data MultipartParam =
    FormData [ByteString]
        -- ^ a form variable consisting of the given 'ByteString' values.
  | Files [FileData]
        -- ^ a file upload consisting of the given 'FileData' values.
  deriving (Int -> MultipartParam -> ShowS
[MultipartParam] -> ShowS
MultipartParam -> String
(Int -> MultipartParam -> ShowS)
-> (MultipartParam -> String)
-> ([MultipartParam] -> ShowS)
-> Show MultipartParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultipartParam] -> ShowS
$cshowList :: [MultipartParam] -> ShowS
show :: MultipartParam -> String
$cshow :: MultipartParam -> String
showsPrec :: Int -> MultipartParam -> ShowS
$cshowsPrec :: Int -> MultipartParam -> ShowS
Show)


------------------------------------------------------------------------------
-- | Represents a single file upload for the 'MultipartParam'.
data FileData = FileData {
      FileData -> ByteString
fdFileName    :: ByteString  -- ^ the file's name
    , FileData -> ByteString
fdContentType :: ByteString  -- ^ the file's content-type
    , FileData -> ByteString
fdContents    :: ByteString  -- ^ the file contents
    }
  deriving (Int -> FileData -> ShowS
[FileData] -> ShowS
FileData -> String
(Int -> FileData -> ShowS)
-> (FileData -> String) -> ([FileData] -> ShowS) -> Show FileData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileData] -> ShowS
$cshowList :: [FileData] -> ShowS
show :: FileData -> String
$cshow :: FileData -> String
showsPrec :: Int -> FileData -> ShowS
$cshowsPrec :: Int -> FileData -> ShowS
Show)


------------------------------------------------------------------------------
-- | The 'RequestType' datatype enumerates the different kinds of HTTP
-- requests you can generate using the testing interface. Most users will
-- prefer to use the 'get', 'postUrlEncoded', 'postMultipart', 'put', and
-- 'delete' convenience functions.
data RequestType
    = GetRequest
    | RequestWithRawBody Method ByteString
    | MultipartPostRequest MultipartParams
    | UrlEncodedPostRequest Params
    | DeleteRequest
    deriving (Int -> RequestType -> ShowS
[RequestType] -> ShowS
RequestType -> String
(Int -> RequestType -> ShowS)
-> (RequestType -> String)
-> ([RequestType] -> ShowS)
-> Show RequestType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestType] -> ShowS
$cshowList :: [RequestType] -> ShowS
show :: RequestType -> String
$cshow :: RequestType -> String
showsPrec :: Int -> RequestType -> ShowS
$cshowsPrec :: Int -> RequestType -> ShowS
Show)


------------------------------------------------------------------------------
-- | Sets the type of the 'Request' being built.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'delete' \"\/foo\/bar\" M.empty >> 'setRequestType' GetRequest
-- GET \/foo\/bar HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- @
setRequestType :: MonadIO m => RequestType -> RequestBuilder m ()
setRequestType :: RequestType -> RequestBuilder m ()
setRequestType RequestType
GetRequest = do
    Request
rq   <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
    InputStream ByteString
body <- IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InputStream ByteString)
 -> RequestBuilder m (InputStream ByteString))
-> IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList ([ByteString] -> IO (InputStream ByteString))
-> [ByteString] -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! []

    Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqMethod :: Method
rqMethod        = Method
GET
              , rqContentLength :: Maybe Word64
rqContentLength = Maybe Word64
forall a. Maybe a
Nothing
              , rqBody :: InputStream ByteString
rqBody          = InputStream ByteString
body
              }

setRequestType RequestType
DeleteRequest = do
    Request
rq   <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
    InputStream ByteString
body <- IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InputStream ByteString)
 -> RequestBuilder m (InputStream ByteString))
-> IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList ([ByteString] -> IO (InputStream ByteString))
-> [ByteString] -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! []

    Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqMethod :: Method
rqMethod        = Method
DELETE
              , rqContentLength :: Maybe Word64
rqContentLength = Maybe Word64
forall a. Maybe a
Nothing
              , rqBody :: InputStream ByteString
rqBody          = InputStream ByteString
body
              }

setRequestType (RequestWithRawBody Method
m ByteString
b) = do
    Request
rq <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
    InputStream ByteString
body <- IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InputStream ByteString)
 -> RequestBuilder m (InputStream ByteString))
-> IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList ([ByteString] -> IO (InputStream ByteString))
-> [ByteString] -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! [ ByteString
b ]
    Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqMethod :: Method
rqMethod        = Method
m
              , rqContentLength :: Maybe Word64
rqContentLength = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
b
              , rqBody :: InputStream ByteString
rqBody          = InputStream ByteString
body
              }

setRequestType (MultipartPostRequest MultipartParams
fp) = MultipartParams -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
MultipartParams -> RequestBuilder m ()
encodeMultipart MultipartParams
fp

setRequestType (UrlEncodedPostRequest Params
fp) = do
    Request
rq <- (Request -> Request)
-> RequestBuilder m Request -> RequestBuilder m Request
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CI ByteString -> ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Content-Type"
                             ByteString
"application/x-www-form-urlencoded") RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
    let b :: ByteString
b = Params -> ByteString
printUrlEncoded Params
fp
    InputStream ByteString
body <- IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InputStream ByteString)
 -> RequestBuilder m (InputStream ByteString))
-> IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList ([ByteString] -> IO (InputStream ByteString))
-> [ByteString] -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$! [ByteString
b]

    Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqMethod :: Method
rqMethod        = Method
POST
              , rqContentLength :: Maybe Word64
rqContentLength = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$!  Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
b
              , rqBody :: InputStream ByteString
rqBody          = InputStream ByteString
body
              }


------------------------------------------------------------------------------
makeBoundary :: MonadIO m => m ByteString
makeBoundary :: m ByteString
makeBoundary = do
    [Word8]
xs  <- IO [Word8] -> m [Word8]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Word8] -> m [Word8]) -> IO [Word8] -> m [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> IO Word8 -> IO [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 IO Word8
randomWord8
    let x :: ByteString
x = String -> ByteString
S.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum) [Word8]
xs
    ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat [ ByteString
"snap-boundary-", ByteString -> ByteString
encode ByteString
x ]

  where
    randomWord8 :: IO Word8
    randomWord8 :: IO Word8
randomWord8 = (Int -> Word8) -> IO Int -> IO Word8
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\Int
c -> Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO

    table :: Vector Char
table = String -> Vector Char
forall a. [a] -> Vector a
V.fromList [ Char
'0', Char
'1', Char
'2', Char
'3', Char
'4', Char
'5', Char
'6', Char
'7', Char
'8', Char
'9'
                       , Char
'a', Char
'b', Char
'c', Char
'd', Char
'e', Char
'f' ]

    encode :: ByteString -> ByteString
encode = Builder -> ByteString
toByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Word8 -> Builder) -> Builder -> ByteString -> Builder
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S8.foldl' Builder -> Word8 -> Builder
f Builder
forall a. Monoid a => a
mempty

#if MIN_VERSION_base(4,5,0)
    shR :: Word8 -> Int -> Word8
shR = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftR
#else
    shR = shiftR
#endif

    f :: Builder -> Word8 -> Builder
f Builder
m Word8
c = let low :: Word8
low = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf
                hi :: Word8
hi  = (Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf0) Word8 -> Int -> Word8
`shR` Int
4
                k :: Word8 -> Builder
k   = \Word8
i -> Word8 -> Builder
word8 (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$! Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$! Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$!
                            Vector Char -> Int -> Char
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Char
table (Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
i)
            in Builder
m Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Word8 -> Builder
k Word8
hi Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Word8 -> Builder
k Word8
low


------------------------------------------------------------------------------
multipartHeader :: ByteString -> ByteString -> Builder
multipartHeader :: ByteString -> ByteString -> Builder
multipartHeader ByteString
boundary ByteString
name =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ ByteString -> Builder
byteString ByteString
boundary
            , ByteString -> Builder
byteString ByteString
"\r\ncontent-disposition: form-data"
            , ByteString -> Builder
byteString ByteString
"; name=\""
            , ByteString -> Builder
byteString ByteString
name
            , ByteString -> Builder
byteString ByteString
"\"\r\n" ]


------------------------------------------------------------------------------
-- Assume initial or preceding "--" just before this
encodeFormData :: ByteString -> ByteString -> [ByteString] -> IO Builder
encodeFormData :: ByteString -> ByteString -> [ByteString] -> IO Builder
encodeFormData ByteString
boundary ByteString
name [ByteString]
vals =
    case [ByteString]
vals of
      []  -> Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
forall a. Monoid a => a
mempty
      [ByteString
v] -> Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
hdr
                              , Builder
cr
                              , ByteString -> Builder
byteString ByteString
v
                              , ByteString -> Builder
byteString ByteString
"\r\n--" ]
      [ByteString]
_   -> IO Builder
multi

  where
    hdr :: Builder
hdr = ByteString -> ByteString -> Builder
multipartHeader ByteString
boundary ByteString
name
    cr :: Builder
cr = ByteString -> Builder
byteString ByteString
"\r\n"

    oneVal :: ByteString -> ByteString -> Builder
oneVal ByteString
b ByteString
v = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ ByteString -> Builder
byteString ByteString
b
                         , Builder
cr
                         , Builder
cr
                         , ByteString -> Builder
byteString ByteString
v
                         , ByteString -> Builder
byteString ByteString
"\r\n--" ]

    multi :: IO Builder
multi = do
        ByteString
b <- IO ByteString
forall (m :: * -> *). MonadIO m => m ByteString
makeBoundary
        Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
hdr
                         , ByteString -> Builder
multipartMixed ByteString
b
                         , Builder
cr
                         , ByteString -> Builder
byteString ByteString
"--"
                         , [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((ByteString -> Builder) -> [ByteString] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString -> Builder
oneVal ByteString
b) [ByteString]
vals)
                         , ByteString -> Builder
byteString ByteString
b
                         , ByteString -> Builder
byteString ByteString
"--\r\n--" ]


------------------------------------------------------------------------------
multipartMixed :: ByteString -> Builder
multipartMixed :: ByteString -> Builder
multipartMixed ByteString
b = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ ByteString -> Builder
byteString ByteString
"Content-Type: multipart/mixed"
                           , ByteString -> Builder
byteString ByteString
"; boundary="
                           , ByteString -> Builder
byteString ByteString
b
                           , ByteString -> Builder
byteString ByteString
"\r\n" ]


------------------------------------------------------------------------------
encodeFiles :: ByteString -> ByteString -> [FileData] -> IO Builder
encodeFiles :: ByteString -> ByteString -> [FileData] -> IO Builder
encodeFiles ByteString
boundary ByteString
name [FileData]
files =
    case [FileData]
files of
      [] -> Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
forall a. Monoid a => a
mempty
      [FileData]
_  -> do
          ByteString
b <- IO ByteString
forall (m :: * -> *). MonadIO m => m ByteString
makeBoundary
          Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
hdr
                           , ByteString -> Builder
multipartMixed ByteString
b
                           , Builder
cr
                           , ByteString -> Builder
byteString ByteString
"--"
                           , [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((FileData -> Builder) -> [FileData] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> FileData -> Builder
oneVal ByteString
b) [FileData]
files)
                           , ByteString -> Builder
byteString ByteString
b
                           , ByteString -> Builder
byteString ByteString
"--\r\n--"
                           ]

  where
    --------------------------------------------------------------------------
    contentDisposition :: ByteString -> Builder
contentDisposition ByteString
fn = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [
                              ByteString -> Builder
byteString ByteString
"Content-Disposition: attachment"
                            , ByteString -> Builder
byteString ByteString
"; filename=\""
                            , ByteString -> Builder
byteString ByteString
fn
                            , ByteString -> Builder
byteString ByteString
"\"\r\n"
                            ]

    --------------------------------------------------------------------------
    contentType :: ByteString -> Builder
contentType ByteString
ct = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [
                       ByteString -> Builder
byteString ByteString
"Content-Type: "
                     , ByteString -> Builder
byteString ByteString
ct
                     , Builder
cr
                     ]

    --------------------------------------------------------------------------
    oneVal :: ByteString -> FileData -> Builder
oneVal ByteString
b FileData
fd =
        [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ ByteString -> Builder
byteString ByteString
b
                , Builder
cr
                , ByteString -> Builder
contentType ByteString
ct
                , ByteString -> Builder
contentDisposition ByteString
fileName
                , ByteString -> Builder
byteString ByteString
"Content-Transfer-Encoding: binary\r\n"
                , Builder
cr
                , ByteString -> Builder
byteString ByteString
contents
                , ByteString -> Builder
byteString ByteString
"\r\n--"
                ]
      where
        fileName :: ByteString
fileName = FileData -> ByteString
fdFileName FileData
fd
        ct :: ByteString
ct       = FileData -> ByteString
fdContentType FileData
fd
        contents :: ByteString
contents = FileData -> ByteString
fdContents FileData
fd

    --------------------------------------------------------------------------
    hdr :: Builder
hdr = ByteString -> ByteString -> Builder
multipartHeader ByteString
boundary ByteString
name
    cr :: Builder
cr  = ByteString -> Builder
byteString ByteString
"\r\n"


------------------------------------------------------------------------------
encodeMultipart :: MonadIO m => MultipartParams -> RequestBuilder m ()
encodeMultipart :: MultipartParams -> RequestBuilder m ()
encodeMultipart MultipartParams
kvps = do
    ByteString
boundary <- IO ByteString -> RequestBuilder m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> RequestBuilder m ByteString)
-> IO ByteString -> RequestBuilder m ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString
forall (m :: * -> *). MonadIO m => m ByteString
makeBoundary
    [Builder]
builders <- IO [Builder] -> RequestBuilder m [Builder]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Builder] -> RequestBuilder m [Builder])
-> IO [Builder] -> RequestBuilder m [Builder]
forall a b. (a -> b) -> a -> b
$ ((ByteString, MultipartParam) -> IO Builder)
-> MultipartParams -> IO [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ByteString -> (ByteString, MultipartParam) -> IO Builder
handleOne ByteString
boundary) MultipartParams
kvps

    let b :: ByteString
b = Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (ByteString -> Builder
byteString ByteString
"--" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
builders)
                             Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
finalBoundary ByteString
boundary

    Request
rq0 <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet

    InputStream ByteString
body <- IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InputStream ByteString)
 -> RequestBuilder m (InputStream ByteString))
-> IO (InputStream ByteString)
-> RequestBuilder m (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList [ByteString
b]

    let rq :: Request
rq = CI ByteString -> ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Content-Type"
               (ByteString -> ByteString -> ByteString
S.append ByteString
"multipart/form-data; boundary=" ByteString
boundary)
               Request
rq0

    Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqMethod :: Method
rqMethod        = Method
POST
              , rqContentLength :: Maybe Word64
rqContentLength = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
b
              , rqBody :: InputStream ByteString
rqBody          = InputStream ByteString
body
              }


  where
    finalBoundary :: ByteString -> Builder
finalBoundary ByteString
b = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ByteString -> Builder
byteString ByteString
b, ByteString -> Builder
byteString ByteString
"--\r\n"]

    handleOne :: ByteString -> (ByteString, MultipartParam) -> IO Builder
handleOne ByteString
boundary (ByteString
name, MultipartParam
mp) =
        case MultipartParam
mp of
          (FormData [ByteString]
vals) -> ByteString -> ByteString -> [ByteString] -> IO Builder
encodeFormData ByteString
boundary ByteString
name [ByteString]
vals
          (Files [FileData]
fs)      -> ByteString -> ByteString -> [FileData] -> IO Builder
encodeFiles ByteString
boundary ByteString
name [FileData]
fs


------------------------------------------------------------------------------
fixupURI :: Monad m => RequestBuilder m ()
fixupURI :: RequestBuilder m ()
fixupURI = do
    Request
rq <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
    Request -> ByteString -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
Request -> ByteString -> RequestBuilder m ()
upd Request
rq (ByteString -> RequestBuilder m ())
-> ByteString -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
S.concat [ Request -> ByteString
rqContextPath Request
rq
                       , Request -> ByteString
rqPathInfo Request
rq
                       , let q :: ByteString
q = Request -> ByteString
rqQueryString Request
rq
                         in if ByteString -> Bool
S.null ByteString
q
                              then ByteString
""
                              else ByteString -> ByteString -> ByteString
S.append ByteString
"?" ByteString
q
                       ]
  where
    upd :: Request -> ByteString -> RequestBuilder m ()
upd Request
rq !ByteString
u = let !ByteString
_ = Request -> ByteString
rqURI Request
rq
                in Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqURI :: ByteString
rqURI = ByteString
u }


------------------------------------------------------------------------------
-- | Sets the request's query string to be the raw bytestring provided,
-- without any escaping or other interpretation. Most users should instead
-- choose the 'setQueryString' function, which takes a parameter mapping.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'get' \"\/foo\/bar\" M.empty >> 'setQueryStringRaw' "param0=baz&param1=qux"
-- GET \/foo\/bar?param0=baz&param1=qux HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- params: param0: ["baz"], param1: ["qux"]
-- @
setQueryStringRaw :: Monad m => ByteString -> RequestBuilder m ()
setQueryStringRaw :: ByteString -> RequestBuilder m ()
setQueryStringRaw ByteString
r = do
    Request
rq <- RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
    Request -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Request -> RequestBuilder m ()
rPut (Request -> RequestBuilder m ()) -> Request -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request
rq { rqQueryString :: ByteString
rqQueryString = ByteString
r }
    RequestBuilder m ()
forall (m :: * -> *). Monad m => RequestBuilder m ()
fixupURI


------------------------------------------------------------------------------
-- | Escapes the given parameter mapping and sets it as the request's query
-- string.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'get' \"\/foo\/bar\" M.empty >> 'setQueryString' (M.fromList [("param0", ["baz"]), ("param1", ["qux"])])
-- GET \/foo\/bar?param0=baz&param1=qux HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- params: param0: ["baz"], param1: ["qux"]
-- @
setQueryString :: Monad m => Params -> RequestBuilder m ()
setQueryString :: Params -> RequestBuilder m ()
setQueryString Params
p = ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setQueryStringRaw (ByteString -> RequestBuilder m ())
-> ByteString -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Params -> ByteString
printUrlEncoded Params
p


------------------------------------------------------------------------------
-- | Sets the given header in the request being built, overwriting any header
-- with the same name already present.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> :{
-- ghci| 'buildRequest' $ do get \"\/foo\/bar\" M.empty
-- ghci|                   'setHeader' \"Accept\" "text\/html"
-- ghci|                   'setHeader' \"Accept\" "text\/plain"
-- ghci| :}
-- GET \/foo\/bar HTTP\/1.1
-- accept: text\/plain
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- @
setHeader :: (Monad m) => CI ByteString -> ByteString -> RequestBuilder m ()
setHeader :: CI ByteString -> ByteString -> RequestBuilder m ()
setHeader CI ByteString
k ByteString
v = (Request -> Request) -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
(Request -> Request) -> RequestBuilder m ()
rModify (CI ByteString -> ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
k ByteString
v)


------------------------------------------------------------------------------
-- | Adds the given header to the request being built.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> :{
-- ghci| 'buildRequest' $ do 'get' \"\/foo\/bar\" M.empty
-- ghci|                   'addHeader' \"Accept\" "text\/html"
-- ghci|                   'addHeader' \"Accept\" "text\/plain"
-- ghci| :}
-- GET \/foo\/bar HTTP\/1.1
-- accept: text\/html,text\/plain
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- @
addHeader :: (Monad m) => CI ByteString -> ByteString -> RequestBuilder m ()
addHeader :: CI ByteString -> ByteString -> RequestBuilder m ()
addHeader CI ByteString
k ByteString
v = (Request -> Request) -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
(Request -> Request) -> RequestBuilder m ()
rModify (CI ByteString -> ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.addHeader CI ByteString
k ByteString
v)

------------------------------------------------------------------------------
-- | Adds the given cookies to the request being built.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> import "Snap.Core"
-- ghci> let cookie = 'Snap.Core.Cookie' "name" "value" Nothing Nothing Nothing False False
-- ghci> 'buildRequest' $ 'get' \"\/foo\/bar\" M.empty >> 'addCookies' [cookie]
-- GET \/foo\/bar HTTP\/1.1
-- cookie: name=value
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- cookies: Cookie {cookieName = "name", cookieValue = "value", ...}
-- @
addCookies :: (Monad m) => [Cookie] -> RequestBuilder m ()
addCookies :: [Cookie] -> RequestBuilder m ()
addCookies [Cookie]
cookies = do
    (Request -> Request) -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
(Request -> Request) -> RequestBuilder m ()
rModify ((Request -> Request) -> RequestBuilder m ())
-> (Request -> Request) -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ \Request
rq -> Request
rq { rqCookies :: [Cookie]
rqCookies = Request -> [Cookie]
rqCookies Request
rq [Cookie] -> [Cookie] -> [Cookie]
forall a. [a] -> [a] -> [a]
++ [Cookie]
cookies }
    [Cookie]
allCookies <- (Request -> [Cookie])
-> RequestBuilder m Request -> RequestBuilder m [Cookie]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> [Cookie]
rqCookies RequestBuilder m Request
forall (m :: * -> *). Monad m => RequestBuilder m Request
rGet
    let cstr :: [ByteString]
cstr = (Cookie -> ByteString) -> [Cookie] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Cookie -> ByteString
cookieToBS [Cookie]
allCookies
    CI ByteString -> ByteString -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
CI ByteString -> ByteString -> RequestBuilder m ()
setHeader CI ByteString
"Cookie" (ByteString -> RequestBuilder m ())
-> ByteString -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
S.intercalate ByteString
"; " [ByteString]
cstr


------------------------------------------------------------------------------
-- | Convert 'Cookie' into 'ByteString' for output.
cookieToBS :: Cookie -> ByteString
cookieToBS :: Cookie -> ByteString
cookieToBS (Cookie ByteString
k ByteString
v !Maybe UTCTime
_ !Maybe ByteString
_ !Maybe ByteString
_ !Bool
_ !Bool
_) = ByteString
cookie
  where
    cookie :: ByteString
cookie  = [ByteString] -> ByteString
S.concat [ByteString
k, ByteString
"=", ByteString
v]


------------------------------------------------------------------------------
-- | Sets the request's @content-type@ to the given MIME type.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'put' \"\/foo\/bar\" "text\/html" "some text" >> 'setContentType' "text\/plain"
-- PUT \/foo\/bar HTTP\/1.1
-- content-type: text\/plain
-- content-length: 9
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=9
-- @
setContentType :: Monad m => ByteString -> RequestBuilder m ()
setContentType :: ByteString -> RequestBuilder m ()
setContentType ByteString
c = (Request -> Request) -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
(Request -> Request) -> RequestBuilder m ()
rModify (CI ByteString -> ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Content-Type" ByteString
c)


------------------------------------------------------------------------------
-- | Controls whether the test request being generated appears to be an https
-- request or not.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'delete' \"\/foo\/bar\" M.empty >> 'setSecure' True
-- DELETE \/foo\/bar HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a secure
-- @
setSecure :: Monad m => Bool -> RequestBuilder m ()
setSecure :: Bool -> RequestBuilder m ()
setSecure Bool
b = (Request -> Request) -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
(Request -> Request) -> RequestBuilder m ()
rModify ((Request -> Request) -> RequestBuilder m ())
-> (Request -> Request) -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ \Request
rq -> Request
rq { rqIsSecure :: Bool
rqIsSecure = Bool
b }


------------------------------------------------------------------------------
-- | Sets the test request's http version
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'delete' \"\/foo\/bar\" M.empty >> 'setHttpVersion' (1,0)
-- DELETE \/foo\/bar HTTP\/1.0
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- @
setHttpVersion :: Monad m => (Int,Int) -> RequestBuilder m ()
setHttpVersion :: HttpVersion -> RequestBuilder m ()
setHttpVersion HttpVersion
v = (Request -> Request) -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
(Request -> Request) -> RequestBuilder m ()
rModify ((Request -> Request) -> RequestBuilder m ())
-> (Request -> Request) -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ \Request
rq -> Request
rq { rqVersion :: HttpVersion
rqVersion = HttpVersion
v }


------------------------------------------------------------------------------
-- | Sets the request's path. The path provided must begin with a \"@/@\" and
-- must /not/ contain a query string; if you want to provide a query string
-- in your test request, you must use 'setQueryString' or 'setQueryStringRaw'.
-- Note that 'rqContextPath' is never set by any 'RequestBuilder' function.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'get' \"\/foo\/bar\" M.empty >> 'setRequestPath' "\/bar\/foo"
-- GET \/bar\/foo HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- @
setRequestPath :: Monad m => ByteString -> RequestBuilder m ()
setRequestPath :: ByteString -> RequestBuilder m ()
setRequestPath ByteString
p0 = do
    (Request -> Request) -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
(Request -> Request) -> RequestBuilder m ()
rModify ((Request -> Request) -> RequestBuilder m ())
-> (Request -> Request) -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ \Request
rq -> Request
rq { rqContextPath :: ByteString
rqContextPath = ByteString
"/"
                        , rqPathInfo :: ByteString
rqPathInfo    = ByteString
p }
    RequestBuilder m ()
forall (m :: * -> *). Monad m => RequestBuilder m ()
fixupURI

  where
    p :: ByteString
p = if ByteString -> ByteString -> Bool
S.isPrefixOf ByteString
"/" ByteString
p0 then Int -> ByteString -> ByteString
S.drop Int
1 ByteString
p0 else ByteString
p0


------------------------------------------------------------------------------
-- | Builds an HTTP \"GET\" request with the given query parameters.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'get' \"\/foo\/bar\" (M.fromList [("param0", ["baz", "quux"])])
-- GET \/foo\/bar?param0=baz&param0=quux HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- params: param0: ["baz","quux"]
-- @
get :: MonadIO m =>
       ByteString               -- ^ request path
    -> Params                   -- ^ request's form parameters
    -> RequestBuilder m ()
get :: ByteString -> Params -> RequestBuilder m ()
get ByteString
uri Params
params = do
    RequestType -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
RequestType -> RequestBuilder m ()
setRequestType RequestType
GetRequest
    Params -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Params -> RequestBuilder m ()
setQueryString Params
params
    ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setRequestPath ByteString
uri

------------------------------------------------------------------------------
-- | Builds an HTTP \"HEAD\" request with the given query parameters.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'head' \"\/foo\/bar\" (M.fromList ("param0", ["baz", "quux"])])
-- HEAD \/foo\/bar?param0=baz&param0=quux HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- params: param0: ["baz","quux"]
-- @
-- @since 1.0.4.3 
head :: MonadIO m =>
        ByteString              -- ^ request path
     -> Params                  -- ^ request's form parameters
     -> RequestBuilder m ()
head :: ByteString -> Params -> RequestBuilder m ()
head ByteString
uri Params
params = do
  RequestType -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
RequestType -> RequestBuilder m ()
setRequestType (RequestType -> RequestBuilder m ())
-> (ByteString -> RequestType) -> ByteString -> RequestBuilder m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> ByteString -> RequestType
RequestWithRawBody Method
HEAD (ByteString -> RequestBuilder m ())
-> ByteString -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ ByteString
""
  Params -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Params -> RequestBuilder m ()
setQueryString Params
params
  ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setRequestPath ByteString
uri

------------------------------------------------------------------------------
-- | Builds an HTTP \"DELETE\" request with the given query parameters.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'delete' \"\/foo\/bar\" M.empty
-- DELETE \/foo\/bar HTTP\/1.1
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=n\/a
-- @
delete :: MonadIO m =>
          ByteString            -- ^ request path
       -> Params                -- ^ request's form parameters
       -> RequestBuilder m ()
delete :: ByteString -> Params -> RequestBuilder m ()
delete ByteString
uri Params
params = do
    RequestType -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
RequestType -> RequestBuilder m ()
setRequestType RequestType
DeleteRequest
    Params -> RequestBuilder m ()
forall (m :: * -> *). Monad m => Params -> RequestBuilder m ()
setQueryString Params
params
    ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setRequestPath ByteString
uri


------------------------------------------------------------------------------
-- | Builds an HTTP \"POST\" request with the given form parameters, using the
-- \"application/x-www-form-urlencoded\" MIME type.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> 'buildRequest' $ 'postUrlEncoded' \"\/foo\/bar\" (M.fromList [("param0", ["baz", "quux"])])
-- POST \/foo\/bar HTTP\/1.1
-- content-type: application\/x-www-form-urlencoded
-- content-length: 22
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=22
-- params: param0: ["baz","quux"]
-- @
postUrlEncoded :: MonadIO m =>
                  ByteString    -- ^ request path
               -> Params        -- ^ request's form parameters
               -> RequestBuilder m ()
postUrlEncoded :: ByteString -> Params -> RequestBuilder m ()
postUrlEncoded ByteString
uri Params
params = do
    RequestType -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
RequestType -> RequestBuilder m ()
setRequestType (RequestType -> RequestBuilder m ())
-> RequestType -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Params -> RequestType
UrlEncodedPostRequest Params
params
    ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setRequestPath ByteString
uri


------------------------------------------------------------------------------
-- | Builds an HTTP \"POST\" request with the given form parameters, using the
-- \"form-data/multipart\" MIME type.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> 'buildRequest' $ 'postMultipart' \"\/foo\/bar\" [("param0", FormData ["baz", "quux"])]
-- POST \/foo\/bar HTTP\/1.1
-- content-type: multipart\/form-data; boundary=snap-boundary-572334111ec0c05ad4812481e8585dfa
-- content-length: 406
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=406
-- @
postMultipart :: MonadIO m =>
                 ByteString        -- ^ request path
              -> MultipartParams   -- ^ multipart form parameters
              -> RequestBuilder m ()
postMultipart :: ByteString -> MultipartParams -> RequestBuilder m ()
postMultipart ByteString
uri MultipartParams
params = do
    RequestType -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
RequestType -> RequestBuilder m ()
setRequestType (RequestType -> RequestBuilder m ())
-> RequestType -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ MultipartParams -> RequestType
MultipartPostRequest MultipartParams
params
    ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setRequestPath ByteString
uri


------------------------------------------------------------------------------
-- | Builds an HTTP \"PUT\" request.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> 'buildRequest' $ 'put' \"\/foo\/bar\" "text\/plain" "some text"
-- PUT \/foo\/bar HTTP\/1.1
-- content-type: text/plain
-- content-length: 9
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=9
-- @
put :: MonadIO m =>
       ByteString               -- ^ request path
    -> ByteString               -- ^ request body MIME content-type
    -> ByteString               -- ^ request body contents
    -> RequestBuilder m ()
put :: ByteString -> ByteString -> ByteString -> RequestBuilder m ()
put ByteString
uri ByteString
contentType ByteString
putData = do
    RequestType -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
RequestType -> RequestBuilder m ()
setRequestType (RequestType -> RequestBuilder m ())
-> RequestType -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Method -> ByteString -> RequestType
RequestWithRawBody Method
PUT ByteString
putData
    CI ByteString -> ByteString -> RequestBuilder m ()
forall (m :: * -> *).
Monad m =>
CI ByteString -> ByteString -> RequestBuilder m ()
setHeader CI ByteString
"Content-Type" ByteString
contentType
    ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setRequestPath ByteString
uri


------------------------------------------------------------------------------
-- | Builds a \"raw\" HTTP \"POST\" request, with the given MIME type and body
-- contents.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> 'buildRequest' $ 'postRaw' \"\/foo\/bar\" "text/plain" "some text"
-- POST \/foo\/bar HTTP\/1.1
-- content-type: text\/plain
-- content-length: 9
-- host: localhost
--
-- sn="localhost" c=127.0.0.1:60000 s=127.0.0.1:8080 ctx=\/ clen=9
-- @
postRaw :: MonadIO m =>
           ByteString           -- ^ request path
        -> ByteString           -- ^ request body MIME content-type
        -> ByteString           -- ^ request body contents
        -> RequestBuilder m ()
postRaw :: ByteString -> ByteString -> ByteString -> RequestBuilder m ()
postRaw ByteString
uri ByteString
contentType ByteString
postData = do
    RequestType -> RequestBuilder m ()
forall (m :: * -> *).
MonadIO m =>
RequestType -> RequestBuilder m ()
setRequestType (RequestType -> RequestBuilder m ())
-> RequestType -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Method -> ByteString -> RequestType
RequestWithRawBody Method
POST ByteString
postData
    ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setContentType ByteString
contentType
    ByteString -> RequestBuilder m ()
forall (m :: * -> *). Monad m => ByteString -> RequestBuilder m ()
setRequestPath ByteString
uri


------------------------------------------------------------------------------
-- | Given a web handler in the 'Snap' monad, and a 'RequestBuilder' defining
-- a test request, runs the handler, producing an HTTP 'Response'.
--
-- This function will produce almost exactly the same output as running the
-- handler in a real server, except that chunked transfer encoding is not
-- applied, and the \"Transfer-Encoding\" header is not set (this makes it
-- easier to test response output).
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> import "Snap.Core"
-- ghci> 'runHandler' ('get' "foo/bar" M.empty) ('Snap.Core.writeBS' "Hello, world!")
-- HTTP\/1.1 200 OK
-- server: Snap/test
-- date: Thu, 17 Jul 2014 21:03:23 GMT
--
-- Hello, world!
-- @
runHandler :: MonadIO m =>
              RequestBuilder m ()   -- ^ a request builder
           -> Snap a                -- ^ a web handler
           -> m Response
runHandler :: RequestBuilder m () -> Snap a -> m Response
runHandler = (forall a. Request -> Snap a -> m Response)
-> RequestBuilder m () -> Snap a -> m Response
forall (m :: * -> *) (n :: * -> *) b.
(MonadIO m, MonadSnap n) =>
(forall a. Request -> n a -> m Response)
-> RequestBuilder m () -> n b -> m Response
runHandlerM forall a. Request -> Snap a -> m Response
forall (m :: * -> *) a.
MonadIO m =>
Request -> Snap a -> m Response
rs
  where
    rs :: Request -> Snap a -> m Response
rs Request
rq Snap a
s = IO Response -> m Response
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Response -> m Response) -> IO Response -> m Response
forall a b. (a -> b) -> a -> b
$ do
        (Request
_,Response
rsp) <- Snap a
-> (ByteString -> IO ())
-> ((Int -> Int) -> IO ())
-> Request
-> IO (Request, Response)
forall a.
Snap a
-> (ByteString -> IO ())
-> ((Int -> Int) -> IO ())
-> Request
-> IO (Request, Response)
runSnap Snap a
s (\ByteString
x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! (ByteString
x ByteString -> () -> ()
`seq` ()))
                             (\Int -> Int
f -> let !Int
_ = Int -> Int
f Int
0 in () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                             Request
rq
        Request -> Response -> IO Response
fixupResponse Request
rq Response
rsp


------------------------------------------------------------------------------
-- | Given a web handler in some arbitrary 'MonadSnap' monad, a function
-- specifying how to evaluate it within the context of the test monad, and a
-- 'RequestBuilder' defining a test request, runs the handler, producing an
-- HTTP 'Response'.
runHandlerM :: (MonadIO m, MonadSnap n) =>
               (forall a . Request -> n a -> m Response)
            -- ^ a function defining how the 'MonadSnap' monad should be run
            -> RequestBuilder m ()
            -- ^ a request builder
            -> n b
            -- ^ a web handler
            -> m Response
runHandlerM :: (forall a. Request -> n a -> m Response)
-> RequestBuilder m () -> n b -> m Response
runHandlerM forall a. Request -> n a -> m Response
rSnap RequestBuilder m ()
rBuilder n b
snap = do
    Request
rq  <- RequestBuilder m () -> m Request
forall (m :: * -> *). MonadIO m => RequestBuilder m () -> m Request
buildRequest RequestBuilder m ()
rBuilder
    Response
rsp <- Request -> n b -> m Response
forall a. Request -> n a -> m Response
rSnap Request
rq n b
snap

    -- simulate server logic
    ByteString
t1  <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EpochTime
epochTime IO EpochTime -> (EpochTime -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EpochTime -> IO ByteString
formatHttpTime)
    Response -> m Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString -> Response -> Response
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Date" ByteString
t1
           (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString -> Response -> Response
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Server" ByteString
"Snap/test"
           (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$ if Response -> Maybe Word64
rspContentLength Response
rsp Maybe Word64 -> Maybe Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Word64
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                Request -> HttpVersion
rqVersion Request
rq HttpVersion -> HttpVersion -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
1,Int
1)
               then CI ByteString -> ByteString -> Response -> Response
forall a. HasHeaders a => CI ByteString -> ByteString -> a -> a
H.setHeader CI ByteString
"Connection" ByteString
"close" Response
rsp
               else Response
rsp


------------------------------------------------------------------------------
-- | Given a web handler in the 'Snap' monad, and a 'RequestBuilder' defining a
-- test request, runs the handler and returns the monadic value it produces.
--
-- Throws an exception if the 'Snap' handler early-terminates with
-- 'Snap.Core.finishWith' or 'Control.Monad.mzero'.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import "Control.Monad"
-- ghci> import qualified "Data.Map" as M
-- ghci> import "Snap.Core"
-- ghci> 'evalHandler' ('get' "foo/bar" M.empty) ('Snap.Core.writeBS' "Hello, world!" >> return 42)
-- 42
-- ghci> 'evalHandler' ('get' "foo/bar" M.empty) 'Control.Monad.mzero'
-- *** Exception: No handler for request: failure was pass
-- @
evalHandler :: MonadIO m =>
               RequestBuilder m ()
            -> Snap a
            -> m a
evalHandler :: RequestBuilder m () -> Snap a -> m a
evalHandler = (forall a. Request -> Snap a -> m a)
-> RequestBuilder m () -> Snap a -> m a
forall (m :: * -> *) (n :: * -> *) b.
(MonadIO m, MonadSnap n) =>
(forall a. Request -> n a -> m a)
-> RequestBuilder m () -> n b -> m b
evalHandlerM forall a. Request -> Snap a -> m a
forall (m :: * -> *) a. MonadIO m => Request -> Snap a -> m a
rs
  where
    rs :: Request -> Snap a -> m a
rs Request
rq Snap a
s = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Snap a
-> (ByteString -> IO ())
-> ((Int -> Int) -> IO ())
-> Request
-> IO a
forall a.
Snap a
-> (ByteString -> IO ())
-> ((Int -> Int) -> IO ())
-> Request
-> IO a
evalSnap Snap a
s (IO () -> ByteString -> IO ()
forall a b. a -> b -> a
const (IO () -> ByteString -> IO ()) -> IO () -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                                  (IO () -> (Int -> Int) -> IO ()
forall a b. a -> b -> a
const (IO () -> (Int -> Int) -> IO ()) -> IO () -> (Int -> Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                                  Request
rq


------------------------------------------------------------------------------
-- | Given a web handler in some arbitrary 'MonadSnap' monad, a function
-- specifying how to evaluate it within the context of the test monad, and a
-- 'RequestBuilder' defining a test request, runs the handler, returning the
-- monadic value it produces.
--
-- Throws an exception if the 'Snap' handler early-terminates with
-- 'Snap.Core.finishWith' or 'Control.Monad.mzero'.
evalHandlerM :: (MonadIO m, MonadSnap n) =>
                (forall a . Request -> n a -> m a)  -- ^ a function defining
                                                    -- how the 'MonadSnap'
                                                    -- monad should be run
             -> RequestBuilder m ()                 -- ^ a request builder
             -> n b                                 -- ^ a web handler
             -> m b
evalHandlerM :: (forall a. Request -> n a -> m a)
-> RequestBuilder m () -> n b -> m b
evalHandlerM forall a. Request -> n a -> m a
rSnap RequestBuilder m ()
rBuilder n b
snap = do
    Request
rq <- RequestBuilder m () -> m Request
forall (m :: * -> *). MonadIO m => RequestBuilder m () -> m Request
buildRequest RequestBuilder m ()
rBuilder
    Request -> n b -> m b
forall a. Request -> n a -> m a
rSnap Request
rq n b
snap


------------------------------------------------------------------------------
-- | Converts the given 'Response' to a bytestring.
--
-- Example:
--
-- @
-- ghci> import "Snap.Core"
-- ghci> 'responseToString' 'Snap.Core.emptyResponse'
-- \"HTTP\/1.1 200 OK\\r\\n\\r\\n\"
-- @
responseToString :: Response -> IO ByteString
responseToString :: Response -> IO ByteString
responseToString Response
resp = do
    let act :: StreamProc
act = ResponseBody -> StreamProc
rspBodyToEnum (ResponseBody -> StreamProc) -> ResponseBody -> StreamProc
forall a b. (a -> b) -> a -> b
$ Response -> ResponseBody
rspBody Response
resp

    (OutputStream Builder
listOut, IO [Builder]
grab) <- IO (OutputStream Builder, IO [Builder])
forall c. IO (OutputStream c, IO [c])
Streams.listOutputStream
    IO (OutputStream Builder) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (OutputStream Builder) -> IO ())
-> IO (OutputStream Builder) -> IO ()
forall a b. (a -> b) -> a -> b
$ StreamProc
act OutputStream Builder
listOut
    Builder
builder <- ([Builder] -> Builder) -> IO [Builder] -> IO Builder
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat IO [Builder]
grab

    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Response -> Builder
forall a. Show a => a -> Builder
fromShow Response
resp Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
builder


------------------------------------------------------------------------------
-- | Converts the given 'Request' to a bytestring.
--
-- Since: 1.0.0.0
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Data.Map" as M
-- ghci> r <- 'buildRequest' $ get \"\/foo\/bar\" M.empty
-- ghci> 'requestToString' r
-- \"GET \/foo\/bar HTTP\/1.1\\r\\nhost: localhost\\r\\n\\r\\n\"
-- @
requestToString :: Request -> IO ByteString
requestToString :: Request -> IO ByteString
requestToString Request
req0 = do
    (Request
req, InputStream ByteString
is) <- IO (Request, InputStream ByteString)
maybeChunk
    ByteString
body <- ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [ByteString] -> ByteString
S.concat (IO [ByteString] -> IO ByteString)
-> IO [ByteString] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ InputStream ByteString -> IO [ByteString]
forall a. InputStream a -> IO [a]
Streams.toList InputStream ByteString
is
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
statusLine
                                     , [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Headers -> [Builder]) -> Headers -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> Builder)
-> [(CI ByteString, ByteString)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (CI ByteString, ByteString) -> Builder
oneHeader ([(CI ByteString, ByteString)] -> [Builder])
-> (Headers -> [(CI ByteString, ByteString)])
-> Headers
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Headers -> [(CI ByteString, ByteString)]
H.toList
                                               (Headers -> Builder) -> Headers -> Builder
forall a b. (a -> b) -> a -> b
$ Request -> Headers
rqHeaders Request
req
                                     , Builder
crlf
                                     , ByteString -> Builder
byteString ByteString
body
                                     ]
  where
    maybeChunk :: IO (Request, InputStream ByteString)
maybeChunk = do
        if CI ByteString -> Request -> Maybe ByteString
forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
getHeader CI ByteString
"Transfer-Encoding" Request
req0 Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"chunked"
          then do
              let req :: Request
req = CI ByteString -> Request -> Request
forall a. HasHeaders a => CI ByteString -> a -> a
deleteHeader CI ByteString
"Content-Length" (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
                        Request
req0 { rqContentLength :: Maybe Word64
rqContentLength = Maybe Word64
forall a. Maybe a
Nothing }
              InputStream ByteString
is' <- (ByteString -> ByteString)
-> InputStream ByteString -> IO (InputStream ByteString)
forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
Streams.map ByteString -> ByteString
chunk (InputStream ByteString -> IO (InputStream ByteString))
-> InputStream ByteString -> IO (InputStream ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> InputStream ByteString
rqBody Request
req
              InputStream ByteString
out <- IO (InputStream ByteString)
eof IO (InputStream ByteString)
-> (InputStream ByteString -> IO (InputStream ByteString))
-> IO (InputStream ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputStream ByteString
-> InputStream ByteString -> IO (InputStream ByteString)
forall a. InputStream a -> InputStream a -> IO (InputStream a)
Streams.appendInputStream InputStream ByteString
is'
              (Request, InputStream ByteString)
-> IO (Request, InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
req, InputStream ByteString
out)
          else (Request, InputStream ByteString)
-> IO (Request, InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
req0, Request -> InputStream ByteString
rqBody Request
req0)
      where
        chunk :: ByteString -> ByteString
chunk ByteString
s = [ByteString] -> ByteString
S.concat [ String -> ByteString
S.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%x\r\n" (ByteString -> Int
S.length ByteString
s)
                           , ByteString
s
                           , ByteString
"\r\n"
                           ]
        eof :: IO (InputStream ByteString)
eof = [ByteString] -> IO (InputStream ByteString)
forall c. [c] -> IO (InputStream c)
Streams.fromList [ByteString
"0\r\n\r\n"]

    (Int
v1,Int
v2) = Request -> HttpVersion
rqVersion Request
req0
    crlf :: Builder
crlf = Char -> Builder
char8 Char
'\r' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
char8 Char
'\n'
    statusLine :: Builder
statusLine = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Method -> Builder
forall a. Show a => a -> Builder
fromShow (Method -> Builder) -> Method -> Builder
forall a b. (a -> b) -> a -> b
$ Request -> Method
rqMethod Request
req0
                         , Char -> Builder
char8 Char
' '
                         , ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
rqURI Request
req0
                         , ByteString -> Builder
byteString ByteString
" HTTP/"
                         , Int -> Builder
forall a. Show a => a -> Builder
fromShow Int
v1
                         , Char -> Builder
char8 Char
'.'
                         , Int -> Builder
forall a. Show a => a -> Builder
fromShow Int
v2
                         , Builder
crlf
                         ]

    oneHeader :: (CI ByteString, ByteString) -> Builder
oneHeader (CI ByteString
k,ByteString
v) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
k
                              , ByteString -> Builder
byteString ByteString
": "
                              , ByteString -> Builder
byteString ByteString
v
                              , Builder
crlf
                              ]


------------------------------------------------------------------------------
rGet :: Monad m => RequestBuilder m Request
rGet :: RequestBuilder m Request
rGet   = StateT Request m Request -> RequestBuilder m Request
forall (m :: * -> *) a. StateT Request m a -> RequestBuilder m a
RequestBuilder StateT Request m Request
forall s (m :: * -> *). MonadState s m => m s
State.get

rPut :: Monad m => Request -> RequestBuilder m ()
rPut :: Request -> RequestBuilder m ()
rPut Request
s = StateT Request m () -> RequestBuilder m ()
forall (m :: * -> *) a. StateT Request m a -> RequestBuilder m a
RequestBuilder (StateT Request m () -> RequestBuilder m ())
-> StateT Request m () -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ Request -> StateT Request m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put Request
s

rModify :: Monad m => (Request -> Request) -> RequestBuilder m ()
rModify :: (Request -> Request) -> RequestBuilder m ()
rModify Request -> Request
f = StateT Request m () -> RequestBuilder m ()
forall (m :: * -> *) a. StateT Request m a -> RequestBuilder m a
RequestBuilder (StateT Request m () -> RequestBuilder m ())
-> StateT Request m () -> RequestBuilder m ()
forall a b. (a -> b) -> a -> b
$ (Request -> Request) -> StateT Request m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Request -> Request
f


------------------------------------------------------------------------------
toByteString :: Builder -> ByteString
toByteString :: Builder -> ByteString
toByteString = [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString)
-> (Builder -> [ByteString]) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> (Builder -> ByteString) -> Builder -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString


------------------------------------------------------------------------------
fromShow :: Show a => a -> Builder
fromShow :: a -> Builder
fromShow = String -> Builder
stringUtf8 (String -> Builder) -> (a -> String) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show