| Copyright | (c) Joseph Abrahamson 2013 |
|---|---|
| License | MIT |
| Maintainer | me@jspha.com |
| Stability | experimental |
| Portability | non-portable |
| Safe Haskell | None |
| Language | Haskell2010 |
Network.OAuth.Simple
Contents
Description
Simplified Monadic interface for managing http-client and
oauthenticated state. Re-exposes all of the functionality from
Network.OAuth and Network.OAuth.ThreeLegged.
- 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.
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.
Instances
| Monad m => MonadState SystemRNG (OAuthT ty m) | |
| MonadTrans (OAuthT ty) | |
| Monad m => Monad (OAuthT ty m) | |
| Functor m => Functor (OAuthT ty m) | |
| (Monad m, Functor m) => Applicative (OAuthT ty m) | |
| MonadThrow m => MonadThrow (OAuthT ty m) | |
| MonadCatch m => MonadCatch (OAuthT ty m) | |
| MonadIO m => MonadIO (OAuthT ty m) |
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) | |
| Data ty => Data (Token ty) | |
| Ord (Token ty) | |
| Show (Token ty) | |
| ToJSON (Token ty) | Produces a JSON object using keys named |
| FromJSON (Token ty) | Parses a JSON object with keys |
| Typeable (* -> *) Token |
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.
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 | |
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 |
data SignatureMethod 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 |
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
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.
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.