{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}

-- |
-- Module      : Network.OAuth.Signing
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : MIT
--
-- Maintainer  : me@jspha.com
-- Stability   : experimental
-- Portability : non-portable
--
-- Signing forms the core process for OAuth. Given a 'C.Request' about to be
-- sent, 'Server' parameters, and a full 'Oa' we append a set of parameters to
-- the 'C.Request' which turns it into a signed OAuth request.

module Network.OAuth.Signing (

  -- * Primary interface

  -- | The 'oauth' and 'sign' commands can be used as low level signing
  -- primitives, and they are indeed used to build the "Network.OAuth.Stateful"
  -- interface exported by default.

  oauth, sign,

  -- * Low-level interface

  -- | The low-level interface is used to build 'oauth' and 'sign' and can be
  -- useful for testing.

  makeSignature, augmentRequest, canonicalBaseString, canonicalParams,
  oauthParams, canonicalUri, bodyParams, queryParams

  ) where

import qualified Blaze.ByteString.Builder        as Blz
import           Control.Monad.IO.Class          (MonadIO)
import           Crypto.Hash                     (SHA1)
import           Crypto.Random                   (MonadRandom)
import           Crypto.MAC.HMAC                 (HMAC, hmac)
import           Data.ByteArray                  (convert)
import qualified Data.ByteString                 as S
import qualified Data.ByteString.Base64          as S64
import qualified Data.ByteString.Char8           as S8
import qualified Data.ByteString.Lazy            as SL
import           Data.Char                       (toUpper)
import           Data.List                       (sort)
import           Data.Maybe                      (fromMaybe, mapMaybe)
import qualified Network.HTTP.Client             as C
import qualified Network.HTTP.Types              as H
import qualified Network.HTTP.Types.QueryLike    as H
import           Network.OAuth.MuLens
import           Network.OAuth.Types.Credentials
import           Network.OAuth.Types.Params
import           Network.OAuth.Util
import           Network.URI

-- | Sign a request with a fresh set of parameters.
oauth :: (MonadIO m, MonadRandom m) => Cred ty -> Server -> C.Request -> m C.Request
oauth :: Cred ty -> Server -> Request -> m Request
oauth Cred ty
creds Server
sv Request
req = do
  Oa ty
oax <- Cred ty -> m (Oa ty)
forall (m :: * -> *) ty.
(MonadRandom m, MonadIO m) =>
Cred ty -> m (Oa ty)
freshOa Cred ty
creds
  Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Oa ty -> Server -> Request -> Request
forall ty. Oa ty -> Server -> Request -> Request
sign Oa ty
oax Server
sv Request
req

-- | Sign a request given generated parameters
sign :: Oa ty -> Server -> C.Request -> C.Request
sign :: Oa ty -> Server -> Request -> Request
sign Oa ty
oax Server
server Request
req =
  let payload :: ByteString
payload = Oa ty -> Server -> Request -> ByteString
forall ty. Oa ty -> Server -> Request -> ByteString
canonicalBaseString Oa ty
oax Server
server Request
req
      sigKey :: ByteString
sigKey  = Cred ty -> ByteString
forall ty. Cred ty -> ByteString
signingKey (Oa ty -> Cred ty
forall ty. Oa ty -> Cred ty
credentials Oa ty
oax)
      sig :: ByteString
sig     = SignatureMethod -> ByteString -> ByteString -> ByteString
makeSignature (Server -> SignatureMethod
signatureMethod Server
server) ByteString
sigKey ByteString
payload
      params :: [(ByteString, Maybe ByteString)]
params  = (ByteString
"oauth_signature", ByteString -> Maybe ByteString
forall a. QueryValueLike a => a -> Maybe ByteString
H.toQueryValue ByteString
sig) (ByteString, Maybe ByteString)
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. a -> [a] -> [a]
: Oa ty -> Server -> [(ByteString, Maybe ByteString)]
forall ty. Oa ty -> Server -> [(ByteString, Maybe ByteString)]
oauthParams Oa ty
oax Server
server
  in ParameterMethod
-> [(ByteString, Maybe ByteString)] -> Request -> Request
augmentRequest (Server -> ParameterMethod
parameterMethod Server
server) [(ByteString, Maybe ByteString)]
params Request
req

makeSignature :: SignatureMethod -> S.ByteString -> S.ByteString -> S.ByteString
makeSignature :: SignatureMethod -> ByteString -> ByteString -> ByteString
makeSignature SignatureMethod
HmacSha1  ByteString
sigKey ByteString
payload = ByteString -> ByteString
S64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HMAC SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> ByteString -> HMAC SHA1
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
sigKey ByteString
payload :: HMAC SHA1)
makeSignature SignatureMethod
Plaintext ByteString
sigKey ByteString
_       = ByteString
sigKey

-- | Augments whatever component of the 'C.Request' is specified by
-- 'ParameterMethod' with one built from the apropriate OAuth parameters
-- (passed as a 'H.Query').
--
-- Currently this actually /replaces/ the @Authorization@ header if one
-- exists. This may be a bad idea if the @realm@ parameter is pre-set,
-- perhaps.
--
-- TODO: Parse @Authorization@ header and augment it.
--
-- Currently this actually /replaces/ the entity body if one
-- exists. This is definitely just me being lazy.
--
-- TODO: Try to parse entity body and augment it.
augmentRequest :: ParameterMethod -> H.Query -> C.Request -> C.Request
augmentRequest :: ParameterMethod
-> [(ByteString, Maybe ByteString)] -> Request -> Request
augmentRequest ParameterMethod
AuthorizationHeader [(ByteString, Maybe ByteString)]
q Request
req =
  let replaceHeader :: H.HeaderName -> S.ByteString -> H.RequestHeaders -> H.RequestHeaders
      replaceHeader :: HeaderName -> ByteString -> RequestHeaders -> RequestHeaders
replaceHeader HeaderName
n ByteString
b [] = [(HeaderName
n, ByteString
b)]
      replaceHeader HeaderName
n ByteString
b (x :: Header
x@(HeaderName
hn, ByteString
_):RequestHeaders
rest) | HeaderName
n HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
hn   = (HeaderName
n, ByteString
b)Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:RequestHeaders
rest
                 | Bool
otherwise = Header
x Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: HeaderName -> ByteString -> RequestHeaders -> RequestHeaders
replaceHeader HeaderName
n ByteString
b RequestHeaders
rest
      authHeader :: ByteString
authHeader = ByteString
"OAuth " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
S8.intercalate ByteString
", " [ByteString]
pairs
      pairs :: [ByteString]
pairs = ((ByteString, Maybe ByteString) -> ByteString)
-> [(ByteString, Maybe ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Maybe ByteString) -> ByteString
mkPair [(ByteString, Maybe ByteString)]
q
      -- We should perhaps pctEncode the key in each pair as well, but so
      -- long as this is a well-formed OAuth header the keys will never
      -- require encoding.
      mkPair :: (ByteString, Maybe ByteString) -> ByteString
mkPair (ByteString
k, Maybe ByteString
v) = ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"=\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
pctEncode (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
v) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
  in Request
req { requestHeaders :: RequestHeaders
C.requestHeaders = HeaderName -> ByteString -> RequestHeaders -> RequestHeaders
replaceHeader HeaderName
H.hAuthorization ByteString
authHeader (Request -> RequestHeaders
C.requestHeaders Request
req) }
augmentRequest ParameterMethod
QueryString [(ByteString, Maybe ByteString)]
q Request
req =
  let q0 :: [(ByteString, Maybe ByteString)]
q0 = ByteString -> [(ByteString, Maybe ByteString)]
H.parseQuery (Request -> ByteString
C.queryString Request
req)
  in  Request
req { queryString :: ByteString
C.queryString = Bool -> [(ByteString, Maybe ByteString)] -> ByteString
H.renderQuery Bool
True ([(ByteString, Maybe ByteString)]
q [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
q0) }
augmentRequest ParameterMethod
RequestEntityBody [(ByteString, Maybe ByteString)]
q Request
req =
  let fixQ :: [(ByteString, ByteString)]
fixQ = ((ByteString, Maybe ByteString) -> Maybe (ByteString, ByteString))
-> [(ByteString, Maybe ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(ByteString
a, Maybe ByteString
mayB) -> (ByteString
a,) (ByteString -> (ByteString, ByteString))
-> Maybe ByteString -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mayB) [(ByteString, Maybe ByteString)]
q
  in  [(ByteString, ByteString)] -> Request -> Request
C.urlEncodedBody [(ByteString, ByteString)]
fixQ Request
req

canonicalBaseString :: Oa ty -> Server -> C.Request -> S.ByteString
canonicalBaseString :: Oa ty -> Server -> Request -> ByteString
canonicalBaseString Oa ty
oax Server
server Request
req =
  ByteString -> [ByteString] -> ByteString
S8.intercalate ByteString
"&" [ (Char -> Char) -> ByteString -> ByteString
S8.map Char -> Char
toUpper (Request -> ByteString
C.method Request
req)
                     , Request -> ByteString
canonicalUri Request
req
                     , Oa ty -> Server -> Request -> ByteString
forall ty. Oa ty -> Server -> Request -> ByteString
canonicalParams Oa ty
oax Server
server Request
req
                     ]

canonicalParams :: Oa ty -> Server -> C.Request -> S.ByteString
canonicalParams :: Oa ty -> Server -> Request -> ByteString
canonicalParams Oa ty
oax Server
server Request
req =
  let build :: H.QueryItem -> S.ByteString
      build :: (ByteString, Maybe ByteString) -> ByteString
build (ByteString
k, Maybe ByteString
mayV) = ByteString -> ByteString
pctEncode ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
S.empty (\ByteString
v -> ByteString
"=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
pctEncode ByteString
v) Maybe ByteString
mayV

      combine :: [S.ByteString] -> S.ByteString
      combine :: [ByteString] -> ByteString
combine = ByteString -> ByteString
pctEncode (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
S8.intercalate ByteString
"&"

      reqIsFormUrlEncoded :: Bool
reqIsFormUrlEncoded = case HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
H.hContentType (Request -> RequestHeaders
C.requestHeaders Request
req) of
                              Just ByteString
"application/x-www-form-urlencoded" -> Bool
True
                              Maybe ByteString
_                                        -> Bool
False
  in [ByteString] -> ByteString
combine ([ByteString] -> ByteString)
-> ([[(ByteString, Maybe ByteString)]] -> [ByteString])
-> [[(ByteString, Maybe ByteString)]]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
sort ([ByteString] -> [ByteString])
-> ([[(ByteString, Maybe ByteString)]] -> [ByteString])
-> [[(ByteString, Maybe ByteString)]]
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Maybe ByteString) -> ByteString)
-> [(ByteString, Maybe ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Maybe ByteString) -> ByteString
build ([(ByteString, Maybe ByteString)] -> [ByteString])
-> ([[(ByteString, Maybe ByteString)]]
    -> [(ByteString, Maybe ByteString)])
-> [[(ByteString, Maybe ByteString)]]
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(ByteString, Maybe ByteString)]]
-> [(ByteString, Maybe ByteString)]
forall a. Monoid a => [a] -> a
mconcat
     ([[(ByteString, Maybe ByteString)]] -> ByteString)
-> [[(ByteString, Maybe ByteString)]] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ Oa ty -> Server -> [(ByteString, Maybe ByteString)]
forall ty. Oa ty -> Server -> [(ByteString, Maybe ByteString)]
oauthParams Oa ty
oax Server
server
       , if Bool
reqIsFormUrlEncoded then Request -> [(ByteString, Maybe ByteString)]
bodyParams Request
req else []
       , Request -> [(ByteString, Maybe ByteString)]
queryParams Request
req
       ]

oauthParams :: Oa ty -> Server -> H.Query
oauthParams :: Oa ty -> Server -> [(ByteString, Maybe ByteString)]
oauthParams (Oa {Cred ty
OaPin
Workflow
pin :: forall ty. Oa ty -> OaPin
workflow :: forall ty. Oa ty -> Workflow
pin :: OaPin
workflow :: Workflow
credentials :: Cred ty
credentials :: forall ty. Oa ty -> Cred ty
..}) (Server {Version
SignatureMethod
ParameterMethod
oAuthVersion :: Server -> Version
oAuthVersion :: Version
signatureMethod :: SignatureMethod
parameterMethod :: ParameterMethod
parameterMethod :: Server -> ParameterMethod
signatureMethod :: Server -> SignatureMethod
..}) =
  let

    OaPin {ByteString
Timestamp
nonce :: OaPin -> ByteString
timestamp :: OaPin -> Timestamp
nonce :: ByteString
timestamp :: Timestamp
..} = OaPin
pin

    infix 8 -:
    a
s -: :: a -> a -> (a, Maybe ByteString)
-: a
v = (a
s, a -> Maybe ByteString
forall a. QueryValueLike a => a -> Maybe ByteString
H.toQueryValue a
v)

    -- **NOTE** dfithian: It worked for my use case to move oauth_token into these params. From the
    -- PR:
    --
    -- I presume one very controversial thing I did was to move `oauth_token` into `workflowParams`.
    -- I came to this conclusion by skimming through the [RFC](https://tools.ietf.org/html/rfc5849)
    -- and deciding that since I only ever saw `oauth_token` in conjunction with either
    -- `oauth_callback` or `oauth_verifier` that they should go together. I'd be perfectly happy to
    -- instead pass in some function of the settings telling it whether or not to include
    -- `oauth_token` for a given request. Whatever the conclusion, the service I'm integrating to
    -- specifically does NOT want the `oauth_token` so that was the motivation.
    workflowParams :: Workflow -> [(a, Maybe ByteString)]
workflowParams Workflow
Standard = []
    workflowParams (TemporaryTokenRequest Callback
callback) =
      [ a
"oauth_callback" a -> Callback -> (a, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: Callback
callback
      , a
"oauth_token" a -> ByteString -> (a, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: (Cred ty -> Token ty
forall ty. Cred ty -> Token ty
getResourceTokenDef Cred ty
credentials Token ty
-> ((ByteString -> Constant ByteString ByteString)
    -> Token ty -> Constant ByteString (Token ty))
-> ByteString
forall s a. s -> ((a -> Constant a a) -> s -> Constant a s) -> a
^. (ByteString -> Constant ByteString ByteString)
-> Token ty -> Constant ByteString (Token ty)
forall (f :: * -> *) ty.
Functor f =>
(ByteString -> f ByteString) -> Token ty -> f (Token ty)
key) ]
    workflowParams (PermanentTokenRequest ByteString
verifier) =
      [ a
"oauth_verifier" a -> ByteString -> (a, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: ByteString
verifier
      , a
"oauth_token" a -> ByteString -> (a, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: (Cred ty -> Token ty
forall ty. Cred ty -> Token ty
getResourceTokenDef Cred ty
credentials Token ty
-> ((ByteString -> Constant ByteString ByteString)
    -> Token ty -> Constant ByteString (Token ty))
-> ByteString
forall s a. s -> ((a -> Constant a a) -> s -> Constant a s) -> a
^. (ByteString -> Constant ByteString ByteString)
-> Token ty -> Constant ByteString (Token ty)
forall (f :: * -> *) ty.
Functor f =>
(ByteString -> f ByteString) -> Token ty -> f (Token ty)
key) ]

  in

    [ ByteString
"oauth_version"          ByteString -> Version -> (ByteString, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: Version
oAuthVersion
    , ByteString
"oauth_consumer_key"     ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: (Cred ty
credentials Cred ty
-> ((ByteString -> Constant ByteString ByteString)
    -> Cred ty -> Constant ByteString (Cred ty))
-> ByteString
forall s a. s -> ((a -> Constant a a) -> s -> Constant a s) -> a
^. (Token Client -> Constant ByteString (Token Client))
-> Cred ty -> Constant ByteString (Cred ty)
forall (f :: * -> *) ty.
Functor f =>
(Token Client -> f (Token Client)) -> Cred ty -> f (Cred ty)
clientToken ((Token Client -> Constant ByteString (Token Client))
 -> Cred ty -> Constant ByteString (Cred ty))
-> ((ByteString -> Constant ByteString ByteString)
    -> Token Client -> Constant ByteString (Token Client))
-> (ByteString -> Constant ByteString ByteString)
-> Cred ty
-> Constant ByteString (Cred ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Constant ByteString ByteString)
-> Token Client -> Constant ByteString (Token Client)
forall (f :: * -> *) ty.
Functor f =>
(ByteString -> f ByteString) -> Token ty -> f (Token ty)
key)
    , ByteString
"oauth_signature_method" ByteString -> SignatureMethod -> (ByteString, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: SignatureMethod
signatureMethod
    , ByteString
"oauth_timestamp"        ByteString -> Timestamp -> (ByteString, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: Timestamp
timestamp
    , ByteString
"oauth_nonce"            ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall a a. QueryValueLike a => a -> a -> (a, Maybe ByteString)
-: ByteString
nonce
    ] [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ Workflow -> [(ByteString, Maybe ByteString)]
forall a. IsString a => Workflow -> [(a, Maybe ByteString)]
workflowParams Workflow
workflow

canonicalUri :: C.Request -> S.ByteString
canonicalUri :: Request -> ByteString
canonicalUri Request
req =
  ByteString -> ByteString
pctEncode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
uriScheme String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"//" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe URIAuth -> String
fauthority Maybe URIAuth
uriAuthority String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
uriPath
  where
    URI {String
Maybe URIAuth
uriScheme :: URI -> String
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> String
uriQuery :: URI -> String
uriFragment :: URI -> String
uriFragment :: String
uriQuery :: String
uriPath :: String
uriAuthority :: Maybe URIAuth
uriScheme :: String
..} = Request -> URI
C.getUri Request
req
    fauthority :: Maybe URIAuth -> String
fauthority Maybe URIAuth
Nothing               = String
""
    fauthority (Just (URIAuth {String
uriUserInfo :: URIAuth -> String
uriRegName :: URIAuth -> String
uriPort :: URIAuth -> String
uriPort :: String
uriRegName :: String
uriUserInfo :: String
..})) =
      let -- Canonical URIs do not display their port unless it is non-standard
          fport :: String
fport | (String
uriPort String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
":443") Bool -> Bool -> Bool
&& (String
uriScheme String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"https:") = String
""
                | (String
uriPort String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
":80" ) Bool -> Bool -> Bool
&& (String
uriScheme String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"http:" ) = String
""
                | Bool
otherwise                                      = String
uriPort
      in  String
uriRegName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fport

-- | Queries a 'C.Request' body and tries to interpret it as a set of OAuth
-- valid parameters. It makes the assumption that if the body type is a
-- streaming variety or impure then it is /not/ a set of OAuth parameters---
-- dropping this assumption would prevent this from being pure.
bodyParams :: C.Request -> H.Query
bodyParams :: Request -> [(ByteString, Maybe ByteString)]
bodyParams = RequestBody -> [(ByteString, Maybe ByteString)]
digestBody (RequestBody -> [(ByteString, Maybe ByteString)])
-> (Request -> RequestBody)
-> Request
-> [(ByteString, Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> RequestBody
C.requestBody where
  digestBody :: C.RequestBody -> H.Query
  digestBody :: RequestBody -> [(ByteString, Maybe ByteString)]
digestBody (C.RequestBodyLBS ByteString
lbs) = ByteString -> [(ByteString, Maybe ByteString)]
H.parseQuery (ByteString -> ByteString
SL.toStrict ByteString
lbs)
  digestBody (C.RequestBodyBS   ByteString
bs) = ByteString -> [(ByteString, Maybe ByteString)]
H.parseQuery ByteString
bs
  digestBody (C.RequestBodyBuilder Int64
_ Builder
b) = ByteString -> [(ByteString, Maybe ByteString)]
H.parseQuery (Builder -> ByteString
Blz.toByteString Builder
b)
  digestBody (C.RequestBodyStream  Int64
_ GivesPopper ()
_) = []
  digestBody (C.RequestBodyStreamChunked GivesPopper ()
_) = []
  digestBody (C.RequestBodyIO IO RequestBody
_) = []

  -- digestBody (Left (_, builder)) = H.parseQuery (Blz.toByteString builder)
  -- digestBody (Right _) = []

queryParams :: C.Request -> H.Query
queryParams :: Request -> [(ByteString, Maybe ByteString)]
queryParams = ByteString -> [(ByteString, Maybe ByteString)]
H.parseQuery (ByteString -> [(ByteString, Maybe ByteString)])
-> (Request -> ByteString)
-> Request
-> [(ByteString, Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
C.queryString