keycloak-hs 2.1.0 → 3.0.0

raw patch · 7 files changed

+121/−105 lines, 7 filesdep +monad-timePVP ok

version bump matches the API change (PVP)

Dependencies added: monad-time

API changes (from Hackage documentation)

Files

• README.md +1/−0
• keycloak-hs.cabal +2/−1
• src/Keycloak/Authorizations.hs +16/−18
• src/Keycloak/Tokens.hs +22/−21
• src/Keycloak/Types.hs +24/−9
• src/Keycloak/Users.hs +7/−7
• src/Keycloak/Utils.hs +49/−49

@@ -1,5 +1,6 @@ Keycloak-hs ===========+[![Build status](https://github.com/cdupont/keycloak-hs/actions/workflows/ci.yml/badge.svg)](https://github.com/cdupont/keycloak-hs/actions/workflows/ci.yml)  Keycloak-hs is an Haskell library for connecting to [Keycloak](https://www.keycloak.org/). Keycloak allows to authenticate and manage users and to protect API resources.

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: keycloak-hs-version: 2.1.0+version: 3.0.0 license: BSD3 license-file: LICENSE copyright: 2019 Corentin Dupont@@ -48,6 +48,7 @@         jose >=0.8 && <0.9,         lens >=4.17 && <4.20,         lens-aeson >=1.1 && <1.2,+        monad-time >= 0.3 && <0.4,         mtl >=2.2 && <2.3,         string-conversions >=0.4 && <0.5,         safe >=0.3 && <0.4,

@@ -28,7 +28,6 @@ module Keycloak.Authorizations where  import           Control.Monad.Reader as R-import           Control.Monad.Except (throwError) import           Data.Aeson as JSON import           Data.Text as T hiding (head, tail, map) import           Data.Either@@ -45,19 +44,19 @@ -- * Permissions  -- | Returns true if the resource is authorized under the given scope.-isAuthorized :: ResourceId -> ScopeName -> JWT -> Keycloak Bool+isAuthorized :: MonadIO m => ResourceId -> ScopeName -> JWT -> KeycloakT m Bool isAuthorized res scope tok = do   r <- U.try $ checkPermission res scope tok   case r of     Right _ -> return True     Left e | (statusCode <$> U.getErrorStatus e) == Just 403 -> return False-    Left e -> throwError e --rethrow the error+    Left e -> kcError e --rethrow the error  -- | Return the permissions for the permission requests.-getPermissions :: [PermReq] -> JWT -> Keycloak [Permission]+getPermissions :: MonadIO m => [PermReq] -> JWT -> KeycloakT m [Permission] getPermissions reqs tok = do   debug "Get all permissions"-  client <- view $ confAdapterConfig.confResource+  client <- viewConfig $ confAdapterConfig.confResource   let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),              "audience" := client,              "response_mode" := ("permissions" :: Text)] @@ -69,7 +68,7 @@       return ret     Left (err2 :: String) -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)   where     getPermString :: PermReq -> [Text]     getPermString (PermReq (Just (ResourceId rid)) []) = [rid]@@ -77,10 +76,10 @@     getPermString (PermReq Nothing scopes) = map (\(ScopeName s) -> ("#" <> s)) scopes  -- | Checks if a scope is permitted on a resource. An HTTP Exception 403 will be thrown if not.-checkPermission :: ResourceId -> ScopeName -> JWT -> Keycloak ()+checkPermission :: MonadIO m => ResourceId -> ScopeName -> JWT -> KeycloakT m () checkPermission (ResourceId res) (ScopeName scope) tok = do   debug $ "Checking permissions: " ++ (show res) ++ " " ++ (show scope)-  client <- view $ confAdapterConfig.confResource+  client <- viewConfig $ confAdapterConfig.confResource   let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),              "audience" := client,              "permission"  := res <> "#" <> scope]@@ -90,7 +89,7 @@ -- * Resource  -- | Create an authorization resource in Keycloak, under the configured client.-createResource :: Resource -> JWT -> Keycloak ResourceId+createResource :: MonadIO m => Resource -> JWT -> KeycloakT m ResourceId createResource r tok = do   debug $ convertString $ "Creating resource: " <> (JSON.encode r)   body <- keycloakPost "authz/protection/resource_set" (toJSON r) tok@@ -101,17 +100,17 @@       return $ fromJustNote "create" $ resId ret     Left err2 -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)  -- | Delete the resource-deleteResource :: ResourceId -> JWT -> Keycloak ()+deleteResource :: MonadIO m => ResourceId -> JWT -> KeycloakT m () deleteResource (ResourceId rid) tok = do   --tok2 <- getClientAuthToken    keycloakDelete ("authz/protection/resource_set/" <> rid) tok   return ()  -- | Delete all resources in Keycloak-deleteAllResources :: JWT -> Keycloak ()+deleteAllResources :: MonadIO m => JWT ->  KeycloakT m () deleteAllResources tok = do   debug "Deleting all Keycloak resources..."   ids <- getAllResourceIds@@ -119,7 +118,7 @@   debug $ "Deleted " ++ (show $ L.length $ rights res) ++ " resources out of " ++ (show $ L.length ids)  -- | get a single resource-getResource :: ResourceId -> JWT -> Keycloak Resource+getResource :: MonadIO m => ResourceId -> JWT -> KeycloakT m Resource getResource (ResourceId rid) tok = do   body <- keycloakGet ("authz/protection/resource_set/" <> rid) tok   case eitherDecode body of@@ -127,10 +126,10 @@       return ret     Left (err2 :: String) -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)  -- | get all resources IDs-getAllResourceIds :: Keycloak [ResourceId]+getAllResourceIds :: MonadIO m => KeycloakT m [ResourceId] getAllResourceIds = do   debug "Get all resources"   tok2 <- getClientJWT @@ -140,9 +139,8 @@       return ret     Left (err2 :: String) -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)  -- | Update a resource-updateResource :: Resource -> JWT -> Keycloak ResourceId+updateResource :: MonadIO m => Resource -> JWT ->  KeycloakT m ResourceId updateResource = createResource-

@@ -39,7 +39,8 @@ module Keycloak.Tokens where  import           Control.Lens hiding ((.=))-import           Control.Monad.Except (throwError)+import           Control.Monad.IO.Class+import           Control.Monad.Time (MonadTime) import           Crypto.JWT as JWT import           Data.Aeson as JSON import           Data.Aeson.Lens@@ -54,11 +55,11 @@  -- | Retrieve the user's token. This token can be used to authenticate the user. -- This token can be also used for every other Keycloak calls.-getJWT :: Username -> Password -> Keycloak JWT-getJWT username password = do +getJWT :: MonadIO m => Username -> Password ->  KeycloakT m JWT+getJWT username password = do   debug "Get user token"-  client <- view $ confAdapterConfig.confResource-  secret <- view $ confAdapterConfig.confCredentials.confSecret+  client <- viewConfig $ confAdapterConfig.confResource+  secret <- viewConfig $ confAdapterConfig.confCredentials.confSecret   let dat = ["client_id" := client,               "client_secret" := secret,              "grant_type" := ("password" :: Text),@@ -67,19 +68,19 @@   body <- keycloakPost' "protocol/openid-connect/token" dat   debug $ "Keycloak: " ++ (show body)    case eitherDecode body of-    Right ret -> do +    Right ret -> do       debug $ "Keycloak success: " ++ (show ret) -      decodeCompact $ convertString $ accessToken ret+      KeycloakT $ decodeCompact $ convertString $ accessToken ret     Left err2 -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)  -- | return a Client token (linked to a Client, not a User). It is useful to create Resources in that Client in Keycloak.-getClientJWT :: Keycloak JWT+getClientJWT :: MonadIO m => KeycloakT m JWT getClientJWT = do   debug "Get client token"-  client <- view $ confAdapterConfig.confResource-  secret <- view $ confAdapterConfig.confCredentials.confSecret+  client <- viewConfig $ confAdapterConfig.confResource+  secret <- viewConfig $ confAdapterConfig.confCredentials.confSecret   let dat = ["client_id" := client,               "client_secret" := secret,              "grant_type" := ("client_credentials" :: Text)]@@ -87,17 +88,17 @@   case eitherDecode body of     Right ret -> do       debug $ "Keycloak success: " ++ (show ret) -      decodeCompact $ convertString $ accessToken ret+      KeycloakT $ decodeCompact $ convertString $ accessToken ret     Left err2 -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)   -- | Verify a JWT. If sucessful, the claims are returned. Otherwise, a JWTError is thrown. -verifyJWT :: JWT -> Keycloak ClaimsSet+verifyJWT :: (MonadTime m, MonadIO m) => JWT -> KeycloakT m ClaimsSet verifyJWT jwt = do-  jwks <- view confJWKs-  verifyClaims (defaultJWTValidationSettings (const True)) (head jwks) jwt+  jwks <- viewConfig confJWKs+  KeycloakT $ verifyClaims (defaultJWTValidationSettings (const True)) (head jwks) jwt  -- | Extract the user identity from a token. Additional attributes can be encoded in the token. getClaimsUser :: ClaimsSet -> User@@ -114,14 +115,14 @@ getJWKs :: Realm -> ServerURL -> IO [JWK] getJWKs realm baseUrl = do   let opts = W.defaults-  let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/protocol/openid-connect/certs") -  info $ "Issuing KEYCLOAK GET with url: " ++ (show url) -  debug $ "  headers: " ++ (show $ opts ^. W.headers) +  let url = unpack (baseUrl <> "/realms/" <> realm <> "/protocol/openid-connect/certs")+  info $ "Issuing KEYCLOAK GET with url: " ++ show url+  debug $ "  headers: " ++ show (opts ^. W.headers)   res <- W.getWith opts url   let body = fromJust $ res ^? responseBody   info $ show body   case eitherDecode body of      Right (JWKSet jwks) -> return jwks      Left (err2 :: String) -> do-       debug $ "Keycloak parse error: " ++ (show err2) -       error $ (show err2)+       debug $ "Keycloak parse error: " ++ show err2+       error $ show err2

@@ -2,6 +2,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Keycloak.Types where @@ -16,6 +20,7 @@ import           Data.Char import           Control.Monad.Except (ExceptT, runExceptT) import           Control.Monad.Reader as R+import           Control.Monad.Time (MonadTime) import           Control.Lens hiding ((.=)) import           GHC.Generics (Generic) import           Network.HTTP.Client as HC hiding (responseBody)@@ -29,14 +34,20 @@ -- | Keycloak Monad stack: a simple Reader monad containing the config, and an ExceptT to handle HTTPErrors and parse errors. -- You can extract the value using 'runKeycloak'. -- Example: @keys <- runKeycloak getJWKs defaultKCConfig@-type Keycloak a = ReaderT KCConfig (ExceptT KCError IO) a+type Keycloak a = KeycloakT IO a +newtype KeycloakT m a = KeycloakT { unKeycloakT :: ReaderT KCConfig (ExceptT KCError m) a }+    deriving newtype (Monad, Applicative, Functor, MonadIO, MonadTime)++instance MonadTrans KeycloakT where+    lift = KeycloakT . lift . lift+ -- | Contains HTTP errors and parse errors. data KCError = HTTPError HttpException  -- ^ Keycloak returned an HTTP error.              | ParseError Text          -- ^ Failed when parsing the response              | JWTError JWTError        -- ^ Failed to decode the token              | EmptyError               -- ^ Empty error to serve as a zero element for Monoid.-             deriving (Show)+             deriving stock (Show)  instance AsJWTError KCError where   _JWTError = prism' JWTError up where@@ -62,7 +73,7 @@   _confAuthServerUrl :: ServerURL,          -- ^ Base url where Keycloak resides   _confResource      :: ClientId,           -- ^ client id   _confCredentials   :: ClientCredentials}  -- ^ client secret, found in Client/Credentials tab-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)  instance ToJSON AdapterConfig where   toJSON = genericToJSON $ trainDrop 5@@ -72,7 +83,7 @@  data ClientCredentials = ClientCredentials {   _confSecret :: Text}-  deriving (Eq, Show, Generic)+  deriving stock (Eq, Show, Generic)  instance ToJSON ClientCredentials where   toJSON = genericToJSON $ trainDrop 5@@ -92,8 +103,8 @@   _confCredentials   = ClientCredentials "4e9dcb80-efcd-484c-b3d7-1e95a0096ac0"}  -- | Run a Keycloak monad within IO.-runKeycloak :: Keycloak a -> KCConfig -> IO (Either KCError a)-runKeycloak kc conf = runExceptT $ runReaderT kc conf+runKeycloak :: Monad m => KeycloakT m a -> KCConfig -> m (Either KCError a)+runKeycloak kc conf = runExceptT $ runReaderT (unKeycloakT kc) conf  type Path = Text @@ -109,7 +120,7 @@   tokenType         :: Text,   notBeforePolicy   :: Int,   sessionState      :: Text,-  tokenScope        :: Text} deriving (Show, Eq)+  tokenScope        :: Text} deriving stock (Show, Eq)  instance FromJSON TokenRep where   parseJSON (Object v) = TokenRep <$> v .: "access_token"@@ -126,7 +137,9 @@  -- | Scope name, such as "houses:view" -- You need to create the scopes in Client/Authorization panel/Authorization scopes tab-newtype ScopeName = ScopeName {unScopeName :: Text} deriving (Eq, Generic, Ord, Hashable)+newtype ScopeName = ScopeName {unScopeName :: Text}+    deriving stock (Eq, Generic, Ord)+    deriving newtype (Hashable)  --JSON instances instance ToJSON ScopeName where@@ -250,7 +263,9 @@ type ResourceType = Text  -- | A resource Id-newtype ResourceId = ResourceId {unResId :: Text} deriving (Show, Eq, Generic, Ord, Hashable)+newtype ResourceId = ResourceId {unResId :: Text}+    deriving stock (Show, Eq, Generic, Ord)+    deriving newtype (Hashable)  -- JSON instances instance ToJSON ResourceId where

@@ -22,7 +22,7 @@  module Keycloak.Users where -import           Control.Monad.Except (throwError)+import           Control.Monad.IO.Class import           Data.Aeson as JSON import           Data.Text as T hiding (head, tail, map) import           Data.String.Conversions@@ -33,7 +33,7 @@ -- * Users  -- | Get users. Default number of users is 100. Parameters max and first allow to paginate and retrieve more than 100 users.-getUsers :: Maybe Max -> Maybe First -> Maybe Username -> JWT -> Keycloak [User]+getUsers :: MonadIO m => Maybe Max -> Maybe First -> Maybe Username -> JWT ->  KeycloakT m [User] getUsers mmax first username tok = do   let query = maybe [] (\m -> [("max", Just $ convertString $ show m)]) mmax            ++ maybe [] (\f -> [("first", Just $ convertString $ show f)]) first@@ -46,10 +46,10 @@       return ret     Left (err2 :: String) -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)  -- | Get a single user, based on his Id-getUser :: UserId -> JWT -> Keycloak User+getUser :: MonadIO m => UserId -> JWT ->  KeycloakT m User getUser (UserId uid) tok = do   body <- keycloakAdminGet ("users/" <> (convertString uid)) tok    debug $ "Keycloak success: " ++ (show body) @@ -59,17 +59,17 @@       return ret     Left (err2 :: String) -> do       debug $ "Keycloak parse error: " ++ (show err2) -      throwError $ ParseError $ pack (show err2)+      kcError $ ParseError $ pack (show err2)  -- | Create a user-createUser :: User -> JWT -> Keycloak UserId+createUser :: MonadIO m => User -> JWT ->  KeycloakT m UserId createUser user tok = do   res <- keycloakAdminPost ("users/") (toJSON user) tok    debug $ "Keycloak success: " ++ (show res)    return $ UserId $ convertString res  -- | Get a single user, based on his Id-updateUser :: UserId -> User -> JWT -> Keycloak ()+updateUser :: MonadIO m => UserId -> User -> JWT ->  KeycloakT m () updateUser (UserId uid) user tok = do   keycloakAdminPut ("users/" <> (convertString uid)) (toJSON user) tok    return ()

@@ -24,120 +24,113 @@   -- | Perform post to Keycloak.-keycloakPost :: (Postable dat, Show dat) => Path -> dat -> JWT -> Keycloak BL.ByteString+keycloakPost :: (Postable dat, Show dat, MonadIO m) => Path -> dat -> JWT -> KeycloakT m BL.ByteString keycloakPost path dat jwt = do-  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (convertString $ encodeCompact jwt)]   let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK POST with url: " ++ (show url)    debug $ "  data: " ++ (show dat)    --debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.postWith opts url dat+  eRes <- liftIO $ C.try $ W.postWith opts url dat   case eRes of      Right res -> do       return $ fromJust $ res ^? responseBody     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er  -- | Perform post to Keycloak, without token.-keycloakPost' :: (Postable dat, Show dat) => Path -> dat -> Keycloak BL.ByteString+keycloakPost' :: (Postable dat, Show dat, MonadIO m) => Path -> dat -> KeycloakT m BL.ByteString keycloakPost' path dat = do -  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults   let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK POST with url: " ++ (show url)    debug $ "  data: " ++ (show dat)    --debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.postWith opts url dat+  eRes <- liftIO $ C.try $ W.postWith opts url dat   case eRes of      Right res -> do       return $ fromJust $ res ^? responseBody     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er  -- | Perform delete to Keycloak.-keycloakDelete :: Path -> JWT -> Keycloak ()+keycloakDelete :: MonadIO m => Path -> JWT -> KeycloakT m () keycloakDelete path jwt = do -  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (convertString $ encodeCompact jwt)]   let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK DELETE with url: " ++ (show url)    debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.deleteWith opts url+  eRes <- liftIO $ C.try $ W.deleteWith opts url   case eRes of      Right _ -> return ()     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er  -- | Perform get to Keycloak on admin API-keycloakGet :: Path -> JWT -> Keycloak BL.ByteString-keycloakGet path tok = do -  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+keycloakGet :: MonadIO m => Path -> JWT -> KeycloakT m BL.ByteString+keycloakGet path tok = do+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (convertString $ encodeCompact tok)]   let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK GET with url: " ++ (show url)    debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.getWith opts url+  eRes <- liftIO $ C.try $ W.getWith opts url   case eRes of      Right res -> do       return $ fromJust $ res ^? responseBody     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er  -- | Perform get to Keycloak on admin API, without token-keycloakGet' :: Path -> Keycloak BL.ByteString-keycloakGet' path = do -  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+keycloakGet' :: MonadIO m => Path -> KeycloakT m BL.ByteString+keycloakGet' path = do+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults   let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK GET with url: " ++ (show url)    debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.getWith opts url-  case eRes of +  eRes <- liftIO $ C.try $ W.getWith opts url+  case eRes of     Right res -> do       return $ fromJust $ res ^? responseBody     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er   -- | Perform get to Keycloak on admin API-keycloakAdminGet :: Path -> JWT -> Keycloak BL.ByteString+keycloakAdminGet :: MonadIO m => Path -> JWT -> KeycloakT m BL.ByteString keycloakAdminGet path tok = do -  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (convertString $ encodeCompact tok)]   let url = (unpack $ baseUrl <> "/admin/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK GET with url: " ++ (show url)    debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.getWith opts url+  eRes <- liftIO $ C.try $ W.getWith opts url   case eRes of      Right res -> do       return $ fromJust $ res ^? responseBody     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er  -- | Perform post to Keycloak.-keycloakAdminPost :: (Postable dat, Show dat) => Path -> dat -> JWT -> Keycloak BL.ByteString+keycloakAdminPost :: (Postable dat, Show dat, MonadIO m) => Path -> dat -> JWT -> KeycloakT m BL.ByteString keycloakAdminPost path dat tok = do -  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (convertString $ encodeCompact tok)]   let url = (unpack $ baseUrl <> "/admin/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK POST with url: " ++ (show url)    debug $ "  data: " ++ (show dat)    --debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.postWith opts url dat+  eRes <- liftIO $ C.try $ W.postWith opts url dat   case eRes of      Right res -> do       debug $ (show eRes)@@ -145,29 +138,39 @@       return $ convertString $ L.last $ T.split (== '/') $ convertString $ fromJust $ lookup "Location" hs     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er  -- | Perform put to Keycloak.-keycloakAdminPut :: (Putable dat, Show dat) => Path -> dat -> JWT -> Keycloak ()+keycloakAdminPut :: (Putable dat, Show dat, MonadIO m) => Path -> dat -> JWT -> KeycloakT m () keycloakAdminPut path dat tok = do -  realm <- view (confAdapterConfig.confRealm)-  baseUrl <- view (confAdapterConfig.confAuthServerUrl)+  (realm,baseUrl) <- viewRealmAndUrl   let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (convertString $ encodeCompact tok)]   let url = (unpack $ baseUrl <> "/admin/realms/" <> realm <> "/" <> path)    info $ "Issuing KEYCLOAK PUT with url: " ++ (show url)    debug $ "  data: " ++ (show dat)    debug $ "  headers: " ++ (show $ opts ^. W.headers) -  eRes <- C.try $ liftIO $ W.putWith opts url dat+  eRes <- liftIO $ C.try $ W.putWith opts url dat   case eRes of      Right _ -> return ()     Left er -> do       warn $ "Keycloak HTTP error: " ++ (show er)-      throwError $ HTTPError er+      kcError $ HTTPError er +kcError :: Monad m => KCError -> KeycloakT m a+kcError = KeycloakT . throwError +viewRealmAndUrl :: Monad m => KeycloakT m (Realm,ServerURL)+viewRealmAndUrl = do+  realm <- viewConfig (confAdapterConfig.confRealm)+  baseUrl <- viewConfig (confAdapterConfig.confAuthServerUrl)+  pure (realm,baseUrl)++viewConfig :: Monad m => Getting b KCConfig b -> KeycloakT m b+viewConfig = KeycloakT . view+ -- * Helpers -debug, warn, info, err :: (MonadIO m) => String -> m ()+debug, warn, info, err :: MonadIO m => String -> m () debug s = liftIO $ debugM "Keycloak" s info s  = liftIO $ infoM "Keycloak" s warn s  = liftIO $ warningM "Keycloak" s@@ -177,8 +180,5 @@ getErrorStatus (HTTPError (HttpExceptionRequest _ (StatusCodeException r _))) = Just $ HC.responseStatus r getErrorStatus _ = Nothing -try :: MonadError a m => m b -> m (Either a b)-try act = catchError (Right <$> act) (return . Left)---+try :: Monad m => KeycloakT m b -> KeycloakT m (Either KCError b)+try (KeycloakT act) = KeycloakT $ catchError (Right <$> act) (return . Left)