planb-token-introspection 0.1.2.0 → 0.1.3.0

raw patch · 6 files changed

+73/−52 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• planb-token-introspection.cabal +1/−1
• src/Network/PlanB/Introspection.hs +4/−6
• src/Network/PlanB/Introspection/Internal.hs +13/−9
• src/Network/PlanB/Introspection/Internal/Types.hs +16/−11
• tests/Network/PlanB/Introspection/Internal/Test.hs +24/−2
• tests/Network/PlanB/Introspection/Test.hs +15/−23

@@ -1,5 +1,5 @@ name:                planb-token-introspection-version:             0.1.2.0+version:             0.1.3.0 synopsis:            Token Introspection for PlanB description:         This package provides token introspection functionality                      for the PlanB token provider.

@@ -1,14 +1,12 @@ module Network.PlanB.Introspection   ( TokenInfo(..)-  , Conf-  , IntrospectionException(..)+  , IntrospectionError(..)   , ErrorResponse(..)+  , TokenIntrospector(..)   , new   , newWithManager   , newFromEnv-  , newWithBackend-  , httpRequestExecuteIO-  , introspectToken-  ) where+  )+where  import           Network.PlanB.Introspection.Internal

@@ -5,14 +5,17 @@ module Network.PlanB.Introspection.Internal   ( TokenInfo(..)   , Conf-  , IntrospectionException(..)+  , IntrospectionError(..)   , ErrorResponse(..)+  , TokenIntrospector(..)+  , Backend(..)+  , BackendEnv(..)+  , BackendHttp(..)   , new   , newWithManager   , newFromEnv   , newWithBackend-  , httpRequestExecuteIO-  , introspectToken+  , backendIO   ) where  import           Control.Arrow@@ -33,22 +36,23 @@  import           Network.PlanB.Introspection.Internal.Types --- | Create a new PlanB introspector using the provided endpoint.+-- | Create a new PlanB token introspector using the provided endpoint. Uses a global default HTTP manager. new :: (MonadThrow m, MonadIO m)     => Text     -> m (TokenIntrospector m) new = newWithBackend (backendIO Nothing) --- | Create a new PlanB introspector using the provided endpoint and--- manager.+-- | Create a new PlanB toke introspector using the provided endpoint and+-- HTTP manager. newWithManager :: (MonadThrow m, MonadIO m)                => Manager                -> Text                -> m (TokenIntrospector m) newWithManager manager = newWithBackend (backendIO (Just manager)) +-- | Produces the default IO backend. backendIO :: MonadIO m-          => Maybe Manager+          => Maybe Manager -- ^ Use global default HTTP manager if 'Nothing'.           -> Backend m backendIO maybeManager =   Backend { backendHttp = httpBackendIO maybeManager@@ -85,7 +89,7 @@     Nothing -> throwM NoEndpoint   newWithBackend backend endpoint --- | Create a new PlanB introspector using the provided backend and endpoint.+-- | Create a new PlanB token introspector using the provided backend and endpoint. newWithBackend   :: (MonadThrow m, MonadIO m)   => Backend m@@ -143,7 +147,7 @@         BackendHttp { .. } = backend & backendHttp  bodyToPlanBException-  :: ByteString -> IntrospectionException+  :: ByteString -> IntrospectionError bodyToPlanBException bytes =   case eitherDecodeStrict bytes of     Right err @ ErrorResponse { .. } ->

@@ -8,10 +8,10 @@ import           Control.Exception.Safe import           Data.Aeson.Casing import           Data.Aeson.TH-import           Data.ByteString        (ByteString)-import qualified Data.ByteString.Lazy   as ByteString.Lazy+import           Data.ByteString                ( ByteString )+import qualified Data.ByteString.Lazy          as ByteString.Lazy import           Data.Set-import           Data.Text              (Text)+import           Data.Text                      ( Text ) import           GHC.Generics import           Network.HTTP.Client @@ -20,9 +20,10 @@ -- | A 'TokenIntrospector' can be used for introspecting tokens. data TokenIntrospector m =   TokenIntrospector-  { introspectToken :: ByteString -> m TokenInfo -- ^ Introspect the provided token+  { introspectToken :: ByteString -> m TokenInfo -- ^ Introspect the provided token.   } +-- | Information returned on a successful token introspection. data TokenInfo =   TokenInfo { tokenInfoExpiresIn :: Int             , tokenInfoScope     :: Set Text@@ -40,6 +41,7 @@   { envLookup :: Text -> m (Maybe Text)   } +-- | Type for backends for the PlanB token introspector. data Backend m = Backend   { backendHttp :: BackendHttp m   , backendEnv  :: BackendEnv m@@ -49,6 +51,7 @@   { confIntrospectionRequest :: Request   , confBackend              :: Backend m } +-- | Contains the error response data returned from a PlanB server in case of an introspection error. data ErrorResponse = ErrorResponse   { errorResponseError            :: Text   , errorResponseErrorDescription :: Maybe Text@@ -56,11 +59,13 @@  $(deriveJSON (aesonDrop (length ("errorResponse" :: String)) snakeCase) ''ErrorResponse) -data IntrospectionException = DeserializationFailure Text ByteString-                            | InvalidRequest ErrorResponse-                            | InvalidToken ErrorResponse-                            | Other ErrorResponse-                            | NoEndpoint-  deriving (Typeable, Show)+-- | This type models the error scenarios specific to a token introspection attempt. These can be used+-- as exceptions and are in fact thrown by a PlanB token introspector.+data IntrospectionError = DeserializationFailure Text ByteString+                        | InvalidRequest ErrorResponse+                        | InvalidToken ErrorResponse+                        | Other ErrorResponse+                        | NoEndpoint+  deriving (Typeable, Show, Eq, Generic) -instance Exception IntrospectionException+instance Exception IntrospectionError

@@ -29,9 +29,32 @@         testIntrospectToken     , testCase "Deserialization failure is converted to exception"         testDeserializationFailure+    , testCase "InvalidToken exception is thrown"+        testInvalidToken     ]   ] +testInvalidToken :: Assertion+testInvalidToken = do+  let rspBody = ByteString.Lazy.fromStrict . Text.encodeUtf8 $+        [fmt|{"error":"invalid_token","error_description":"Access Token not valid"}|]+      response = Response { responseStatus    = status401+                          , responseVersion   = http20+                          , responseHeaders   = []+                          , responseBody      = rspBody+                          , responseCookieJar = CJ []+                          , responseClose'    = ResponseClose (pure ())+                          }+      testState = TestState+                  { _testStateHttpResponse = Just response+                  , _testStateHttpRequests = []+                  , _testStateEnvironment = Map.empty+                  }+  Left (PlanB.InvalidToken _) <- try $ runTestStack testState $ do+    introspector <- makeTestIntrospector+    void $ introspectToken introspector "some-token"+  pure ()+ testDeserializationFailure :: Assertion testDeserializationFailure = do   let rspBody = ByteString.Lazy.fromStrict . Text.encodeUtf8 $ "{something broken"@@ -47,10 +70,9 @@                   , _testStateHttpRequests = []                   , _testStateEnvironment = Map.empty                   }-      tokenName = "some-token-name"   Left (PlanB.DeserializationFailure _ _) <- try $ runTestStack testState $ do     introspector <- makeTestIntrospector-    void $ introspectToken introspector tokenName+    void $ introspectToken introspector "some-token"   pure ()  testIntrospectToken :: Assertion

@@ -13,26 +13,24 @@  import           Control.Arrow import           Control.Lens-import           Control.Monad.Catch                        hiding (bracket)+import           Control.Monad.Catch     hiding ( bracket ) import           Control.Monad.IO.Class import           Control.Monad.IO.Unlift import           Control.Monad.Reader import           Control.Monad.State-import qualified Data.ByteString.Lazy                       as ByteString.Lazy+import qualified Data.ByteString.Lazy          as ByteString.Lazy import           Data.IORef-import           Data.Map                                   (Map)-import qualified Data.Map                                   as Map-import           Data.Text                                  (Text)+import           Data.Map                       ( Map )+import qualified Data.Map                      as Map+import           Data.Text                      ( Text ) import           Network.HTTP.Client- import           Network.PlanB.Introspection.Internal-import           Network.PlanB.Introspection.Internal.Types  runTestStack :: TestState -> TestStack a -> IO (a, TestState) runTestStack testState m = do   s <- newIORef testState   a <- m & (_runTestStack >>> flip runReaderT s)-  (a,) <$> readIORef s+  (a, ) <$> readIORef s  evalTestStack :: TestState -> TestStack a -> IO a evalTestStack testState m = do@@ -72,23 +70,20 @@     envRef <- ask     liftIO $ writeIORef envRef s -mockHttpRequestExecute :: Request -> TestStack (Response LazyByteString)+mockHttpRequestExecute+  :: Request -> TestStack (Response ByteString.Lazy.ByteString) mockHttpRequestExecute request = do   testStateHttpRequests %= (request :)   maybeResponse <- gets (view testStateHttpResponse)   case maybeResponse of-    Just response ->-      pure response-    Nothing ->-      error "FIXME"+    Just response -> pure response+    Nothing       -> error "FIXME"  mockHttpBackend :: BackendHttp TestStack-mockHttpBackend =-  BackendHttp { httpRequestExecute = mockHttpRequestExecute }+mockHttpBackend = BackendHttp {httpRequestExecute = mockHttpRequestExecute}  mockEnvBackend :: BackendEnv TestStack-mockEnvBackend =-  BackendEnv { envLookup = mockEnvLookup }+mockEnvBackend = BackendEnv {envLookup = mockEnvLookup}  mockEnvLookup :: Text -> TestStack (Maybe Text) mockEnvLookup name = do@@ -96,11 +91,8 @@   pure $ Map.lookup name environment  mockBackend :: Backend TestStack-mockBackend = Backend-  { backendHttp = mockHttpBackend-  , backendEnv = mockEnvBackend-  }+mockBackend =+  Backend {backendHttp = mockHttpBackend, backendEnv = mockEnvBackend}  makeTestIntrospector :: TestStack (TokenIntrospector TestStack)-makeTestIntrospector =-  newWithBackend mockBackend "https://localhost"+makeTestIntrospector = newWithBackend mockBackend "https://localhost"