| Copyright | (c) Joseph Abrahamson 2013 |
|---|---|
| License | MIT |
| Maintainer | me@jspha.com |
| Stability | experimental |
| Portability | non-portable |
| Safe Haskell | None |
| Language | Haskell2010 |
Network.OAuth.Simple
Description
Simplified Monadic interface for managing http-client and
oauthenticated state. Re-exposes all of the functionality from
Network.OAuth and Network.OAuth.ThreeLegged.
Synopsis
- oauth :: MonadIO m => Request -> OAuthT ty m Request
- runOAuthSimple :: OAuth ty a -> Cred ty -> IO a
- runOAuth :: OAuth ty a -> Cred ty -> Server -> ThreeLegged -> IO a
- runOAuthT :: MonadIO m => OAuthT ty m a -> Cred ty -> Server -> ThreeLegged -> m a
- newtype OAuthT ty m a = OAuthT {}
- type OAuth ty = OAuthT ty IO
- upgradeCred :: (ResourceToken ty', Monad m) => Token ty' -> OAuthT ty m (Cred ty')
- upgrade :: (ResourceToken ty', Monad m) => Token ty' -> OAuthT ty' m a -> OAuthT ty m a
- 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
- data ThreeLegged = ThreeLegged {}
- parseThreeLegged :: String -> String -> String -> Callback -> Maybe ThreeLegged
- data Callback
- type Verifier = ByteString
- requestTemporaryToken :: MonadIO m => Manager -> OAuthT Client m (Response (Either ByteString (Token Temporary)))
- buildAuthorizationUrl :: Monad m => OAuthT Temporary m URI
- requestPermanentToken :: MonadIO m => Manager -> Verifier -> OAuthT Temporary m (Response (Either ByteString (Token Permanent)))
- requestTokenProtocol :: (Functor m, MonadIO m, MonadCatch m) => Manager -> (URI -> m Verifier) -> OAuthT Client m (Either TokenRequestFailure (Cred Permanent))
- data TokenRequestFailure
A monad for authenticated requests
Network.OAuth.Simple re-exports the Network.OAuth and
Network.Oauth.ThreeLegged interfaces using the obvious StateT and ReaderT
wrappers for tracking configuration, credentials, and random generator state.
Managing Manager state is out of scope for this module, but since OAuthT
is a monad transformer, it's easy enough to add another layer with the needed
state.
oauth :: MonadIO m => Request -> OAuthT ty m Request Source #
Sign a request using fresh credentials.
runOAuthSimple :: OAuth ty a -> Cred ty -> IO a Source #
The simplest way to execute a set of authenticated requests. Produces
invalid ThreeLegged requests---use runOAuth to provide Server and
ThreeLegged configuration information.
More sophisticated interface
runOAuthT :: MonadIO m => OAuthT ty m a -> Cred ty -> Server -> ThreeLegged -> m a Source #
Run's an OAuthT using a fresh EntropyPool.
newtype OAuthT ty m a Source #
Instances
| MonadTrans (OAuthT ty) Source # | |
Defined in Network.OAuth.Simple | |
| Monad m => Monad (OAuthT ty m) Source # | |
| Functor m => Functor (OAuthT ty m) Source # | |
| Applicative m => Applicative (OAuthT ty m) Source # | |
Defined in Network.OAuth.Simple | |
| MonadIO m => MonadIO (OAuthT ty m) Source # | |
Defined in Network.OAuth.Simple | |
| MonadThrow m => MonadThrow (OAuthT ty m) Source # | |
Defined in Network.OAuth.Simple | |
| MonadCatch m => MonadCatch (OAuthT ty m) Source # | |
Configuration management
upgradeCred :: (ResourceToken ty', Monad m) => Token ty' -> OAuthT ty m (Cred ty') Source #
upgrade :: (ResourceToken ty', Monad m) => Token ty' -> OAuthT ty' m a -> OAuthT ty m a Source #
Given a ResourceToken of some kind, run an inner OAuthT session
with the same configuration but new credentials.
Configuration re-exports
OAuth Credentials
Instances
| Eq (Token ty) Source # | |
| Data ty => Data (Token ty) Source # | |
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 # | |
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 |
Credentials 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 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 # | |
Defined in Network.OAuth.Types.Credentials | |
| Show (Cred ty) 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
| Data Client Source # | |
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 # | |
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
| Data Temporary Source # | |
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 # | |
Defined in Network.OAuth.Types.Credentials | |
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
| Data Permanent Source # | |
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 # | |
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.
Constructors
| Server | |
Fields | |
Instances
| Eq Server Source # | |
| Data Server Source # | |
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 # | |
| 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.
Constructors
| 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.
Constructors
| 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 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 # | |
Defined in Network.OAuth.Types.Params | |
| Show Version Source # | |
| QueryValueLike Version Source # | All three OAuth 1.0 versions confusingly report the same version number. |
Defined in Network.OAuth.Types.Params Methods toQueryValue :: Version -> Maybe ByteString # | |
Three-Legged Authorization
Configuration types
data ThreeLegged Source #
Data parameterizing the "Three-legged OAuth" redirection-based authorization protocol. These parameters cover the protocol as described in the community editions OAuth Core 1.0 and OAuth Core 1.0a as well as RFC 5849.
Constructors
| ThreeLegged | |
Fields
| |
Instances
| Show ThreeLegged Source # | |
Defined in Network.OAuth.ThreeLegged Methods showsPrec :: Int -> ThreeLegged -> ShowS # show :: ThreeLegged -> String # showList :: [ThreeLegged] -> ShowS # | |
parseThreeLegged :: String -> String -> String -> Callback -> Maybe ThreeLegged Source #
Convenience method for creating a ThreeLegged configuration from
a trio of URLs and a Callback. Returns Nothing if one of the
callback URLs could not be parsed correctly.
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.
Instances
| Show Callback Source # | |
| QueryValueLike Callback Source # | Prints out in Epoch time format, a printed integer |
Defined in Network.OAuth.Types.Params Methods toQueryValue :: Callback -> Maybe ByteString # | |
type Verifier = ByteString Source #
Actions
requestTemporaryToken :: MonadIO m => Manager -> OAuthT Client m (Response (Either ByteString (Token Temporary))) Source #
requestPermanentToken :: MonadIO m => Manager -> Verifier -> OAuthT Temporary m (Response (Either ByteString (Token Permanent))) Source #
Example System
requestTokenProtocol :: (Functor m, MonadIO m, MonadCatch m) => Manager -> (URI -> m Verifier) -> OAuthT Client m (Either TokenRequestFailure (Cred Permanent)) Source #
Run a full Three-legged authorization protocol using the simple interface
of this module. This is similar to the requestTokenProtocol in
Network.OAuth.ThreeLegged, but offers better error handling due in part to
the easier management of configuration state.
data TokenRequestFailure Source #
Constructors
| OnTemporaryRequest HttpException | |
| BadTemporaryToken ByteString | |
| OnPermanentRequest HttpException | |
| BadPermanentToken ByteString |
Instances
| Show TokenRequestFailure Source # | |
Defined in Network.OAuth.Simple Methods showsPrec :: Int -> TokenRequestFailure -> ShowS # show :: TokenRequestFailure -> String # showList :: [TokenRequestFailure] -> ShowS # | |