{-|
Module      : Network.HTTP.Client.Request.Modifiers
Description : Convenient monadic HTTP request modifiers
Copyright   : (c) 2014 Sean Leather
License     : BSD3
Maintainer  : sean.leather@gmail.com
Stability   : experimental

Each of the functions in this module is a monadic request modifier, using the
'ReqMod' type. Most of them do not have any side effects; however, the
consistent use of 'Monad' allows for easy chaining with bind ('>>=') or Kleisli
composition ('>=>').

== Example

The example that inspired this package is modifying the 'Request' from
'parseUrl':

@
  'parseUrl' \"http:\/\/httpbin.org\/post\"
    >>= 'setMethod' 'POST'
    >>= 'setBodyLBS' "hello"
@

Suppose I want to reuse the URL post request but not the body. I can define a
function for just that part:

@
  let httpbinPost :: 'MonadThrow' m => m 'Request'
      httpbinPost = 'parseUrl' \"http:\/\/httpbin.org\/post\" >>= 'setMethod' 'POST'
@

Alternative formulations of the above, without using request modifiers, are:

@
  'parseUrl' \"http:\/\/httpbin.org\/post\"
    >>= \req -> return $ req
      { 'method' = 'renderStdMethod' 'POST'
      , 'requestBody' = 'RequestBodyLBS' "hello"
      }
@

and

@
  let httpbinPost :: 'MonadThrow' m => m 'Request'
      httpbinPost = do req <- 'parseUrl' \"http:\/\/httpbin.org\/post\"
                       return $ req { 'method' = 'renderStdMethod' 'POST' }
@

== Benefits

The main benefits of monadic request modifiers are:

  * composability,
  * conciseness, and
  * allowing an arbitrary combination of 'Monad's.

== Naming Scheme

The naming scheme used for functions in this module is:

  * @set@ - Set a value, overriding any existing value.
  * @add@ - Append a value to the end of a list and do not override any existing
    values.
  * @BS@ - Use a strict 'BS.ByteString' as a parameter.
  * @LBS@ - Use a lazy 'BS.ByteString' as a parameter.
-}
module Network.HTTP.Client.Request.Modifiers (
  -- * Request Modifier Type
    ReqMod
  -- * URI/URL
  , setUri
  , setUriRelative
  -- * Query String
  , setQueryBS
  , setQuery
  , addQuery
  , addQueryPair
  -- * Method
  , setMethodBS
  , setMethod
  -- * Headers
  , setHeaders
  , setHeader
  , addHeaders
  , addHeader
  , setContentTypeHeader
  , setAcceptHeader
  -- * Body
  , setBody
  , setBodyBS
  , setBodyLBS
  , setUrlEncodedBody
  -- * Convenient Combinations
  , setSimpleRequestBS
  , setSimpleRequestLBS
  ) where

--------------------------------------------------------------------------------

import Control.Monad
import Control.Monad.Catch (MonadThrow)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Network.HTTP.Client
import qualified Network.HTTP.Client.Internal as I
import Network.HTTP.Media.MediaType
import Network.HTTP.Types
import Network.HTTP.Types.QueryLike
import Network.URI (URI)

--------------------------------------------------------------------------------

-- | Request modifier, abbreviated
--
-- Since 0.1
type ReqMod m = Request -> m Request

--------------------------------------------------------------------------------

-- | Validate and set the request URI.
--
-- Since 0.1
setUri :: MonadThrow m => URI -> ReqMod m
setUri = flip I.setUri

-- | Extend the request URI with a relative URI.
--
-- Since 0.1
setUriRelative :: MonadThrow m => URI -> ReqMod m
setUriRelative = flip I.setUriRelative

--------------------------------------------------------------------------------

-- | Set the query string with a strict 'BS.ByteString'.
--
-- Since 0.1
setQueryBS :: Monad m => BS.ByteString -> ReqMod m
setQueryBS q req = return $ req { queryString = q }

-- | Set the query string with a rendered 'Query'.
--
-- Since 0.1
setQuery :: (Monad m, QueryLike q) => q -> ReqMod m
setQuery = setQueryBS . renderQuery True . toQuery

-- | Add a rendered 'Query' to the end of the query string.
--
-- Since 0.1
addQuery :: (Monad m, QueryLike q) => q -> ReqMod m
addQuery q req = setQuery (parseQuery (queryString req) ++ toQuery q) req

-- | Add a single query key/value pair to the end of the query string.
--
-- Since 0.1
addQueryPair :: (Monad m, QueryKeyLike k, QueryValueLike v) => k -> v -> ReqMod m
addQueryPair k v = addQuery [(toQueryKey k, toQueryValue v)]

--------------------------------------------------------------------------------

-- | Set the method with a strict 'BS.ByteString'.
--
-- See "Network.HTTP.Types.Method" for the methods, e.g. 'methodGet' or
-- 'methodPost'.
--
-- Since 0.1
setMethodBS :: Monad m => Method -> ReqMod m
setMethodBS m req = return $ req { method = m }

-- | Set the method with a standard method, e.g. 'GET' or 'POST'.
--
-- Since 0.1
setMethod :: Monad m => StdMethod -> ReqMod m
setMethod = setMethodBS . renderStdMethod

--------------------------------------------------------------------------------

-- | Set the request headers.
--
-- Since 0.1
setHeaders :: Monad m => RequestHeaders -> ReqMod m
setHeaders hs req = return $ req { requestHeaders = hs }

-- | Set the request header by name, removing any other headers with the same
-- name.
--
-- Since 0.1
setHeader :: Monad m => HeaderName -> BS.ByteString -> ReqMod m
setHeader n v req =
  setHeaders (filter ((/= n) . fst) (requestHeaders req) ++ [(n, v)]) req

-- | Add headers to the request.
--
-- Since 0.1
addHeaders :: Monad m => RequestHeaders -> ReqMod m
addHeaders hs req = setHeaders (requestHeaders req ++ hs) req

-- | Add a single header.
--
-- Since 0.1
addHeader :: Monad m => HeaderName -> BS.ByteString -> ReqMod m
addHeader n v = addHeaders [(n, v)]

-- | Set the @Content-Type@ header with a 'MediaType'.
--
-- Since 0.1
setContentTypeHeader :: Monad m => MediaType -> ReqMod m
setContentTypeHeader = setHeader hContentType . toByteString

-- | Set the @Accept@ header with a 'MediaType'.
--
-- Since 0.1
setAcceptHeader :: Monad m => MediaType -> ReqMod m
setAcceptHeader = setHeader hAccept . toByteString

--------------------------------------------------------------------------------

-- | Set the request body.
--
-- Since 0.1
setBody :: Monad m => RequestBody -> Request -> m Request
setBody b req = return $ req { requestBody = b }

-- | Set the request body with a strict 'BS.ByteString'.
--
-- Since 0.1
setBodyBS :: Monad m => BS.ByteString -> Request -> m Request
setBodyBS = setBody . RequestBodyBS

-- | Set the request body with a lazy 'LBS.ByteString'.
--
-- Since 0.1
setBodyLBS :: Monad m => LBS.ByteString -> Request -> m Request
setBodyLBS = setBody . RequestBodyLBS

-- | Set the request body with URL-encoded key/value pairs.
--
-- Since 0.1
setUrlEncodedBody :: Monad m => [(BS.ByteString, BS.ByteString)] -> ReqMod m
setUrlEncodedBody b = return . urlEncodedBody b

--------------------------------------------------------------------------------

-- | Set the method, @Content-Type@, and strict 'BS.ByteString' body.
--
-- Since 0.1
setSimpleRequestBS :: Monad m => StdMethod -> MediaType -> BS.ByteString -> ReqMod m
setSimpleRequestBS m c b = setMethod m >=> setContentTypeHeader c >=> setBodyBS b

-- | Set the method, @Content-Type@, and lazy 'LBS.ByteString' body.
--
-- Since 0.1
setSimpleRequestLBS :: Monad m => StdMethod -> MediaType -> LBS.ByteString -> ReqMod m
setSimpleRequestLBS m c b = setMethod m >=> setContentTypeHeader c >=> setBodyLBS b