{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings, StandaloneDeriving                            #-}
module Web.Authenticate.OAuth
    ( -- * Data types
      OAuth, def, newOAuth, oauthServerName, oauthRequestUri, oauthAccessTokenUri,
      oauthAuthorizeUri, oauthSignatureMethod, oauthConsumerKey,
      oauthConsumerSecret, oauthCallback, oauthRealm, oauthVersion,
      OAuthVersion(..), SignMethod(..), Credential(..), OAuthException(..),
      -- ** Access token request
      AccessTokenRequest,
      defaultAccessTokenRequest,
      accessTokenAddAuth,
      accessTokenRequestHook,
      accessTokenOAuth,
      accessTokenTemporaryCredential,
      accessTokenManager,
      -- * Operations for credentials
      newCredential, emptyCredential, insert, delete, inserts, injectVerifier,
      -- * Signature
      signOAuth, genSign, checkOAuth,
      -- * Url & operation for authentication
      -- ** Temporary credentials
      getTemporaryCredential, getTemporaryCredentialWithScope,
      getTemporaryCredentialProxy, getTemporaryCredential',
      -- ** Authorization URL
      authorizeUrl, authorizeUrl',
      -- ** Attaching auth to requests
      addAuthBody,
      -- ** Finishing authentication
      getAccessToken,
      getAccessTokenProxy,
      getTokenCredential,
      getTokenCredentialProxy,
      getAccessToken',
      getAccessTokenWith,
      -- * Utility Methods
      paramEncode, addScope, addMaybeProxy
    ) where

import           Blaze.ByteString.Builder     (toByteString)
import           Control.Exception
import           Control.Arrow                (second)
import           Control.Monad
import           Control.Monad.IO.Class       (MonadIO, liftIO)
import           Control.Monad.Trans.Except
import           Crypto.Types.PubKey.RSA      (PrivateKey (..)) -- , PublicKey (..)
import           Data.ByteString.Base64
import qualified Data.ByteString.Char8        as BS
import qualified Data.ByteString.Lazy.Char8   as BSL
import           Data.Char
import           Data.Default
import           Data.Digest.Pure.SHA
import qualified Data.IORef                   as I
import           Data.List                    as List (sort, find)
import           Data.Maybe
import           Data.Time
import           Network.HTTP.Client
import           Network.HTTP.Types           (SimpleQuery, parseSimpleQuery)
import           Network.HTTP.Types           (Header)
import           Network.HTTP.Types           (renderSimpleQuery, status200)
import           Numeric
import           System.Random
#if MIN_VERSION_base(4,7,0)
import Data.Data hiding (Proxy (..))
#else
import Data.Data
#endif
import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, hashSHA1, hashSHA256, hashSHA512)


----------------------------------------------------------------------
-- Data types


-- | Data type for OAuth client (consumer).
--
-- The constructor for this data type is not exposed.
-- Instead, you should use the 'def' method or 'newOAuth' function to retrieve a default instance,
-- and then use the records below to make modifications.
-- This approach allows us to add configuration options without breaking backwards compatibility.
data OAuth = OAuth { OAuth -> String
oauthServerName      :: String -- ^ Service name (default: @\"\"@)
                   , OAuth -> String
oauthRequestUri      :: String
                   -- ^ URI to request temporary credential (default: @\"\"@).
                   --   You MUST specify if you use 'getTemporaryCredential'', 'getTemporaryCredentialProxy'
                   --   or 'getTemporaryCredential'; otherwise you can just leave this empty.
                   , OAuth -> String
oauthAccessTokenUri  :: String
                   -- ^ Uri to obtain access token (default: @\"\"@).
                   --   You MUST specify if you use 'getAcessToken' or 'getAccessToken'' or 'getAccessTokenWith';
                   --   otherwise you can just leave this empty.
                   , OAuth -> String
oauthAuthorizeUri    :: String
                   -- ^ Uri to authorize (default: @\"\"@).
                   --   You MUST specify if you use 'authorizeUrl' or 'authorizeZUrl'';
                   --   otherwise you can just leave this empty.
                   , OAuth -> SignMethod
oauthSignatureMethod :: SignMethod
                   -- ^ Signature Method (default: 'HMACSHA1')
                   , OAuth -> ByteString
oauthConsumerKey     :: BS.ByteString
                   -- ^ Consumer key (You MUST specify)
                   , OAuth -> ByteString
oauthConsumerSecret  :: BS.ByteString
                   -- ^ Consumer Secret (You MUST specify)
                   , OAuth -> Maybe ByteString
oauthCallback        :: Maybe BS.ByteString
                   -- ^ Callback uri to redirect after authentication (default: @Nothing@)
                   , OAuth -> Maybe ByteString
oauthRealm           :: Maybe BS.ByteString
                   -- ^ Optional authorization realm (default: @Nothing@)
                   , OAuth -> OAuthVersion
oauthVersion         :: OAuthVersion
                   -- ^ OAuth spec version (default: 'OAuth10a')
                   } deriving (Int -> OAuth -> ShowS
[OAuth] -> ShowS
OAuth -> String
(Int -> OAuth -> ShowS)
-> (OAuth -> String) -> ([OAuth] -> ShowS) -> Show OAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuth -> ShowS
showsPrec :: Int -> OAuth -> ShowS
$cshow :: OAuth -> String
show :: OAuth -> String
$cshowList :: [OAuth] -> ShowS
showList :: [OAuth] -> ShowS
Show, OAuth -> OAuth -> Bool
(OAuth -> OAuth -> Bool) -> (OAuth -> OAuth -> Bool) -> Eq OAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuth -> OAuth -> Bool
== :: OAuth -> OAuth -> Bool
$c/= :: OAuth -> OAuth -> Bool
/= :: OAuth -> OAuth -> Bool
Eq, ReadPrec [OAuth]
ReadPrec OAuth
Int -> ReadS OAuth
ReadS [OAuth]
(Int -> ReadS OAuth)
-> ReadS [OAuth]
-> ReadPrec OAuth
-> ReadPrec [OAuth]
-> Read OAuth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OAuth
readsPrec :: Int -> ReadS OAuth
$creadList :: ReadS [OAuth]
readList :: ReadS [OAuth]
$creadPrec :: ReadPrec OAuth
readPrec :: ReadPrec OAuth
$creadListPrec :: ReadPrec [OAuth]
readListPrec :: ReadPrec [OAuth]
Read, Typeable OAuth
Typeable OAuth =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OAuth -> c OAuth)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OAuth)
-> (OAuth -> Constr)
-> (OAuth -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OAuth))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OAuth))
-> ((forall b. Data b => b -> b) -> OAuth -> OAuth)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r)
-> (forall u. (forall d. Data d => d -> u) -> OAuth -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OAuth -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OAuth -> m OAuth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OAuth -> m OAuth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OAuth -> m OAuth)
-> Data OAuth
OAuth -> Constr
OAuth -> DataType
(forall b. Data b => b -> b) -> OAuth -> OAuth
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OAuth -> u
forall u. (forall d. Data d => d -> u) -> OAuth -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuth
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuth -> c OAuth
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuth)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OAuth)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuth -> c OAuth
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuth -> c OAuth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuth
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuth
$ctoConstr :: OAuth -> Constr
toConstr :: OAuth -> Constr
$cdataTypeOf :: OAuth -> DataType
dataTypeOf :: OAuth -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuth)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OAuth)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OAuth)
$cgmapT :: (forall b. Data b => b -> b) -> OAuth -> OAuth
gmapT :: (forall b. Data b => b -> b) -> OAuth -> OAuth
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OAuth -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OAuth -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuth -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuth -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
Data, Typeable)


data OAuthVersion = OAuth10     -- ^ OAuth protocol ver 1.0 (no oauth_verifier; differs from RFC 5849).
                  | OAuth10a    -- ^ OAuth protocol ver 1.0a. This corresponds to community's 1.0a spec and RFC 5849.
                    deriving (Int -> OAuthVersion -> ShowS
[OAuthVersion] -> ShowS
OAuthVersion -> String
(Int -> OAuthVersion -> ShowS)
-> (OAuthVersion -> String)
-> ([OAuthVersion] -> ShowS)
-> Show OAuthVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthVersion -> ShowS
showsPrec :: Int -> OAuthVersion -> ShowS
$cshow :: OAuthVersion -> String
show :: OAuthVersion -> String
$cshowList :: [OAuthVersion] -> ShowS
showList :: [OAuthVersion] -> ShowS
Show, OAuthVersion -> OAuthVersion -> Bool
(OAuthVersion -> OAuthVersion -> Bool)
-> (OAuthVersion -> OAuthVersion -> Bool) -> Eq OAuthVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthVersion -> OAuthVersion -> Bool
== :: OAuthVersion -> OAuthVersion -> Bool
$c/= :: OAuthVersion -> OAuthVersion -> Bool
/= :: OAuthVersion -> OAuthVersion -> Bool
Eq, Int -> OAuthVersion
OAuthVersion -> Int
OAuthVersion -> [OAuthVersion]
OAuthVersion -> OAuthVersion
OAuthVersion -> OAuthVersion -> [OAuthVersion]
OAuthVersion -> OAuthVersion -> OAuthVersion -> [OAuthVersion]
(OAuthVersion -> OAuthVersion)
-> (OAuthVersion -> OAuthVersion)
-> (Int -> OAuthVersion)
-> (OAuthVersion -> Int)
-> (OAuthVersion -> [OAuthVersion])
-> (OAuthVersion -> OAuthVersion -> [OAuthVersion])
-> (OAuthVersion -> OAuthVersion -> [OAuthVersion])
-> (OAuthVersion -> OAuthVersion -> OAuthVersion -> [OAuthVersion])
-> Enum OAuthVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OAuthVersion -> OAuthVersion
succ :: OAuthVersion -> OAuthVersion
$cpred :: OAuthVersion -> OAuthVersion
pred :: OAuthVersion -> OAuthVersion
$ctoEnum :: Int -> OAuthVersion
toEnum :: Int -> OAuthVersion
$cfromEnum :: OAuthVersion -> Int
fromEnum :: OAuthVersion -> Int
$cenumFrom :: OAuthVersion -> [OAuthVersion]
enumFrom :: OAuthVersion -> [OAuthVersion]
$cenumFromThen :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
enumFromThen :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
$cenumFromTo :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
enumFromTo :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
$cenumFromThenTo :: OAuthVersion -> OAuthVersion -> OAuthVersion -> [OAuthVersion]
enumFromThenTo :: OAuthVersion -> OAuthVersion -> OAuthVersion -> [OAuthVersion]
Enum, Eq OAuthVersion
Eq OAuthVersion =>
(OAuthVersion -> OAuthVersion -> Ordering)
-> (OAuthVersion -> OAuthVersion -> Bool)
-> (OAuthVersion -> OAuthVersion -> Bool)
-> (OAuthVersion -> OAuthVersion -> Bool)
-> (OAuthVersion -> OAuthVersion -> Bool)
-> (OAuthVersion -> OAuthVersion -> OAuthVersion)
-> (OAuthVersion -> OAuthVersion -> OAuthVersion)
-> Ord OAuthVersion
OAuthVersion -> OAuthVersion -> Bool
OAuthVersion -> OAuthVersion -> Ordering
OAuthVersion -> OAuthVersion -> OAuthVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OAuthVersion -> OAuthVersion -> Ordering
compare :: OAuthVersion -> OAuthVersion -> Ordering
$c< :: OAuthVersion -> OAuthVersion -> Bool
< :: OAuthVersion -> OAuthVersion -> Bool
$c<= :: OAuthVersion -> OAuthVersion -> Bool
<= :: OAuthVersion -> OAuthVersion -> Bool
$c> :: OAuthVersion -> OAuthVersion -> Bool
> :: OAuthVersion -> OAuthVersion -> Bool
$c>= :: OAuthVersion -> OAuthVersion -> Bool
>= :: OAuthVersion -> OAuthVersion -> Bool
$cmax :: OAuthVersion -> OAuthVersion -> OAuthVersion
max :: OAuthVersion -> OAuthVersion -> OAuthVersion
$cmin :: OAuthVersion -> OAuthVersion -> OAuthVersion
min :: OAuthVersion -> OAuthVersion -> OAuthVersion
Ord, Typeable OAuthVersion
Typeable OAuthVersion =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OAuthVersion -> c OAuthVersion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OAuthVersion)
-> (OAuthVersion -> Constr)
-> (OAuthVersion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OAuthVersion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OAuthVersion))
-> ((forall b. Data b => b -> b) -> OAuthVersion -> OAuthVersion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r)
-> (forall u. (forall d. Data d => d -> u) -> OAuthVersion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OAuthVersion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion)
-> Data OAuthVersion
OAuthVersion -> Constr
OAuthVersion -> DataType
(forall b. Data b => b -> b) -> OAuthVersion -> OAuthVersion
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OAuthVersion -> u
forall u. (forall d. Data d => d -> u) -> OAuthVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthVersion -> c OAuthVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthVersion)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthVersion -> c OAuthVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthVersion -> c OAuthVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthVersion
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthVersion
$ctoConstr :: OAuthVersion -> Constr
toConstr :: OAuthVersion -> Constr
$cdataTypeOf :: OAuthVersion -> DataType
dataTypeOf :: OAuthVersion -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthVersion)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthVersion)
$cgmapT :: (forall b. Data b => b -> b) -> OAuthVersion -> OAuthVersion
gmapT :: (forall b. Data b => b -> b) -> OAuthVersion -> OAuthVersion
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthVersion -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthVersion -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuthVersion -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuthVersion -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
Data, Typeable, ReadPrec [OAuthVersion]
ReadPrec OAuthVersion
Int -> ReadS OAuthVersion
ReadS [OAuthVersion]
(Int -> ReadS OAuthVersion)
-> ReadS [OAuthVersion]
-> ReadPrec OAuthVersion
-> ReadPrec [OAuthVersion]
-> Read OAuthVersion
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OAuthVersion
readsPrec :: Int -> ReadS OAuthVersion
$creadList :: ReadS [OAuthVersion]
readList :: ReadS [OAuthVersion]
$creadPrec :: ReadPrec OAuthVersion
readPrec :: ReadPrec OAuthVersion
$creadListPrec :: ReadPrec [OAuthVersion]
readListPrec :: ReadPrec [OAuthVersion]
Read)


-- | Default value for OAuth datatype.
-- You must specify at least oauthServerName, URIs and Tokens.
newOAuth :: OAuth
newOAuth :: OAuth
newOAuth = OAuth { oauthSignatureMethod :: SignMethod
oauthSignatureMethod = SignMethod
HMACSHA1
                 , oauthCallback :: Maybe ByteString
oauthCallback = Maybe ByteString
forall a. Maybe a
Nothing
                 , oauthRealm :: Maybe ByteString
oauthRealm    = Maybe ByteString
forall a. Maybe a
Nothing
                 , oauthServerName :: String
oauthServerName = String
""
                 , oauthRequestUri :: String
oauthRequestUri = String
""
                 , oauthAccessTokenUri :: String
oauthAccessTokenUri = String
""
                 , oauthAuthorizeUri :: String
oauthAuthorizeUri = String
""
                 , oauthConsumerKey :: ByteString
oauthConsumerKey = String -> ByteString
forall a. HasCallStack => String -> a
error String
"You MUST specify oauthConsumerKey parameter."
                 , oauthConsumerSecret :: ByteString
oauthConsumerSecret = String -> ByteString
forall a. HasCallStack => String -> a
error String
"You MUST specify oauthConsumerSecret parameter."
                 , oauthVersion :: OAuthVersion
oauthVersion = OAuthVersion
OAuth10a
                 }

instance Default OAuth where
  def :: OAuth
def = OAuth
newOAuth


-- | Data type for signature method.
data SignMethod = PLAINTEXT
                | HMACSHA1
                | HMACSHA256
                | HMACSHA512
                | RSASHA1 PrivateKey
                | RSASHA256 PrivateKey
                | RSASHA512 PrivateKey
                  deriving (Int -> SignMethod -> ShowS
[SignMethod] -> ShowS
SignMethod -> String
(Int -> SignMethod -> ShowS)
-> (SignMethod -> String)
-> ([SignMethod] -> ShowS)
-> Show SignMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignMethod -> ShowS
showsPrec :: Int -> SignMethod -> ShowS
$cshow :: SignMethod -> String
show :: SignMethod -> String
$cshowList :: [SignMethod] -> ShowS
showList :: [SignMethod] -> ShowS
Show, SignMethod -> SignMethod -> Bool
(SignMethod -> SignMethod -> Bool)
-> (SignMethod -> SignMethod -> Bool) -> Eq SignMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignMethod -> SignMethod -> Bool
== :: SignMethod -> SignMethod -> Bool
$c/= :: SignMethod -> SignMethod -> Bool
/= :: SignMethod -> SignMethod -> Bool
Eq, ReadPrec [SignMethod]
ReadPrec SignMethod
Int -> ReadS SignMethod
ReadS [SignMethod]
(Int -> ReadS SignMethod)
-> ReadS [SignMethod]
-> ReadPrec SignMethod
-> ReadPrec [SignMethod]
-> Read SignMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SignMethod
readsPrec :: Int -> ReadS SignMethod
$creadList :: ReadS [SignMethod]
readList :: ReadS [SignMethod]
$creadPrec :: ReadPrec SignMethod
readPrec :: ReadPrec SignMethod
$creadListPrec :: ReadPrec [SignMethod]
readListPrec :: ReadPrec [SignMethod]
Read, Typeable SignMethod
Typeable SignMethod =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SignMethod -> c SignMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SignMethod)
-> (SignMethod -> Constr)
-> (SignMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SignMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SignMethod))
-> ((forall b. Data b => b -> b) -> SignMethod -> SignMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SignMethod -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SignMethod -> r)
-> (forall u. (forall d. Data d => d -> u) -> SignMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SignMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SignMethod -> m SignMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SignMethod -> m SignMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SignMethod -> m SignMethod)
-> Data SignMethod
SignMethod -> Constr
SignMethod -> DataType
(forall b. Data b => b -> b) -> SignMethod -> SignMethod
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SignMethod -> u
forall u. (forall d. Data d => d -> u) -> SignMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMethod -> c SignMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMethod)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMethod -> c SignMethod
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMethod -> c SignMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMethod
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMethod
$ctoConstr :: SignMethod -> Constr
toConstr :: SignMethod -> Constr
$cdataTypeOf :: SignMethod -> DataType
dataTypeOf :: SignMethod -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMethod)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMethod)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMethod)
$cgmapT :: (forall b. Data b => b -> b) -> SignMethod -> SignMethod
gmapT :: (forall b. Data b => b -> b) -> SignMethod -> SignMethod
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SignMethod -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SignMethod -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignMethod -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignMethod -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
Data, Typeable)


newtype OAuthException = OAuthException String
                      deriving (Int -> OAuthException -> ShowS
[OAuthException] -> ShowS
OAuthException -> String
(Int -> OAuthException -> ShowS)
-> (OAuthException -> String)
-> ([OAuthException] -> ShowS)
-> Show OAuthException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthException -> ShowS
showsPrec :: Int -> OAuthException -> ShowS
$cshow :: OAuthException -> String
show :: OAuthException -> String
$cshowList :: [OAuthException] -> ShowS
showList :: [OAuthException] -> ShowS
Show, OAuthException -> OAuthException -> Bool
(OAuthException -> OAuthException -> Bool)
-> (OAuthException -> OAuthException -> Bool) -> Eq OAuthException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthException -> OAuthException -> Bool
== :: OAuthException -> OAuthException -> Bool
$c/= :: OAuthException -> OAuthException -> Bool
/= :: OAuthException -> OAuthException -> Bool
Eq, Typeable OAuthException
Typeable OAuthException =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OAuthException -> c OAuthException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OAuthException)
-> (OAuthException -> Constr)
-> (OAuthException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OAuthException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OAuthException))
-> ((forall b. Data b => b -> b)
    -> OAuthException -> OAuthException)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OAuthException -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OAuthException -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OAuthException -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OAuthException -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OAuthException -> m OAuthException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OAuthException -> m OAuthException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OAuthException -> m OAuthException)
-> Data OAuthException
OAuthException -> Constr
OAuthException -> DataType
(forall b. Data b => b -> b) -> OAuthException -> OAuthException
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> OAuthException -> u
forall u. (forall d. Data d => d -> u) -> OAuthException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthException -> c OAuthException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthException)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthException -> c OAuthException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthException -> c OAuthException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthException
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthException
$ctoConstr :: OAuthException -> Constr
toConstr :: OAuthException -> Constr
$cdataTypeOf :: OAuthException -> DataType
dataTypeOf :: OAuthException -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthException)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthException)
$cgmapT :: (forall b. Data b => b -> b) -> OAuthException -> OAuthException
gmapT :: (forall b. Data b => b -> b) -> OAuthException -> OAuthException
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthException -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthException -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OAuthException -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OAuthException -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
Data, Typeable)

instance Exception OAuthException


-- | Data type for getAccessTokenWith method.
--
-- You can create values of this type using 'defaultAccessTokenRequest'.
--
-- Since 1.5.1
data AccessTokenRequest = AccessTokenRequest {
    AccessTokenRequest
-> ByteString -> Credential -> Request -> Request
accessTokenAddAuth :: (BS.ByteString -> Credential -> Request -> Request)
    -- ^ add auth hook.
    --
    -- Default: addAuthHeader
    --
    -- Since 1.5.1
  , AccessTokenRequest -> Request -> Request
accessTokenRequestHook :: (Request -> Request)
    -- ^ Request Hook.
    --
    -- Default: @id@
    --
    -- Since 1.5.1
  , AccessTokenRequest -> OAuth
accessTokenOAuth :: OAuth
    -- ^ OAuth Application
    --
    -- Since 1.5.1
  , AccessTokenRequest -> Credential
accessTokenTemporaryCredential :: Credential
    -- ^ Temporary Credential (with oauth_verifier if >= 1.0a)
    --
    -- Since 1.5.1
  , AccessTokenRequest -> Manager
accessTokenManager :: Manager
    -- ^ Manager
    --
    -- Since 1.5.1
  }

-- | Create a value of type 'AccessTokenRequest' with default values filled in.
--
-- Note that this is a settings type. More information on usage can be found
-- at: <http://www.yesodweb.com/book/settings-types>.
--
-- Since 1.5.1
defaultAccessTokenRequest :: OAuth -> Credential -> Manager -> AccessTokenRequest
defaultAccessTokenRequest :: OAuth -> Credential -> Manager -> AccessTokenRequest
defaultAccessTokenRequest OAuth
oauth Credential
cred Manager
man = AccessTokenRequest
    { accessTokenAddAuth :: ByteString -> Credential -> Request -> Request
accessTokenAddAuth = ByteString -> Credential -> Request -> Request
addAuthHeader
    , accessTokenRequestHook :: Request -> Request
accessTokenRequestHook = Request -> Request
forall a. a -> a
id
    , accessTokenOAuth :: OAuth
accessTokenOAuth = OAuth
oauth
    , accessTokenTemporaryCredential :: Credential
accessTokenTemporaryCredential = Credential
cred
    , accessTokenManager :: Manager
accessTokenManager = Manager
man
    }

----------------------------------------------------------------------
-- Credentials


-- | Data type for credential.
newtype Credential = Credential -- we can easily change it back to "data" later if needed, right?
    { Credential -> [(ByteString, ByteString)]
unCredential :: [(BS.ByteString, BS.ByteString)] }
    deriving (Int -> Credential -> ShowS
[Credential] -> ShowS
Credential -> String
(Int -> Credential -> ShowS)
-> (Credential -> String)
-> ([Credential] -> ShowS)
-> Show Credential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Credential -> ShowS
showsPrec :: Int -> Credential -> ShowS
$cshow :: Credential -> String
show :: Credential -> String
$cshowList :: [Credential] -> ShowS
showList :: [Credential] -> ShowS
Show, Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
/= :: Credential -> Credential -> Bool
Eq, Eq Credential
Eq Credential =>
(Credential -> Credential -> Ordering)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Credential)
-> (Credential -> Credential -> Credential)
-> Ord Credential
Credential -> Credential -> Bool
Credential -> Credential -> Ordering
Credential -> Credential -> Credential
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Credential -> Credential -> Ordering
compare :: Credential -> Credential -> Ordering
$c< :: Credential -> Credential -> Bool
< :: Credential -> Credential -> Bool
$c<= :: Credential -> Credential -> Bool
<= :: Credential -> Credential -> Bool
$c> :: Credential -> Credential -> Bool
> :: Credential -> Credential -> Bool
$c>= :: Credential -> Credential -> Bool
>= :: Credential -> Credential -> Bool
$cmax :: Credential -> Credential -> Credential
max :: Credential -> Credential -> Credential
$cmin :: Credential -> Credential -> Credential
min :: Credential -> Credential -> Credential
Ord, ReadPrec [Credential]
ReadPrec Credential
Int -> ReadS Credential
ReadS [Credential]
(Int -> ReadS Credential)
-> ReadS [Credential]
-> ReadPrec Credential
-> ReadPrec [Credential]
-> Read Credential
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Credential
readsPrec :: Int -> ReadS Credential
$creadList :: ReadS [Credential]
readList :: ReadS [Credential]
$creadPrec :: ReadPrec Credential
readPrec :: ReadPrec Credential
$creadListPrec :: ReadPrec [Credential]
readListPrec :: ReadPrec [Credential]
Read, Typeable Credential
Typeable Credential =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Credential -> c Credential)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Credential)
-> (Credential -> Constr)
-> (Credential -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Credential))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Credential))
-> ((forall b. Data b => b -> b) -> Credential -> Credential)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Credential -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Credential -> r)
-> (forall u. (forall d. Data d => d -> u) -> Credential -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Credential -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Credential -> m Credential)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Credential -> m Credential)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Credential -> m Credential)
-> Data Credential
Credential -> Constr
Credential -> DataType
(forall b. Data b => b -> b) -> Credential -> Credential
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Credential -> u
forall u. (forall d. Data d => d -> u) -> Credential -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Credential
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Credential -> c Credential
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Credential)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Credential)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Credential -> c Credential
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Credential -> c Credential
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Credential
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Credential
$ctoConstr :: Credential -> Constr
toConstr :: Credential -> Constr
$cdataTypeOf :: Credential -> DataType
dataTypeOf :: Credential -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Credential)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Credential)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Credential)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Credential)
$cgmapT :: (forall b. Data b => b -> b) -> Credential -> Credential
gmapT :: (forall b. Data b => b -> b) -> Credential -> Credential
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Credential -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Credential -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Credential -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Credential -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
Data, Typeable)


-- | Convenient function to create 'Credential' with OAuth Token and Token Secret.
newCredential :: BS.ByteString -- ^ value for oauth_token
              -> BS.ByteString -- ^ value for oauth_token_secret
              -> Credential
newCredential :: ByteString -> ByteString -> Credential
newCredential ByteString
tok ByteString
sec = [(ByteString, ByteString)] -> Credential
Credential [(ByteString
"oauth_token", ByteString
tok), (ByteString
"oauth_token_secret", ByteString
sec)]


-- | Empty credential.
emptyCredential :: Credential
emptyCredential :: Credential
emptyCredential = [(ByteString, ByteString)] -> Credential
Credential []


-- | Insert an oauth parameter into given 'Credential'.
insert :: BS.ByteString -- ^ Parameter Name
       -> BS.ByteString -- ^ Value
       -> Credential    -- ^ Credential
       -> Credential    -- ^ Result
insert :: ByteString -> ByteString -> Credential -> Credential
insert ByteString
k ByteString
v = [(ByteString, ByteString)] -> Credential
Credential ([(ByteString, ByteString)] -> Credential)
-> (Credential -> [(ByteString, ByteString)])
-> Credential
-> Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> [(ByteString, ByteString)]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
insertMap ByteString
k ByteString
v ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> (Credential -> [(ByteString, ByteString)])
-> Credential
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> [(ByteString, ByteString)]
unCredential


-- | Convenient method for inserting multiple parameters into credential.
inserts :: [(BS.ByteString, BS.ByteString)] -> Credential -> Credential
inserts :: [(ByteString, ByteString)] -> Credential -> Credential
inserts = (Credential -> [(ByteString, ByteString)] -> Credential)
-> [(ByteString, ByteString)] -> Credential -> Credential
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Credential -> [(ByteString, ByteString)] -> Credential)
 -> [(ByteString, ByteString)] -> Credential -> Credential)
-> (Credential -> [(ByteString, ByteString)] -> Credential)
-> [(ByteString, ByteString)]
-> Credential
-> Credential
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> Credential -> Credential)
-> Credential -> [(ByteString, ByteString)] -> Credential
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ByteString -> ByteString -> Credential -> Credential)
-> (ByteString, ByteString) -> Credential -> Credential
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Credential -> Credential
insert)


-- | Remove an oauth parameter for key from given 'Credential'.
delete :: BS.ByteString -- ^ Parameter name
       -> Credential    -- ^ Credential
       -> Credential    -- ^ Result
delete :: ByteString -> Credential -> Credential
delete ByteString
key = [(ByteString, ByteString)] -> Credential
Credential ([(ByteString, ByteString)] -> Credential)
-> (Credential -> [(ByteString, ByteString)])
-> Credential
-> Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
deleteMap ByteString
key ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> (Credential -> [(ByteString, ByteString)])
-> Credential
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> [(ByteString, ByteString)]
unCredential


-- | Insert @oauth-verifier@ on a 'Credential'.
injectVerifier :: BS.ByteString -> Credential -> Credential
injectVerifier :: ByteString -> Credential -> Credential
injectVerifier = ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_verifier"


----------------------------------------------------------------------
-- Signature

-- | Add OAuth headers & sign to 'Request'.
signOAuth :: MonadIO m
          => OAuth              -- ^ OAuth Application
          -> Credential         -- ^ Credential
          -> Request            -- ^ Original Request
          -> m Request          -- ^ Signed OAuth Request
signOAuth :: forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m Request
signOAuth OAuth
oa Credential
crd Request
req = OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> m Request
forall (m :: * -> *).
MonadIO m =>
OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> m Request
signOAuth' OAuth
oa Credential
crd Bool
True ByteString -> Credential -> Request -> Request
addAuthHeader Request
req

-- | More flexible signOAuth
signOAuth' :: MonadIO m
          => OAuth              -- ^ OAuth Application
          -> Credential         -- ^ Credential
          -> Bool               -- ^ whether to insert oauth_body_hash or not
          -> (BS.ByteString -> Credential -> Request -> Request) -- ^ signature style
          -> Request            -- ^ Original Request
          -> m Request          -- ^ Signed OAuth Request
signOAuth' :: forall (m :: * -> *).
MonadIO m =>
OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> m Request
signOAuth' OAuth
oa Credential
crd Bool
withHash ByteString -> Credential -> Request -> Request
add_auth Request
req = do
  Credential
crd' <- Credential -> m Credential
forall (m :: * -> *). MonadIO m => Credential -> m Credential
addTimeStamp (Credential -> m Credential) -> m Credential -> m Credential
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Credential -> m Credential
forall (m :: * -> *). MonadIO m => Credential -> m Credential
addNonce Credential
crd
  Maybe ByteString
mhash <- m (Maybe ByteString)
moauth_body_hash
  let tok :: Credential
tok = Maybe ByteString -> Credential -> Credential
addHashToCred Maybe ByteString
mhash (Credential -> Credential) -> Credential -> Credential
forall a b. (a -> b) -> a -> b
$ OAuth -> Credential -> Credential
injectOAuthToCred OAuth
oa Credential
crd'
  ByteString
sign <- OAuth -> Credential -> Request -> m ByteString
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m ByteString
genSign OAuth
oa Credential
tok Request
req
  let prefix :: ByteString
prefix = case OAuth -> Maybe ByteString
oauthRealm OAuth
oa of
        Maybe ByteString
Nothing -> ByteString
"OAuth "
        Just ByteString
v  -> ByteString
"OAuth realm=\"" ByteString -> ByteString -> ByteString
`BS.append` ByteString
v ByteString -> ByteString -> ByteString
`BS.append` ByteString
"\","
  Request -> m Request
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Credential -> Request -> Request
add_auth ByteString
prefix
                    (ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_signature" ByteString
sign Credential
tok)
                    Request
req
  where -- adding extension https://oauth.googlecode.com/svn/spec/ext/body_hash/1.0/oauth-bodyhash.html
    moauth_body_hash :: m (Maybe ByteString)
moauth_body_hash = if Bool -> Bool
not Bool
withHash Bool -> Bool -> Bool
|| [Header] -> Bool
isBodyFormEncoded (Request -> [Header]
requestHeaders Request
req)
          then Maybe ByteString -> m (Maybe ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
          else (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
             (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode
             (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
             (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA1State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest
             (Digest SHA1State -> ByteString)
-> (ByteString -> Digest SHA1State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
sha1
             (ByteString -> Digest SHA1State)
-> (ByteString -> ByteString) -> ByteString -> Digest SHA1State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict) (ByteString -> Maybe ByteString)
-> m ByteString -> m (Maybe ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Request -> m ByteString
forall (m :: * -> *). MonadIO m => Request -> m ByteString
loadBodyBS Request
req
    -- encodeHash (Just h) = "oauth_body_hash=\"" `BS.append` paramEncode h `BS.append` "\","
    -- encodeHash Nothing  = ""
    addHashToCred :: Maybe ByteString -> Credential -> Credential
addHashToCred (Just ByteString
h) = ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_body_hash" ByteString
h
    addHashToCred Maybe ByteString
Nothing  = Credential -> Credential
forall a. a -> a
id


-- | Generate OAuth signature.  Used by 'signOAuth'.
genSign :: MonadIO m => OAuth -> Credential -> Request -> m BS.ByteString
genSign :: forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m ByteString
genSign OAuth
oa Credential
tok Request
req =
  case OAuth -> SignMethod
oauthSignatureMethod OAuth
oa of
    SignMethod
HMACSHA1 -> do
      ByteString
text <- Credential -> Request -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req
      let key :: ByteString
key  = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
      ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA1State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA1State -> ByteString) -> Digest SHA1State -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Digest SHA1State
hmacSha1 (ByteString -> ByteString
fromStrict ByteString
key) ByteString
text
    SignMethod
HMACSHA256 -> do
      ByteString
text <- Credential -> Request -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req
      let key :: ByteString
key  = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
      ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA256State -> ByteString)
-> Digest SHA256State -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Digest SHA256State
hmacSha256 (ByteString -> ByteString
fromStrict ByteString
key) ByteString
text
    SignMethod
HMACSHA512 -> do
      ByteString
text <- Credential -> Request -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req
      let key :: ByteString
key  = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
      ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA512State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA512State -> ByteString)
-> Digest SHA512State -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Digest SHA512State
hmacSha512 (ByteString -> ByteString
fromStrict ByteString
key) ByteString
text
    SignMethod
PLAINTEXT ->
      ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
    RSASHA1 PrivateKey
pr ->
      (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString
encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashInfo -> PrivateKey -> ByteString -> ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hashSHA1 PrivateKey
pr) (Credential -> Request -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req)
    RSASHA256 PrivateKey
pr ->
      (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString
encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashInfo -> PrivateKey -> ByteString -> ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hashSHA256 PrivateKey
pr) (Credential -> Request -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req)
    RSASHA512 PrivateKey
pr ->
      (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString
encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashInfo -> PrivateKey -> ByteString -> ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hashSHA512 PrivateKey
pr) (Credential -> Request -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req)

-- | Test existing OAuth signature.
--   Since 1.5.2
checkOAuth :: MonadIO m
           => OAuth -> Credential -> Request
           -> ExceptT OAuthException m Request
checkOAuth :: forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> ExceptT OAuthException m Request
checkOAuth OAuth
oa Credential
crd Request
req = if [Header] -> Bool
isBodyFormEncoded [Header]
origHeaders then OAuth -> Credential -> Request -> ExceptT OAuthException m Request
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> ExceptT OAuthException m Request
checkOAuthB OAuth
oa Credential
crd Request
req else do
  case Maybe ByteString
mosig of
    Maybe ByteString
Nothing -> OAuthException -> ExceptT OAuthException m Request
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (OAuthException -> ExceptT OAuthException m Request)
-> OAuthException -> ExceptT OAuthException m Request
forall a b. (a -> b) -> a -> b
$ String -> OAuthException
OAuthException String
"oauth_signature parameter not found"
    Just ByteString
osig -> do
      Maybe ByteString
mhash <- ExceptT OAuthException m (Maybe ByteString)
moauth_body_hash
      case (\ByteString
oh ByteString
nh -> ByteString
oh ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
paramEncode ByteString
nh) (ByteString -> ByteString -> Bool)
-> Maybe ByteString -> Maybe (ByteString -> Bool)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Maybe ByteString
moauth_body_hash_orig Maybe (ByteString -> Bool) -> Maybe ByteString -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Maybe ByteString
mhash of
        Just Bool
False -> OAuthException -> ExceptT OAuthException m Request
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (OAuthException -> ExceptT OAuthException m Request)
-> OAuthException -> ExceptT OAuthException m Request
forall a b. (a -> b) -> a -> b
$ String -> OAuthException
OAuthException String
"Failed test of oauth_body_hash"
        Maybe Bool
_ -> let tok :: Credential
tok = Maybe ByteString -> Credential -> Credential
addHashToCred Maybe ByteString
mhash (Credential -> Credential)
-> (Credential -> Credential) -> Credential -> Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuth -> Credential -> Credential
injectOAuthToCred OAuth
oa (Credential -> Credential) -> Credential -> Credential
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Credential -> Credential
inserts (Maybe [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall {b}. Maybe [(ByteString, b)] -> [(ByteString, b)]
remParams Maybe [(ByteString, ByteString)]
authParams) Credential
crd
             in OAuth
-> Credential -> Request -> ExceptT OAuthException m ByteString
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m ByteString
genSign OAuth
oa Credential
tok Request
req
                  {requestHeaders = catMaybes [mtypeHeader]}
                ExceptT OAuthException m ByteString
-> (ByteString -> ExceptT OAuthException m Request)
-> ExceptT OAuthException m Request
forall a b.
ExceptT OAuthException m a
-> (a -> ExceptT OAuthException m b) -> ExceptT OAuthException m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
nsig -> if ByteString
osig ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
paramEncode ByteString
nsig
                             then Request -> ExceptT OAuthException m Request
forall a. a -> ExceptT OAuthException m a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
req
                             else OAuthException -> ExceptT OAuthException m Request
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (OAuthException -> ExceptT OAuthException m Request)
-> OAuthException -> ExceptT OAuthException m Request
forall a b. (a -> b) -> a -> b
$ String -> OAuthException
OAuthException String
"Failed test of oauth_signature"
  where
    origHeaders :: [Header]
origHeaders = Request -> [Header]
requestHeaders Request
req
    mauthHeader :: Maybe Header
mauthHeader = (Header -> Bool) -> [Header] -> Maybe Header
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ( (HeaderName
"Authorization" HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
==) (HeaderName -> Bool) -> (Header -> HeaderName) -> Header -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> HeaderName
forall a b. (a, b) -> a
fst) ([Header] -> Maybe Header) -> [Header] -> Maybe Header
forall a b. (a -> b) -> a -> b
$ [Header]
origHeaders
    mtypeHeader :: Maybe Header
mtypeHeader = (Header -> Bool) -> [Header] -> Maybe Header
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ( (HeaderName
"Content-Type" HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
==) (HeaderName -> Bool) -> (Header -> HeaderName) -> Header -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> HeaderName
forall a b. (a, b) -> a
fst) ([Header] -> Maybe Header) -> [Header] -> Maybe Header
forall a b. (a -> b) -> a -> b
$ [Header]
origHeaders
    authParams :: Maybe [(ByteString, ByteString)]
authParams = ((ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ByteString, ByteString)
parseParam ([ByteString] -> [(ByteString, ByteString)])
-> (Header -> [ByteString]) -> Header -> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BS.split Char
',' (ByteString -> [ByteString])
-> (Header -> ByteString) -> Header -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
6 (ByteString -> ByteString)
-> (Header -> ByteString) -> Header -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> ByteString
forall a b. (a, b) -> b
snd) (Header -> [(ByteString, ByteString)])
-> Maybe Header -> Maybe [(ByteString, ByteString)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Maybe Header
mauthHeader
    remParams :: Maybe [(ByteString, b)] -> [(ByteString, b)]
remParams Maybe [(ByteString, b)]
Nothing = []
    remParams (Just [(ByteString, b)]
ms) = ((ByteString, b) -> Bool) -> [(ByteString, b)] -> [(ByteString, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ( Bool -> Bool
not (Bool -> Bool)
-> ((ByteString, b) -> Bool) -> (ByteString, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> Bool)
-> [ByteString] -> ByteString -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
                                            (ByteString
"realm" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString
"oauth_signature" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ((ByteString, ByteString) -> ByteString)
-> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst (Credential -> [(ByteString, ByteString)]
unCredential Credential
crd))
                                       (ByteString -> Bool)
-> ((ByteString, b) -> ByteString) -> (ByteString, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, b) -> ByteString
forall a b. (a, b) -> a
fst) [(ByteString, b)]
ms
    mosig :: Maybe ByteString
mosig = ((ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Maybe (ByteString, ByteString) -> Maybe ByteString)
-> (Maybe (Maybe (ByteString, ByteString))
    -> Maybe (ByteString, ByteString))
-> Maybe (Maybe (ByteString, ByteString))
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe (ByteString, ByteString))
-> Maybe (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (ByteString, ByteString)) -> Maybe ByteString)
-> Maybe (Maybe (ByteString, ByteString)) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> Maybe (ByteString, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((ByteString
"oauth_signature" ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst) ([(ByteString, ByteString)] -> Maybe (ByteString, ByteString))
-> Maybe [(ByteString, ByteString)]
-> Maybe (Maybe (ByteString, ByteString))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Maybe [(ByteString, ByteString)]
authParams
    parseParam :: ByteString -> (ByteString, ByteString)
parseParam = (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Char -> Bool) -> ByteString -> ByteString
BS.takeWhile (Char
'"' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
1 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (Char
'"' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=))
               ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitEq (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)
    splitEq :: ByteString -> (ByteString, ByteString)
splitEq ByteString
s = case Char -> ByteString -> Maybe Int
BS.elemIndex Char
'=' ByteString
s of
                  Maybe Int
Nothing -> (ByteString
s,ByteString
"")
                  Just Int
i -> Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
i ByteString
s
    moauth_body_hash_orig :: Maybe ByteString
moauth_body_hash_orig = Maybe (Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ByteString) -> Maybe ByteString)
-> Maybe (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (((ByteString, ByteString) -> ByteString)
-> Maybe (ByteString, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Maybe (ByteString, ByteString) -> Maybe ByteString)
-> ([(ByteString, ByteString)] -> Maybe (ByteString, ByteString))
-> [(ByteString, ByteString)]
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> Maybe (ByteString, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ( (ByteString
"oauth_body_hash" ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst)) ([(ByteString, ByteString)] -> Maybe ByteString)
-> Maybe [(ByteString, ByteString)] -> Maybe (Maybe ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Maybe [(ByteString, ByteString)]
authParams
    moauth_body_hash :: ExceptT OAuthException m (Maybe ByteString)
moauth_body_hash = if Maybe ByteString
moauth_body_hash_orig Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ByteString
forall a. Maybe a
Nothing
          then Maybe ByteString -> ExceptT OAuthException m (Maybe ByteString)
forall a. a -> ExceptT OAuthException m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
          else (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
             (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode
             (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
             (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA1State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest
             (Digest SHA1State -> ByteString)
-> (ByteString -> Digest SHA1State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
sha1
             (ByteString -> Digest SHA1State)
-> (ByteString -> ByteString) -> ByteString -> Digest SHA1State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict) (ByteString -> Maybe ByteString)
-> ExceptT OAuthException m ByteString
-> ExceptT OAuthException m (Maybe ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Request -> ExceptT OAuthException m ByteString
forall (m :: * -> *). MonadIO m => Request -> m ByteString
loadBodyBS Request
req
    addHashToCred :: Maybe ByteString -> Credential -> Credential
addHashToCred (Just ByteString
h) = ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_body_hash" ByteString
h
    addHashToCred Maybe ByteString
Nothing  = Credential -> Credential
forall a. a -> a
id

checkOAuthB :: MonadIO m
            => OAuth -> Credential -> Request
            -> ExceptT OAuthException m Request
checkOAuthB :: forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> ExceptT OAuthException m Request
checkOAuthB OAuth
oa Credential
crd Request
req0 = do
  (ByteString
mosig, ByteString
reqBody) <- ByteString -> (ByteString, ByteString)
getSig (ByteString -> (ByteString, ByteString))
-> ExceptT OAuthException m ByteString
-> ExceptT OAuthException m (ByteString, ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Request -> ExceptT OAuthException m ByteString
forall (m :: * -> *). MonadIO m => Request -> m ByteString
loadBodyBS Request
req0
  let req :: Request
req = Request
req0 {requestBody = RequestBodyBS reqBody}
  case ByteString
mosig of
    ByteString
"" -> OAuthException -> ExceptT OAuthException m Request
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (OAuthException -> ExceptT OAuthException m Request)
-> OAuthException -> ExceptT OAuthException m Request
forall a b. (a -> b) -> a -> b
$ String -> OAuthException
OAuthException String
"oauth_signature parameter not found"
    ByteString
osig -> do
          ByteString
nsig <- OAuth
-> Credential -> Request -> ExceptT OAuthException m ByteString
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m ByteString
genSign OAuth
oa Credential
crd Request
req
          if ByteString
osig ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
paramEncode ByteString
nsig
            then Request -> ExceptT OAuthException m Request
forall a. a -> ExceptT OAuthException m a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
req0
            else OAuthException -> ExceptT OAuthException m Request
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (OAuthException -> ExceptT OAuthException m Request)
-> OAuthException -> ExceptT OAuthException m Request
forall a b. (a -> b) -> a -> b
$ String -> OAuthException
OAuthException String
"Failed test of oauth_signature"
  where
    getSig :: ByteString -> (ByteString, ByteString)
getSig ByteString
b = let (ByteString
h1 , ByteString
r ) = ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"&oauth_signature=" ByteString
b
                   (ByteString
sig, ByteString
h2) = ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"&" (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
17 ByteString
r
               in (ByteString
sig, ByteString
h1 ByteString -> ByteString -> ByteString
`BS.append` ByteString
h2)



----------------------------------------------------------------------
-- Temporary credentails


-- | Get temporary credential for requesting acces token.
getTemporaryCredential :: MonadIO m
                       => OAuth         -- ^ OAuth Application
                       -> Manager
                       -> m Credential -- ^ Temporary Credential (Request Token & Secret).
getTemporaryCredential :: forall (m :: * -> *). MonadIO m => OAuth -> Manager -> m Credential
getTemporaryCredential = (Request -> Request) -> OAuth -> Manager -> m Credential
forall (m :: * -> *).
MonadIO m =>
(Request -> Request) -> OAuth -> Manager -> m Credential
getTemporaryCredential' Request -> Request
forall a. a -> a
id


-- | Get temporary credential for requesting access token with Scope parameter.
getTemporaryCredentialWithScope :: MonadIO m
                                => BS.ByteString -- ^ Scope parameter string
                                -> OAuth         -- ^ OAuth Application
                                -> Manager
                                -> m Credential -- ^ Temporay Credential (Request Token & Secret).
getTemporaryCredentialWithScope :: forall (m :: * -> *).
MonadIO m =>
ByteString -> OAuth -> Manager -> m Credential
getTemporaryCredentialWithScope ByteString
bs = (Request -> Request) -> OAuth -> Manager -> m Credential
forall (m :: * -> *).
MonadIO m =>
(Request -> Request) -> OAuth -> Manager -> m Credential
getTemporaryCredential' (ByteString -> Request -> Request
addScope ByteString
bs)


-- | Get temporary credential for requesting access token via the proxy.
getTemporaryCredentialProxy :: MonadIO m
                            => Maybe Proxy   -- ^ Proxy
                            -> OAuth         -- ^ OAuth Application
                            -> Manager
                            -> m Credential -- ^ Temporary Credential (Request Token & Secret).
getTemporaryCredentialProxy :: forall (m :: * -> *).
MonadIO m =>
Maybe Proxy -> OAuth -> Manager -> m Credential
getTemporaryCredentialProxy Maybe Proxy
p OAuth
oa Manager
m = (Request -> Request) -> OAuth -> Manager -> m Credential
forall (m :: * -> *).
MonadIO m =>
(Request -> Request) -> OAuth -> Manager -> m Credential
getTemporaryCredential' (Maybe Proxy -> Request -> Request
addMaybeProxy Maybe Proxy
p) OAuth
oa Manager
m


getTemporaryCredential' :: MonadIO m
                        => (Request -> Request)       -- ^ Request Hook
                        -> OAuth                      -- ^ OAuth Application
                        -> Manager
                        -> m Credential    -- ^ Temporary Credential (Request Token & Secret).
getTemporaryCredential' :: forall (m :: * -> *).
MonadIO m =>
(Request -> Request) -> OAuth -> Manager -> m Credential
getTemporaryCredential' Request -> Request
hook OAuth
oa Manager
manager = do
  let req :: Request
req = Maybe Request -> Request
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Request -> Request) -> Maybe Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrl (String -> Maybe Request) -> String -> Maybe Request
forall a b. (a -> b) -> a -> b
$ OAuth -> String
oauthRequestUri OAuth
oa
      crd :: Credential
crd = (Credential -> Credential)
-> (ByteString -> Credential -> Credential)
-> Maybe ByteString
-> Credential
-> Credential
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Credential -> Credential
forall a. a -> a
id (ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_callback") (OAuth -> Maybe ByteString
oauthCallback OAuth
oa) (Credential -> Credential) -> Credential -> Credential
forall a b. (a -> b) -> a -> b
$ Credential
emptyCredential
  Request
req' <- OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> m Request
forall (m :: * -> *).
MonadIO m =>
OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> m Request
signOAuth' OAuth
oa Credential
crd Bool
False ByteString -> Credential -> Request -> Request
addAuthHeader (Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request -> Request
hook (Request
req { method = "POST" })
  Response ByteString
rsp <- IO (Response ByteString) -> m (Response ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
req' Manager
manager
  if Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
rsp Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200
    then do
      let dic :: [(ByteString, ByteString)]
dic = ByteString -> [(ByteString, ByteString)]
parseSimpleQuery (ByteString -> [(ByteString, ByteString)])
-> (Response ByteString -> ByteString)
-> Response ByteString
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> [(ByteString, ByteString)])
-> Response ByteString -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Response ByteString
rsp
      Credential -> m Credential
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Credential -> m Credential) -> Credential -> m Credential
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Credential
Credential [(ByteString, ByteString)]
dic
    else IO Credential -> m Credential
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Credential -> m Credential)
-> (String -> IO Credential) -> String -> m Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthException -> IO Credential
forall e a. Exception e => e -> IO a
throwIO (OAuthException -> IO Credential)
-> (String -> OAuthException) -> String -> IO Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OAuthException
OAuthException
            (String -> m Credential) -> String -> m Credential
forall a b. (a -> b) -> a -> b
$ String
"Gaining OAuth Temporary Credential Failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSL.unpack (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp)


----------------------------------------------------------------------
-- Authorization URL


-- | URL to obtain OAuth verifier.
authorizeUrl :: OAuth           -- ^ OAuth Application
             -> Credential      -- ^ Temporary Credential (Request Token & Secret)
             -> String          -- ^ URL to authorize
authorizeUrl :: OAuth -> Credential -> String
authorizeUrl = (OAuth -> Credential -> [(ByteString, ByteString)])
-> OAuth -> Credential -> String
authorizeUrl' ((OAuth -> Credential -> [(ByteString, ByteString)])
 -> OAuth -> Credential -> String)
-> (OAuth -> Credential -> [(ByteString, ByteString)])
-> OAuth
-> Credential
-> String
forall a b. (a -> b) -> a -> b
$ \OAuth
oa -> [(ByteString, ByteString)]
-> Credential -> [(ByteString, ByteString)]
forall a b. a -> b -> a
const [(ByteString
"oauth_consumer_key", OAuth -> ByteString
oauthConsumerKey OAuth
oa)]


-- | Convert OAuth and Credential to URL to authorize.
--   This takes function to choice parameter to pass to the server other than
--   /oauth_callback/ or /oauth_token/.
authorizeUrl' :: (OAuth -> Credential -> SimpleQuery)
              -> OAuth           -- ^ OAuth Application
              -> Credential      -- ^ Temporary Credential (Request Token & Secret)
              -> String          -- ^ URL to authorize
authorizeUrl' :: (OAuth -> Credential -> [(ByteString, ByteString)])
-> OAuth -> Credential -> String
authorizeUrl' OAuth -> Credential -> [(ByteString, ByteString)]
f OAuth
oa Credential
cr = OAuth -> String
oauthAuthorizeUri OAuth
oa String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS.unpack (Bool -> [(ByteString, ByteString)] -> ByteString
renderSimpleQuery Bool
True [(ByteString, ByteString)]
queries)
  where fixed :: [(ByteString, ByteString)]
fixed   = (ByteString
"oauth_token", Credential -> ByteString
token Credential
cr)(ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
:OAuth -> Credential -> [(ByteString, ByteString)]
f OAuth
oa Credential
cr
        queries :: [(ByteString, ByteString)]
queries =
          case OAuth -> Maybe ByteString
oauthCallback OAuth
oa of
            Maybe ByteString
Nothing       -> [(ByteString, ByteString)]
fixed
            Just ByteString
callback -> (ByteString
"oauth_callback", ByteString
callback)(ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
:[(ByteString, ByteString)]
fixed


----------------------------------------------------------------------
-- Finishing authentication


-- | Get Access token.
getAccessToken, getTokenCredential
               :: MonadIO m
               => OAuth         -- ^ OAuth Application
               -> Credential    -- ^ Temporary Credential (with oauth_verifier if >= 1.0a)
               -> Manager
               -> m Credential -- ^ Token Credential (Access Token & Secret)
getAccessToken :: forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Manager -> m Credential
getAccessToken = (Request -> Request)
-> OAuth -> Credential -> Manager -> m Credential
forall (m :: * -> *).
MonadIO m =>
(Request -> Request)
-> OAuth -> Credential -> Manager -> m Credential
getAccessToken' Request -> Request
forall a. a -> a
id


-- | Get Access token via the proxy.
getAccessTokenProxy, getTokenCredentialProxy
               :: MonadIO m
               => Maybe Proxy   -- ^ Proxy
               -> OAuth         -- ^ OAuth Application
               -> Credential    -- ^ Temporary Credential (with oauth_verifier if >= 1.0a)
               -> Manager
               -> m Credential -- ^ Token Credential (Access Token & Secret)
getAccessTokenProxy :: forall (m :: * -> *).
MonadIO m =>
Maybe Proxy -> OAuth -> Credential -> Manager -> m Credential
getAccessTokenProxy Maybe Proxy
p = (Request -> Request)
-> OAuth -> Credential -> Manager -> m Credential
forall (m :: * -> *).
MonadIO m =>
(Request -> Request)
-> OAuth -> Credential -> Manager -> m Credential
getAccessToken' ((Request -> Request)
 -> OAuth -> Credential -> Manager -> m Credential)
-> (Request -> Request)
-> OAuth
-> Credential
-> Manager
-> m Credential
forall a b. (a -> b) -> a -> b
$ Maybe Proxy -> Request -> Request
addMaybeProxy Maybe Proxy
p

getAccessToken' :: MonadIO m
                => (Request -> Request)       -- ^ Request Hook
                -> OAuth                      -- ^ OAuth Application
                -> Credential                 -- ^ Temporary Credential (with oauth_verifier if >= 1.0a)
                -> Manager
                -> m Credential     -- ^ Token Credential (Access Token & Secret)
getAccessToken' :: forall (m :: * -> *).
MonadIO m =>
(Request -> Request)
-> OAuth -> Credential -> Manager -> m Credential
getAccessToken' Request -> Request
hook OAuth
oauth Credential
cr Manager
manager = do
    Either (Response ByteString) Credential
maybe_access_token <- AccessTokenRequest -> m (Either (Response ByteString) Credential)
forall (m :: * -> *).
MonadIO m =>
AccessTokenRequest -> m (Either (Response ByteString) Credential)
getAccessTokenWith AccessTokenRequest
            { accessTokenAddAuth :: ByteString -> Credential -> Request -> Request
accessTokenAddAuth = ByteString -> Credential -> Request -> Request
addAuthHeader
            , accessTokenRequestHook :: Request -> Request
accessTokenRequestHook = Request -> Request
hook
            , accessTokenOAuth :: OAuth
accessTokenOAuth = OAuth
oauth
            , accessTokenTemporaryCredential :: Credential
accessTokenTemporaryCredential = Credential
cr
            , accessTokenManager :: Manager
accessTokenManager = Manager
manager
            }
    case Either (Response ByteString) Credential
maybe_access_token of
        Left Response ByteString
error_response -> IO Credential -> m Credential
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Credential -> m Credential)
-> (String -> IO Credential) -> String -> m Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuthException -> IO Credential
forall e a. Exception e => e -> IO a
throwIO (OAuthException -> IO Credential)
-> (String -> OAuthException) -> String -> IO Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OAuthException
OAuthException
                            (String -> m Credential) -> String -> m Credential
forall a b. (a -> b) -> a -> b
$ String
"Gaining OAuth Token Credential Failed: "
                                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSL.unpack (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
error_response)
        Right Credential
access_token -> Credential -> m Credential
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Credential
access_token

getAccessTokenWith :: MonadIO m
                => AccessTokenRequest -- ^ extensible parameters
                -> m (Either (Response BSL.ByteString) Credential
                     )  -- ^ Token Credential (Access Token & Secret) or the conduit response on failures
getAccessTokenWith :: forall (m :: * -> *).
MonadIO m =>
AccessTokenRequest -> m (Either (Response ByteString) Credential)
getAccessTokenWith AccessTokenRequest
params = do
      let req :: Request
req = Request -> Request
hook (Maybe Request -> Request
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Request -> Request) -> Maybe Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrl (String -> Maybe Request) -> String -> Maybe Request
forall a b. (a -> b) -> a -> b
$ OAuth -> String
oauthAccessTokenUri OAuth
oa) { method = "POST" }
      Response ByteString
rsp <- IO (Response ByteString) -> m (Response ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ (Request -> Manager -> IO (Response ByteString))
-> Manager -> Request -> IO (Response ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Request -> Manager -> IO (Response ByteString)
httpLbs Manager
manager
                    (Request -> IO (Response ByteString))
-> IO Request -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> IO Request
forall (m :: * -> *).
MonadIO m =>
OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> m Request
signOAuth' OAuth
oa (if OAuth -> OAuthVersion
oauthVersion OAuth
oa OAuthVersion -> OAuthVersion -> Bool
forall a. Eq a => a -> a -> Bool
== OAuthVersion
OAuth10
                                       then ByteString -> Credential -> Credential
delete ByteString
"oauth_verifier" Credential
cr
                                       else Credential
cr) Bool
False ByteString -> Credential -> Request -> Request
add_auth Request
req
      if Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
rsp Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200
        then do
          let dic :: [(ByteString, ByteString)]
dic = ByteString -> [(ByteString, ByteString)]
parseSimpleQuery (ByteString -> [(ByteString, ByteString)])
-> (Response ByteString -> ByteString)
-> Response ByteString
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> [(ByteString, ByteString)])
-> Response ByteString -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Response ByteString
rsp
          Either (Response ByteString) Credential
-> m (Either (Response ByteString) Credential)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Response ByteString) Credential
 -> m (Either (Response ByteString) Credential))
-> Either (Response ByteString) Credential
-> m (Either (Response ByteString) Credential)
forall a b. (a -> b) -> a -> b
$ Credential -> Either (Response ByteString) Credential
forall a b. b -> Either a b
Right (Credential -> Either (Response ByteString) Credential)
-> Credential -> Either (Response ByteString) Credential
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Credential
Credential [(ByteString, ByteString)]
dic
        else
          Either (Response ByteString) Credential
-> m (Either (Response ByteString) Credential)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Response ByteString) Credential
 -> m (Either (Response ByteString) Credential))
-> Either (Response ByteString) Credential
-> m (Either (Response ByteString) Credential)
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Either (Response ByteString) Credential
forall a b. a -> Either a b
Left Response ByteString
rsp
    where
      add_auth :: ByteString -> Credential -> Request -> Request
add_auth = AccessTokenRequest
-> ByteString -> Credential -> Request -> Request
accessTokenAddAuth AccessTokenRequest
params
      hook :: Request -> Request
hook = AccessTokenRequest -> Request -> Request
accessTokenRequestHook AccessTokenRequest
params
      oa :: OAuth
oa = AccessTokenRequest -> OAuth
accessTokenOAuth AccessTokenRequest
params
      cr :: Credential
cr = AccessTokenRequest -> Credential
accessTokenTemporaryCredential AccessTokenRequest
params
      manager :: Manager
manager = AccessTokenRequest -> Manager
accessTokenManager AccessTokenRequest
params

getTokenCredential :: forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Manager -> m Credential
getTokenCredential = OAuth -> Credential -> Manager -> m Credential
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Manager -> m Credential
getAccessToken
getTokenCredentialProxy :: forall (m :: * -> *).
MonadIO m =>
Maybe Proxy -> OAuth -> Credential -> Manager -> m Credential
getTokenCredentialProxy = Maybe Proxy -> OAuth -> Credential -> Manager -> m Credential
forall (m :: * -> *).
MonadIO m =>
Maybe Proxy -> OAuth -> Credential -> Manager -> m Credential
getAccessTokenProxy


baseTime :: UTCTime
baseTime :: UTCTime
baseTime = Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
0
  where
    day :: Day
day = Integer -> Day
ModifiedJulianDay Integer
40587

showSigMtd :: SignMethod -> BS.ByteString
showSigMtd :: SignMethod -> ByteString
showSigMtd SignMethod
PLAINTEXT = ByteString
"PLAINTEXT"
showSigMtd SignMethod
HMACSHA1  = ByteString
"HMAC-SHA1"
showSigMtd SignMethod
HMACSHA256  = ByteString
"HMAC-SHA256"
showSigMtd SignMethod
HMACSHA512  = ByteString
"HMAC-SHA512"
showSigMtd (RSASHA1 PrivateKey
_) = ByteString
"RSA-SHA1"
showSigMtd (RSASHA256 PrivateKey
_) = ByteString
"RSA-SHA256"
showSigMtd (RSASHA512 PrivateKey
_) = ByteString
"RSA-SHA512"

addNonce :: MonadIO m => Credential -> m Credential
addNonce :: forall (m :: * -> *). MonadIO m => Credential -> m Credential
addNonce Credential
cred = do
  String
nonce <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ Int -> IO Char -> IO String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
10 ((Char, Char) -> IO Char
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Char
'a',Char
'z')) -- FIXME very inefficient
  Credential -> m Credential
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Credential -> m Credential) -> Credential -> m Credential
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_nonce" (String -> ByteString
BS.pack String
nonce) Credential
cred

addTimeStamp :: MonadIO m => Credential -> m Credential
addTimeStamp :: forall (m :: * -> *). MonadIO m => Credential -> m Credential
addTimeStamp Credential
cred = do
  Integer
stamp <- (NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Integer)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
baseTime)) (UTCTime -> Integer) -> m UTCTime -> m Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Credential -> m Credential
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Credential -> m Credential) -> Credential -> m Credential
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_timestamp" (String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer
stamp :: Integer)) Credential
cred

injectOAuthToCred :: OAuth -> Credential -> Credential
injectOAuthToCred :: OAuth -> Credential -> Credential
injectOAuthToCred OAuth
oa Credential
cred =
    [(ByteString, ByteString)] -> Credential -> Credential
inserts [ (ByteString
"oauth_signature_method", SignMethod -> ByteString
showSigMtd (SignMethod -> ByteString) -> SignMethod -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth -> SignMethod
oauthSignatureMethod OAuth
oa)
            , (ByteString
"oauth_consumer_key", OAuth -> ByteString
oauthConsumerKey OAuth
oa)
            , (ByteString
"oauth_version", ByteString
"1.0")
            ] Credential
cred


-- | Place the authentication information in a URL encoded body instead of the Authorization header.
--
-- Note that the first parameter is used for realm in addAuthHeader, and this
-- function needs the same type. The parameter, however, is unused.
--
-- Since 1.5.1
addAuthBody :: a -> Credential -> Request -> Request
addAuthBody :: forall a. a -> Credential -> Request -> Request
addAuthBody a
_ (Credential [(ByteString, ByteString)]
cred) Request
req = [(ByteString, ByteString)] -> Request -> Request
urlEncodedBody ([(ByteString, ByteString)] -> [(ByteString, ByteString)]
filterCreds [(ByteString, ByteString)]
cred) Request
req

addAuthHeader :: BS.ByteString -> Credential -> Request -> Request
addAuthHeader :: ByteString -> Credential -> Request -> Request
addAuthHeader ByteString
prefix (Credential [(ByteString, ByteString)]
cred) Request
req =
  Request
req { requestHeaders = insertMap "Authorization" (renderAuthHeader prefix cred) $ requestHeaders req }

renderAuthHeader :: BS.ByteString -> [(BS.ByteString, BS.ByteString)] -> BS.ByteString
renderAuthHeader :: ByteString -> [(ByteString, ByteString)] -> ByteString
renderAuthHeader ByteString
prefix = (ByteString
prefix ByteString -> ByteString -> ByteString
`BS.append`)
                        (ByteString -> ByteString)
-> ([(ByteString, ByteString)] -> ByteString)
-> [(ByteString, ByteString)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
","
                        ([ByteString] -> ByteString)
-> ([(ByteString, ByteString)] -> [ByteString])
-> [(ByteString, ByteString)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> ByteString)
-> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
a,ByteString
b) -> [ByteString] -> ByteString
BS.concat [ByteString -> ByteString
paramEncode ByteString
a, ByteString
"=\"",  ByteString -> ByteString
paramEncode ByteString
b, ByteString
"\""])
                        ([(ByteString, ByteString)] -> [ByteString])
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)]
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, ByteString)] -> [(ByteString, ByteString)]
filterCreds

filterCreds :: [(BS.ByteString, BS.ByteString)] -> [(BS.ByteString, BS.ByteString)]
-- as per http://oauth.net/core/1.0a  -- 9.1.1.  Normalize Request Parameters
-- everything except "realm" parameter should be encoded
-- 6.1.1, 6.1.2, 6.2.1,  6.3.2 and 7 allow encoding anything in the authorization parameters
-- 6.2.3 is only limited to oauth_token and oauth_verifier (although query params are allowed)
-- 6.3.1 does not allow specifing other params, so no need to filter them (it is an error anyway)
filterCreds :: [(ByteString, ByteString)] -> [(ByteString, ByteString)]
filterCreds = ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ByteString, ByteString) -> Bool)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> Bool)
-> [ByteString] -> ByteString -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [ByteString
"realm", ByteString
"oauth_token_secret"] (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst )
--filterCreds = filter ((`elem` [ "oauth_consumer_key"
--                              , "oauth_token"
--                              , "oauth_signature"
--                              , "oauth_signature_method"
--                              , "oauth_timestamp"
--                              , "oauth_nonce"
--                              , "oauth_verifier"
--                              , "oauth_version"
--                              , "oauth_callback"
--                              ] ) . fst )


getBaseString :: MonadIO m => Credential -> Request -> m BSL.ByteString
getBaseString :: forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req = do
  let bsMtd :: ByteString
bsMtd  = (Char -> Char) -> ByteString -> ByteString
BS.map Char -> Char
toUpper (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
method Request
req
      isHttps :: Bool
isHttps = Request -> Bool
secure Request
req
      scheme :: ByteString
scheme = if Bool
isHttps then ByteString
"https" else ByteString
"http"
      bsPort :: ByteString
bsPort = if (Bool
isHttps Bool -> Bool -> Bool
&& Request -> Int
port Request
req Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
443) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isHttps Bool -> Bool -> Bool
&& Request -> Int
port Request
req Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
80)
                 then Char
':' Char -> ByteString -> ByteString
`BS.cons` String -> ByteString
BS.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Request -> Int
port Request
req) else ByteString
""
      bsURI :: ByteString
bsURI = [ByteString] -> ByteString
BS.concat [ByteString
scheme, ByteString
"://", Request -> ByteString
host Request
req, ByteString
bsPort, Request -> ByteString
path Request
req]
      bsQuery :: [(ByteString, ByteString)]
bsQuery = ByteString -> [(ByteString, ByteString)]
parseSimpleQuery (ByteString -> [(ByteString, ByteString)])
-> ByteString -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req
  [(ByteString, ByteString)]
bsBodyQ <- if [Header] -> Bool
isBodyFormEncoded ([Header] -> Bool) -> [Header] -> Bool
forall a b. (a -> b) -> a -> b
$ Request -> [Header]
requestHeaders Request
req
                  then (ByteString -> [(ByteString, ByteString)])
-> m ByteString -> m [(ByteString, ByteString)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> [(ByteString, ByteString)]
parseSimpleQuery (m ByteString -> m [(ByteString, ByteString)])
-> m ByteString -> m [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> m ByteString
forall (m :: * -> *). MonadIO m => Request -> m ByteString
loadBodyBS Request
req
                  else [(ByteString, ByteString)] -> m [(ByteString, ByteString)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  let bsAuthParams :: [(ByteString, ByteString)]
bsAuthParams = [(ByteString, ByteString)] -> [(ByteString, ByteString)]
filterCreds ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Credential -> [(ByteString, ByteString)]
unCredential Credential
tok
      allParams :: [(ByteString, ByteString)]
allParams = [(ByteString, ByteString)]
bsQuery[(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++[(ByteString, ByteString)]
bsBodyQ[(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++[(ByteString, ByteString)]
bsAuthParams
      bsParams :: ByteString
bsParams = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> ByteString)
-> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
a,ByteString
b)->[ByteString] -> ByteString
BS.concat[ByteString
a,ByteString
"=",ByteString
b]) ([(ByteString, ByteString)] -> [ByteString])
-> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Ord a => [a] -> [a]
sort
                   ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> (ByteString, ByteString))
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
a,ByteString
b) -> (ByteString -> ByteString
paramEncode ByteString
a,ByteString -> ByteString
paramEncode ByteString
b)) [(ByteString, ByteString)]
allParams
  -- parameter encoding method in OAuth is slight different from ordinary one.
  -- So this is OK.
  ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString)
-> (ByteString -> ByteString) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [ByteString
bsMtd, ByteString
bsURI, ByteString
bsParams]


----------------------------------------------------------------------
-- Utilities

-- | Encode a string using the percent encoding method for OAuth.
paramEncode :: BS.ByteString -> BS.ByteString
paramEncode :: ByteString -> ByteString
paramEncode = (Char -> ByteString) -> ByteString -> ByteString
BS.concatMap Char -> ByteString
escape
  where
    escape :: Char -> ByteString
escape Char
c | Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"-._~" :: String)) = Char -> ByteString
BS.singleton Char
c
             | Bool
otherwise = let num :: String
num = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
c) String
""
                               oct :: String
oct = Char
'%' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
num) Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
num
                           in String -> ByteString
BS.pack String
oct


addScope :: BS.ByteString -> Request -> Request
addScope :: ByteString -> Request -> Request
addScope ByteString
scope Request
req | ByteString -> Bool
BS.null ByteString
scope = Request
req
                   | Bool
otherwise     = [(ByteString, ByteString)] -> Request -> Request
urlEncodedBody [(ByteString
"scope", ByteString
scope)] Request
req


token, tokenSecret :: Credential -> BS.ByteString
token :: Credential -> ByteString
token = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString)
-> (Credential -> Maybe ByteString) -> Credential -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"oauth_token" ([(ByteString, ByteString)] -> Maybe ByteString)
-> (Credential -> [(ByteString, ByteString)])
-> Credential
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> [(ByteString, ByteString)]
unCredential
tokenSecret :: Credential -> ByteString
tokenSecret = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString)
-> (Credential -> Maybe ByteString) -> Credential -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"oauth_token_secret" ([(ByteString, ByteString)] -> Maybe ByteString)
-> (Credential -> [(ByteString, ByteString)])
-> Credential
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> [(ByteString, ByteString)]
unCredential


addMaybeProxy :: Maybe Proxy -> Request -> Request
addMaybeProxy :: Maybe Proxy -> Request -> Request
addMaybeProxy Maybe Proxy
p Request
req = Request
req { proxy = p }


insertMap :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
insertMap :: forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
insertMap a
key b
val = ((a
key,b
val)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:) ([(a, b)] -> [(a, b)])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
key)(a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> a
forall a b. (a, b) -> a
fst)

deleteMap :: Eq a => a -> [(a,b)] -> [(a,b)]
deleteMap :: forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
deleteMap a
k = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
k)(a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> a
forall a b. (a, b) -> a
fst)


toStrict :: BSL.ByteString -> BS.ByteString
toStrict :: ByteString -> ByteString
toStrict = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks

fromStrict :: BS.ByteString -> BSL.ByteString
fromStrict :: ByteString -> ByteString
fromStrict = [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return


loadBodyBS :: MonadIO m => Request -> m BS.ByteString
loadBodyBS :: forall (m :: * -> *). MonadIO m => Request -> m ByteString
loadBodyBS = RequestBody -> m ByteString
forall (m :: * -> *). MonadIO m => RequestBody -> m ByteString
toBS (RequestBody -> m ByteString)
-> (Request -> RequestBody) -> Request -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> RequestBody
requestBody

toBS :: MonadIO m => RequestBody -> m BS.ByteString
toBS :: forall (m :: * -> *). MonadIO m => RequestBody -> m ByteString
toBS (RequestBodyLBS ByteString
l) = ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict ByteString
l
toBS (RequestBodyBS ByteString
s) = ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
toBS (RequestBodyBuilder Int64
_ Builder
b) = ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toByteString Builder
b
toBS (RequestBodyStream Int64
_ GivesPopper ()
givesPopper) = GivesPopper () -> m ByteString
forall (m :: * -> *). MonadIO m => GivesPopper () -> m ByteString
toBS' GivesPopper ()
givesPopper
toBS (RequestBodyStreamChunked GivesPopper ()
givesPopper) = GivesPopper () -> m ByteString
forall (m :: * -> *). MonadIO m => GivesPopper () -> m ByteString
toBS' GivesPopper ()
givesPopper
#if MIN_VERSION_http_client(0, 4, 28)
toBS (RequestBodyIO IO RequestBody
op) = IO RequestBody -> m RequestBody
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO RequestBody
op m RequestBody -> (RequestBody -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RequestBody -> m ByteString
forall (m :: * -> *). MonadIO m => RequestBody -> m ByteString
toBS
#else
#endif

toBS' :: MonadIO m => GivesPopper () -> m BS.ByteString
toBS' :: forall (m :: * -> *). MonadIO m => GivesPopper () -> m ByteString
toBS' GivesPopper ()
gp = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
    IORef ByteString
ref <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
I.newIORef ByteString
BS.empty
    GivesPopper ()
gp (IORef ByteString -> IO ByteString -> IO ()
go IORef ByteString
ref)
    IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
I.readIORef IORef ByteString
ref
  where
    go :: IORef ByteString -> IO ByteString -> IO ()
go IORef ByteString
ref IO ByteString
popper =
        ([ByteString] -> [ByteString]) -> IO ()
loop [ByteString] -> [ByteString]
forall a. a -> a
id
      where
        loop :: ([ByteString] -> [ByteString]) -> IO ()
loop [ByteString] -> [ByteString]
front = do
            ByteString
bs <- IO ByteString
popper
            if ByteString -> Bool
BS.null ByteString
bs
                then IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
I.writeIORef IORef ByteString
ref (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
                else ([ByteString] -> [ByteString]) -> IO ()
loop ([ByteString] -> [ByteString]
front ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))


isBodyFormEncoded :: [Header] -> Bool
isBodyFormEncoded :: [Header] -> Bool
isBodyFormEncoded = Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString
"application/x-www-form-urlencoded") (Maybe ByteString -> Bool)
-> ([Header] -> Maybe ByteString) -> [Header] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Content-Type"