content: {- 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 ( Applicative
             , Functor
             , Monad
  #if MIN_VERSION_base(4,13,0)
             , MonadFail
  #endif
             , MonadIO
             , MonadState Request
             , MonadTrans
             )
  
  
  ------------------------------------------------------------------------------
  mkDefaultRequest :: IO Request
  mkDefaultRequest = do
      b <- Streams.fromList $! []
      return $ Request "localhost"
                       "127.0.0.1"
                       60000
                       "127.0.0.1"
                       8080
                       "localhost"
                       False
                       H.empty
                       b
                       Nothing
                       GET
                       (1,1)
                       []
                       ""
                       "/"
                       "/"
                       ""
                       Map.empty
                       Map.empty
                       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 mm = do
      let (RequestBuilder m) = (mm >> fixup)
      rq0 <- liftIO mkDefaultRequest
      execStateT m rq0
  
    where
      fixup = do
          fixupURI
          fixupMethod
          fixupCL
          fixupParams
          fixupHost
  
      fixupMethod = do
          rq <- rGet
          if (rqMethod rq == GET || rqMethod rq == DELETE ||
              rqMethod rq == HEAD)
            then do
                -- drain the old request body and replace it with a new one
                !_ <- liftIO $ Streams.toList $ rqBody rq
                !b <- liftIO $ Streams.fromList $! []
                -- These requests are not permitted to have bodies
                let rq' = deleteHeader "Content-Type" $
                          rq { rqBody = b }
                rPut $ rq' { rqContentLength = Nothing }
            else return $! ()
  
      fixupCL = do
          rq <- rGet
          maybe (rPut $ deleteHeader "Content-Length" rq)
                (\cl -> rPut $ H.setHeader "Content-Length"
                                           (S.pack (show cl)) rq)
                (rqContentLength rq)
  
      fixupParams = do
          rq <- rGet
          let !query       = rqQueryString rq
          -- force the stuff from mkDefaultRequest that we just overwrite
          let !_           = rqPostParams rq
          let !_           = rqParams rq
          let !_           = rqQueryParams rq
          let !queryParams = parseUrlEncoded query
          let !mbCT        = getHeader "Content-Type" rq
  
          (!postParams, rq') <-
              if mbCT == Just "application/x-www-form-urlencoded"
                then liftIO $ do
                    !l <- Streams.toList $ rqBody rq
                    -- snap-server regurgitates the parsed form body
                    !b <- Streams.fromList l
                    return (parseUrlEncoded (S.concat l), rq { rqBody = b })
                else return (Map.empty, rq)
          let !newParams = Map.unionWith (flip (++)) queryParams postParams
  
          rPut $ rq' { rqParams      = newParams
                     , rqPostParams  = postParams
                     , rqQueryParams = queryParams }
  
      fixupHost = do
          rq <- rGet
          case H.getHeader "Host" rq of
            Nothing -> do
              let !hn = rqHostName rq
              rPut $ H.setHeader "Host" hn rq
            Just hn ->
              rPut $ rq { rqHostName = 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 (Show)
  
  
  ------------------------------------------------------------------------------
  -- | Represents a single file upload for the 'MultipartParam'.
  data FileData = FileData {
        fdFileName    :: ByteString  -- ^ the file's name
      , fdContentType :: ByteString  -- ^ the file's content-type
      , fdContents    :: ByteString  -- ^ the file contents
      }
    deriving (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 (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 GetRequest = do
      rq   <- rGet
      body <- liftIO $ Streams.fromList $! []
  
      rPut $ rq { rqMethod        = GET
                , rqContentLength = Nothing
                , rqBody          = body
                }
  
  setRequestType DeleteRequest = do
      rq   <- rGet
      body <- liftIO $ Streams.fromList $! []
  
      rPut $ rq { rqMethod        = DELETE
                , rqContentLength = Nothing
                , rqBody          = body
                }
  
  setRequestType (RequestWithRawBody m b) = do
      rq <- rGet
      body <- liftIO $ Streams.fromList $! [ b ]
      rPut $ rq { rqMethod        = m
                , rqContentLength = Just $ fromIntegral $ S.length b
                , rqBody          = body
                }
  
  setRequestType (MultipartPostRequest fp) = encodeMultipart fp
  
  setRequestType (UrlEncodedPostRequest fp) = do
      rq <- liftM (H.setHeader "Content-Type"
                               "application/x-www-form-urlencoded") rGet
      let b = printUrlEncoded fp
      body <- liftIO $ Streams.fromList $! [b]
  
      rPut $ rq { rqMethod        = POST
                , rqContentLength = Just $!  fromIntegral $ S.length b
                , rqBody          = body
                }
  
  
  ------------------------------------------------------------------------------
  makeBoundary :: MonadIO m => m ByteString
  makeBoundary = do
      xs  <- liftIO $ replicateM 16 randomWord8
      let x = S.pack $ map (toEnum . fromEnum) xs
      return $ S.concat [ "snap-boundary-", encode x ]
  
    where
      randomWord8 :: IO Word8
      randomWord8 = liftM (\c -> toEnum $ c .&. 0xff) randomIO
  
      table = V.fromList [ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'
                         , 'a', 'b', 'c', 'd', 'e', 'f' ]
  
      encode = toByteString . S8.foldl' f mempty
  
  #if MIN_VERSION_base(4,5,0)
      shR = unsafeShiftR
  #else
      shR = shiftR
  #endif
  
      f m c = let low = c .&. 0xf
                  hi  = (c .&. 0xf0) `shR` 4
                  k   = \i -> word8 $! toEnum $! fromEnum $!
                              V.unsafeIndex table (fromEnum i)
              in m `mappend` k hi `mappend` k low
  
  
  ------------------------------------------------------------------------------
  multipartHeader :: ByteString -> ByteString -> Builder
  multipartHeader boundary name =
      mconcat [ byteString boundary
              , byteString "\r\ncontent-disposition: form-data"
              , byteString "; name=\""
              , byteString name
              , byteString "\"\r\n" ]
  
  
  ------------------------------------------------------------------------------
  -- Assume initial or preceding "--" just before this
  encodeFormData :: ByteString -> ByteString -> [ByteString] -> IO Builder
  encodeFormData boundary name vals =
      case vals of
        []  -> return mempty
        [v] -> return $ mconcat [ hdr
                                , cr
                                , byteString v
                                , byteString "\r\n--" ]
        _   -> multi
  
    where
      hdr = multipartHeader boundary name
      cr = byteString "\r\n"
  
      oneVal b v = mconcat [ byteString b
                           , cr
                           , cr
                           , byteString v
                           , byteString "\r\n--" ]
  
      multi = do
          b <- makeBoundary
          return $ mconcat [ hdr
                           , multipartMixed b
                           , cr
                           , byteString "--"
                           , mconcat (map (oneVal b) vals)
                           , byteString b
                           , byteString "--\r\n--" ]
  
  
  ------------------------------------------------------------------------------
  multipartMixed :: ByteString -> Builder
  multipartMixed b = mconcat [ byteString "Content-Type: multipart/mixed"
                             , byteString "; boundary="
                             , byteString b
                             , byteString "\r\n" ]
  
  
  ------------------------------------------------------------------------------
  encodeFiles :: ByteString -> ByteString -> [FileData] -> IO Builder
  encodeFiles boundary name files =
      case files of
        [] -> return mempty
        _  -> do
            b <- makeBoundary
            return $ mconcat [ hdr
                             , multipartMixed b
                             , cr
                             , byteString "--"
                             , mconcat (map (oneVal b) files)
                             , byteString b
                             , byteString "--\r\n--"
                             ]
  
    where
      --------------------------------------------------------------------------
      contentDisposition fn = mconcat [
                                byteString "Content-Disposition: attachment"
                              , byteString "; filename=\""
                              , byteString fn
                              , byteString "\"\r\n"
                              ]
  
      --------------------------------------------------------------------------
      contentType ct = mconcat [
                         byteString "Content-Type: "
                       , byteString ct
                       , cr
                       ]
  
      --------------------------------------------------------------------------
      oneVal b fd =
          mconcat [ byteString b
                  , cr
                  , contentType ct
                  , contentDisposition fileName
                  , byteString "Content-Transfer-Encoding: binary\r\n"
                  , cr
                  , byteString contents
                  , byteString "\r\n--"
                  ]
        where
          fileName = fdFileName fd
          ct       = fdContentType fd
          contents = fdContents fd
  
      --------------------------------------------------------------------------
      hdr = multipartHeader boundary name
      cr  = byteString "\r\n"
  
  
  ------------------------------------------------------------------------------
  encodeMultipart :: MonadIO m => MultipartParams -> RequestBuilder m ()
  encodeMultipart kvps = do
      boundary <- liftIO $ makeBoundary
      builders <- liftIO $ mapM (handleOne boundary) kvps
  
      let b = toByteString $ mconcat (byteString "--" : builders)
                               `mappend` finalBoundary boundary
  
      rq0 <- rGet
  
      body <- liftIO $ Streams.fromList [b]
  
      let rq = H.setHeader "Content-Type"
                 (S.append "multipart/form-data; boundary=" boundary)
                 rq0
  
      rPut $ rq { rqMethod        = POST
                , rqContentLength = Just $ fromIntegral $ S.length b
                , rqBody          = body
                }
  
  
    where
      finalBoundary b = mconcat [byteString b, byteString "--\r\n"]
  
      handleOne boundary (name, mp) =
          case mp of
            (FormData vals) -> encodeFormData boundary name vals
            (Files fs)      -> encodeFiles boundary name fs
  
  
  ------------------------------------------------------------------------------
  fixupURI :: Monad m => RequestBuilder m ()
  fixupURI = do
      rq <- rGet
      upd rq $! S.concat [ rqContextPath rq
                         , rqPathInfo rq
                         , let q = rqQueryString rq
                           in if S.null q
                                then ""
                                else S.append "?" q
                         ]
    where
      upd rq !u = let !_ = rqURI rq
                  in rPut $ rq { rqURI = 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 r = do
      rq <- rGet
      rPut $ rq { rqQueryString = r }
      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 p = setQueryStringRaw $ printUrlEncoded 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 k v = rModify (H.setHeader k 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 k v = rModify (H.addHeader k 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 cookies = do
      rModify $ \rq -> rq { rqCookies = rqCookies rq ++ cookies }
      allCookies <- liftM rqCookies rGet
      let cstr = map cookieToBS allCookies
      setHeader "Cookie" $ S.intercalate "; " cstr
  
  
  ------------------------------------------------------------------------------
  -- | Convert 'Cookie' into 'ByteString' for output.
  cookieToBS :: Cookie -> ByteString
  cookieToBS (Cookie k v !_ !_ !_ !_ !_) = cookie
    where
      cookie  = S.concat [k, "=", 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 c = rModify (H.setHeader "Content-Type" 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 b = rModify $ \rq -> rq { rqIsSecure = 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 v = rModify $ \rq -> rq { rqVersion = 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 p0 = do
      rModify $ \rq -> rq { rqContextPath = "/"
                          , rqPathInfo    = p }
      fixupURI
  
    where
      p = if S.isPrefixOf "/" p0 then S.drop 1 p0 else 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 uri params = do
      setRequestType GetRequest
      setQueryString params
      setRequestPath 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 uri params = do
    setRequestType . RequestWithRawBody HEAD $ ""
    setQueryString params
    setRequestPath 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 uri params = do
      setRequestType DeleteRequest
      setQueryString params
      setRequestPath 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 uri params = do
      setRequestType $ UrlEncodedPostRequest params
      setRequestPath 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 uri params = do
      setRequestType $ MultipartPostRequest params
      setRequestPath 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 uri contentType putData = do
      setRequestType $ RequestWithRawBody PUT putData
      setHeader "Content-Type" contentType
      setRequestPath 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 uri contentType postData = do
      setRequestType $ RequestWithRawBody POST postData
      setContentType contentType
      setRequestPath 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 = runHandlerM rs
    where
      rs rq s = liftIO $ do
          (_,rsp) <- runSnap s (\x -> return $! (x `seq` ()))
                               (\f -> let !_ = f 0 in return $! ())
                               rq
          fixupResponse rq 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 rSnap rBuilder snap = do
      rq  <- buildRequest rBuilder
      rsp <- rSnap rq snap
  
      -- simulate server logic
      t1  <- liftIO (epochTime >>= formatHttpTime)
      return $ H.setHeader "Date" t1
             $ H.setHeader "Server" "Snap/test"
             $ if rspContentLength rsp == Nothing &&
                  rqVersion rq < (1,1)
                 then H.setHeader "Connection" "close" rsp
                 else 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 = evalHandlerM rs
    where
      rs rq s = liftIO $ evalSnap s (const $ return $! ())
                                    (const $ return $! ())
                                    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 rSnap rBuilder snap = do
      rq <- buildRequest rBuilder
      rSnap rq 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 resp = do
      let act = rspBodyToEnum $ rspBody resp
  
      (listOut, grab) <- Streams.listOutputStream
      void $ act listOut
      builder <- liftM mconcat grab
  
      return $! toByteString $ fromShow resp `mappend` 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 req0 = do
      (req, is) <- maybeChunk
      body <- liftM S.concat $ Streams.toList is
      return $! toByteString $ mconcat [ statusLine
                                       , mconcat . map oneHeader . H.toList
                                                 $ rqHeaders req
                                       , crlf
                                       , byteString body
                                       ]
    where
      maybeChunk = do
          if getHeader "Transfer-Encoding" req0 == Just "chunked"
            then do
                let req = deleteHeader "Content-Length" $
                          req0 { rqContentLength = Nothing }
                is' <- Streams.map chunk $ rqBody req
                out <- eof >>= Streams.appendInputStream is'
                return (req, out)
            else return (req0, rqBody req0)
        where
          chunk s = S.concat [ S.pack $ printf "%x\r\n" (S.length s)
                             , s
                             , "\r\n"
                             ]
          eof = Streams.fromList ["0\r\n\r\n"]
  
      (v1,v2) = rqVersion req0
      crlf = char8 '\r' `mappend` char8 '\n'
      statusLine = mconcat [ fromShow $ rqMethod req0
                           , char8 ' '
                           , byteString $ rqURI req0
                           , byteString " HTTP/"
                           , fromShow v1
                           , char8 '.'
                           , fromShow v2
                           , crlf
                           ]
  
      oneHeader (k,v) = mconcat [ byteString $ original k
                                , byteString ": "
                                , byteString v
                                , crlf
                                ]
  
  
  ------------------------------------------------------------------------------
  rGet :: Monad m => RequestBuilder m Request
  rGet   = RequestBuilder State.get
  
  rPut :: Monad m => Request -> RequestBuilder m ()
  rPut s = RequestBuilder $ State.put s
  
  rModify :: Monad m => (Request -> Request) -> RequestBuilder m ()
  rModify f = RequestBuilder $ modify f
  
  
  ------------------------------------------------------------------------------
  toByteString :: Builder -> ByteString
  toByteString = S.concat . L.toChunks . toLazyByteString
  
  
  ------------------------------------------------------------------------------
  fromShow :: Show a => a -> Builder
  fromShow = stringUtf8 . show
  