diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ + 0.3 + * Split HasCredentials into HasCredentials, HasToken + 0.2 * Rename Cloud to WebApiM * Stackage LTS 10.5 (ghc 8.2.2) diff --git a/goggles.cabal b/goggles.cabal --- a/goggles.cabal +++ b/goggles.cabal @@ -1,7 +1,7 @@ name: goggles -version: 0.2 -synopsis: Interface to Google Cloud APIs -description: High-level, extensible interface to Google Cloud APIs. +version: 0.3 +synopsis: Extensible interface to Web APIs +description: `goggles` helps with exchanging data with APIs that require authentication. In particular, it handles the details of expiring session tokens, so the user does not have to implement this logic in her program. homepage: https://github.com/ocramz/goggles license: BSD3 license-file: LICENSE @@ -23,12 +23,12 @@ Network.Goggles.Auth other-modules: Data.Keys Network.Goggles.Cloud - Network.Utils.HTTP Network.Goggles.Types + Network.Goggles.Control.Exceptions + Network.Utils.HTTP -- Network.Goggles.Auth.JWT Network.Goggles.Auth.OAuth2 -- Network.Goggles.Auth.TokenExchange - Network.Goggles.Control.Exceptions build-depends: base >= 4.7 && < 5 , binary , scientific diff --git a/src/Network/Goggles.hs b/src/Network/Goggles.hs --- a/src/Network/Goggles.hs +++ b/src/Network/Goggles.hs @@ -1,66 +1,42 @@ {-| -== /Dependencies/ -The examples require the following declarations (which in turn mean that the @req@ and @bytestring@ libraries are imported by the user's project). You will also need the @OverloadedStrings@ language extension : - -> import qualified Data.ByteString.Lazy as LB -> import Network.HTTP.Req (responseBody) -> import Network.Goggles - -== /Examples/ - -This first example, @listBucket@, reads content from a cloud storage bucket: - -1. it loads the GCP credentials (username and RSA key), -2. retrieves a token via OAuth2, -3. performs a single call to the Cloud Storage API endpoint that lists the metadata related to the contents of a storage bucket, and -4. returns the raw API data to the user as a lazy ByteString. - -> listBucket :: IO LB.ByteString -> listBucket = do -> let usr = "...iam.gserviceaccount.com" -> bucket = "" -> key = "" -> pvtkey <- parseRSAPrivateKey key -> let creds = GCPServiceAccount pvtkey usr Nothing "" -> hdl <- createHandle creds scopesDefault -> responseBody <$> evalWebApiIO hdl (listObjects bucket) - - -} module Network.Goggles ( -- ** Running WebApiM programs createHandle , evalWebApiIO - -- *** "Lifting" IO programs into 'WebApiM' + -- *** Lifting IO programs into 'WebApiM' , liftWebApiIO -- * Types - -- , GCP - -- , GCPServiceAccount(..) - -- , GCPTokenOptions(..) , WebApiM(..) -- ** Authentication , HasCredentials(..) + , HasToken(..) , Token(..) - -- , accessToken - -- , refreshToken + , accessToken + , refreshToken , Handle(..) -- * Private key , parseRSAPrivateKey + -- * OAuth2 related + , OAuth2Token(..) -- * Exceptions , KeyException(..) , JWTError(..) , TokenExchangeException(..) - , CloudException(..) + , CloudException(..) + -- * Utilities + , putLbs, getLbs, urlEncode ) where import Network.Goggles.Control.Exceptions import Network.Goggles.Cloud -import Network.Goggles.Types --- import Network.Goggles.Auth.TokenExchange +import Network.Goggles.Auth +-- import Network.Goggles.Types +import Network.Utils.HTTP import Data.Keys --- import System.Environment (lookupEnv) + diff --git a/src/Network/Goggles/Auth.hs b/src/Network/Goggles/Auth.hs --- a/src/Network/Goggles/Auth.hs +++ b/src/Network/Goggles/Auth.hs @@ -1,6 +1,13 @@ {-# language OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} {-# language RankNTypes #-} -module Network.Goggles.Auth where +module Network.Goggles.Auth + ( + requestOAuth2Token + , OAuth2Token(..) + , OAuth2TokenUTC(..) + , mkOAuth2TokenUTC + ) +where import Network.Goggles.Auth.OAuth2 --- import Network.Goggles.Auth.JWT + diff --git a/src/Network/Goggles/Cloud.hs b/src/Network/Goggles/Cloud.hs --- a/src/Network/Goggles/Cloud.hs +++ b/src/Network/Goggles/Cloud.hs @@ -1,11 +1,22 @@ {-# language OverloadedStrings, TypeFamilies, GeneralizedNewtypeDeriving #-} {-# language FlexibleContexts, MultiParamTypeClasses, DeriveDataTypeable #-} {-# language UndecidableInstances #-} + +{-| +Module : Network.Goggles.Cloud +Description : WebApiM and related functionality +Copyright : (c) Marco Zocca, 2018 +License : GPL-3 +Maintainer : zocca.marco gmail +Stability : experimental +Portability : POSIX +-} module Network.Goggles.Cloud ( WebApiM(..) , evalWebApiIO , liftWebApiIO , HasCredentials(..) + , HasToken(..) , Token(..) , accessToken , refreshToken @@ -27,11 +38,12 @@ import Network.Goggles.Control.Exceptions --- | This class class HasCredentials c where type Credentials c - type Options c - type TokenContent c + +class HasToken c where + type TokenContent c + type Options c tokenFetch :: WebApiM c (Token c) -- | An authentication 'Token' with an expiry date @@ -86,8 +98,8 @@ liftWebApiIO_ m = WebApiM $ ReaderT (const m) -- | Lift an `IO a` action into the 'WebApiM' monad, and catch synchronous exceptions, while rethrowing the asynchronous ones to IO -liftWebApiIO :: HasCredentials c => IO a -> WebApiM c a -liftWebApiIO m = do +liftWebApiIO :: IO a -> WebApiM c a +liftWebApiIO m = liftWebApiIO_ m `catch` \e -> case fromException e of Just asy -> throwM (asy :: AsyncException) Nothing -> throwM $ IOError (show e) @@ -107,13 +119,13 @@ -instance HasCredentials c => MonadIO (WebApiM c) where +instance MonadIO (WebApiM c) where liftIO = liftWebApiIO -instance HasCredentials c => MonadThrow (WebApiM c) where +instance MonadThrow (WebApiM c) where throwM = liftIO . throwM -instance HasCredentials c => MonadCatch (WebApiM c) where +instance MonadCatch (WebApiM c) where catch (WebApiM (ReaderT m)) c = WebApiM $ ReaderT $ \r -> m r `catch` \e -> runReaderT (runWebApiM $ c e) r @@ -123,10 +135,10 @@ handleHttpException = throwM -} -instance HasCredentials c => MonadRandom (WebApiM c) where +instance MonadRandom (WebApiM c) where getRandomBytes = liftIO . getEntropy -instance HasCredentials c => MonadReader (Handle c) (WebApiM c) where +instance MonadReader (Handle c) (WebApiM c) where ask = WebApiM RT.ask local f m = WebApiM $ RT.local f (runWebApiM m) @@ -135,7 +147,7 @@ -- | `cacheToken tok hdl` : Overwrite the token TVar `tv` containing a token if `tok` carries a more recent timestamp. cacheToken :: - HasCredentials c => Token c -> WebApiM c (Token c) + HasToken c => Token c -> WebApiM c (Token c) cacheToken tok = do tv <- asks token liftWebApiIO $ atomically $ do @@ -146,20 +158,20 @@ writeTVar tv (Just new) return new -refreshToken :: HasCredentials c => WebApiM c (Token c) +refreshToken :: HasToken c => WebApiM c (Token c) refreshToken = tokenFetch >>= cacheToken -- | Extract the token content (needed to authenticate subsequent requests). The token will be valid for at least 60 seconds -accessToken :: HasCredentials c => WebApiM c (TokenContent c) +accessToken :: (HasToken c) => WebApiM c (TokenContent c) accessToken = do tokenTVar <- asks token mbToken <- liftWebApiIO $ atomically $ readTVar tokenTVar tToken <$> case mbToken of Nothing -> refreshToken Just t -> do - now <- liftWebApiIO $ getCurrentTime + now <- liftWebApiIO getCurrentTime if now > addUTCTime (- 60) (tTime t) then refreshToken else return t diff --git a/src/Network/Goggles/Types.hs b/src/Network/Goggles/Types.hs --- a/src/Network/Goggles/Types.hs +++ b/src/Network/Goggles/Types.hs @@ -1,5 +1,5 @@ {-# language TypeFamilies, FlexibleInstances #-} module Network.Goggles.Types where -import qualified Data.Text as T +-- import qualified Data.Text as T