oauthenticated-0.3.0.0: Simple OAuth for http-client
Copyright(c) Joseph Abrahamson 2013
LicenseMIT
Maintainerme@jspha.com
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Network.OAuth

Description

OAuth tools for using http-client for authenticated requests.

The functions here form the simplest basis for sending OAuthenticated Requests. In order to generate credentials according to the OAuth "three-legged workflow" use actions in the Network.OAuth.ThreeLegged module.

Synopsis

Authenticating a request

The oauthSimple function can be used to sign a Request as it stands. It should be performed just before the Request is used as it uses the current timestamp and thus may only be valid for a limited amount of time.

oauthSimple creates a new random entropy pool every time it is called, thus it can be both slow and cryptographically dangerous to use it repeatedly as it can drain system entropy. Instead, the plain oauth function should be used which allows for threading of the random source.

oauthSimple :: Cred ty -> Server -> Request -> IO Request Source #

Sign a request with a fresh set of parameters. Uses MonadRandom IO, getting new entropy for each signing and thus is potentially dangerous if used too frequently. In almost all cases, oauth should be used instead with a suitably seeded PRNG.

oauth :: (MonadIO m, MonadRandom m) => Cred ty -> Server -> Request -> m Request Source #

Sign a request with a fresh set of parameters.

Lower-level and pure functionality

When necessary to control or observe the signature more carefully, the lower level API can be used. This requires generating a fresh set of Oa parameters from a relevant or deterministic OaPin and then using sign to sign the Request.

sign :: Oa ty -> Server -> Request -> Request Source #

Sign a request given generated parameters

Generating OAuth parameters

emptyOa :: Cred ty -> Oa ty Source #

Uses emptyPin to create an empty set of params Oa.

freshOa :: (MonadRandom m, MonadIO m) => Cred ty -> m (Oa ty) Source #

Uses freshPin to create a fresh, default set of params Oa.

emptyPin :: OaPin Source #

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!

freshPin :: (MonadRandom m, MonadIO m) => m OaPin Source #

Creates a new, unique, unpredictable OaPin. This should be used quickly as dependent on the OAuth server settings it may expire.

OAuth Credentials

data Token ty Source #

Tokens are public, private key pairs and come in many varieties, Client, Temporary, and Permanent.

Constructors

Token !Key !Secret 

Instances

Instances details
Eq (Token ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

(==) :: Token ty -> Token ty -> Bool #

(/=) :: Token ty -> Token ty -> Bool #

Data ty => Data (Token ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Token ty -> c (Token ty) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Token ty) #

toConstr :: Token ty -> Constr #

dataTypeOf :: Token ty -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Token ty)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Token ty)) #

gmapT :: (forall b. Data b => b -> b) -> Token ty -> Token ty #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token ty -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token ty -> r #

gmapQ :: (forall d. Data d => d -> u) -> Token ty -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Token ty -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Token ty -> m (Token ty) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Token ty -> m (Token ty) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Token ty -> m (Token ty) #

Ord (Token ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

compare :: Token ty -> Token ty -> Ordering #

(<) :: Token ty -> Token ty -> Bool #

(<=) :: Token ty -> Token ty -> Bool #

(>) :: Token ty -> Token ty -> Bool #

(>=) :: Token ty -> Token ty -> Bool #

max :: Token ty -> Token ty -> Token ty #

min :: Token ty -> Token ty -> Token ty #

Show (Token ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

showsPrec :: Int -> Token ty -> ShowS #

show :: Token ty -> String #

showList :: [Token ty] -> ShowS #

ToJSON (Token ty) Source #

Produces a JSON object using keys named oauth_token and oauth_token_secret.

Instance details

Defined in Network.OAuth.Types.Credentials

FromJSON (Token ty) Source #

Parses a JSON object with keys oauth_token and oauth_token_secret, the standard format for OAuth 1.0.

Instance details

Defined in Network.OAuth.Types.Credentials

data Cred ty Source #

Credentials pair a Client Token and either a Temporary or Permanent token corresponding to a particular set of user resources on the server.

Instances

Instances details
Eq (Cred ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

(==) :: Cred ty -> Cred ty -> Bool #

(/=) :: Cred ty -> Cred ty -> Bool #

Data ty => Data (Cred ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Cred ty -> c (Cred ty) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Cred ty) #

toConstr :: Cred ty -> Constr #

dataTypeOf :: Cred ty -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Cred ty)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Cred ty)) #

gmapT :: (forall b. Data b => b -> b) -> Cred ty -> Cred ty #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cred ty -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cred ty -> r #

gmapQ :: (forall d. Data d => d -> u) -> Cred ty -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Cred ty -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Cred ty -> m (Cred ty) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Cred ty -> m (Cred ty) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Cred ty -> m (Cred ty) #

Ord (Cred ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

compare :: Cred ty -> Cred ty -> Ordering #

(<) :: Cred ty -> Cred ty -> Bool #

(<=) :: Cred ty -> Cred ty -> Bool #

(>) :: Cred ty -> Cred ty -> Bool #

(>=) :: Cred ty -> Cred ty -> Bool #

max :: Cred ty -> Cred ty -> Cred ty #

min :: Cred ty -> Cred ty -> Cred ty #

Show (Cred ty) Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

showsPrec :: Int -> Cred ty -> ShowS #

show :: Cred ty -> String #

showList :: [Cred ty] -> ShowS #

data Client Source #

Client Credentials and Tokens are assigned to a particular client by the server and are used for all requests sent by that client. They form the core component of resource specific credentials.

Instances

Instances details
Data Client Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Client -> c Client #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Client #

toConstr :: Client -> Constr #

dataTypeOf :: Client -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Client) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Client) #

gmapT :: (forall b. Data b => b -> b) -> Client -> Client #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Client -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Client -> r #

gmapQ :: (forall d. Data d => d -> u) -> Client -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Client -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Client -> m Client #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Client -> m Client #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Client -> m Client #

data Temporary Source #

Temporary Tokens and Credentials are created during authorization protocols and are rarely meant to be kept for more than a few minutes. Typically they are authorized to access only a very select set of server resources. During "three-legged authorization" in OAuth 1.0 they are used to generate the authorization request URI the client sends and, after that, in the Permanent Token request.

Instances

Instances details
Data Temporary Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Temporary -> c Temporary #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Temporary #

toConstr :: Temporary -> Constr #

dataTypeOf :: Temporary -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Temporary) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Temporary) #

gmapT :: (forall b. Data b => b -> b) -> Temporary -> Temporary #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Temporary -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Temporary -> r #

gmapQ :: (forall d. Data d => d -> u) -> Temporary -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Temporary -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Temporary -> m Temporary #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Temporary -> m Temporary #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Temporary -> m Temporary #

ResourceToken Temporary Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

data Permanent Source #

Permanent Tokens and Credentials are the primary means of accessing server resources. They must be maintained by the client for each user who authorizes that client to access resources on their behalf.

Instances

Instances details
Data Permanent Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Permanent -> c Permanent #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Permanent #

toConstr :: Permanent -> Constr #

dataTypeOf :: Permanent -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Permanent) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Permanent) #

gmapT :: (forall b. Data b => b -> b) -> Permanent -> Permanent #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Permanent -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Permanent -> r #

gmapQ :: (forall d. Data d => d -> u) -> Permanent -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Permanent -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Permanent -> m Permanent #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Permanent -> m Permanent #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Permanent -> m Permanent #

ResourceToken Permanent Source # 
Instance details

Defined in Network.OAuth.Types.Credentials

Creating Credentials

fromUrlEncoded :: ByteString -> Maybe (Bool, Token ty) Source #

Parses a www-form-urlencoded stream to produce a Token if possible. The first result value is whether or not the token data is OAuth 1.0a compatible.

>>> fromUrlEncoded "oauth_token=key&oauth_token_secret=secret"
Just (False, Token "key" "secret")
>>> fromUrlEncoded "oauth_token=key&oauth_token_secret=secret&oauth_callback_confirmed=true"
Just (True, Token "key" "secret")

OAuth Configuration

data Server Source #

The Server information contains details which parameterize how a particular server wants to interpret OAuth requests.

Instances

Instances details
Eq Server Source # 
Instance details

Defined in Network.OAuth.Types.Params

Methods

(==) :: Server -> Server -> Bool #

(/=) :: Server -> Server -> Bool #

Data Server Source # 
Instance details

Defined in Network.OAuth.Types.Params

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Server -> c Server #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Server #

toConstr :: Server -> Constr #

dataTypeOf :: Server -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Server) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server) #

gmapT :: (forall b. Data b => b -> b) -> Server -> Server #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r #

gmapQ :: (forall d. Data d => d -> u) -> Server -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Server -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Server -> m Server #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Server -> m Server #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Server -> m Server #

Ord Server Source # 
Instance details

Defined in Network.OAuth.Types.Params

Show Server Source # 
Instance details

Defined in Network.OAuth.Types.Params

defaultServer :: Server Source #

The default Server parameterization uses OAuth recommended parameters.

data ParameterMethod Source #

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.

Constructors

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.

Instances

Instances details
Eq ParameterMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

Data ParameterMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ParameterMethod -> c ParameterMethod #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ParameterMethod #

toConstr :: ParameterMethod -> Constr #

dataTypeOf :: ParameterMethod -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ParameterMethod) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParameterMethod) #

gmapT :: (forall b. Data b => b -> b) -> ParameterMethod -> ParameterMethod #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ParameterMethod -> r #

gmapQ :: (forall d. Data d => d -> u) -> ParameterMethod -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ParameterMethod -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ParameterMethod -> m ParameterMethod #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ParameterMethod -> m ParameterMethod #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ParameterMethod -> m ParameterMethod #

Ord ParameterMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

Show ParameterMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

data SignatureMethod Source #

OAuth culminates in the creation of the oauth_signature which signs and authenticates the request using the secret components of a particular OAuth Cred.

Several methods exist for generating these signatures, the most popular being HmacSha1.

Constructors

HmacSha1 
Plaintext 

Instances

Instances details
Eq SignatureMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

Data SignatureMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SignatureMethod -> c SignatureMethod #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SignatureMethod #

toConstr :: SignatureMethod -> Constr #

dataTypeOf :: SignatureMethod -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c SignatureMethod) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SignatureMethod) #

gmapT :: (forall b. Data b => b -> b) -> SignatureMethod -> SignatureMethod #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SignatureMethod -> r #

gmapQ :: (forall d. Data d => d -> u) -> SignatureMethod -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SignatureMethod -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SignatureMethod -> m SignatureMethod #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SignatureMethod -> m SignatureMethod #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SignatureMethod -> m SignatureMethod #

Ord SignatureMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

Show SignatureMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

QueryValueLike SignatureMethod Source # 
Instance details

Defined in Network.OAuth.Types.Params

data Version Source #

OAuth has progressed through several versions since its inception. In particular, there are two community editions "OAuth Core 1.0" (2007) and "OAuth Core 1.0a" (2009) along with the IETF Official version RFC 5849 (2010) 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.

Constructors

OAuthCommunity1

OAuth Core 1.0 Community Edition

OAuthCommunity1a

OAuth Core 1.0 Community Edition, Revision A

OAuth1

RFC 5849

Instances

Instances details
Eq Version Source # 
Instance details

Defined in Network.OAuth.Types.Params

Methods

(==) :: Version -> Version -> Bool #

(/=) :: Version -> Version -> Bool #

Data Version Source # 
Instance details

Defined in Network.OAuth.Types.Params

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Version -> c Version #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Version #

toConstr :: Version -> Constr #

dataTypeOf :: Version -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Version) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version) #

gmapT :: (forall b. Data b => b -> b) -> Version -> Version #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Version -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Version -> r #

gmapQ :: (forall d. Data d => d -> u) -> Version -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Version -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Version -> m Version #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Version -> m Version #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Version -> m Version #

Ord Version Source # 
Instance details

Defined in Network.OAuth.Types.Params

Show Version Source # 
Instance details

Defined in Network.OAuth.Types.Params

QueryValueLike Version Source #

All three OAuth 1.0 versions confusingly report the same version number.

Instance details

Defined in Network.OAuth.Types.Params