{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Network.OAuth.Simple
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : MIT
--
-- Maintainer  : me@jspha.com
-- Stability   : experimental
-- Portability : non-portable
--
-- Simplified Monadic interface for managing @http-client@ and
-- @oauthenticated@ state. Re-exposes all of the functionality from
-- "Network.OAuth" and "Network.OAuth.ThreeLegged".
--
module Network.OAuth.Simple (

  -- * 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 'C.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, runOAuthSimple,

  -- ** More sophisticated interface
  runOAuth, runOAuthT, OAuthT (..), OAuth,

  -- * Configuration management
  upgradeCred, upgrade,

  -- * Configuration re-exports

  -- ** OAuth Credentials
  O.Token (..), O.Cred, O.Client, O.Temporary, O.Permanent,

  -- *** Creating Credentials
  O.clientCred, O.temporaryCred, O.permanentCred,
  O.fromUrlEncoded,

  -- ** OAuth Configuration
  O.Server (..), O.defaultServer,
  O.ParameterMethod (..), O.SignatureMethod (..), O.Version (..),

  -- ** Three-Legged Authorization

  -- *** Configuration types
  O.ThreeLegged (..), O.parseThreeLegged, O.Callback (..),
  O.Verifier,

  -- *** Actions
  requestTemporaryToken, buildAuthorizationUrl, requestPermanentToken,

  -- *** Example System
  requestTokenProtocol, TokenRequestFailure (..)

  ) where

import qualified Control.Monad.Catch             as E
import           Control.Monad.Reader
import           Control.Monad.Trans.Except
import qualified Data.ByteString.Lazy            as SL
import qualified Network.HTTP.Client             as C
import qualified Network.OAuth                   as O
import qualified Network.OAuth.ThreeLegged       as O
import qualified Network.OAuth.Types.Credentials as Cred
import           Network.URI                     (URI)

data OaConfig ty =
  OaConfig { OaConfig ty -> Cred ty
cred        :: O.Cred ty
           , OaConfig ty -> Server
server      :: O.Server
           , OaConfig ty -> ThreeLegged
threeLegged :: O.ThreeLegged
           }

-- | Perform authenticated requests using a shared 'C.Manager' and
-- a particular set of 'O.Cred's.
newtype OAuthT ty m a =
  OAuthT { OAuthT ty m a -> ReaderT (OaConfig ty) m a
unOAuthT :: ReaderT (OaConfig ty) m a }
  deriving ( a -> OAuthT ty m b -> OAuthT ty m a
(a -> b) -> OAuthT ty m a -> OAuthT ty m b
(forall a b. (a -> b) -> OAuthT ty m a -> OAuthT ty m b)
-> (forall a b. a -> OAuthT ty m b -> OAuthT ty m a)
-> Functor (OAuthT ty m)
forall a b. a -> OAuthT ty m b -> OAuthT ty m a
forall a b. (a -> b) -> OAuthT ty m a -> OAuthT ty m b
forall ty (m :: * -> *) a b.
Functor m =>
a -> OAuthT ty m b -> OAuthT ty m a
forall ty (m :: * -> *) a b.
Functor m =>
(a -> b) -> OAuthT ty m a -> OAuthT ty m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OAuthT ty m b -> OAuthT ty m a
$c<$ :: forall ty (m :: * -> *) a b.
Functor m =>
a -> OAuthT ty m b -> OAuthT ty m a
fmap :: (a -> b) -> OAuthT ty m a -> OAuthT ty m b
$cfmap :: forall ty (m :: * -> *) a b.
Functor m =>
(a -> b) -> OAuthT ty m a -> OAuthT ty m b
Functor, Functor (OAuthT ty m)
a -> OAuthT ty m a
Functor (OAuthT ty m)
-> (forall a. a -> OAuthT ty m a)
-> (forall a b.
    OAuthT ty m (a -> b) -> OAuthT ty m a -> OAuthT ty m b)
-> (forall a b c.
    (a -> b -> c) -> OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m c)
-> (forall a b. OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b)
-> (forall a b. OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m a)
-> Applicative (OAuthT ty m)
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m a
OAuthT ty m (a -> b) -> OAuthT ty m a -> OAuthT ty m b
(a -> b -> c) -> OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m c
forall a. a -> OAuthT ty m a
forall a b. OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m a
forall a b. OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
forall a b. OAuthT ty m (a -> b) -> OAuthT ty m a -> OAuthT ty m b
forall a b c.
(a -> b -> c) -> OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m c
forall ty (m :: * -> *). Applicative m => Functor (OAuthT ty m)
forall ty (m :: * -> *) a. Applicative m => a -> OAuthT ty m a
forall ty (m :: * -> *) a b.
Applicative m =>
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m a
forall ty (m :: * -> *) a b.
Applicative m =>
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
forall ty (m :: * -> *) a b.
Applicative m =>
OAuthT ty m (a -> b) -> OAuthT ty m a -> OAuthT ty m b
forall ty (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m a
$c<* :: forall ty (m :: * -> *) a b.
Applicative m =>
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m a
*> :: OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
$c*> :: forall ty (m :: * -> *) a b.
Applicative m =>
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
liftA2 :: (a -> b -> c) -> OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m c
$cliftA2 :: forall ty (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m c
<*> :: OAuthT ty m (a -> b) -> OAuthT ty m a -> OAuthT ty m b
$c<*> :: forall ty (m :: * -> *) a b.
Applicative m =>
OAuthT ty m (a -> b) -> OAuthT ty m a -> OAuthT ty m b
pure :: a -> OAuthT ty m a
$cpure :: forall ty (m :: * -> *) a. Applicative m => a -> OAuthT ty m a
$cp1Applicative :: forall ty (m :: * -> *). Applicative m => Functor (OAuthT ty m)
Applicative, Applicative (OAuthT ty m)
a -> OAuthT ty m a
Applicative (OAuthT ty m)
-> (forall a b.
    OAuthT ty m a -> (a -> OAuthT ty m b) -> OAuthT ty m b)
-> (forall a b. OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b)
-> (forall a. a -> OAuthT ty m a)
-> Monad (OAuthT ty m)
OAuthT ty m a -> (a -> OAuthT ty m b) -> OAuthT ty m b
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
forall a. a -> OAuthT ty m a
forall a b. OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
forall a b. OAuthT ty m a -> (a -> OAuthT ty m b) -> OAuthT ty m b
forall ty (m :: * -> *). Monad m => Applicative (OAuthT ty m)
forall ty (m :: * -> *) a. Monad m => a -> OAuthT ty m a
forall ty (m :: * -> *) a b.
Monad m =>
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
forall ty (m :: * -> *) a b.
Monad m =>
OAuthT ty m a -> (a -> OAuthT ty m b) -> OAuthT ty m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> OAuthT ty m a
$creturn :: forall ty (m :: * -> *) a. Monad m => a -> OAuthT ty m a
>> :: OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
$c>> :: forall ty (m :: * -> *) a b.
Monad m =>
OAuthT ty m a -> OAuthT ty m b -> OAuthT ty m b
>>= :: OAuthT ty m a -> (a -> OAuthT ty m b) -> OAuthT ty m b
$c>>= :: forall ty (m :: * -> *) a b.
Monad m =>
OAuthT ty m a -> (a -> OAuthT ty m b) -> OAuthT ty m b
$cp1Monad :: forall ty (m :: * -> *). Monad m => Applicative (OAuthT ty m)
Monad
           , MonadReader (OaConfig ty)
           , MonadThrow (OAuthT ty m)
MonadThrow (OAuthT ty m)
-> (forall e a.
    Exception e =>
    OAuthT ty m a -> (e -> OAuthT ty m a) -> OAuthT ty m a)
-> MonadCatch (OAuthT ty m)
OAuthT ty m a -> (e -> OAuthT ty m a) -> OAuthT ty m a
forall e a.
Exception e =>
OAuthT ty m a -> (e -> OAuthT ty m a) -> OAuthT ty m a
forall ty (m :: * -> *). MonadCatch m => MonadThrow (OAuthT ty m)
forall ty (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
OAuthT ty m a -> (e -> OAuthT ty m a) -> OAuthT ty m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: OAuthT ty m a -> (e -> OAuthT ty m a) -> OAuthT ty m a
$ccatch :: forall ty (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
OAuthT ty m a -> (e -> OAuthT ty m a) -> OAuthT ty m a
$cp1MonadCatch :: forall ty (m :: * -> *). MonadCatch m => MonadThrow (OAuthT ty m)
E.MonadCatch
           , Monad (OAuthT ty m)
e -> OAuthT ty m a
Monad (OAuthT ty m)
-> (forall e a. Exception e => e -> OAuthT ty m a)
-> MonadThrow (OAuthT ty m)
forall e a. Exception e => e -> OAuthT ty m a
forall ty (m :: * -> *). MonadThrow m => Monad (OAuthT ty m)
forall ty (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> OAuthT ty m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> OAuthT ty m a
$cthrowM :: forall ty (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> OAuthT ty m a
$cp1MonadThrow :: forall ty (m :: * -> *). MonadThrow m => Monad (OAuthT ty m)
E.MonadThrow
           , Monad (OAuthT ty m)
Monad (OAuthT ty m)
-> (forall a. IO a -> OAuthT ty m a) -> MonadIO (OAuthT ty m)
IO a -> OAuthT ty m a
forall a. IO a -> OAuthT ty m a
forall ty (m :: * -> *). MonadIO m => Monad (OAuthT ty m)
forall ty (m :: * -> *) a. MonadIO m => IO a -> OAuthT ty m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> OAuthT ty m a
$cliftIO :: forall ty (m :: * -> *) a. MonadIO m => IO a -> OAuthT ty m a
$cp1MonadIO :: forall ty (m :: * -> *). MonadIO m => Monad (OAuthT ty m)
MonadIO
           )
instance MonadTrans (OAuthT ty) where lift :: m a -> OAuthT ty m a
lift = ReaderT (OaConfig ty) m a -> OAuthT ty m a
forall ty (m :: * -> *) a.
ReaderT (OaConfig ty) m a -> OAuthT ty m a
OAuthT (ReaderT (OaConfig ty) m a -> OAuthT ty m a)
-> (m a -> ReaderT (OaConfig ty) m a) -> m a -> OAuthT ty m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (OaConfig ty) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | 'OAuthT' wrapped over 'IO'.
type OAuth ty = OAuthT ty IO

-- | Run's an 'OAuthT' using a fresh 'R.EntropyPool'.
runOAuthT
  :: (MonadIO m) =>
     OAuthT ty m a -> O.Cred ty -> O.Server -> O.ThreeLegged ->
     m a
runOAuthT :: OAuthT ty m a -> Cred ty -> Server -> ThreeLegged -> m a
runOAuthT OAuthT ty m a
oat Cred ty
cr Server
srv ThreeLegged
tl = do
  ReaderT (OaConfig ty) m a -> OaConfig ty -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (OAuthT ty m a -> ReaderT (OaConfig ty) m a
forall ty (m :: * -> *) a.
OAuthT ty m a -> ReaderT (OaConfig ty) m a
unOAuthT OAuthT ty m a
oat) (Cred ty -> Server -> ThreeLegged -> OaConfig ty
forall ty. Cred ty -> Server -> ThreeLegged -> OaConfig ty
OaConfig Cred ty
cr Server
srv ThreeLegged
tl)

runOAuth :: OAuth ty a -> O.Cred ty -> O.Server -> O.ThreeLegged -> IO a
runOAuth :: OAuth ty a -> Cred ty -> Server -> ThreeLegged -> IO a
runOAuth = OAuth ty a -> Cred ty -> Server -> ThreeLegged -> IO a
forall (m :: * -> *) ty a.
MonadIO m =>
OAuthT ty m a -> Cred ty -> Server -> ThreeLegged -> m a
runOAuthT

-- | The simplest way to execute a set of authenticated requests. Produces
-- invalid 'ThreeLegged' requests---use 'runOAuth' to provide 'O.Server' and
-- 'O.ThreeLegged' configuration information.
runOAuthSimple :: OAuth ty a -> O.Cred ty -> IO a
runOAuthSimple :: OAuth ty a -> Cred ty -> IO a
runOAuthSimple OAuth ty a
oat Cred ty
cr = OAuth ty a -> Cred ty -> Server -> ThreeLegged -> IO a
forall ty a. OAuth ty a -> Cred ty -> Server -> ThreeLegged -> IO a
runOAuth OAuth ty a
oat Cred ty
cr Server
O.defaultServer ThreeLegged
tl where
  Just ThreeLegged
tl = String -> String -> String -> Callback -> Maybe ThreeLegged
O.parseThreeLegged String
"http://example.com"
                               String
"http://example.com"
                               String
"http://example.com"
                               Callback
O.OutOfBand

upgradeCred :: (Cred.ResourceToken ty', Monad m) => O.Token ty' -> OAuthT ty m (O.Cred ty')
upgradeCred :: Token ty' -> OAuthT ty m (Cred ty')
upgradeCred Token ty'
tok = (OaConfig ty -> Cred ty')
-> OAuthT ty m (OaConfig ty) -> OAuthT ty m (Cred ty')
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Token ty' -> Cred ty -> Cred ty'
forall tk tk'. ResourceToken tk => Token tk -> Cred tk' -> Cred tk
Cred.upgradeCred Token ty'
tok (Cred ty -> Cred ty')
-> (OaConfig ty -> Cred ty) -> OaConfig ty -> Cred ty'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OaConfig ty -> Cred ty
forall ty. OaConfig ty -> Cred ty
cred) OAuthT ty m (OaConfig ty)
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Given a 'Cred.ResourceToken' of some kind, run an inner 'OAuthT' session
-- with the same configuration but new credentials.
upgrade :: (Cred.ResourceToken ty', Monad m) => O.Token ty' -> OAuthT ty' m a -> OAuthT ty m a
upgrade :: Token ty' -> OAuthT ty' m a -> OAuthT ty m a
upgrade Token ty'
tok OAuthT ty' m a
oat = do
  OaConfig ty
conf <- OAuthT ty m (OaConfig ty)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let conf' :: OaConfig ty'
conf' = OaConfig ty
conf { cred :: Cred ty'
cred = Token ty' -> Cred ty -> Cred ty'
forall tk tk'. ResourceToken tk => Token tk -> Cred tk' -> Cred tk
Cred.upgradeCred Token ty'
tok (OaConfig ty -> Cred ty
forall ty. OaConfig ty -> Cred ty
cred OaConfig ty
conf) }
  m a -> OAuthT ty m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> OAuthT ty m a) -> m a -> OAuthT ty m a
forall a b. (a -> b) -> a -> b
$ ReaderT (OaConfig ty') m a -> OaConfig ty' -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (OAuthT ty' m a -> ReaderT (OaConfig ty') m a
forall ty (m :: * -> *) a.
OAuthT ty m a -> ReaderT (OaConfig ty) m a
unOAuthT OAuthT ty' m a
oat) OaConfig ty'
conf'

liftBasic :: MonadIO m => (OaConfig ty -> IO a) -> OAuthT ty m a
liftBasic :: (OaConfig ty -> IO a) -> OAuthT ty m a
liftBasic OaConfig ty -> IO a
f = do
  OaConfig ty
conf <- OAuthT ty m (OaConfig ty)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO a -> OAuthT ty m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> OAuthT ty m a) -> IO a -> OAuthT ty m a
forall a b. (a -> b) -> a -> b
$ OaConfig ty -> IO a
f OaConfig ty
conf

-- | Sign a request using fresh credentials.
oauth :: MonadIO m => C.Request -> OAuthT ty m C.Request
oauth :: Request -> OAuthT ty m Request
oauth Request
req = (OaConfig ty -> IO Request) -> OAuthT ty m Request
forall (m :: * -> *) ty a.
MonadIO m =>
(OaConfig ty -> IO a) -> OAuthT ty m a
liftBasic ((OaConfig ty -> IO Request) -> OAuthT ty m Request)
-> (OaConfig ty -> IO Request) -> OAuthT ty m Request
forall a b. (a -> b) -> a -> b
$ \OaConfig ty
conf -> Cred ty -> Server -> Request -> IO Request
forall (m :: * -> *) ty.
(MonadIO m, MonadRandom m) =>
Cred ty -> Server -> Request -> m Request
O.oauth (OaConfig ty -> Cred ty
forall ty. OaConfig ty -> Cred ty
cred OaConfig ty
conf) (OaConfig ty -> Server
forall ty. OaConfig ty -> Server
server OaConfig ty
conf) Request
req

-- Three-Legged Authorization
--------------------------------------------------------------------------------

requestTemporaryToken
  :: MonadIO m => C.Manager ->
     OAuthT O.Client m (C.Response (Either SL.ByteString (O.Token O.Temporary)))
requestTemporaryToken :: Manager
-> OAuthT Client m (Response (Either ByteString (Token Temporary)))
requestTemporaryToken Manager
man =
  (OaConfig Client
 -> IO (Response (Either ByteString (Token Temporary))))
-> OAuthT Client m (Response (Either ByteString (Token Temporary)))
forall (m :: * -> *) ty a.
MonadIO m =>
(OaConfig ty -> IO a) -> OAuthT ty m a
liftBasic ((OaConfig Client
  -> IO (Response (Either ByteString (Token Temporary))))
 -> OAuthT
      Client m (Response (Either ByteString (Token Temporary))))
-> (OaConfig Client
    -> IO (Response (Either ByteString (Token Temporary))))
-> OAuthT Client m (Response (Either ByteString (Token Temporary)))
forall a b. (a -> b) -> a -> b
$ \OaConfig Client
conf ->
    Cred Client
-> Server
-> ThreeLegged
-> Manager
-> IO (Response (Either ByteString (Token Temporary)))
forall (m :: * -> *).
(MonadIO m, MonadRandom m) =>
Cred Client
-> Server
-> ThreeLegged
-> Manager
-> m (Response (Either ByteString (Token Temporary)))
O.requestTemporaryToken (OaConfig Client -> Cred Client
forall ty. OaConfig ty -> Cred ty
cred OaConfig Client
conf)
                            (OaConfig Client -> Server
forall ty. OaConfig ty -> Server
server OaConfig Client
conf)
                            (OaConfig Client -> ThreeLegged
forall ty. OaConfig ty -> ThreeLegged
threeLegged OaConfig Client
conf)
                            Manager
man

buildAuthorizationUrl :: Monad m => OAuthT O.Temporary m URI
buildAuthorizationUrl :: OAuthT Temporary m URI
buildAuthorizationUrl = do
  OaConfig Temporary
conf <- OAuthT Temporary m (OaConfig Temporary)
forall r (m :: * -> *). MonadReader r m => m r
ask
  URI -> OAuthT Temporary m URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> OAuthT Temporary m URI) -> URI -> OAuthT Temporary m URI
forall a b. (a -> b) -> a -> b
$ Cred Temporary -> ThreeLegged -> URI
O.buildAuthorizationUrl (OaConfig Temporary -> Cred Temporary
forall ty. OaConfig ty -> Cred ty
cred OaConfig Temporary
conf) (OaConfig Temporary -> ThreeLegged
forall ty. OaConfig ty -> ThreeLegged
threeLegged OaConfig Temporary
conf)

requestPermanentToken
  :: MonadIO m => C.Manager -> O.Verifier ->
     OAuthT O.Temporary m (C.Response (Either SL.ByteString (O.Token O.Permanent)))
requestPermanentToken :: Manager
-> Verifier
-> OAuthT
     Temporary m (Response (Either ByteString (Token Permanent)))
requestPermanentToken Manager
man Verifier
ver =
  (OaConfig Temporary
 -> IO (Response (Either ByteString (Token Permanent))))
-> OAuthT
     Temporary m (Response (Either ByteString (Token Permanent)))
forall (m :: * -> *) ty a.
MonadIO m =>
(OaConfig ty -> IO a) -> OAuthT ty m a
liftBasic ((OaConfig Temporary
  -> IO (Response (Either ByteString (Token Permanent))))
 -> OAuthT
      Temporary m (Response (Either ByteString (Token Permanent))))
-> (OaConfig Temporary
    -> IO (Response (Either ByteString (Token Permanent))))
-> OAuthT
     Temporary m (Response (Either ByteString (Token Permanent)))
forall a b. (a -> b) -> a -> b
$ \OaConfig Temporary
conf ->
    Cred Temporary
-> Server
-> Verifier
-> ThreeLegged
-> Manager
-> IO (Response (Either ByteString (Token Permanent)))
forall (m :: * -> *).
(MonadIO m, MonadRandom m) =>
Cred Temporary
-> Server
-> Verifier
-> ThreeLegged
-> Manager
-> m (Response (Either ByteString (Token Permanent)))
O.requestPermanentToken (OaConfig Temporary -> Cred Temporary
forall ty. OaConfig ty -> Cred ty
cred OaConfig Temporary
conf)
                            (OaConfig Temporary -> Server
forall ty. OaConfig ty -> Server
server OaConfig Temporary
conf)
                            Verifier
ver
                            (OaConfig Temporary -> ThreeLegged
forall ty. OaConfig ty -> ThreeLegged
threeLegged OaConfig Temporary
conf)
                            Manager
man

data TokenRequestFailure =
    OnTemporaryRequest C.HttpException
  | BadTemporaryToken SL.ByteString
  | OnPermanentRequest C.HttpException
  | BadPermanentToken SL.ByteString
  deriving ( Int -> TokenRequestFailure -> ShowS
[TokenRequestFailure] -> ShowS
TokenRequestFailure -> String
(Int -> TokenRequestFailure -> ShowS)
-> (TokenRequestFailure -> String)
-> ([TokenRequestFailure] -> ShowS)
-> Show TokenRequestFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenRequestFailure] -> ShowS
$cshowList :: [TokenRequestFailure] -> ShowS
show :: TokenRequestFailure -> String
$cshow :: TokenRequestFailure -> String
showsPrec :: Int -> TokenRequestFailure -> ShowS
$cshowsPrec :: Int -> TokenRequestFailure -> ShowS
Show )

-- | Run a full Three-legged authorization protocol using the simple interface
-- of this module. This is similar to the 'O.requestTokenProtocol' in
-- "Network.OAuth.ThreeLegged", but offers better error handling due in part to
-- the easier management of configuration state.
requestTokenProtocol
  :: (Functor m, MonadIO m, E.MonadCatch m) =>
     C.Manager -> (URI -> m O.Verifier) ->
     OAuthT O.Client m (Either TokenRequestFailure (O.Cred O.Permanent))
requestTokenProtocol :: Manager
-> (URI -> m Verifier)
-> OAuthT Client m (Either TokenRequestFailure (Cred Permanent))
requestTokenProtocol Manager
man URI -> m Verifier
getVerifier = ExceptT TokenRequestFailure (OAuthT Client m) (Cred Permanent)
-> OAuthT Client m (Either TokenRequestFailure (Cred Permanent))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TokenRequestFailure (OAuthT Client m) (Cred Permanent)
 -> OAuthT Client m (Either TokenRequestFailure (Cred Permanent)))
-> ExceptT TokenRequestFailure (OAuthT Client m) (Cred Permanent)
-> OAuthT Client m (Either TokenRequestFailure (Cred Permanent))
forall a b. (a -> b) -> a -> b
$ do
  -- Most of the code here is very simple, except that it does a LOT of
  -- exception lifting. Try to ignore the EitherT noise on the left side
  -- of each line.
  Response (Either ByteString (Token Temporary))
tempResp <- (HttpException -> TokenRequestFailure)
-> ExceptT
     HttpException
     (OAuthT Client m)
     (Response (Either ByteString (Token Temporary)))
-> ExceptT
     TokenRequestFailure
     (OAuthT Client m)
     (Response (Either ByteString (Token Temporary)))
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HttpException -> TokenRequestFailure
OnTemporaryRequest (ExceptT
   HttpException
   (OAuthT Client m)
   (Response (Either ByteString (Token Temporary)))
 -> ExceptT
      TokenRequestFailure
      (OAuthT Client m)
      (Response (Either ByteString (Token Temporary))))
-> ExceptT
     HttpException
     (OAuthT Client m)
     (Response (Either ByteString (Token Temporary)))
-> ExceptT
     TokenRequestFailure
     (OAuthT Client m)
     (Response (Either ByteString (Token Temporary)))
forall a b. (a -> b) -> a -> b
$ OAuthT
  Client
  m
  (Either
     HttpException (Response (Either ByteString (Token Temporary))))
-> ExceptT
     HttpException
     (OAuthT Client m)
     (Response (Either ByteString (Token Temporary)))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (OAuthT
   Client
   m
   (Either
      HttpException (Response (Either ByteString (Token Temporary))))
 -> ExceptT
      HttpException
      (OAuthT Client m)
      (Response (Either ByteString (Token Temporary))))
-> OAuthT
     Client
     m
     (Either
        HttpException (Response (Either ByteString (Token Temporary))))
-> ExceptT
     HttpException
     (OAuthT Client m)
     (Response (Either ByteString (Token Temporary)))
forall a b. (a -> b) -> a -> b
$ OAuthT Client m (Response (Either ByteString (Token Temporary)))
-> OAuthT
     Client
     m
     (Either
        HttpException (Response (Either ByteString (Token Temporary))))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
E.try (Manager
-> OAuthT Client m (Response (Either ByteString (Token Temporary)))
forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuthT Client m (Response (Either ByteString (Token Temporary)))
requestTemporaryToken Manager
man)
  Token Temporary
ttok     <- (ByteString -> TokenRequestFailure)
-> ExceptT ByteString (OAuthT Client m) (Token Temporary)
-> ExceptT TokenRequestFailure (OAuthT Client m) (Token Temporary)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ByteString -> TokenRequestFailure
BadTemporaryToken (ExceptT ByteString (OAuthT Client m) (Token Temporary)
 -> ExceptT TokenRequestFailure (OAuthT Client m) (Token Temporary))
-> ExceptT ByteString (OAuthT Client m) (Token Temporary)
-> ExceptT TokenRequestFailure (OAuthT Client m) (Token Temporary)
forall a b. (a -> b) -> a -> b
$ OAuthT Client m (Either ByteString (Token Temporary))
-> ExceptT ByteString (OAuthT Client m) (Token Temporary)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (OAuthT Client m (Either ByteString (Token Temporary))
 -> ExceptT ByteString (OAuthT Client m) (Token Temporary))
-> OAuthT Client m (Either ByteString (Token Temporary))
-> ExceptT ByteString (OAuthT Client m) (Token Temporary)
forall a b. (a -> b) -> a -> b
$ Either ByteString (Token Temporary)
-> OAuthT Client m (Either ByteString (Token Temporary))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString (Token Temporary)
 -> OAuthT Client m (Either ByteString (Token Temporary)))
-> Either ByteString (Token Temporary)
-> OAuthT Client m (Either ByteString (Token Temporary))
forall a b. (a -> b) -> a -> b
$ Response (Either ByteString (Token Temporary))
-> Either ByteString (Token Temporary)
forall body. Response body -> body
C.responseBody Response (Either ByteString (Token Temporary))
tempResp
  Token Temporary
-> ExceptT
     TokenRequestFailure (OAuthT Temporary m) (Cred Permanent)
-> ExceptT TokenRequestFailure (OAuthT Client m) (Cred Permanent)
forall (m :: * -> *) ty' e a ty.
(Monad m, ResourceToken ty') =>
Token ty'
-> ExceptT e (OAuthT ty' m) a -> ExceptT e (OAuthT ty m) a
upgradeE Token Temporary
ttok (ExceptT TokenRequestFailure (OAuthT Temporary m) (Cred Permanent)
 -> ExceptT TokenRequestFailure (OAuthT Client m) (Cred Permanent))
-> ExceptT
     TokenRequestFailure (OAuthT Temporary m) (Cred Permanent)
-> ExceptT TokenRequestFailure (OAuthT Client m) (Cred Permanent)
forall a b. (a -> b) -> a -> b
$ do
    Verifier
verifier <- OAuthT Temporary m Verifier
-> ExceptT TokenRequestFailure (OAuthT Temporary m) Verifier
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (OAuthT Temporary m Verifier
 -> ExceptT TokenRequestFailure (OAuthT Temporary m) Verifier)
-> OAuthT Temporary m Verifier
-> ExceptT TokenRequestFailure (OAuthT Temporary m) Verifier
forall a b. (a -> b) -> a -> b
$ OAuthT Temporary m URI
forall (m :: * -> *). Monad m => OAuthT Temporary m URI
buildAuthorizationUrl OAuthT Temporary m URI
-> (URI -> OAuthT Temporary m Verifier)
-> OAuthT Temporary m Verifier
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Verifier -> OAuthT Temporary m Verifier
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Verifier -> OAuthT Temporary m Verifier)
-> (URI -> m Verifier) -> URI -> OAuthT Temporary m Verifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> m Verifier
getVerifier
    Response (Either ByteString (Token Permanent))
permResp <- (HttpException -> TokenRequestFailure)
-> ExceptT
     HttpException
     (OAuthT Temporary m)
     (Response (Either ByteString (Token Permanent)))
-> ExceptT
     TokenRequestFailure
     (OAuthT Temporary m)
     (Response (Either ByteString (Token Permanent)))
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HttpException -> TokenRequestFailure
OnPermanentRequest (ExceptT
   HttpException
   (OAuthT Temporary m)
   (Response (Either ByteString (Token Permanent)))
 -> ExceptT
      TokenRequestFailure
      (OAuthT Temporary m)
      (Response (Either ByteString (Token Permanent))))
-> ExceptT
     HttpException
     (OAuthT Temporary m)
     (Response (Either ByteString (Token Permanent)))
-> ExceptT
     TokenRequestFailure
     (OAuthT Temporary m)
     (Response (Either ByteString (Token Permanent)))
forall a b. (a -> b) -> a -> b
$ OAuthT
  Temporary
  m
  (Either
     HttpException (Response (Either ByteString (Token Permanent))))
-> ExceptT
     HttpException
     (OAuthT Temporary m)
     (Response (Either ByteString (Token Permanent)))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (OAuthT
   Temporary
   m
   (Either
      HttpException (Response (Either ByteString (Token Permanent))))
 -> ExceptT
      HttpException
      (OAuthT Temporary m)
      (Response (Either ByteString (Token Permanent))))
-> OAuthT
     Temporary
     m
     (Either
        HttpException (Response (Either ByteString (Token Permanent))))
-> ExceptT
     HttpException
     (OAuthT Temporary m)
     (Response (Either ByteString (Token Permanent)))
forall a b. (a -> b) -> a -> b
$ OAuthT Temporary m (Response (Either ByteString (Token Permanent)))
-> OAuthT
     Temporary
     m
     (Either
        HttpException (Response (Either ByteString (Token Permanent))))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
E.try (Manager
-> Verifier
-> OAuthT
     Temporary m (Response (Either ByteString (Token Permanent)))
forall (m :: * -> *).
MonadIO m =>
Manager
-> Verifier
-> OAuthT
     Temporary m (Response (Either ByteString (Token Permanent)))
requestPermanentToken Manager
man Verifier
verifier)
    Token Permanent
ptok     <- (ByteString -> TokenRequestFailure)
-> ExceptT ByteString (OAuthT Temporary m) (Token Permanent)
-> ExceptT
     TokenRequestFailure (OAuthT Temporary m) (Token Permanent)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ByteString -> TokenRequestFailure
BadPermanentToken (ExceptT ByteString (OAuthT Temporary m) (Token Permanent)
 -> ExceptT
      TokenRequestFailure (OAuthT Temporary m) (Token Permanent))
-> ExceptT ByteString (OAuthT Temporary m) (Token Permanent)
-> ExceptT
     TokenRequestFailure (OAuthT Temporary m) (Token Permanent)
forall a b. (a -> b) -> a -> b
$ OAuthT Temporary m (Either ByteString (Token Permanent))
-> ExceptT ByteString (OAuthT Temporary m) (Token Permanent)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (OAuthT Temporary m (Either ByteString (Token Permanent))
 -> ExceptT ByteString (OAuthT Temporary m) (Token Permanent))
-> OAuthT Temporary m (Either ByteString (Token Permanent))
-> ExceptT ByteString (OAuthT Temporary m) (Token Permanent)
forall a b. (a -> b) -> a -> b
$ Either ByteString (Token Permanent)
-> OAuthT Temporary m (Either ByteString (Token Permanent))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString (Token Permanent)
 -> OAuthT Temporary m (Either ByteString (Token Permanent)))
-> Either ByteString (Token Permanent)
-> OAuthT Temporary m (Either ByteString (Token Permanent))
forall a b. (a -> b) -> a -> b
$ Response (Either ByteString (Token Permanent))
-> Either ByteString (Token Permanent)
forall body. Response body -> body
C.responseBody Response (Either ByteString (Token Permanent))
permResp
    OAuthT Temporary m (Cred Permanent)
-> ExceptT
     TokenRequestFailure (OAuthT Temporary m) (Cred Permanent)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (OAuthT Temporary m (Cred Permanent)
 -> ExceptT
      TokenRequestFailure (OAuthT Temporary m) (Cred Permanent))
-> OAuthT Temporary m (Cred Permanent)
-> ExceptT
     TokenRequestFailure (OAuthT Temporary m) (Cred Permanent)
forall a b. (a -> b) -> a -> b
$ Token Permanent -> OAuthT Temporary m (Cred Permanent)
forall ty' (m :: * -> *) ty.
(ResourceToken ty', Monad m) =>
Token ty' -> OAuthT ty m (Cred ty')
upgradeCred Token Permanent
ptok
  where
    -- This is just 'upgrade' played out in the EitherT monad.
    upgradeE :: (Monad m, Cred.ResourceToken ty') =>
                Cred.Token ty'
                -> ExceptT e (OAuthT ty' m) a -> ExceptT e (OAuthT ty m) a
    upgradeE :: Token ty'
-> ExceptT e (OAuthT ty' m) a -> ExceptT e (OAuthT ty m) a
upgradeE Token ty'
tok = OAuthT ty m (Either e a) -> ExceptT e (OAuthT ty m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (OAuthT ty m (Either e a) -> ExceptT e (OAuthT ty m) a)
-> (ExceptT e (OAuthT ty' m) a -> OAuthT ty m (Either e a))
-> ExceptT e (OAuthT ty' m) a
-> ExceptT e (OAuthT ty m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token ty' -> OAuthT ty' m (Either e a) -> OAuthT ty m (Either e a)
forall ty' (m :: * -> *) a ty.
(ResourceToken ty', Monad m) =>
Token ty' -> OAuthT ty' m a -> OAuthT ty m a
upgrade Token ty'
tok (OAuthT ty' m (Either e a) -> OAuthT ty m (Either e a))
-> (ExceptT e (OAuthT ty' m) a -> OAuthT ty' m (Either e a))
-> ExceptT e (OAuthT ty' m) a
-> OAuthT ty m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e (OAuthT ty' m) a -> OAuthT ty' m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT