Copyright | (c) Joseph Abrahamson 2013 |
---|---|
License | MIT |
Maintainer | me@jspha.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
OAuth tools for using http-client
for authenticated requests.
The functions here form the simplest basis for sending OAuthenticated
Request
s. In order to generate credentials according to the OAuth
"three-legged workflow" use actions in the Network.OAuth.ThreeLegged
module.
Synopsis
- oauthSimple :: Cred ty -> Server -> Request -> IO Request
- oauth :: (MonadIO m, MonadRandom m) => Cred ty -> Server -> Request -> m Request
- sign :: Oa ty -> Server -> Request -> Request
- emptyOa :: Cred ty -> Oa ty
- freshOa :: (MonadRandom m, MonadIO m) => Cred ty -> m (Oa ty)
- emptyPin :: OaPin
- freshPin :: (MonadRandom m, MonadIO m) => m OaPin
- data Token ty = Token !Key !Secret
- data Cred ty
- data Client
- data Temporary
- data Permanent
- clientCred :: Token Client -> Cred Client
- temporaryCred :: Token Temporary -> Cred Client -> Cred Temporary
- permanentCred :: Token Permanent -> Cred Client -> Cred Permanent
- fromUrlEncoded :: ByteString -> Maybe (Bool, Token ty)
- data Server = Server {}
- defaultServer :: Server
- data ParameterMethod
- data SignatureMethod
- data Version
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
.
Generating OAuth parameters
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
Instances
Eq (Token ty) Source # | |
Data ty => Data (Token ty) Source # | |
Defined in Network.OAuth.Types.Credentials 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 # | |
Defined in Network.OAuth.Types.Credentials | |
Show (Token ty) Source # | |
ToJSON (Token ty) Source # | Produces a JSON object using keys named |
Defined in Network.OAuth.Types.Credentials | |
FromJSON (Token ty) Source # | Parses a JSON object with keys |
Cred
entials pair a Client
Token
and either a Temporary
or
Permanent
token corresponding to a particular set of user
resources on the server.
Instances
Eq (Cred ty) Source # | |
Data ty => Data (Cred ty) Source # | |
Defined in Network.OAuth.Types.Credentials 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 # | |
Defined in Network.OAuth.Types.Credentials | |
Show (Cred ty) Source # | |
Client
Cred
entials and Token
s 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
Data Client Source # | |
Defined in Network.OAuth.Types.Credentials 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 # |
Temporary
Token
s and Cred
entials 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
Data Temporary Source # | |
Defined in Network.OAuth.Types.Credentials 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 # | |
Defined in Network.OAuth.Types.Credentials |
Permanent
Token
s and Cred
entials 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
Data Permanent Source # | |
Defined in Network.OAuth.Types.Credentials 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 # | |
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
The Server
information contains details which parameterize how a
particular server wants to interpret OAuth requests.
Instances
Eq Server Source # | |
Data Server Source # | |
Defined in Network.OAuth.Types.Params 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 # | |
Show Server Source # | |
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.
AuthorizationHeader | Place the |
RequestEntityBody | Augment the |
QueryString | Augment the |
Instances
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
.
Instances
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.
OAuthCommunity1 | OAuth Core 1.0 Community Edition |
OAuthCommunity1a | OAuth Core 1.0 Community Edition, Revision A |
OAuth1 | RFC 5849 |
Instances
Eq Version Source # | |
Data Version Source # | |
Defined in Network.OAuth.Types.Params 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 # | |
Show Version Source # | |
QueryValueLike Version Source # | All three OAuth 1.0 versions confusingly report the same version number. |
Defined in Network.OAuth.Types.Params toQueryValue :: Version -> Maybe ByteString # |