Copyright | (c) Marco Zocca 2018 |
---|---|
License | GPL-3 |
Maintainer | zocca.marco gmail |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Introduction
This library aims to abstract away (part of) the bookkeeping related to exchanging data with web APIs.
In particular, goggles
can take care of automatically refreshing a token that has a finite lifetime such that the program never uses an invalid token. The token is furthermore cached such that network usage is reduced to a minimum.
Preliminaries
import Network.Goggles
Required language extensions: OverloadedStrings
, TypeFamilies
, FlexibleInstances
.
Usage
To begin with, the user provides a type for the remote service she wishes to interface to, along with a couple typeclass instances.
data Remote
newtype C = C { apiKey :: Text
} deriving Eq -- API authentication credentials
Notice we don't actually need any data constructor associated with the Remote
type. In the simplest case it can be a "phantom type", only used to label typeclass instances.
This library design allows to be general as possible (many instances are polymorphic in this label, so the user doesn't need to write them), and specific where needed (as we will see with the exception handling mechanism further below.
There are so far two main use cases for goggles
, corresponding to the complexity of the remote API authentication mechanism.
1. Simple authentication
If calling the remote API only requires a key of some sort (i.e. does not involve a session token), the Remote
type should only be extended with a HasCredentials
interface:
instance HasCredentials Remote where type Credentials Remote = C
2. Token-based authentication
If the API requires a token as well (this is the case with OAuth2-based implementations), the user must extend the HasToken
typeclass as well, by providing two associated types and a method implementation :
instance HasToken Remote where
type Options Remote = ... -- any parameters that should be passed to the API call
type TokenContent Remote = ... -- the raw token string type returned by the API, often a ByteString
tokenFetch = ... -- function that creates and retrieves the token from the remote API
Once this is in place, a valid token can always be retrieved with accessToken
. This checks the validity of the locally cached token and performs a tokenFetch
only when this is about to expire.
Exception handling
Internally, goggles
uses req
for HTTP connections, so the user must always provide a MonadHttp
instance for her Remote
type :
instance MonadHttp (WebApiM Remote) where handleHttpExcepion = ...
The actual implementation of handleHttpException
depends on the actual API semantics, but the user can just use throwM
here (imported from the Catch
module of the exceptions
package).
Putting it all together
The usual workflow is as follows:
- Create a
Handle
from the API credentials and any API options withcreateHandle
. This requires a surrounding IO block because token refreshing is done as an atomic update in the STM monad. - Build up the program that interacts with the external API in the
WebApiM
monad. - Run the program using the handle with
evalWebApiIO
.
- getLbs :: (HasCredentials c, MonadHttp (WebApiM c)) => Url scheme -> Option scheme -> WebApiM c LbsResponse
- postLbs :: (HasCredentials c, MonadHttp (WebApiM c)) => Url scheme -> Option scheme -> ByteString -> WebApiM c LbsResponse
- putLbs :: (HasCredentials c, MonadHttp (WebApiM c)) => Url scheme -> Option scheme -> ByteString -> WebApiM c LbsResponse
- getLbsWithToken :: (HasCredentials c, HasToken c, MonadHttp (WebApiM c)) => (TokenContent c -> Url scheme -> Option scheme -> (Url scheme, Option scheme)) -> Url scheme -> Option scheme -> WebApiM c LbsResponse
- postLbsWithToken :: (HasCredentials c, HasToken c, MonadHttp (WebApiM c)) => (TokenContent c -> Url scheme -> Option scheme -> ByteString -> (Url scheme, Option scheme, ByteString)) -> Url scheme -> Option scheme -> ByteString -> WebApiM c LbsResponse
- putLbsWithToken :: (HasCredentials c, HasToken c, MonadHttp (WebApiM c)) => (TokenContent c -> Url scheme -> Option scheme -> ByteString -> (Url scheme, Option scheme, ByteString)) -> Url scheme -> Option scheme -> ByteString -> WebApiM c LbsResponse
- createHandle :: HasCredentials c => Credentials c -> Options c -> IO (Handle c)
- evalWebApiIO :: Handle c -> WebApiM c a -> IO a
- liftWebApiIO :: IO a -> WebApiM c a
- newtype WebApiM c a = WebApiM {
- runWebApiM :: ReaderT (Handle c) IO a
- class HasCredentials c where
- type Credentials c
- class HasToken c where
- type TokenContent c
- type Options c
- data Token c = Token {
- tToken :: TokenContent c
- tTime :: UTCTime
- accessToken :: HasToken c => WebApiM c (TokenContent c)
- refreshToken :: HasToken c => WebApiM c (Token c)
- data Handle c = Handle {
- credentials :: Credentials c
- token :: TVar (Maybe (Token c))
- options :: Options c
- parseRSAPrivateKey :: MonadThrow m => Text -> m PrivateKey
- data OAuth2Token = OAuth2Token {}
- data KeyException
- data JWTError
- data TokenExchangeException
- data CloudException
- urlEncode :: String -> String
Sending and receiving data
getLbs :: (HasCredentials c, MonadHttp (WebApiM c)) => Url scheme -> Option scheme -> WebApiM c LbsResponse Source #
GET
a lazy bytestring from an API endpoint
postLbs :: (HasCredentials c, MonadHttp (WebApiM c)) => Url scheme -> Option scheme -> ByteString -> WebApiM c LbsResponse Source #
POST
a request to an API endpoint and receive a lazy bytestring in return
putLbs :: (HasCredentials c, MonadHttp (WebApiM c)) => Url scheme -> Option scheme -> ByteString -> WebApiM c LbsResponse Source #
PUT
a request to an API endpoint and receive a lazy bytestring in return
Sending and receiving data, with token authentication
:: (HasCredentials c, HasToken c, MonadHttp (WebApiM c)) | |
=> (TokenContent c -> Url scheme -> Option scheme -> (Url scheme, Option scheme)) | Modify request URL and/or request |
-> Url scheme | Initial URL |
-> Option scheme | Initial |
-> WebApiM c LbsResponse |
Create an authenticated GET
call
:: (HasCredentials c, HasToken c, MonadHttp (WebApiM c)) | |
=> (TokenContent c -> Url scheme -> Option scheme -> ByteString -> (Url scheme, Option scheme, ByteString)) | Modify request URL, request |
-> Url scheme | Initial URL |
-> Option scheme | Initial |
-> ByteString | Initial request body |
-> WebApiM c LbsResponse |
Create an authenticated POST
call
:: (HasCredentials c, HasToken c, MonadHttp (WebApiM c)) | |
=> (TokenContent c -> Url scheme -> Option scheme -> ByteString -> (Url scheme, Option scheme, ByteString)) | Modify request URL, request |
-> Url scheme | Initial URL |
-> Option scheme | Initial |
-> ByteString | Initial request body |
-> WebApiM c LbsResponse |
Create an authenticated PUT
call
Running WebApiM programs
createHandle :: HasCredentials c => Credentials c -> Options c -> IO (Handle c) Source #
Create a Handle
with an initially empty token
Lifting IO programs into WebApiM
liftWebApiIO :: IO a -> WebApiM c a Source #
Lift an `IO a` action into the WebApiM
monad, and catch synchronous exceptions, while rethrowing the asynchronous ones to IO
Types
The main type of the library. It can easily be re-used in libraries that interface with more than one cloud API provider because its type parameter c
lets us declare distinct behaviours for each.
WebApiM | |
|
Monad (WebApiM c) Source # | |
Functor (WebApiM c) Source # | |
Applicative (WebApiM c) Source # | |
HasCredentials c => Alternative (WebApiM c) Source # | |
MonadIO (WebApiM c) Source # | |
MonadRandom (WebApiM c) Source # | |
MonadThrow (WebApiM c) Source # | |
MonadCatch (WebApiM c) Source # | |
MonadReader (Handle c) (WebApiM c) Source # | |
Authentication
class HasCredentials c Source #
type Credentials c Source #
accessToken :: HasToken c => WebApiM c (TokenContent c) Source #
Extract the token content (needed to authenticate subsequent requests). The token will be valid for at least 60 seconds
A Handle
contains all information necessary to communicating with a cloud API provider:
- Authentication credentials (e.g. username/password)
- Authentication token (used to authenticate every API call)
- Options (e.g. GCP authentication scopes)
Handle | |
|
MonadReader (Handle c) (WebApiM c) Source # | |
Private key
parseRSAPrivateKey :: MonadThrow m => Text -> m PrivateKey Source #
Parse a chunk of text into an RSA private key. For Google Cloud Platform , this is the private key associated with the user's "service account" (for server-to-server API use)
https://console.cloud.google.com/apis/credentials
Note: do not supply the RSA header and footer or any newlines (they will be inserted by this function).
OAuth2 related
data OAuth2Token Source #
Exceptions
data KeyException Source #
Authentication key exceptions
Errors associated with JWT-encoded token request
data TokenExchangeException Source #
Token exchange exceptions
NotFound !String | Something went wrong with the request, token not found |
APICredentialsNotFound !String |
data CloudException Source #
Cloud API exception