v0.5

CHANGELOG.md

@@ -8,6 +8,10 @@ and this project adheres to the
 
 ## Unreleased
 
+## 0.5.0.0
+
+Add 'getE', 'postE', 'tryReq' to pattern match against HTTP exceptions
+
 ## 0.4.0.0
 
 Add Session.tokensToList and Session.newTokens

ms-graph-api.cabal

@@ -1,5 +1,5 @@
 name: ms-graph-api
-version: 0.4.0.0
+version: 0.5.0.0
 synopsis: Microsoft Graph API
 description: Bindings to the Microsoft Graph API
 homepage: https://github.com/unfoldml/ms-graph-api

src/MSGraphAPI/Internal/Common.hs

@@ -7,10 +7,15 @@ module MSGraphAPI.Internal.Common (
  -- * GET
  get
  , getLbs
+ -- ** catch HTTP exceptions
+ , getE
  -- * POST
  , post
+ -- ** catch HTTP exceptions
+ , postE
  -- * running requests
  , runReq
+ , tryReq
  -- * JSON : aeson helpers
  , Collection(..)
  , aesonOptions
@@ -38,17 +43,27 @@ import Network.OAuth.OAuth2.Internal (AccessToken(..), ExchangeToken(..), Refres
 -- modern-uri
 import Text.URI (URI, mkURI)
 -- req
-import Network.HTTP.Req (Req, runReq, defaultHttpConfig, req, Option, (=:), GET(..), POST(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody)
+import Network.HTTP.Req (Req, runReq, HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody)
 -- text
 import Data.Text (Text, pack, unpack)
+-- unliftio
+import UnliftIO (MonadUnliftIO(..))
+import UnliftIO.Exception (try)
 
 import Network.OAuth2.Session (Tokens)
 
 
+-- | Specialized version of 'try' to 'HttpException's
+--
+-- This can be used to catch exceptions of composite 'Req' statements, e.g. around a @do@ block
+tryReq :: Req a -> Req (Either HttpException a)
+tryReq = try
+
+
 -- -- GET, POST 
 
 -- | @POST https:\/\/graph.microsoft.com\/v1.0\/...@
-post :: (A.FromJSON b, A.ToJSON a) =>
+post :: (A.ToJSON a, A.FromJSON b) =>
  [Text] -- ^ URI path segments
  -> Option 'Https
  -> a -- ^ request body
@@ -59,6 +74,12 @@ post paths params bdy tok = responseBody <$> req POST url (ReqBodyJson bdy) json
  opts = auth <> params
  (url, auth) = msGraphReqConfig tok paths
 
+-- | Like 'post' but catches 'HttpException's to allow pattern matching
+postE :: (A.ToJSON a, A.FromJSON b) =>
+ [Text] -- ^ URI path segments
+ -> Option 'Https -> a -> AccessToken -> Req (Either HttpException b)
+postE paths params bdy tok = tryReq (post paths params bdy tok)
+
 -- | @GET https:\/\/graph.microsoft.com\/v1.0\/...@
 get :: A.FromJSON a =>
  [Text] -- ^ URI path segments
@@ -70,6 +91,12 @@ get paths params tok = responseBody <$> req GET url NoReqBody jsonResponse opts
  opts = auth <> params
  (url, auth) = msGraphReqConfig tok paths
 
+-- | Like 'get' but catches 'HttpException's to allow pattern matching
+getE :: (A.FromJSON a) =>
+ [Text] -- ^ URI path segments
+ -> Option 'Https -> AccessToken -> Req (Either HttpException a)
+getE paths params tok = tryReq (get paths params tok)
+
 -- | @GET https:\/\/graph.microsoft.com\/v1.0\/...@
 --
 -- Returns the response body as a bytestring, e.g. for endpoints that download files or general bytestring payloads

src/Network/OAuth2/Provider/AzureAD.hs

@@ -34,6 +34,7 @@ data AzureAD = AzureAD deriving (Eq, Show)
 
 type instance IdpUserInfo AzureAD = AzureADUser
 
+-- | Configuration object of the OAuth2 application
 data OAuthCfg = OAuthCfg {
  oacAppName :: TL.Text -- ^ application name
  , oacClientId :: ClientId -- ^ app client ID : see https://stackoverflow.com/a/70670961
@@ -43,7 +44,7 @@ data OAuthCfg = OAuthCfg {
  , oacRedirectURI :: URI -- ^ OAuth2 redirect URI
  }
 
--- | NB : OIDC scopes @openid@ and @offline_access@ are ALWAYS requested since the library assumes we have access to refresh tokens and ID tokens
+-- | NB : scopes @openid@ and @offline_access@ are ALWAYS requested since the library assumes we have access to refresh tokens and ID tokens
 azureADApp :: OAuthCfg -- ^ OAuth configuration
  -> IdpApplication 'AuthorizationCode AzureAD
 azureADApp (OAuthCfg appname clid sec scopes authstate reduri) = defaultAzureADApp{

src/Network/OAuth2/Session.hs

@@ -136,7 +136,7 @@ loginH :: Monad m =>
  IdpApplication 'AuthorizationCode AzureAD
  -> Action m ()
 loginH idpApp = do
- setHeader "Location" (mkAuthorizeRequest idpApp) -- $ azureADApp oacfg)
+ setHeader "Location" (mkAuthorizeRequest idpApp) -- redirect to OAuth consent screen
  status status302
 
 -- | The identity provider redirects the client to the 'reply' endpoint as part of the OAuth flow : https://learn.microsoft.com/en-us/graph/auth-v2-user?view=graph-rest-1.0&tabs=http#authorization-response
@@ -165,7 +165,7 @@ replyH idpApp ts mgr = do
  etoken = ExchangeToken $ TL.toStrict codeP
  _ <- fetchUpdateToken ts idpApp mgr etoken
  pure ()
- Nothing -> throwE OASEExchangeTokenNotFound -- $ T.pack $ unwords ["cannot decode token"]
+ Nothing -> throwE OASEExchangeTokenNotFound
 
 --
 
@@ -183,7 +183,7 @@ fetchUpdateToken :: MonadUnliftIO m =>
  -> IdpApplication 'AuthorizationCode AzureAD
  -> Manager
  -> ExchangeToken -- ^ also called 'code'. Expires in 10 minutes
- -> ExceptT OAuthSessionError m OAuth2Token -- IO (Either T.Text OAuth2Token)
+ -> ExceptT OAuthSessionError m OAuth2Token
 fetchUpdateToken ts idpApp mgr etoken = ExceptT $ do
  tokenResp <- runExceptT $ conduitTokenRequest idpApp mgr etoken -- OAuth2 token
  case tokenResp of
@@ -195,14 +195,15 @@ fetchUpdateToken ts idpApp mgr etoken = ExceptT $ do
  Right uid -> do
  _ <- refreshLoop ts idpApp mgr uid oat -- fork a thread and start refresh loop for this user
  pure $ Right oat
- Left es -> pure $ Left (OASEJWTException es) -- $ T.pack (show e) -- ^ id token validation failed
+ Left es -> pure $ Left (OASEJWTException es) -- id token validation failed
  Left es -> pure $ Left (OASEOAuth2Errors es)
 
+-- | 2) fork a thread and start token refresh loop for user @uid@
 refreshLoop :: (MonadUnliftIO m, Ord uid, HasRefreshTokenRequest a) =>
  Tokens uid OAuth2Token
  -> IdpApplication a i
  -> Manager
- -> uid
+ -> uid -- ^ user ID
  -> OAuth2Token
  -> m ThreadId
 refreshLoop ts idpApp mgr uid oaToken = forkFinally (act oaToken) cleanup