{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings  #-}

-- |
-- Module      : Network.OAuth.Types.Params
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : MIT
--
-- Maintainer  : me@jspha.com
-- Stability   : experimental
-- Portability : non-portable
--
-- /OAuth Parameters/
--
-- OAuth 1.0 operates by creating a set of \"oauth parameters\" here
-- called 'Oa' which augment a request with OAuth specific
-- metadata. They may be used to augment the request by one of several
-- 'ParameterMethods'.

module Network.OAuth.Types.Params where

import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Crypto.Random
import qualified Data.ByteString                 as S
import qualified Data.ByteString.Base64          as S64
import qualified Data.ByteString.Char8           as S8
import           Data.Data
import           Data.Time
import           Data.Time.Clock.POSIX
import qualified Network.HTTP.Client             as Client
import qualified Network.HTTP.Types.QueryLike    as H
import           Network.OAuth.Types.Credentials
import           Network.OAuth.Util

-- Basics
--------------------------------------------------------------------------------

-- | The OAuth spec suggest that the OAuth parameter be passed via the
-- @Authorization@ header, but allows for other methods of
-- transmission (see section "3.5. Parameter Transmission") so we
-- select the 'Server'\'s preferred method with this type.
data ParameterMethod = AuthorizationHeader
                       -- ^ Place the 'Oa' parameters in the
                       -- @Authorization@ HTTP header.
                     | RequestEntityBody
                       -- ^ Augment the @www-form-urlencoded@ request
                       -- body with 'Oa' parameters.
                     | QueryString
                       -- ^ Augment the @www-form-urlencoded@ query
                       -- string with 'Oa' parameters.
                       deriving ( Int -> ParameterMethod -> ShowS
[ParameterMethod] -> ShowS
ParameterMethod -> String
(Int -> ParameterMethod -> ShowS)
-> (ParameterMethod -> String)
-> ([ParameterMethod] -> ShowS)
-> Show ParameterMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterMethod] -> ShowS
$cshowList :: [ParameterMethod] -> ShowS
show :: ParameterMethod -> String
$cshow :: ParameterMethod -> String
showsPrec :: Int -> ParameterMethod -> ShowS
$cshowsPrec :: Int -> ParameterMethod -> ShowS
Show, ParameterMethod -> ParameterMethod -> Bool
(ParameterMethod -> ParameterMethod -> Bool)
-> (ParameterMethod -> ParameterMethod -> Bool)
-> Eq ParameterMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterMethod -> ParameterMethod -> Bool
$c/= :: ParameterMethod -> ParameterMethod -> Bool
== :: ParameterMethod -> ParameterMethod -> Bool
$c== :: ParameterMethod -> ParameterMethod -> Bool
Eq, Eq ParameterMethod
Eq ParameterMethod
-> (ParameterMethod -> ParameterMethod -> Ordering)
-> (ParameterMethod -> ParameterMethod -> Bool)
-> (ParameterMethod -> ParameterMethod -> Bool)
-> (ParameterMethod -> ParameterMethod -> Bool)
-> (ParameterMethod -> ParameterMethod -> Bool)
-> (ParameterMethod -> ParameterMethod -> ParameterMethod)
-> (ParameterMethod -> ParameterMethod -> ParameterMethod)
-> Ord ParameterMethod
ParameterMethod -> ParameterMethod -> Bool
ParameterMethod -> ParameterMethod -> Ordering
ParameterMethod -> ParameterMethod -> ParameterMethod
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 :: ParameterMethod -> ParameterMethod -> ParameterMethod
$cmin :: ParameterMethod -> ParameterMethod -> ParameterMethod
max :: ParameterMethod -> ParameterMethod -> ParameterMethod
$cmax :: ParameterMethod -> ParameterMethod -> ParameterMethod
>= :: ParameterMethod -> ParameterMethod -> Bool
$c>= :: ParameterMethod -> ParameterMethod -> Bool
> :: ParameterMethod -> ParameterMethod -> Bool
$c> :: ParameterMethod -> ParameterMethod -> Bool
<= :: ParameterMethod -> ParameterMethod -> Bool
$c<= :: ParameterMethod -> ParameterMethod -> Bool
< :: ParameterMethod -> ParameterMethod -> Bool
$c< :: ParameterMethod -> ParameterMethod -> Bool
compare :: ParameterMethod -> ParameterMethod -> Ordering
$ccompare :: ParameterMethod -> ParameterMethod -> Ordering
$cp1Ord :: Eq ParameterMethod
Ord, Typeable ParameterMethod
DataType
Constr
Typeable ParameterMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ParameterMethod -> c ParameterMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParameterMethod)
-> (ParameterMethod -> Constr)
-> (ParameterMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParameterMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ParameterMethod))
-> ((forall b. Data b => b -> b)
    -> ParameterMethod -> ParameterMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ParameterMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParameterMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ParameterMethod -> m ParameterMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParameterMethod -> m ParameterMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParameterMethod -> m ParameterMethod)
-> Data ParameterMethod
ParameterMethod -> DataType
ParameterMethod -> Constr
(forall b. Data b => b -> b) -> ParameterMethod -> ParameterMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterMethod -> c ParameterMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterMethod
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) -> ParameterMethod -> u
forall u. (forall d. Data d => d -> u) -> ParameterMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterMethod -> c ParameterMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterMethod)
$cQueryString :: Constr
$cRequestEntityBody :: Constr
$cAuthorizationHeader :: Constr
$tParameterMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
gmapMp :: (forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
gmapM :: (forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParameterMethod -> m ParameterMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> ParameterMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParameterMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> ParameterMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r
gmapT :: (forall b. Data b => b -> b) -> ParameterMethod -> ParameterMethod
$cgmapT :: (forall b. Data b => b -> b) -> ParameterMethod -> ParameterMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ParameterMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterMethod)
dataTypeOf :: ParameterMethod -> DataType
$cdataTypeOf :: ParameterMethod -> DataType
toConstr :: ParameterMethod -> Constr
$ctoConstr :: ParameterMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterMethod -> c ParameterMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterMethod -> c ParameterMethod
$cp1Data :: Typeable ParameterMethod
Data, Typeable )

-- | OAuth culminates in the creation of the @oauth_signature@ which
-- signs and authenticates the request using the secret components of
-- a particular OAuth 'Network.OAuth.Types.Credentials.Cred'.
--
-- Several methods exist for generating these signatures, the most
-- popular being 'HmacSha1'.
data SignatureMethod = HmacSha1
                     | Plaintext
                     deriving ( Int -> SignatureMethod -> ShowS
[SignatureMethod] -> ShowS
SignatureMethod -> String
(Int -> SignatureMethod -> ShowS)
-> (SignatureMethod -> String)
-> ([SignatureMethod] -> ShowS)
-> Show SignatureMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureMethod] -> ShowS
$cshowList :: [SignatureMethod] -> ShowS
show :: SignatureMethod -> String
$cshow :: SignatureMethod -> String
showsPrec :: Int -> SignatureMethod -> ShowS
$cshowsPrec :: Int -> SignatureMethod -> ShowS
Show, SignatureMethod -> SignatureMethod -> Bool
(SignatureMethod -> SignatureMethod -> Bool)
-> (SignatureMethod -> SignatureMethod -> Bool)
-> Eq SignatureMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureMethod -> SignatureMethod -> Bool
$c/= :: SignatureMethod -> SignatureMethod -> Bool
== :: SignatureMethod -> SignatureMethod -> Bool
$c== :: SignatureMethod -> SignatureMethod -> Bool
Eq, Eq SignatureMethod
Eq SignatureMethod
-> (SignatureMethod -> SignatureMethod -> Ordering)
-> (SignatureMethod -> SignatureMethod -> Bool)
-> (SignatureMethod -> SignatureMethod -> Bool)
-> (SignatureMethod -> SignatureMethod -> Bool)
-> (SignatureMethod -> SignatureMethod -> Bool)
-> (SignatureMethod -> SignatureMethod -> SignatureMethod)
-> (SignatureMethod -> SignatureMethod -> SignatureMethod)
-> Ord SignatureMethod
SignatureMethod -> SignatureMethod -> Bool
SignatureMethod -> SignatureMethod -> Ordering
SignatureMethod -> SignatureMethod -> SignatureMethod
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 :: SignatureMethod -> SignatureMethod -> SignatureMethod
$cmin :: SignatureMethod -> SignatureMethod -> SignatureMethod
max :: SignatureMethod -> SignatureMethod -> SignatureMethod
$cmax :: SignatureMethod -> SignatureMethod -> SignatureMethod
>= :: SignatureMethod -> SignatureMethod -> Bool
$c>= :: SignatureMethod -> SignatureMethod -> Bool
> :: SignatureMethod -> SignatureMethod -> Bool
$c> :: SignatureMethod -> SignatureMethod -> Bool
<= :: SignatureMethod -> SignatureMethod -> Bool
$c<= :: SignatureMethod -> SignatureMethod -> Bool
< :: SignatureMethod -> SignatureMethod -> Bool
$c< :: SignatureMethod -> SignatureMethod -> Bool
compare :: SignatureMethod -> SignatureMethod -> Ordering
$ccompare :: SignatureMethod -> SignatureMethod -> Ordering
$cp1Ord :: Eq SignatureMethod
Ord, Typeable SignatureMethod
DataType
Constr
Typeable SignatureMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SignatureMethod -> c SignatureMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SignatureMethod)
-> (SignatureMethod -> Constr)
-> (SignatureMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SignatureMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SignatureMethod))
-> ((forall b. Data b => b -> b)
    -> SignatureMethod -> SignatureMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SignatureMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SignatureMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SignatureMethod -> m SignatureMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SignatureMethod -> m SignatureMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SignatureMethod -> m SignatureMethod)
-> Data SignatureMethod
SignatureMethod -> DataType
SignatureMethod -> Constr
(forall b. Data b => b -> b) -> SignatureMethod -> SignatureMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignatureMethod -> c SignatureMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignatureMethod
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) -> SignatureMethod -> u
forall u. (forall d. Data d => d -> u) -> SignatureMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignatureMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignatureMethod -> c SignatureMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignatureMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SignatureMethod)
$cPlaintext :: Constr
$cHmacSha1 :: Constr
$tSignatureMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
gmapMp :: (forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
gmapM :: (forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SignatureMethod -> m SignatureMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> SignatureMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SignatureMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> SignatureMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SignatureMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r
gmapT :: (forall b. Data b => b -> b) -> SignatureMethod -> SignatureMethod
$cgmapT :: (forall b. Data b => b -> b) -> SignatureMethod -> SignatureMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SignatureMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SignatureMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SignatureMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SignatureMethod)
dataTypeOf :: SignatureMethod -> DataType
$cdataTypeOf :: SignatureMethod -> DataType
toConstr :: SignatureMethod -> Constr
$ctoConstr :: SignatureMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignatureMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SignatureMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignatureMethod -> c SignatureMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SignatureMethod -> c SignatureMethod
$cp1Data :: Typeable SignatureMethod
Data, Typeable )

instance H.QueryValueLike SignatureMethod where
  toQueryValue :: SignatureMethod -> Maybe ByteString
toQueryValue SignatureMethod
HmacSha1  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"HMAC-SHA1"
  toQueryValue SignatureMethod
Plaintext = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"PLAINTEXT"

-- | OAuth has progressed through several versions since its inception. In
-- particular, there are two community editions \"OAuth Core 1.0\" (2007)
-- <<http://oauth.net/core/1.0>> and \"OAuth Core 1.0a\" (2009)
-- <<http://oauth.net/core/1.0a>> along with the IETF Official version RFC
-- 5849 (2010) <<http://tools.ietf.org/html/rfc5849>> which is confusingly
-- named "OAuth 1.0".
--
-- /Servers which only implement the obsoleted community edition \"OAuth
-- Core 1.0\" are susceptible to a session fixation attack./
--
-- If at all possible, choose the RFC 5849 version (the 'OAuth1' value) as
-- it is the modern standard. Some servers may only be compliant with an
-- earlier OAuth version---this should be tested against each server, in
-- particular the protocols defined in "Network.OAuth.ThreeLegged".
data Version = OAuthCommunity1
             -- ^ OAuth Core 1.0 Community Edition
             -- <<http://oauth.net/core/1.0>>
             | OAuthCommunity1a
             -- ^ OAuth Core 1.0 Community Edition, Revision
             -- A <<http://oauth.net/core/1.0a>>
             | OAuth1
             -- ^ RFC 5849 <<http://tools.ietf.org/html/rfc5849>>
  deriving ( Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, Typeable Version
DataType
Constr
Typeable Version
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Version -> c Version)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Version)
-> (Version -> Constr)
-> (Version -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Version))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version))
-> ((forall b. Data b => b -> b) -> Version -> Version)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Version -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Version -> r)
-> (forall u. (forall d. Data d => d -> u) -> Version -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Version -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Version -> m Version)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Version -> m Version)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Version -> m Version)
-> Data Version
Version -> DataType
Version -> Constr
(forall b. Data b => b -> b) -> Version -> Version
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
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) -> Version -> u
forall u. (forall d. Data d => d -> u) -> Version -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Version -> m Version
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Version)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
$cOAuth1 :: Constr
$cOAuthCommunity1a :: Constr
$cOAuthCommunity1 :: Constr
$tVersion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Version -> m Version
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapMp :: (forall d. Data d => d -> m d) -> Version -> m Version
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapM :: (forall d. Data d => d -> m d) -> Version -> m Version
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapQi :: Int -> (forall d. Data d => d -> u) -> Version -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Version -> u
gmapQ :: (forall d. Data d => d -> u) -> Version -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Version -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
gmapT :: (forall b. Data b => b -> b) -> Version -> Version
$cgmapT :: (forall b. Data b => b -> b) -> Version -> Version
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Version)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Version)
dataTypeOf :: Version -> DataType
$cdataTypeOf :: Version -> DataType
toConstr :: Version -> Constr
$ctoConstr :: Version -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
$cp1Data :: Typeable Version
Data, Typeable )

-- | All three OAuth 1.0 versions confusingly report the same version
-- number.
instance H.QueryValueLike Version where
  toQueryValue :: Version -> Maybe ByteString
toQueryValue Version
OAuthCommunity1  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1.0"
  toQueryValue Version
OAuthCommunity1a = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1.0"
  toQueryValue Version
OAuth1           = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1.0"

-- | When performing the second leg of the three-leg token request workflow,
-- the user must pass the @oauth_verifier@ code back to the client. In order to
-- ensure that this protocol is secure, OAuth demands that the client
-- associates this \"callback method\" with the temporary credentials generated
-- for the workflow. This 'Callback' method may be a URL where the parameters
-- are returned to or the string @\"oob\"@ which indicates that the user is
-- responsible for returning the @oauth_verifier@ to the client 'OutOfBand'.
data Callback = OutOfBand | Callback Client.Request
  deriving ( Typeable )

instance Show Callback where
  show :: Callback -> String
show Callback
OutOfBand = String
"OutOfBand"
  show (Callback Request
req) = String
"Callback <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show (Request -> URI
Client.getUri Request
req) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- | Prints out in Epoch time format, a printed integer
instance H.QueryValueLike Callback where
  toQueryValue :: Callback -> Maybe ByteString
toQueryValue Callback
OutOfBand      = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"oob"
  toQueryValue (Callback Request
req) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Request -> ByteString) -> Request -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
pctEncode (ByteString -> ByteString)
-> (Request -> ByteString) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
S8.pack (String -> ByteString)
-> (Request -> String) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> String) -> (Request -> URI) -> Request -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> URI
Client.getUri (Request -> Maybe ByteString) -> Request -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request
req

-- | An Epoch time format timestamp.
newtype Timestamp = Timestamp UTCTime deriving ( Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timestamp] -> ShowS
$cshowList :: [Timestamp] -> ShowS
show :: Timestamp -> String
$cshow :: Timestamp -> String
showsPrec :: Int -> Timestamp -> ShowS
$cshowsPrec :: Int -> Timestamp -> ShowS
Show, Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c== :: Timestamp -> Timestamp -> Bool
Eq, Eq Timestamp
Eq Timestamp
-> (Timestamp -> Timestamp -> Ordering)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Ord Timestamp
Timestamp -> Timestamp -> Bool
Timestamp -> Timestamp -> Ordering
Timestamp -> Timestamp -> Timestamp
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 :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmax :: Timestamp -> Timestamp -> Timestamp
>= :: Timestamp -> Timestamp -> Bool
$c>= :: Timestamp -> Timestamp -> Bool
> :: Timestamp -> Timestamp -> Bool
$c> :: Timestamp -> Timestamp -> Bool
<= :: Timestamp -> Timestamp -> Bool
$c<= :: Timestamp -> Timestamp -> Bool
< :: Timestamp -> Timestamp -> Bool
$c< :: Timestamp -> Timestamp -> Bool
compare :: Timestamp -> Timestamp -> Ordering
$ccompare :: Timestamp -> Timestamp -> Ordering
$cp1Ord :: Eq Timestamp
Ord, Typeable Timestamp
DataType
Constr
Typeable Timestamp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Timestamp -> c Timestamp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Timestamp)
-> (Timestamp -> Constr)
-> (Timestamp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Timestamp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp))
-> ((forall b. Data b => b -> b) -> Timestamp -> Timestamp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Timestamp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Timestamp -> r)
-> (forall u. (forall d. Data d => d -> u) -> Timestamp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Timestamp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> Data Timestamp
Timestamp -> DataType
Timestamp -> Constr
(forall b. Data b => b -> b) -> Timestamp -> Timestamp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
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) -> Timestamp -> u
forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Timestamp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
$cTimestamp :: Constr
$tTimestamp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapMp :: (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapM :: (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapQi :: Int -> (forall d. Data d => d -> u) -> Timestamp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
gmapQ :: (forall d. Data d => d -> u) -> Timestamp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
gmapT :: (forall b. Data b => b -> b) -> Timestamp -> Timestamp
$cgmapT :: (forall b. Data b => b -> b) -> Timestamp -> Timestamp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Timestamp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Timestamp)
dataTypeOf :: Timestamp -> DataType
$cdataTypeOf :: Timestamp -> DataType
toConstr :: Timestamp -> Constr
$ctoConstr :: Timestamp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
$cp1Data :: Typeable Timestamp
Data, Typeable )

-- | Create a 'Timestamp' deterministically from a POSIX Epoch Time.
timestampFromSeconds :: Integer -> Timestamp
timestampFromSeconds :: Integer -> Timestamp
timestampFromSeconds = UTCTime -> Timestamp
Timestamp (UTCTime -> Timestamp)
-> (Integer -> UTCTime) -> Integer -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Integer -> POSIXTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Prints out in Epoch time format, a printed integer
instance H.QueryValueLike Timestamp where
  toQueryValue :: Timestamp -> Maybe ByteString
toQueryValue (Timestamp UTCTime
u) =
    let i :: Int
i = POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
u) :: Int
    in ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i

-- Server information
--------------------------------------------------------------------------------

-- | The 'Server' information contains details which parameterize how a
-- particular server wants to interpret OAuth requests.
data Server =
  Server { Server -> ParameterMethod
parameterMethod :: ParameterMethod
         , Server -> SignatureMethod
signatureMethod :: SignatureMethod
         , Server -> Version
oAuthVersion    :: Version
         } deriving ( Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
(Int -> Server -> ShowS)
-> (Server -> String) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show, Server -> Server -> Bool
(Server -> Server -> Bool)
-> (Server -> Server -> Bool) -> Eq Server
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Eq, Eq Server
Eq Server
-> (Server -> Server -> Ordering)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Server)
-> (Server -> Server -> Server)
-> Ord Server
Server -> Server -> Bool
Server -> Server -> Ordering
Server -> Server -> Server
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 :: Server -> Server -> Server
$cmin :: Server -> Server -> Server
max :: Server -> Server -> Server
$cmax :: Server -> Server -> Server
>= :: Server -> Server -> Bool
$c>= :: Server -> Server -> Bool
> :: Server -> Server -> Bool
$c> :: Server -> Server -> Bool
<= :: Server -> Server -> Bool
$c<= :: Server -> Server -> Bool
< :: Server -> Server -> Bool
$c< :: Server -> Server -> Bool
compare :: Server -> Server -> Ordering
$ccompare :: Server -> Server -> Ordering
$cp1Ord :: Eq Server
Ord, Typeable Server
DataType
Constr
Typeable Server
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Server -> c Server)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Server)
-> (Server -> Constr)
-> (Server -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Server))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server))
-> ((forall b. Data b => b -> b) -> Server -> Server)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Server -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Server -> r)
-> (forall u. (forall d. Data d => d -> u) -> Server -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Server -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Server -> m Server)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Server -> m Server)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Server -> m Server)
-> Data Server
Server -> DataType
Server -> Constr
(forall b. Data b => b -> b) -> Server -> Server
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
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) -> Server -> u
forall u. (forall d. Data d => d -> u) -> Server -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Server -> m Server
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Server -> m Server
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Server)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server)
$cServer :: Constr
$tServer :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Server -> m Server
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Server -> m Server
gmapMp :: (forall d. Data d => d -> m d) -> Server -> m Server
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Server -> m Server
gmapM :: (forall d. Data d => d -> m d) -> Server -> m Server
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Server -> m Server
gmapQi :: Int -> (forall d. Data d => d -> u) -> Server -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Server -> u
gmapQ :: (forall d. Data d => d -> u) -> Server -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Server -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
gmapT :: (forall b. Data b => b -> b) -> Server -> Server
$cgmapT :: (forall b. Data b => b -> b) -> Server -> Server
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Server)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Server)
dataTypeOf :: Server -> DataType
$cdataTypeOf :: Server -> DataType
toConstr :: Server -> Constr
$ctoConstr :: Server -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
$cp1Data :: Typeable Server
Data, Typeable )

-- | The default 'Server' parameterization uses OAuth recommended parameters.
defaultServer :: Server
defaultServer :: Server
defaultServer = ParameterMethod -> SignatureMethod -> Version -> Server
Server ParameterMethod
AuthorizationHeader SignatureMethod
HmacSha1 Version
OAuth1

-- Params
--------------------------------------------------------------------------------

-- | A 'Verifier' is produced when a user authorizes a set of 'Temporary'
-- 'Cred's. Using the 'Verifier' allows the client to request 'Permanent'
-- 'Cred's.
type Verifier = S.ByteString

-- | Some special OAuth requests use extra @oauth_*@ parameters. For example,
-- when requesting a temporary credential, it's necessary that a
-- @oauth_callback@ parameter be specified. 'WorkflowParams' allows these extra
-- parameters to be specified.
data Workflow = Standard
                -- ^ No special OAuth parameters needed
              | TemporaryTokenRequest Callback
              | PermanentTokenRequest S.ByteString
                -- ^ Includes the @oauth_verifier@
  deriving ( Int -> Workflow -> ShowS
[Workflow] -> ShowS
Workflow -> String
(Int -> Workflow -> ShowS)
-> (Workflow -> String) -> ([Workflow] -> ShowS) -> Show Workflow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Workflow] -> ShowS
$cshowList :: [Workflow] -> ShowS
show :: Workflow -> String
$cshow :: Workflow -> String
showsPrec :: Int -> Workflow -> ShowS
$cshowsPrec :: Int -> Workflow -> ShowS
Show, Typeable )

-- | The 'OaPin' is a set of impure OAuth parameters which are generated for each
-- request in order to ensure uniqueness and temporality.
data OaPin =
  OaPin { OaPin -> Timestamp
timestamp :: Timestamp
        , OaPin -> ByteString
nonce     :: S.ByteString
        } deriving ( Int -> OaPin -> ShowS
[OaPin] -> ShowS
OaPin -> String
(Int -> OaPin -> ShowS)
-> (OaPin -> String) -> ([OaPin] -> ShowS) -> Show OaPin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OaPin] -> ShowS
$cshowList :: [OaPin] -> ShowS
show :: OaPin -> String
$cshow :: OaPin -> String
showsPrec :: Int -> OaPin -> ShowS
$cshowsPrec :: Int -> OaPin -> ShowS
Show, OaPin -> OaPin -> Bool
(OaPin -> OaPin -> Bool) -> (OaPin -> OaPin -> Bool) -> Eq OaPin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OaPin -> OaPin -> Bool
$c/= :: OaPin -> OaPin -> Bool
== :: OaPin -> OaPin -> Bool
$c== :: OaPin -> OaPin -> Bool
Eq, Eq OaPin
Eq OaPin
-> (OaPin -> OaPin -> Ordering)
-> (OaPin -> OaPin -> Bool)
-> (OaPin -> OaPin -> Bool)
-> (OaPin -> OaPin -> Bool)
-> (OaPin -> OaPin -> Bool)
-> (OaPin -> OaPin -> OaPin)
-> (OaPin -> OaPin -> OaPin)
-> Ord OaPin
OaPin -> OaPin -> Bool
OaPin -> OaPin -> Ordering
OaPin -> OaPin -> OaPin
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 :: OaPin -> OaPin -> OaPin
$cmin :: OaPin -> OaPin -> OaPin
max :: OaPin -> OaPin -> OaPin
$cmax :: OaPin -> OaPin -> OaPin
>= :: OaPin -> OaPin -> Bool
$c>= :: OaPin -> OaPin -> Bool
> :: OaPin -> OaPin -> Bool
$c> :: OaPin -> OaPin -> Bool
<= :: OaPin -> OaPin -> Bool
$c<= :: OaPin -> OaPin -> Bool
< :: OaPin -> OaPin -> Bool
$c< :: OaPin -> OaPin -> Bool
compare :: OaPin -> OaPin -> Ordering
$ccompare :: OaPin -> OaPin -> Ordering
$cp1Ord :: Eq OaPin
Ord, Typeable OaPin
DataType
Constr
Typeable OaPin
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OaPin -> c OaPin)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OaPin)
-> (OaPin -> Constr)
-> (OaPin -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OaPin))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OaPin))
-> ((forall b. Data b => b -> b) -> OaPin -> OaPin)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r)
-> (forall u. (forall d. Data d => d -> u) -> OaPin -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OaPin -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OaPin -> m OaPin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OaPin -> m OaPin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OaPin -> m OaPin)
-> Data OaPin
OaPin -> DataType
OaPin -> Constr
(forall b. Data b => b -> b) -> OaPin -> OaPin
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OaPin -> c OaPin
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OaPin
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) -> OaPin -> u
forall u. (forall d. Data d => d -> u) -> OaPin -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OaPin -> m OaPin
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OaPin -> m OaPin
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OaPin
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OaPin -> c OaPin
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OaPin)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OaPin)
$cOaPin :: Constr
$tOaPin :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OaPin -> m OaPin
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OaPin -> m OaPin
gmapMp :: (forall d. Data d => d -> m d) -> OaPin -> m OaPin
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OaPin -> m OaPin
gmapM :: (forall d. Data d => d -> m d) -> OaPin -> m OaPin
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OaPin -> m OaPin
gmapQi :: Int -> (forall d. Data d => d -> u) -> OaPin -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OaPin -> u
gmapQ :: (forall d. Data d => d -> u) -> OaPin -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OaPin -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OaPin -> r
gmapT :: (forall b. Data b => b -> b) -> OaPin -> OaPin
$cgmapT :: (forall b. Data b => b -> b) -> OaPin -> OaPin
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OaPin)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OaPin)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OaPin)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OaPin)
dataTypeOf :: OaPin -> DataType
$cdataTypeOf :: OaPin -> DataType
toConstr :: OaPin -> Constr
$ctoConstr :: OaPin -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OaPin
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OaPin
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OaPin -> c OaPin
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OaPin -> c OaPin
$cp1Data :: Typeable OaPin
Data, Typeable )

-- | An \"empty\" pin useful for testing. This 'OaPin' is referentially
-- transparent and thus has none of the necessary security features---it should
-- /never/ be used in an actual transaction!
emptyPin :: OaPin
emptyPin :: OaPin
emptyPin = OaPin :: Timestamp -> ByteString -> OaPin
OaPin { timestamp :: Timestamp
timestamp = UTCTime -> Timestamp
Timestamp (Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
0) DiffTime
0)
                 , nonce :: ByteString
nonce     = ByteString
"\0\0\0\0\0"
                 }

-- | Creates a new, unique, unpredictable 'OaPin'. This should be used quickly
-- as dependent on the OAuth server settings it may expire.
freshPin :: (MonadRandom m, MonadIO m) => m OaPin
freshPin :: m OaPin
freshPin = do
  Timestamp
t <- UTCTime -> Timestamp
Timestamp (UTCTime -> Timestamp) -> m UTCTime -> m Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  ByteString
n <- ByteString -> ByteString
S64.encode (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
8
  OaPin -> m OaPin
forall (m :: * -> *) a. Monad m => a -> m a
return OaPin :: Timestamp -> ByteString -> OaPin
OaPin { timestamp :: Timestamp
timestamp = Timestamp
t, nonce :: ByteString
nonce = ByteString
n }

-- | Uses 'emptyPin' to create an empty set of params 'Oa'.
emptyOa :: Cred ty -> Oa ty
emptyOa :: Cred ty -> Oa ty
emptyOa Cred ty
creds =
  Oa :: forall ty. Cred ty -> Workflow -> OaPin -> Oa ty
Oa { credentials :: Cred ty
credentials = Cred ty
creds, workflow :: Workflow
workflow = Workflow
Standard, pin :: OaPin
pin = OaPin
emptyPin }

-- | Uses 'freshPin' to create a fresh, default set of params 'Oa'.
freshOa :: (MonadRandom m, MonadIO m) => Cred ty -> m (Oa ty)
freshOa :: Cred ty -> m (Oa ty)
freshOa Cred ty
creds = do
  OaPin
pinx <- m OaPin
forall (m :: * -> *). (MonadRandom m, MonadIO m) => m OaPin
freshPin
  Oa ty -> m (Oa ty)
forall (m :: * -> *) a. Monad m => a -> m a
return Oa :: forall ty. Cred ty -> Workflow -> OaPin -> Oa ty
Oa { credentials :: Cred ty
credentials = Cred ty
creds, workflow :: Workflow
workflow = Workflow
Standard, pin :: OaPin
pin = OaPin
pinx }

-- | The 'Oa' parameters include all the OAuth information specific to a single
-- request. They are not sufficient information by themselves to generate the
-- entire OAuth request but instead must be augmented with 'Server' information.
data Oa ty =
  Oa { Oa ty -> Cred ty
credentials :: Cred ty
     , Oa ty -> Workflow
workflow    :: Workflow
     , Oa ty -> OaPin
pin         :: OaPin
     }
  deriving ( Int -> Oa ty -> ShowS
[Oa ty] -> ShowS
Oa ty -> String
(Int -> Oa ty -> ShowS)
-> (Oa ty -> String) -> ([Oa ty] -> ShowS) -> Show (Oa ty)
forall ty. Int -> Oa ty -> ShowS
forall ty. [Oa ty] -> ShowS
forall ty. Oa ty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Oa ty] -> ShowS
$cshowList :: forall ty. [Oa ty] -> ShowS
show :: Oa ty -> String
$cshow :: forall ty. Oa ty -> String
showsPrec :: Int -> Oa ty -> ShowS
$cshowsPrec :: forall ty. Int -> Oa ty -> ShowS
Show, Typeable )