planb-token-introspection 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+93/−41 lines, 7 filesdep +th-formatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: th-format

API changes (from Hackage documentation)

Files

• README.md +1/−1
• planb-token-introspection.cabal +2/−1
• src/Network/PlanB/Introspection.hs +3/−2
• src/Network/PlanB/Introspection/Internal.hs +40/−21
• src/Network/PlanB/Introspection/Internal/Types.hs +8/−5
• tests/Network/PlanB/Introspection/Internal/Test.hs +38/−10
• tests/Network/PlanB/Introspection/Test.hs +1/−1

@@ -18,7 +18,7 @@ alternatively use  ```haskell-  introspector <- PlanB.newFromEnv+  introspector <- PlanB.newFromEnv Nothing ```  for creating the PlanB introspector.

@@ -1,5 +1,5 @@ name:                planb-token-introspection-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Token Introspection for PlanB description:         This package provides token introspection functionality                      for the PlanB token provider.@@ -58,6 +58,7 @@                      , http-types                      , unliftio-core                      , safe-exceptions+                     , th-format   ghc-options:         -Wall   default-language:    Haskell2010 

@@ -1,10 +1,11 @@ module Network.PlanB.Introspection   ( TokenInfo(..)   , Conf-  , PlanBIntrospectionException+  , IntrospectionException(..)   , new+  , newWithManager   , newFromEnv-  , newCustom+  , newWithBackend   , httpRequestExecuteIO   , introspectToken   ) where

@@ -5,10 +5,11 @@ module Network.PlanB.Introspection.Internal   ( TokenInfo(..)   , Conf-  , PlanBIntrospectionException+  , IntrospectionException(..)   , new+  , newWithManager   , newFromEnv-  , newCustom+  , newWithBackend   , httpRequestExecuteIO   , introspectToken   ) where@@ -35,12 +36,23 @@ new :: (MonadThrow m, MonadIO m)     => Text     -> m (TokenIntrospector m)-new endpoint = do-  conf <- newConf backendIO endpoint+new = newWithManager Nothing++-- | Create a new PlanB introspector using the provided endpoint and+-- manager.+newWithManager :: (MonadThrow m, MonadIO m)+               => Maybe Manager+               -> Text+               -> m (TokenIntrospector m)+newWithManager maybeManager endpoint = do+  conf <- newConf (backendIO maybeManager) endpoint   pure $ TokenIntrospector { introspectToken = introspectTokenImpl conf }-backendIO :: MonadIO m => Backend m-backendIO =-  Backend { backendHttp = httpBackendIO++backendIO :: MonadIO m+          => Maybe Manager+          -> Backend m+backendIO maybeManager =+  Backend { backendHttp = httpBackendIO maybeManager           , backendEnv  = envBackendIO }  envBackendIO :: MonadIO m => BackendEnv m@@ -54,26 +66,33 @@   >>> fmap (fmap Text.pack)   >>> liftIO -httpBackendIO :: MonadIO m => BackendHttp m-httpBackendIO =-  BackendHttp { httpRequestExecute = httpRequestExecuteIO Nothing }+httpBackendIO :: MonadIO m+              => Maybe Manager+              -> BackendHttp m+httpBackendIO maybeManager =+  BackendHttp { httpRequestExecute = httpRequestExecuteIO maybeManager } +-- | Convenience function. Create a new PlanB introspector using the+-- provided manager. The PlanB server to use is retrieved from the+-- environment variable @PLANB_INTROSPECTION_ENDPOINT@. newFromEnv :: (MonadThrow m, MonadIO m)-           => m (TokenIntrospector m)-newFromEnv = do-  let backend    = backendIO+           => Maybe Manager+           -> m (TokenIntrospector m)+newFromEnv maybeManager = do+  let backend = backendIO maybeManager       BackendEnv { .. } = backendEnv backend   endpoint <- envLookup "PLANB_INTROSPECTION_ENDPOINT" >>= \ case     Just ep -> pure ep-    Nothing -> throwM PlanBIntrospectionEndpointMissing-  newCustom backend endpoint+    Nothing -> throwM IntrospectionEndpointMissing+  newWithBackend backend endpoint -newCustom+-- | Create a new PlanB introspector using the provided backend and endpoint.+newWithBackend   :: (MonadThrow m, MonadIO m)   => Backend m   -> Text   -> m (TokenIntrospector m)-newCustom backend introspectionEndpoint = do+newWithBackend backend introspectionEndpoint = do   conf <- newConf backend introspectionEndpoint   pure $ TokenIntrospector { introspectToken = introspectTokenImpl conf } @@ -122,14 +141,14 @@     Right tokenInfo ->       pure tokenInfo     Left errMsg ->-      throwM $ PlanBIntrospectionDeserialization (Text.pack errMsg) body+      throwM $ IntrospectionDeserialization (Text.pack errMsg) body  bodyToPlanBException-  :: ByteString -> PlanBIntrospectionException+  :: ByteString -> IntrospectionException bodyToPlanBException bytes =   case eitherDecodeStrict bytes of     Right err ->-      PlanBIntrospectionError err+      IntrospectionError err     Left errMsgStr  ->       let errMsg = Text.pack errMsgStr-      in PlanBIntrospectionDeserialization errMsg bytes+      in IntrospectionDeserialization errMsg bytes

@@ -17,8 +17,11 @@  type LazyByteString = ByteString.Lazy.ByteString +-- | A 'TokenIntrospector' can be used for introspecting tokens. data TokenIntrospector m =-  TokenIntrospector { introspectToken :: ByteString -> m TokenInfo }+  TokenIntrospector+  { introspectToken :: ByteString -> m TokenInfo -- ^ Introspect the provided token+  }  data TokenInfo =   TokenInfo { tokenInfoExpiresIn :: Int@@ -56,9 +59,9 @@  $(deriveJSON (aesonDrop (length ("oauth2" :: String)) snakeCase) ''PlanBError) -data PlanBIntrospectionException = PlanBIntrospectionDeserialization Text ByteString-                                 | PlanBIntrospectionError PlanBError-                                 | PlanBIntrospectionEndpointMissing+data IntrospectionException = IntrospectionDeserialization Text ByteString+                            | IntrospectionError PlanBError+                            | IntrospectionEndpointMissing   deriving (Typeable, Show) -instance Exception PlanBIntrospectionException+instance Exception IntrospectionException

@@ -1,11 +1,15 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}  module Network.PlanB.Introspection.Internal.Test   ( planBTokenIntrospectionTests   ) where +import           Control.Exception.Safe+import           Control.Monad import           Data.ByteString                  (ByteString) import qualified Data.ByteString.Lazy             as ByteString.Lazy+import           Data.Format import qualified Data.Map                         as Map import qualified Data.Text.Encoding               as Text import           Network.HTTP.Client.Internal@@ -23,21 +27,45 @@   [ testGroup "Network.PlanB.Introspection.Internal" $     [ testCase "Introspect token"         testIntrospectToken+    , testCase "Deserialization failure is converted to exception"+        testDeserializationFailure     ]   ] +testDeserializationFailure :: Assertion+testDeserializationFailure = do+  let rspBody = ByteString.Lazy.fromStrict . Text.encodeUtf8 $ "{something broken"+      response = Response { responseStatus    = ok200+                          , responseVersion   = http20+                          , responseHeaders   = []+                          , responseBody      = rspBody+                          , responseCookieJar = CJ []+                          , responseClose'    = ResponseClose (pure ())+                          }+      testState = TestState+                  { _testStateHttpResponse = Just response+                  , _testStateHttpRequests = []+                  , _testStateEnvironment = Map.empty+                  }+      tokenName = "some-token-name"+  Left (PlanB.IntrospectionDeserialization _ _) <- try $ runTestStack testState $ do+    introspector <- makeTestIntrospector+    void $ introspectToken introspector tokenName+  pure ()+ testIntrospectToken :: Assertion testIntrospectToken = do-  let rspBody = ByteString.Lazy.fromStrict . Text.encodeUtf8 $-        "{ \"access_token\": \"some-token\",    \-        \  \"client_id\":    \"test-suite\",    \-        \  \"cn\":           \"some-username\", \-        \  \"expires_in\":   3591,              \-        \  \"grant_type\":   \"password\",      \-        \  \"realm\":        \"/employees\",    \-        \  \"scope\":        [\"uid\"],         \-        \  \"token_type\":   \"Bearer\",        \-        \  \"uid\":          \"some-user-name\" }"+  let rspBody = ByteString.Lazy.fromStrict . Text.encodeUtf8 $ [fmt|+        { "access_token": "some-token",+          "client_id":    "test-suite",+          "cn":           "some-username",+          "expires_in":   3591,+          "grant_type":   "password",+          "realm":        "/employees",+          "scope":        ["uid"],+          "token_type":   "Bearer",+          "uid":          "some-user-name" }+          |]       response = Response { responseStatus    = ok200                           , responseVersion   = http20                           , responseHeaders   = []

@@ -103,4 +103,4 @@  makeTestIntrospector :: TestStack (TokenIntrospector TestStack) makeTestIntrospector =-  newCustom mockBackend "https://localhost"+  newWithBackend mockBackend "https://localhost"