keycloak-hs 1.1.1 → 2.0.0
raw patch · 10 files changed
+598/−499 lines, 10 filesdep +hashabledep +josedep +lens-aesondep −jwtdep ~hslogger
Dependencies added: hashable, jose, lens-aeson, unordered-containers
Dependencies removed: jwt
Dependency ranges changed: hslogger
Files
- README.md +22/−7
- examples/Main.hs +62/−38
- keycloak-hs.cabal +11/−4
- src/Keycloak.hs +26/−19
- src/Keycloak/Authorizations.hs +123/−0
- src/Keycloak/Client.hs +0/−364
- src/Keycloak/Tokens.hs +91/−0
- src/Keycloak/Types.hs +25/−67
- src/Keycloak/Users.hs +60/−0
- src/Keycloak/Utils.hs +178/−0
README.md view
@@ -3,6 +3,7 @@ Keycloak-hs is an Haskell library for connecting to [Keycloak](https://www.keycloak.org/). Keycloak allows to authenticate users and protect API resources.+This library allows you to retrieve and analyse Keycloak authentication tokens, and to protect resources in your API. Install =======@@ -15,25 +16,39 @@ Tutorial ======== -In this tutorial we'll learn how to use Keycloak-hs with a [small example](./example/Main.hs).+In this tutorial we'll learn how to use Keycloak-hs with a [small example](./examples/Main.hs). First you should install and run Keycloak: [follow this tutorial](https://www.keycloak.org/docs/latest/getting_started/index.html).++Authentication+--------------++Authentication with Keycloak is based on [JWTs](https://jwt.io/).+ In Keycloak admin panel, create the following: - a realm named "demo"-- a user "demo" with password "demo" - a client named "demo".+- a user "demo" with password "demo" +In the user, add an attribute, such as "phone".+In order for this attribute to appear in the token claims, we should also add a client "mapper".+In the client "demo", click on "Mappers"/"add mappers".+Fill the name="demo", Mapper Type=User attribute, Token Claim Name="demo", Claim JSON Type=String, and save.++At this point, you should be able to retrieve tokens from Keycloak, verify them using this library, and extract a User from the tokens.++Authorizations+--------------+ In the client "demo": - change "Access Type" to confidential - turn "Authorization Enabled" ON. A new "Authorization" tab should appear. -Authorizations---------------- Let's set up some authorization policies in order to demonstrate the capacity of Keycloak-hs. We want to authorize our user "demo" to "view" any resource.-Frist go in the new "Authorization" tab that appeared.+First go in the new "Authorization" tab that appeared.+Flip ON "Remote Resource Management". Create a new Scope in the "Authorization Scopes" tab: - Name it "view".@@ -53,7 +68,7 @@ Example code ----------- -The folder example contains an [exemple of usage](./example/Main.hs).+The folder example contains an [exemple of usage](./examples/Main.hs). You should first input your "client secret", that can be found in the demo client "Credentials" tab in Keycloak admin panel. Then run the example:
examples/Main.hs view
@@ -5,51 +5,75 @@ import Keycloak import Control.Monad import Control.Monad.IO.Class+import System.Log.Logger + -- Kecyloak configuration. kcConfig :: KCConfig kcConfig = KCConfig { _confBaseUrl = "http://localhost:8080/auth", _confRealm = "demo", _confClientId = "demo",- _confClientSecret = "4270ce82-4a8f-4d89-9ea9-d9b28c3bab3e"}+ _confClientSecret = "3d792576-4e56-4c58-991a-49074e6a92ea"} main :: IO ()-main = void $ flip runKeycloak kcConfig $ do- - liftIO $ putStrLn "Getting Client token"-- -- * We first get a client token, used to create resources - clientToken <- getClientAuthToken-- liftIO $ putStrLn "Creating resource"-- -- * We will than create a resource to be protected in Keycloak- let res = Resource {- resId = Nothing,- resName = "MyResource",- resType = Nothing,- resUris = [],- resScopes = [Scope Nothing (ScopeName "view")],- resOwner = Owner Nothing (Just "demo"),- resOwnerManagedAccess = False,- resAttributes = []}- resId <- createResource res clientToken -- liftIO $ putStrLn "Getting User token"-- -- * Let's get a token for a specific user- userToken <- getUserAuthToken "demo" "demo"-- -- * Can I access this resource?- isAuth <- isAuthorized resId (ScopeName "view") userToken-- liftIO $ putStrLn $ "User 'demo' can access resource 'demo': " ++ (show isAuth)-- -- We can also retrieve all the permissions for our user.- perms <- getPermissions [PermReq Nothing [ScopeName "view"]] userToken-- liftIO $ putStrLn $ "All permissions: " ++ (show perms)+main = do+ updateGlobalLogger rootLoggerName (setLevel DEBUG) - --resources can be deleted- --deleteResource resId clientToken+ void $ flip runKeycloak kcConfig $ do+ liftIO $ putStrLn "Starting tests..."+ + -- JWKs are public keys delivered by Keycloak to check the integrity of any JWT (user tokens).+ -- an application may retrieve these keys at startup and keep them.+ jwks <- getJWKs+ liftIO $ putStrLn $ "Got JWKs: \n" ++ (show jwks) ++ "\n\n"+ + -- Get a JWT from Keycloak. A JWT can then be used to authentify yourself with an application.+ jwt <- getJWT "demo" "demo" + liftIO $ putStrLn $ "Got JWT: \n" ++ (show jwt) ++ "\n\n"+ + -- Retrieve the claims contained in the JWT.+ claims <- verifyJWT (head jwks) jwt+ liftIO $ putStrLn $ "Claims decoded from Token: \n" ++ (show claims) ++ "\n\n"+ + -- get the user from the claim+ let user = getClaimsUser claims+ liftIO $ putStrLn $ "User decoded from claims: \n" ++ (show user) ++ "\n\n"+ + + liftIO $ putStrLn "Getting Client token"+ + -- * We first get a client token, used to create resources + clientToken <- getClientJWT+ + liftIO $ putStrLn "Creating resource"+ + -- * We will than create a resource to be protected in Keycloak+ let res = Resource {+ resId = Nothing,+ resName = "MyResource",+ resType = Nothing,+ resUris = [],+ resScopes = [Scope Nothing (ScopeName "view")],+ resOwner = Owner Nothing (Just "demo"),+ resOwnerManagedAccess = False,+ resAttributes = []}+ resId <- createResource res clientToken + + liftIO $ putStrLn "Getting User token"+ + -- * Let's get a token for a specific user+ userToken <- getJWT "demo" "demo"+ + -- * Can I access this resource?+ isAuth <- isAuthorized resId (ScopeName "view") userToken+ + liftIO $ putStrLn $ "User 'demo' can access resource 'demo': " ++ (show isAuth)+ + -- We can also retrieve all the permissions for our user.+ perms <- getPermissions [PermReq Nothing [ScopeName "view"]] userToken+ + liftIO $ putStrLn $ "All permissions: " ++ (show perms)+ + --resources can be deleted+ --deleteResource resId clientToken
keycloak-hs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: keycloak-hs-version: 1.1.1+version: 2.0.0 license: BSD3 license-file: LICENSE copyright: 2019 Corentin Dupont@@ -21,7 +21,10 @@ library exposed-modules:- Keycloak.Client+ Keycloak.Tokens+ Keycloak.Authorizations+ Keycloak.Users+ Keycloak.Utils Keycloak.Types Keycloak hs-source-dirs: src@@ -36,16 +39,19 @@ containers >=0.5.9 && <0.7, bytestring >=0.10 && <0.11, exceptions >=0.10 && <0.11,+ hashable -any, http-api-data >=0.4 && <0.5, http-types >=0.12 && <0.13, http-client >=0.5 && <0.7, hslogger >=1.2 && <1.4,- jwt ==0.10.*,+ jose, lens >=4.17 && <4.19,+ lens-aeson, mtl >=2.2 && <2.3, string-conversions >=0.4 && <0.5, safe >=0.3 && <0.4, text >=1.2 && <1.3,+ unordered-containers, wreq >=0.5 && <0.6, word8 >=0.1 && <0.2 @@ -56,4 +62,5 @@ ghc-options: -threaded -Wall build-depends: base >=4.9.1.0 && <5,- keycloak-hs -any+ keycloak-hs -any,+ hslogger -any
src/Keycloak.hs view
@@ -1,21 +1,28 @@--module Keycloak (isAuthorized,- getPermissions,- checkPermission,- getUserAuthToken,- getClientAuthToken,- getUsername,- createResource,- deleteResource,- deleteAllResources,- getResource,- getAllResourceIds,- updateResource,- getUsers,- getUser,- createUser,- updateUser, - module Keycloak.Types) where+module Keycloak (+ -- | Tokens+ getJWKs,+ getJWT,+ getClientJWT,+ verifyJWT,+ getClaimsUser,+ isAuthorized,+ -- | Authorizations+ getPermissions,+ checkPermission,+ createResource,+ deleteResource,+ deleteAllResources,+ getResource,+ getAllResourceIds,+ updateResource,+ -- | Users+ getUsers,+ getUser,+ createUser,+ updateUser,+ module Keycloak.Types) where -import Keycloak.Client+import Keycloak.Tokens+import Keycloak.Users+import Keycloak.Authorizations import Keycloak.Types
+ src/Keycloak/Authorizations.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++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+import Data.List as L+import Data.String.Conversions+import Keycloak.Types+import Keycloak.Tokens+import Keycloak.Utils as U+import Network.HTTP.Types.Status+import Network.Wreq as W hiding (statusCode)+import Safe++-- * Permissions++-- | Returns true if the resource is authorized under the given scope.+isAuthorized :: ResourceId -> ScopeName -> JWT -> Keycloak 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++-- | Return the permissions for the permission requests.+getPermissions :: [PermReq] -> JWT -> Keycloak [Permission]+getPermissions reqs tok = do+ debug "Get all permissions"+ client <- asks _confClientId+ let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),+ "audience" := client,+ "response_mode" := ("permissions" :: Text)] + <> map (\p -> "permission" := p) (join $ map getPermString reqs)+ body <- keycloakPost "protocol/openid-connect/token" dat tok+ case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak returned perms: " ++ (show ret)+ return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)+ where+ getPermString :: PermReq -> [Text]+ getPermString (PermReq (Just (ResourceId rid)) []) = [rid]+ getPermString (PermReq (Just (ResourceId rid)) scopes) = map (\(ScopeName s) -> (rid <> "#" <> s)) scopes+ 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 (ResourceId res) (ScopeName scope) tok = do+ debug $ "Checking permissions: " ++ (show res) ++ " " ++ (show scope)+ client <- asks _confClientId+ let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),+ "audience" := client,+ "permission" := res <> "#" <> scope]+ void $ keycloakPost "protocol/openid-connect/token" dat tok+++-- * Resource++-- | Create an authorization resource in Keycloak, under the configured client.+createResource :: Resource -> JWT -> Keycloak ResourceId+createResource r tok = do+ debug $ convertString $ "Creating resource: " <> (JSON.encode r)+ body <- keycloakPost "authz/protection/resource_set" (toJSON r) tok+ debug $ convertString $ "Created resource: " ++ convertString body+ case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret)+ return $ fromJustNote "create" $ resId ret+ Left err2 -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++-- | Delete the resource+deleteResource :: ResourceId -> JWT -> Keycloak ()+deleteResource (ResourceId rid) tok = do+ --tok2 <- getClientAuthToken + keycloakDelete ("authz/protection/resource_set/" <> rid) tok+ return ()++-- | Delete all resources in Keycloak+deleteAllResources :: JWT -> Keycloak ()+deleteAllResources tok = do+ debug "Deleting all Keycloak resources..."+ ids <- getAllResourceIds+ res <- mapM (\rid -> try $ deleteResource rid tok) ids+ debug $ "Deleted " ++ (show $ L.length $ rights res) ++ " resources out of " ++ (show $ L.length ids)++-- | get a single resource+getResource :: ResourceId -> JWT -> Keycloak Resource+getResource (ResourceId rid) tok = do+ body <- keycloakGet ("authz/protection/resource_set/" <> rid) tok+ case eitherDecode body of+ Right ret -> do+ return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++-- | get all resources IDs+getAllResourceIds :: Keycloak [ResourceId]+getAllResourceIds = do+ debug "Get all resources"+ tok2 <- getClientJWT + body <- keycloakGet ("authz/protection/resource_set?max=1000") tok2+ case eitherDecode body of+ Right ret -> do+ return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++-- | Update a resource+updateResource :: Resource -> JWT -> Keycloak ResourceId+updateResource = createResource+
− src/Keycloak/Client.hs
@@ -1,364 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}--module Keycloak.Client where--import Control.Lens hiding ((.=))-import Control.Monad.Reader as R-import qualified Control.Monad.Catch as C-import Control.Monad.Except (throwError, catchError, MonadError)-import Data.Aeson as JSON-import Data.Text as T hiding (head, tail, map)-import Data.Maybe-import Data.Either-import Data.List as L-import Data.Map hiding (map, lookup)-import Data.String.Conversions-import qualified Data.ByteString.Lazy as BL-import Keycloak.Types-import Network.HTTP.Client as HC hiding (responseBody, path)-import Network.HTTP.Types.Status-import Network.HTTP.Types (renderQuery)-import Network.Wreq as W hiding (statusCode)-import Network.Wreq.Types-import System.Log.Logger-import Web.JWT as JWT-import Safe---- * Permissions---- | Returns true if the resource is authorized under the given scope.-isAuthorized :: ResourceId -> ScopeName -> Token -> Keycloak Bool-isAuthorized res scope tok = do- r <- try $ checkPermission res scope tok- case r of- Right _ -> return True- Left e | (statusCode <$> getErrorStatus e) == Just 403 -> return False- Left e -> throwError e --rethrow the error---- | Return the permissions for the permission requests.-getPermissions :: [PermReq] -> Token -> Keycloak [Permission]-getPermissions reqs tok = do- debug "Get all permissions"- client <- asks _confClientId- let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),- "audience" := client,- "response_mode" := ("permissions" :: Text)] - <> map (\p -> "permission" := p) (join $ map getPermString reqs)- body <- keycloakPost "protocol/openid-connect/token" dat tok- case eitherDecode body of- Right ret -> do- debug $ "Keycloak returned perms: " ++ (show ret)- return ret- Left (err2 :: String) -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)- where- getPermString :: PermReq -> [Text]- getPermString (PermReq (Just (ResourceId rid)) []) = [rid]- getPermString (PermReq (Just (ResourceId rid)) scopes) = map (\(ScopeName s) -> (rid <> "#" <> s)) scopes- 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 -> Token -> Keycloak ()-checkPermission (ResourceId res) (ScopeName scope) tok = do- debug $ "Checking permissions: " ++ (show res) ++ " " ++ (show scope)- client <- asks _confClientId- let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),- "audience" := client,- "permission" := res <> "#" <> scope]- void $ keycloakPost "protocol/openid-connect/token" dat tok----- * Tokens---- | Retrieve the user's token. This token will be used for every other Keycloak calls.-getUserAuthToken :: Username -> Password -> Keycloak Token-getUserAuthToken username password = do - debug "Get user token"- client <- asks _confClientId- secret <- asks _confClientSecret- let dat = ["client_id" := client, - "client_secret" := secret,- "grant_type" := ("password" :: Text),- "password" := password,- "username" := username]- body <- keycloakPost' "protocol/openid-connect/token" dat- debug $ "Keycloak: " ++ (show body) - case eitherDecode body of- Right ret -> do - debug $ "Keycloak success: " ++ (show ret) - return $ Token $ convertString $ accessToken ret- Left err2 -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)---- | return a Client token. It is useful to create Resources.-getClientAuthToken :: Keycloak Token-getClientAuthToken = do- debug "Get client token"- client <- asks _confClientId- secret <- asks _confClientSecret- let dat = ["client_id" := client, - "client_secret" := secret,- "grant_type" := ("client_credentials" :: Text)]- body <- keycloakPost' "protocol/openid-connect/token" dat- case eitherDecode body of- Right ret -> do- debug $ "Keycloak success: " ++ (show ret) - return $ Token $ convertString $ accessToken ret- Left err2 -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)----- | Extract user name from a token-getUsername :: Token -> Username-getUsername (Token tok) = do - case JWT.decode $ convertString tok of- Just t -> case (unClaimsMap $ unregisteredClaims $ claims t) !? "preferred_username" of- Just (String u) -> u- _ -> error "preferred_username not present in token" - Nothing -> error "Error while decoding token"----- * Resource---- | Create an authorization resource in Keycloak, under the configured client.-createResource :: Resource -> Token -> Keycloak ResourceId-createResource r tok = do- debug $ convertString $ "Creating resource: " <> (JSON.encode r)- body <- keycloakPost "authz/protection/resource_set" (toJSON r) tok- debug $ convertString $ "Created resource: " ++ convertString body- case eitherDecode body of- Right ret -> do- debug $ "Keycloak success: " ++ (show ret)- return $ fromJustNote "create" $ resId ret- Left err2 -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)---- | Delete the resource-deleteResource :: ResourceId -> Token -> Keycloak ()-deleteResource (ResourceId rid) tok = do- --tok2 <- getClientAuthToken - keycloakDelete ("authz/protection/resource_set/" <> rid) tok- return ()---- | Delete all resources in Keycloak-deleteAllResources :: Token -> Keycloak ()-deleteAllResources tok = do- debug "Deleting all Keycloak resources..."- ids <- getAllResourceIds- res <- mapM (\rid -> try $ deleteResource rid tok) ids- debug $ "Deleted " ++ (show $ L.length $ rights res) ++ " resources out of " ++ (show $ L.length ids)---- | get a single resource-getResource :: ResourceId -> Token -> Keycloak Resource-getResource (ResourceId rid) tok = do- body <- keycloakGet ("authz/protection/resource_set/" <> rid) tok- case eitherDecode body of- Right ret -> do- return ret- Left (err2 :: String) -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)---- | get all resources IDs-getAllResourceIds :: Keycloak [ResourceId]-getAllResourceIds = do- debug "Get all resources"- tok2 <- getClientAuthToken - body <- keycloakGet ("authz/protection/resource_set?max=1000") tok2- case eitherDecode body of- Right ret -> do- return ret- Left (err2 :: String) -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)---- | Update a resource-updateResource :: Resource -> Token -> Keycloak ResourceId-updateResource = createResource---- * 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 -> Token -> Keycloak [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- ++ maybe [] (\u -> [("username", Just $ convertString u)]) username- body <- keycloakAdminGet ("users" <> (convertString $ renderQuery True query)) tok - debug $ "Keycloak success" - case eitherDecode body of- Right ret -> do- debug $ "Keycloak success: " ++ (show ret) - return ret- Left (err2 :: String) -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)---- | Get a single user, based on his Id-getUser :: UserId -> Token -> Keycloak User-getUser (UserId uid) tok = do- body <- keycloakAdminGet ("users/" <> (convertString uid)) tok - debug $ "Keycloak success: " ++ (show body) - case eitherDecode body of- Right ret -> do- debug $ "Keycloak success: " ++ (show ret) - return ret- Left (err2 :: String) -> do- debug $ "Keycloak parse error: " ++ (show err2) - throwError $ ParseError $ pack (show err2)---- | Create a user-createUser :: User -> Token -> Keycloak 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 -> Token -> Keycloak ()-updateUser (UserId uid) user tok = do- keycloakAdminPut ("users/" <> (convertString uid)) (toJSON user) tok - return ()----- * Keycloak basic requests---- | Perform post to Keycloak.-keycloakPost :: (Postable dat, Show dat) => Path -> dat -> Token -> Keycloak BL.ByteString-keycloakPost path dat tok = do - (KCConfig baseUrl realm _ _) <- ask- let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken tok)]- 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- case eRes of - Right res -> do- return $ fromJust $ res ^? responseBody- Left er -> do- warn $ "Keycloak HTTP error: " ++ (show er)- throwError $ HTTPError er---- | Perform post to Keycloak, without token.-keycloakPost' :: (Postable dat, Show dat) => Path -> dat -> Keycloak BL.ByteString-keycloakPost' path dat = do - (KCConfig baseUrl realm _ _) <- ask- 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- case eRes of - Right res -> do- return $ fromJust $ res ^? responseBody- Left er -> do- warn $ "Keycloak HTTP error: " ++ (show er)- throwError $ HTTPError er---- | Perform delete to Keycloak.-keycloakDelete :: Path -> Token -> Keycloak ()-keycloakDelete path tok = do - (KCConfig baseUrl realm _ _) <- ask- let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken tok)]- 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- case eRes of - Right res -> return ()- Left err -> do- warn $ "Keycloak HTTP error: " ++ (show err)- throwError $ HTTPError err---- | Perform get to Keycloak on admin API-keycloakGet :: Path -> Token -> Keycloak BL.ByteString-keycloakGet path tok = do - (KCConfig baseUrl realm _ _) <- ask- let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken 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- case eRes of - Right res -> do- return $ fromJust $ res ^? responseBody- Left err -> do- warn $ "Keycloak HTTP error: " ++ (show err)- throwError $ HTTPError err---- | Perform get to Keycloak on admin API-keycloakAdminGet :: Path -> Token -> Keycloak BL.ByteString-keycloakAdminGet path tok = do - (KCConfig baseUrl realm _ _) <- ask- let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken 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- case eRes of - Right res -> do- return $ fromJust $ res ^? responseBody- Left err -> do- warn $ "Keycloak HTTP error: " ++ (show err)- throwError $ HTTPError err---- | Perform post to Keycloak.-keycloakAdminPost :: (Postable dat, Show dat) => Path -> dat -> Token -> Keycloak BL.ByteString-keycloakAdminPost path dat tok = do - (KCConfig baseUrl realm _ _) <- ask- let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken 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- case eRes of - Right res -> do- debug $ (show eRes)- let headers = fromJust $ res ^? W.responseHeaders- return $ convertString $ L.last $ T.split (== '/') $ convertString $ fromJust $ lookup "Location" headers- Left err -> do- warn $ "Keycloak HTTP error: " ++ (show err)- throwError $ HTTPError err---- | Perform put to Keycloak.-keycloakAdminPut :: (Putable dat, Show dat) => Path -> dat -> Token -> Keycloak ()-keycloakAdminPut path dat tok = do - (KCConfig baseUrl realm _ _) <- ask- let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken 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- case eRes of - Right res -> return ()- Left err -> do- warn $ "Keycloak HTTP error: " ++ (show err)- throwError $ HTTPError err----- * Helpers--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-err s = liftIO $ errorM "Keycloak" s--getErrorStatus :: KCError -> Maybe Status -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)-
+ src/Keycloak/Tokens.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Keycloak.Tokens where++import Control.Lens hiding ((.=))+import Control.Monad.Reader as R+import Control.Monad.Except (throwError)+import Crypto.JWT as JWT+import Data.Aeson as JSON+import Data.Aeson.Lens+import Data.Text as T hiding (head, tail, map)+import Data.Maybe+import qualified Data.HashMap.Strict as HM+import Data.String.Conversions+import Keycloak.Types+import Keycloak.Utils+import Network.Wreq as W hiding (statusCode)++-- * Tokens++-- | return JWKs from Keycloak. Its a set of keys that can be used to check signed tokens (JWTs)+getJWKs :: Keycloak [JWK]+getJWKs = do+ body <- keycloakGet' ("protocol/openid-connect/certs")+ info $ show body+ (JWKSet jwks) <- case eitherDecode body of+ Right ret -> do+ return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)+ return jwks+++-- | Retrieve the user's token. This token can be used for every other Keycloak calls.+getJWT :: Username -> Password -> Keycloak JWT+getJWT username password = do + debug "Get user token"+ client <- asks _confClientId+ secret <- asks _confClientSecret+ let dat = ["client_id" := client, + "client_secret" := secret,+ "grant_type" := ("password" :: Text),+ "password" := password,+ "username" := username]+ body <- keycloakPost' "protocol/openid-connect/token" dat+ debug $ "Keycloak: " ++ (show body) + case eitherDecode body of+ Right ret -> do + debug $ "Keycloak success: " ++ (show ret) + decodeCompact $ convertString $ accessToken ret+ Left err2 -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ 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 = do+ debug "Get client token"+ client <- asks _confClientId+ secret <- asks _confClientSecret+ let dat = ["client_id" := client, + "client_secret" := secret,+ "grant_type" := ("client_credentials" :: Text)]+ body <- keycloakPost' "protocol/openid-connect/token" dat+ case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + decodeCompact $ convertString $ accessToken ret+ Left err2 -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)+++-- | Verify a JWT. If sucessful, the claims are returned. Otherwise, a JWTError is thrown. +verifyJWT :: JWK -> JWT -> Keycloak ClaimsSet+verifyJWT jwk jwt = verifyClaims (defaultJWTValidationSettings (const True)) jwk jwt++-- | Extract the user identity from a token. Additional attributes can be encoded in the token.+getClaimsUser :: ClaimsSet -> User+getClaimsUser claims = User { userId = Just $ UserId $ view (claimSub . _Just . string) claims+ , userUsername = view (unregisteredClaims . at "preferred_username" . _Just . _String) claims+ , userFirstName = preview (unregisteredClaims . at "given_name" . _Just . _String) claims+ , userLastName = preview (unregisteredClaims . at "family_name" . _Just . _String) claims+ , userEmail = preview (unregisteredClaims . at "email" . _Just . _String) claims+ , userAttributes = preview unregisteredClaims claims}++
src/Keycloak/Types.hs view
@@ -1,28 +1,28 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveAnyClass #-} module Keycloak.Types where import Data.Aeson import Data.Aeson.Casing+import Data.Hashable import Data.Text hiding (head, tail, map, toLower, drop)-import Data.Text.Encoding import Data.String.Conversions import Data.Maybe import Data.Map hiding (drop, map)-import qualified Data.ByteString as BS-import qualified Data.Word8 as W8 (isSpace, toLower)+import qualified Data.HashMap.Strict as HM import Data.Char import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.Reader as R import Control.Lens hiding ((.=)) import GHC.Generics (Generic)-import Web.HttpApiData (FromHttpApiData(..), ToHttpApiData(..)) import Network.HTTP.Client as HC hiding (responseBody)+import Crypto.JWT as JWT +type JWT = SignedJWT+ -- * Keycloak Monad -- | Keycloak Monad stack: a simple Reader monad containing the config, and an ExceptT to handle HTTPErrors and parse errors.@@ -31,9 +31,19 @@ -- | 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) +instance AsJWTError KCError where+ _JWTError = prism' JWTError up where+ up (JWTError e) = Just e+ up _ = Nothing++instance AsError KCError where+ _Error = _JWSError++ -- | Configuration of Keycloak. data KCConfig = KCConfig { _confBaseUrl :: Text,@@ -58,58 +68,6 @@ -- * Token --- | Wrapper for tokens.-newtype Token = Token {unToken :: BS.ByteString} deriving (Eq, Show, Generic)--instance ToJSON Token where- toJSON (Token t) = String $ convertString t---- | parser for Authorization header-instance FromHttpApiData Token where- parseQueryParam = parseHeader . encodeUtf8- parseHeader (extractBearerAuth -> Just tok) = Right $ Token tok- parseHeader _ = Left "cannot extract auth Bearer"--extractBearerAuth :: BS.ByteString -> Maybe BS.ByteString-extractBearerAuth bs =- let (x, y) = BS.break W8.isSpace bs- in if BS.map W8.toLower x == "bearer"- then Just $ BS.dropWhile W8.isSpace y- else Nothing---- | Create Authorization header-instance ToHttpApiData Token where- toQueryParam (Token token) = "Bearer " <> (decodeUtf8 token)- --- | Keycloak Token additional claims-tokNonce, tokAuthTime, tokSessionState, tokAtHash, tokCHash, tokName, tokGivenName, tokFamilyName, tokMiddleName, tokNickName, tokPreferredUsername, tokProfile, tokPicture, tokWebsite, tokEmail, tokEmailVerified, tokGender, tokBirthdate, tokZoneinfo, tokLocale, tokPhoneNumber, tokPhoneNumberVerified,tokAddress, tokUpdateAt, tokClaimsLocales, tokACR :: Text-tokNonce = "nonce";-tokAuthTime = "auth_time";-tokSessionState = "session_state";-tokAtHash = "at_hash";-tokCHash = "c_hash";-tokName = "name";-tokGivenName = "given_name";-tokFamilyName = "family_name";-tokMiddleName = "middle_name";-tokNickName = "nickname";-tokPreferredUsername = "preferred_username";-tokProfile = "profile";-tokPicture = "picture";-tokWebsite = "website";-tokEmail = "email";-tokEmailVerified = "email_verified";-tokGender = "gender";-tokBirthdate = "birthdate";-tokZoneinfo = "zoneinfo";-tokLocale = "locale";-tokPhoneNumber = "phone_number";-tokPhoneNumberVerified = "phone_number_verified";-tokAddress = "address";-tokUpdateAt = "updated_at";-tokClaimsLocales = "claims_locales";-tokACR = "acr";- -- | Token reply from Keycloak data TokenRep = TokenRep { accessToken :: Text,@@ -135,7 +93,7 @@ -- * Permissions -- | Scope name-newtype ScopeName = ScopeName {unScopeName :: Text} deriving (Eq, Generic, Ord)+newtype ScopeName = ScopeName {unScopeName :: Text} deriving (Eq, Generic, Ord, Hashable) --JSON instances instance ToJSON ScopeName where@@ -186,7 +144,7 @@ data PermReq = PermReq { permReqResourceId :: Maybe ResourceId, -- Requested ressource Ids. Nothing means "All resources". permReqScopes :: [ScopeName] -- Scopes requested. [] means "all scopes".- } deriving (Generic, Eq, Ord)+ } deriving (Generic, Eq, Ord, Hashable) instance Show PermReq where show (PermReq (Just (ResourceId res1)) scopes) = (show res1) <> " " <> (show scopes)@@ -213,12 +171,12 @@ -- | User data User = User- { userId :: Maybe UserId -- ^ The unique user ID - , userUsername :: Username -- ^ Username- , userFirstName :: Maybe Text -- ^ First name- , userLastName :: Maybe Text -- ^ Last name- , userEmail :: Maybe Text -- ^ Email- , userAttributes :: Maybe (Map Text [Text]) + { userId :: Maybe UserId -- ^ The unique user ID + , userUsername :: Username -- ^ Username+ , userFirstName :: Maybe Text -- ^ First name+ , userLastName :: Maybe Text -- ^ Last name+ , userEmail :: Maybe Text -- ^ Email+ , userAttributes :: Maybe (HM.HashMap Text Value) } deriving (Show, Eq, Generic) unCapitalize :: String -> String@@ -254,7 +212,7 @@ type ResourceType = Text -- | A resource Id-newtype ResourceId = ResourceId {unResId :: Text} deriving (Show, Eq, Generic, Ord)+newtype ResourceId = ResourceId {unResId :: Text} deriving (Show, Eq, Generic, Ord, Hashable) -- JSON instances instance ToJSON ResourceId where
+ src/Keycloak/Users.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Keycloak.Users where++import Control.Monad.Except (throwError)+import Data.Aeson as JSON+import Data.Text as T hiding (head, tail, map)+import Data.String.Conversions+import Keycloak.Types+import Keycloak.Utils as U+import Network.HTTP.Types (renderQuery)++-- * 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 mmax first username tok = do+ let query = maybe [] (\m -> [("max", Just $ convertString $ show m)]) mmax+ ++ maybe [] (\f -> [("first", Just $ convertString $ show f)]) first+ ++ maybe [] (\u -> [("username", Just $ convertString u)]) username+ body <- keycloakAdminGet ("users" <> (convertString $ renderQuery True query)) tok + debug $ "Keycloak success" + case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++-- | Get a single user, based on his Id+getUser :: UserId -> JWT -> Keycloak User+getUser (UserId uid) tok = do+ body <- keycloakAdminGet ("users/" <> (convertString uid)) tok + debug $ "Keycloak success: " ++ (show body) + case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++-- | Create a user+createUser :: User -> JWT -> Keycloak 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 (UserId uid) user tok = do+ keycloakAdminPut ("users/" <> (convertString uid)) (toJSON user) tok + return ()++
+ src/Keycloak/Utils.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Keycloak.Utils where++import Control.Lens hiding ((.=))+import Control.Monad.Reader as R+import qualified Control.Monad.Catch as C+import Control.Monad.Except (throwError, catchError, MonadError)+import Data.Aeson as JSON+import Data.Text as T hiding (head, tail, map)+import Data.Maybe+import Data.List as L+import Data.String.Conversions+import qualified Data.ByteString.Lazy as BL+import Keycloak.Types+import Network.HTTP.Client as HC hiding (responseBody, path)+import Network.HTTP.Types.Status+import Network.Wreq as W hiding (statusCode)+import Network.Wreq.Types+import System.Log.Logger+import Crypto.JWT as JWT++-- | Perform post to Keycloak.+keycloakPost :: (Postable dat, Show dat) => Path -> dat -> JWT -> Keycloak BL.ByteString+keycloakPost path dat jwt = do + (KCConfig baseUrl realm _ _) <- ask+ 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+ case eRes of + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er++-- | Perform post to Keycloak, without token.+keycloakPost' :: (Postable dat, Show dat) => Path -> dat -> Keycloak BL.ByteString+keycloakPost' path dat = do + (KCConfig baseUrl realm _ _) <- ask+ 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+ case eRes of + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er++-- | Perform delete to Keycloak.+keycloakDelete :: Path -> JWT -> Keycloak ()+keycloakDelete path jwt = do + (KCConfig baseUrl realm _ _) <- ask+ 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+ case eRes of + Right _ -> return ()+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er++-- | Perform get to Keycloak on admin API+keycloakGet :: Path -> JWT -> Keycloak BL.ByteString+keycloakGet path tok = do + (KCConfig baseUrl realm _ _) <- ask+ 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+ case eRes of + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er++-- | Perform get to Keycloak on admin API, without token+keycloakGet' :: Path -> Keycloak BL.ByteString+keycloakGet' path = do + (KCConfig baseUrl realm _ _) <- ask+ 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 + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er+++-- | Perform get to Keycloak on admin API+keycloakAdminGet :: Path -> JWT -> Keycloak BL.ByteString+keycloakAdminGet path tok = do + (KCConfig baseUrl realm _ _) <- ask+ 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+ case eRes of + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er++-- | Perform post to Keycloak.+keycloakAdminPost :: (Postable dat, Show dat) => Path -> dat -> JWT -> Keycloak BL.ByteString+keycloakAdminPost path dat tok = do + (KCConfig baseUrl realm _ _) <- ask+ 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+ case eRes of + Right res -> do+ debug $ (show eRes)+ let hs = fromJust $ res ^? W.responseHeaders+ return $ convertString $ L.last $ T.split (== '/') $ convertString $ fromJust $ lookup "Location" hs+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er++-- | Perform put to Keycloak.+keycloakAdminPut :: (Putable dat, Show dat) => Path -> dat -> JWT -> Keycloak ()+keycloakAdminPut path dat tok = do + (KCConfig baseUrl realm _ _) <- ask+ 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+ case eRes of + Right _ -> return ()+ Left er -> do+ warn $ "Keycloak HTTP error: " ++ (show er)+ throwError $ HTTPError er+++-- * Helpers++readString :: Value -> Maybe Text+readString (String a) = Just a+readString _ = Nothing++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+err s = liftIO $ errorM "Keycloak" s++getErrorStatus :: KCError -> Maybe Status +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)+