{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth] -> ShowS
$cshowList :: [OAuth] -> ShowS
show :: OAuth -> String
$cshow :: OAuth -> String
showsPrec :: Int -> OAuth -> ShowS
$cshowsPrec :: Int -> OAuth -> ShowS
Show, OAuth -> OAuth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth -> OAuth -> Bool
$c/= :: OAuth -> OAuth -> Bool
== :: OAuth -> OAuth -> Bool
$c== :: OAuth -> OAuth -> Bool
Eq, ReadPrec [OAuth]
ReadPrec OAuth
Int -> ReadS OAuth
ReadS [OAuth]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OAuth]
$creadListPrec :: ReadPrec [OAuth]
readPrec :: ReadPrec OAuth
$creadPrec :: ReadPrec OAuth
readList :: ReadS [OAuth]
$creadList :: ReadS [OAuth]
readsPrec :: Int -> ReadS OAuth
$creadsPrec :: Int -> ReadS OAuth
Read, Typeable OAuth
OAuth -> DataType
OAuth -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuth -> m OAuth
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuth -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuth -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OAuth -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OAuth -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OAuth -> r
gmapT :: (forall b. Data b => b -> b) -> OAuth -> OAuth
$cgmapT :: (forall b. Data b => b -> b) -> OAuth -> OAuth
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OAuth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OAuth)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuth)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuth)
dataTypeOf :: OAuth -> DataType
$cdataTypeOf :: OAuth -> DataType
toConstr :: OAuth -> Constr
$ctoConstr :: OAuth -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuth
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuth -> c OAuth
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuth -> c 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuthVersion] -> ShowS
$cshowList :: [OAuthVersion] -> ShowS
show :: OAuthVersion -> String
$cshow :: OAuthVersion -> String
showsPrec :: Int -> OAuthVersion -> ShowS
$cshowsPrec :: Int -> OAuthVersion -> ShowS
Show, OAuthVersion -> OAuthVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuthVersion -> OAuthVersion -> Bool
$c/= :: OAuthVersion -> OAuthVersion -> Bool
== :: OAuthVersion -> OAuthVersion -> Bool
$c== :: OAuthVersion -> OAuthVersion -> Bool
Eq, Int -> OAuthVersion
OAuthVersion -> Int
OAuthVersion -> [OAuthVersion]
OAuthVersion -> OAuthVersion
OAuthVersion -> OAuthVersion -> [OAuthVersion]
OAuthVersion -> OAuthVersion -> OAuthVersion -> [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
enumFromThenTo :: OAuthVersion -> OAuthVersion -> OAuthVersion -> [OAuthVersion]
$cenumFromThenTo :: OAuthVersion -> OAuthVersion -> OAuthVersion -> [OAuthVersion]
enumFromTo :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
$cenumFromTo :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
enumFromThen :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
$cenumFromThen :: OAuthVersion -> OAuthVersion -> [OAuthVersion]
enumFrom :: OAuthVersion -> [OAuthVersion]
$cenumFrom :: OAuthVersion -> [OAuthVersion]
fromEnum :: OAuthVersion -> Int
$cfromEnum :: OAuthVersion -> Int
toEnum :: Int -> OAuthVersion
$ctoEnum :: Int -> OAuthVersion
pred :: OAuthVersion -> OAuthVersion
$cpred :: OAuthVersion -> OAuthVersion
succ :: OAuthVersion -> OAuthVersion
$csucc :: OAuthVersion -> OAuthVersion
Enum, Eq 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
min :: OAuthVersion -> OAuthVersion -> OAuthVersion
$cmin :: OAuthVersion -> OAuthVersion -> OAuthVersion
max :: OAuthVersion -> OAuthVersion -> OAuthVersion
$cmax :: OAuthVersion -> OAuthVersion -> OAuthVersion
>= :: OAuthVersion -> OAuthVersion -> Bool
$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
compare :: OAuthVersion -> OAuthVersion -> Ordering
$ccompare :: OAuthVersion -> OAuthVersion -> Ordering
Ord, Typeable OAuthVersion
OAuthVersion -> DataType
OAuthVersion -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OAuthVersion -> m OAuthVersion
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuthVersion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OAuthVersion -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthVersion -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthVersion -> r
gmapT :: (forall b. Data b => b -> b) -> OAuthVersion -> OAuthVersion
$cgmapT :: (forall b. Data b => b -> b) -> OAuthVersion -> OAuthVersion
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthVersion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthVersion)
dataTypeOf :: OAuthVersion -> DataType
$cdataTypeOf :: OAuthVersion -> DataType
toConstr :: OAuthVersion -> Constr
$ctoConstr :: OAuthVersion -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthVersion -> c OAuthVersion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthVersion -> c OAuthVersion
Data, Typeable, ReadPrec [OAuthVersion]
ReadPrec OAuthVersion
Int -> ReadS OAuthVersion
ReadS [OAuthVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OAuthVersion]
$creadListPrec :: ReadPrec [OAuthVersion]
readPrec :: ReadPrec OAuthVersion
$creadPrec :: ReadPrec OAuthVersion
readList :: ReadS [OAuthVersion]
$creadList :: ReadS [OAuthVersion]
readsPrec :: Int -> ReadS OAuthVersion
$creadsPrec :: Int -> ReadS 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 = forall a. Maybe a
Nothing
                 , oauthRealm :: Maybe ByteString
oauthRealm    = forall a. Maybe a
Nothing
                 , oauthServerName :: String
oauthServerName = String
""
                 , oauthRequestUri :: String
oauthRequestUri = String
""
                 , oauthAccessTokenUri :: String
oauthAccessTokenUri = String
""
                 , oauthAuthorizeUri :: String
oauthAuthorizeUri = String
""
                 , oauthConsumerKey :: ByteString
oauthConsumerKey = forall a. HasCallStack => String -> a
error String
"You MUST specify oauthConsumerKey parameter."
                 , oauthConsumerSecret :: ByteString
oauthConsumerSecret = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignMethod] -> ShowS
$cshowList :: [SignMethod] -> ShowS
show :: SignMethod -> String
$cshow :: SignMethod -> String
showsPrec :: Int -> SignMethod -> ShowS
$cshowsPrec :: Int -> SignMethod -> ShowS
Show, SignMethod -> SignMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignMethod -> SignMethod -> Bool
$c/= :: SignMethod -> SignMethod -> Bool
== :: SignMethod -> SignMethod -> Bool
$c== :: SignMethod -> SignMethod -> Bool
Eq, ReadPrec [SignMethod]
ReadPrec SignMethod
Int -> ReadS SignMethod
ReadS [SignMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignMethod]
$creadListPrec :: ReadPrec [SignMethod]
readPrec :: ReadPrec SignMethod
$creadPrec :: ReadPrec SignMethod
readList :: ReadS [SignMethod]
$creadList :: ReadS [SignMethod]
readsPrec :: Int -> ReadS SignMethod
$creadsPrec :: Int -> ReadS SignMethod
Read, Typeable SignMethod
SignMethod -> DataType
SignMethod -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SignMethod -> m SignMethod
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignMethod -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SignMethod -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SignMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SignMethod -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignMethod -> r
gmapT :: (forall b. Data b => b -> b) -> SignMethod -> SignMethod
$cgmapT :: (forall b. Data b => b -> b) -> SignMethod -> SignMethod
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignMethod)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignMethod)
dataTypeOf :: SignMethod -> DataType
$cdataTypeOf :: SignMethod -> DataType
toConstr :: SignMethod -> Constr
$ctoConstr :: SignMethod -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignMethod
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMethod -> c SignMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignMethod -> c SignMethod
Data, Typeable)


newtype OAuthException = OAuthException String
                      deriving (Int -> OAuthException -> ShowS
[OAuthException] -> ShowS
OAuthException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuthException] -> ShowS
$cshowList :: [OAuthException] -> ShowS
show :: OAuthException -> String
$cshow :: OAuthException -> String
showsPrec :: Int -> OAuthException -> ShowS
$cshowsPrec :: Int -> OAuthException -> ShowS
Show, OAuthException -> OAuthException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuthException -> OAuthException -> Bool
$c/= :: OAuthException -> OAuthException -> Bool
== :: OAuthException -> OAuthException -> Bool
$c== :: OAuthException -> OAuthException -> Bool
Eq, Typeable OAuthException
OAuthException -> DataType
OAuthException -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OAuthException -> m OAuthException
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OAuthException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OAuthException -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OAuthException -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OAuthException -> r
gmapT :: (forall b. Data b => b -> b) -> OAuthException -> OAuthException
$cgmapT :: (forall b. Data b => b -> b) -> OAuthException -> OAuthException
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OAuthException)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OAuthException)
dataTypeOf :: OAuthException -> DataType
$cdataTypeOf :: OAuthException -> DataType
toConstr :: OAuthException -> Constr
$ctoConstr :: OAuthException -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OAuthException
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthException -> c OAuthException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OAuthException -> c 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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credential] -> ShowS
$cshowList :: [Credential] -> ShowS
show :: Credential -> String
$cshow :: Credential -> String
showsPrec :: Int -> Credential -> ShowS
$cshowsPrec :: Int -> Credential -> ShowS
Show, Credential -> Credential -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c== :: Credential -> Credential -> Bool
Eq, Eq 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
min :: Credential -> Credential -> Credential
$cmin :: Credential -> Credential -> Credential
max :: Credential -> Credential -> Credential
$cmax :: Credential -> Credential -> Credential
>= :: Credential -> Credential -> Bool
$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
compare :: Credential -> Credential -> Ordering
$ccompare :: Credential -> Credential -> Ordering
Ord, ReadPrec [Credential]
ReadPrec Credential
Int -> ReadS Credential
ReadS [Credential]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Credential]
$creadListPrec :: ReadPrec [Credential]
readPrec :: ReadPrec Credential
$creadPrec :: ReadPrec Credential
readList :: ReadS [Credential]
$creadList :: ReadS [Credential]
readsPrec :: Int -> ReadS Credential
$creadsPrec :: Int -> ReadS Credential
Read, Typeable Credential
Credential -> DataType
Credential -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Credential -> m Credential
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Credential -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Credential -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Credential -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Credential -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Credential -> r
gmapT :: (forall b. Data b => b -> b) -> Credential -> Credential
$cgmapT :: (forall b. Data b => b -> b) -> Credential -> Credential
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Credential)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Credential)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Credential)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Credential)
dataTypeOf :: Credential -> DataType
$cdataTypeOf :: Credential -> DataType
toConstr :: Credential -> Constr
$ctoConstr :: Credential -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Credential
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Credential
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Credential -> c Credential
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Credential -> c 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
insertMap ByteString
k ByteString
v 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
deleteMap ByteString
key 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 = 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' <- forall (m :: * -> *). MonadIO m => Credential -> m Credential
addTimeStamp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 forall a b. (a -> b) -> a -> b
$ OAuth -> Credential -> Credential
injectOAuthToCred OAuth
oa Credential
crd'
  ByteString
sign <- 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
"\","
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else (forall a. a -> Maybe a
Just
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Digest t -> ByteString
bytestringDigest
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
sha1
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` 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  = 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 <- forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req
      let key :: ByteString
key  = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ forall t. Digest t -> ByteString
bytestringDigest forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Digest SHA1State
hmacSha1 (ByteString -> ByteString
fromStrict ByteString
key) ByteString
text
    SignMethod
HMACSHA256 -> do
      ByteString
text <- forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req
      let key :: ByteString
key  = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ forall t. Digest t -> ByteString
bytestringDigest forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Digest SHA256State
hmacSha256 (ByteString -> ByteString
fromStrict ByteString
key) ByteString
text
    SignMethod
HMACSHA512 -> do
      ByteString
text <- forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req
      let key :: ByteString
key  = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ forall t. Digest t -> ByteString
bytestringDigest forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Digest SHA512State
hmacSha512 (ByteString -> ByteString
fromStrict ByteString
key) ByteString
text
    SignMethod
PLAINTEXT ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
paramEncode [OAuth -> ByteString
oauthConsumerSecret OAuth
oa, Credential -> ByteString
tokenSecret Credential
tok]
    RSASHA1 PrivateKey
pr ->
      forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashInfo -> PrivateKey -> ByteString -> ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hashSHA1 PrivateKey
pr) (forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req)
    RSASHA256 PrivateKey
pr ->
      forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashInfo -> PrivateKey -> ByteString -> ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hashSHA256 PrivateKey
pr) (forall (m :: * -> *).
MonadIO m =>
Credential -> Request -> m ByteString
getBaseString Credential
tok Request
req)
    RSASHA512 PrivateKey
pr ->
      forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashInfo -> PrivateKey -> ByteString -> ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hashSHA512 PrivateKey
pr) (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 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 -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE 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 forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
paramEncode ByteString
nh) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Maybe ByteString
moauth_body_hash_orig forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Maybe ByteString
mhash of
        Just Bool
False -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuth -> Credential -> Credential
injectOAuthToCred OAuth
oa forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Credential -> Credential
inserts (forall {b}. Maybe [(ByteString, b)] -> [(ByteString, b)]
remParams Maybe [(ByteString, ByteString)]
authParams) Credential
crd
             in forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m ByteString
genSign OAuth
oa Credential
tok Request
req
                  {requestHeaders :: [Header]
requestHeaders = forall a. [Maybe a] -> [a]
catMaybes [Maybe Header
mtypeHeader]}
                forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
nsig -> if ByteString
osig forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
paramEncode ByteString
nsig
                             then forall (m :: * -> *) a. Monad m => a -> m a
return Request
req
                             else forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ( (HeaderName
"Authorization" forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [Header]
origHeaders
    mtypeHeader :: Maybe Header
mtypeHeader = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ( (HeaderName
"Content-Type" forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [Header]
origHeaders
    authParams :: Maybe [(ByteString, ByteString)]
authParams = (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ByteString, ByteString)
parseParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BS.split Char
',' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
6 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) 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) = forall a. (a -> Bool) -> [a] -> [a]
filter ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
                                            (ByteString
"realm" forall a. a -> [a] -> [a]
: ByteString
"oauth_signature" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (Credential -> [(ByteString, ByteString)]
unCredential Credential
crd))
                                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ByteString, b)]
ms
    mosig :: Maybe ByteString
mosig = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((ByteString
"oauth_signature" forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Maybe [(ByteString, ByteString)]
authParams
    parseParam :: ByteString -> (ByteString, ByteString)
parseParam = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Char -> Bool) -> ByteString -> ByteString
BS.takeWhile (Char
'"' forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (Char
'"' forall a. Eq a => a -> a -> Bool
/=))
               forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitEq forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (Char
' ' 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 = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ( (ByteString
"oauth_body_hash" forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)) 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 forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else (forall a. a -> Maybe a
Just
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Digest t -> ByteString
bytestringDigest
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
sha1
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` 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  = 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 forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Request -> m ByteString
loadBodyBS Request
req0
  let req :: Request
req = Request
req0 {requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyBS ByteString
reqBody}
  case ByteString
mosig of
    ByteString
"" -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ String -> OAuthException
OAuthException String
"oauth_signature parameter not found"
    ByteString
osig -> do
          ByteString
nsig <- forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m ByteString
genSign OAuth
oa Credential
crd Request
req
          if ByteString
osig forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
paramEncode ByteString
nsig
            then forall (m :: * -> *) a. Monad m => a -> m a
return Request
req0
            else forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE 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
"&" 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 = forall (m :: * -> *).
MonadIO m =>
(Request -> Request) -> OAuth -> Manager -> m Credential
getTemporaryCredential' 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 = 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 = 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 = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrl forall a b. (a -> b) -> a -> b
$ OAuth -> String
oauthRequestUri OAuth
oa
      crd :: Credential
crd = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_callback") (OAuth -> Maybe ByteString
oauthCallback OAuth
oa) forall a b. (a -> b) -> a -> b
$ Credential
emptyCredential
  Request
req' <- 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 forall a b. (a -> b) -> a -> b
$ Request -> Request
hook (Request
req { method :: ByteString
method = ByteString
"POST" })
  Response ByteString
rsp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
req' Manager
manager
  if forall body. Response body -> Status
responseStatus Response ByteString
rsp forall a. Eq a => a -> a -> Bool
== Status
status200
    then do
      let dic :: [(ByteString, ByteString)]
dic = ByteString -> [(ByteString, ByteString)]
parseSimpleQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody forall a b. (a -> b) -> a -> b
$ Response ByteString
rsp
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Credential
Credential [(ByteString, ByteString)]
dic
    else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OAuthException
OAuthException
            forall a b. (a -> b) -> a -> b
$ String
"Gaining OAuth Temporary Credential Failed: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSL.unpack (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' forall a b. (a -> b) -> a -> b
$ \OAuth
oa -> 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 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)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)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 = forall (m :: * -> *).
MonadIO m =>
(Request -> Request)
-> OAuth -> Credential -> Manager -> m Credential
getAccessToken' 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 = forall (m :: * -> *).
MonadIO m =>
(Request -> Request)
-> OAuth -> Credential -> Manager -> m Credential
getAccessToken' 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 <- 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 -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OAuthException
OAuthException
                            forall a b. (a -> b) -> a -> b
$ String
"Gaining OAuth Token Credential Failed: "
                                    forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSL.unpack (forall body. Response body -> body
responseBody Response ByteString
error_response)
        Right Credential
access_token -> 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 (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrl forall a b. (a -> b) -> a -> b
$ OAuth -> String
oauthAccessTokenUri OAuth
oa) { method :: ByteString
method = ByteString
"POST" }
      Response ByteString
rsp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip Request -> Manager -> IO (Response ByteString)
httpLbs Manager
manager
                    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
MonadIO m =>
OAuth
-> Credential
-> Bool
-> (ByteString -> Credential -> Request -> Request)
-> Request
-> m Request
signOAuth' OAuth
oa (if OAuth -> OAuthVersion
oauthVersion OAuth
oa 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 forall body. Response body -> Status
responseStatus Response ByteString
rsp forall a. Eq a => a -> a -> Bool
== Status
status200
        then do
          let dic :: [(ByteString, ByteString)]
dic = ByteString -> [(ByteString, ByteString)]
parseSimpleQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody forall a b. (a -> b) -> a -> b
$ Response ByteString
rsp
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Credential
Credential [(ByteString, ByteString)]
dic
        else
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Manager -> m Credential
getAccessToken
getTokenCredentialProxy :: forall (m :: * -> *).
MonadIO m =>
Maybe Proxy -> OAuth -> Credential -> Manager -> m Credential
getTokenCredentialProxy = 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
10 (forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Char
'a',Char
'z')) -- FIXME very inefficient
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- (forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
baseTime)) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Credential -> Credential
insert ByteString
"oauth_timestamp" (String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ 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 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 :: [Header]
requestHeaders = forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
insertMap HeaderName
"Authorization" (ByteString -> [(ByteString, ByteString)] -> ByteString
renderAuthHeader ByteString
prefix [(ByteString, ByteString)]
cred) forall a b. (a -> b) -> a -> b
$ Request -> [Header]
requestHeaders Request
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`)
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
","
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
"\""])
                        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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [ByteString
"realm", ByteString
"oauth_token_secret"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 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 forall a. Eq a => a -> a -> Bool
/= Int
80)
                 then Char
':' Char -> ByteString -> ByteString
`BS.cons` String -> ByteString
BS.pack (forall a. Show a => a -> String
show 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 forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req
  [(ByteString, ByteString)]
bsBodyQ <- if [Header] -> Bool
isBodyFormEncoded forall a b. (a -> b) -> a -> b
$ Request -> [Header]
requestHeaders Request
req
                  then forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> [(ByteString, ByteString)]
parseSimpleQuery forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Request -> m ByteString
loadBodyBS Request
req
                  else forall (m :: * -> *) a. Monad m => a -> m a
return []
  let bsAuthParams :: [(ByteString, ByteString)]
bsAuthParams = [(ByteString, ByteString)] -> [(ByteString, ByteString)]
filterCreds forall a b. (a -> b) -> a -> b
$ Credential -> [(ByteString, ByteString)]
unCredential Credential
tok
      allParams :: [(ByteString, ByteString)]
allParams = [(ByteString, ByteString)]
bsQueryforall a. [a] -> [a] -> [a]
++[(ByteString, ByteString)]
bsBodyQforall a. [a] -> [a] -> [a]
++[(ByteString, ByteString)]
bsAuthParams
      bsParams :: ByteString
bsParams = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
a,ByteString
b)->[ByteString] -> ByteString
BS.concat[ByteString
a,ByteString
"=",ByteString
b]) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort
                   forall a b. (a -> b) -> a -> b
$ 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.
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"&" forall a b. (a -> b) -> a -> b
$ 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 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 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
c) String
""
                               oct :: String
oct = Char
'%' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
2 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
num) Char
'0' 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 = forall a. a -> Maybe a -> a
fromMaybe ByteString
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"oauth_token" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> [(ByteString, ByteString)]
unCredential
tokenSecret :: Credential -> ByteString
tokenSecret = forall a. a -> Maybe a -> a
fromMaybe ByteString
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"oauth_token_secret" 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 :: Maybe Proxy
proxy = Maybe 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)forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=a
key)forall b c a. (b -> c) -> (a -> b) -> a -> c
.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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=a
k)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst)


toStrict :: BSL.ByteString -> BS.ByteString
toStrict :: ByteString -> ByteString
toStrict = [ByteString] -> ByteString
BS.concat 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *). MonadIO m => RequestBody -> m ByteString
toBS 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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict ByteString
l
toBS (RequestBodyBS ByteString
s) = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
toBS (RequestBodyBuilder Int64
_ Builder
b) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toByteString Builder
b
toBS (RequestBodyStream Int64
_ GivesPopper ()
givesPopper) = forall (m :: * -> *). MonadIO m => GivesPopper () -> m ByteString
toBS' GivesPopper ()
givesPopper
toBS (RequestBodyStreamChunked GivesPopper ()
givesPopper) = forall (m :: * -> *). MonadIO m => GivesPopper () -> m ByteString
toBS' GivesPopper ()
givesPopper
#if MIN_VERSION_http_client(0, 4, 28)
toBS (RequestBodyIO IO RequestBody
op) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO RequestBody
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    IORef ByteString
ref <- forall a. a -> IO (IORef a)
I.newIORef ByteString
BS.empty
    GivesPopper ()
gp (IORef ByteString -> IO ByteString -> IO ()
go IORef ByteString
ref)
    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 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 forall a. IORef a -> a -> IO ()
I.writeIORef IORef ByteString
ref forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
                else ([ByteString] -> [ByteString]) -> IO ()
loop ([ByteString] -> [ByteString]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bsforall a. a -> [a] -> [a]
:))


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