keycloak-hs 0.1.1 → 0.2.0
raw patch · 3 files changed
+75/−23 lines, 3 filesdep +safe
Dependencies added: safe
Files
- keycloak-hs.cabal +2/−1
- src/Keycloak/Client.hs +64/−18
- src/Keycloak/Types.hs +9/−4
keycloak-hs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: keycloak-hs-version: 0.1.1+version: 0.2.0 description: Please see the README on GitHub at <https://github.com/cdupont/keycloak-hs#readme> homepage: https://github.com/cdupont/keycloak-hs#readme bug-reports: https://github.com/cdupont/keycloak-hs/issues@@ -46,6 +46,7 @@ , exceptions , jwt , containers+ , safe default-language: Haskell2010
src/Keycloak/Client.hs view
@@ -28,9 +28,9 @@ import Network.Wreq as W hiding (statusCode) import Network.Wreq.Types import System.Log.Logger-import Debug.Trace import System.IO.Unsafe import Web.JWT as JWT+import Safe -- * Permissions @@ -66,7 +66,6 @@ body <- keycloakPost "protocol/openid-connect/token" dat tok case eitherDecode body of Right ret -> do- debug $ "Keycloak success: " ++ (show ret) return ret Left (err2 :: String) -> do debug $ "Keycloak parse error: " ++ (show err2) @@ -116,15 +115,13 @@ -- | Extract user name from a token-getUsername :: Token -> Maybe Username+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 un) -> Just un- _ -> Nothing- Nothing -> do- traceM $ "Error while decoding token"- Nothing+ Just (String un) -> un+ _ -> error "preferred_username not present in token" + Nothing -> error "Error while decoding token" -- * Resource@@ -140,8 +137,8 @@ debug $ convertString $ "Created resource: " ++ convertString body case eitherDecode body of Right ret -> do- debug $ "Keycloak success: " ++ (show ret) - return $ fromJust $ resId ret+ debug $ "Keycloak success: " ++ (show ret)+ return $ fromJustNote "create" $ resId ret Left err2 -> do debug $ "Keycloak parse error: " ++ (show err2) throwError $ ParseError $ pack (show err2)@@ -149,21 +146,54 @@ -- | Delete the resource deleteResource :: ResourceId -> Token -> Keycloak () deleteResource (ResourceId rid) tok = do- tok2 <- getClientAuthToken - keycloakDelete ("authz/protection/resource_set/" <> rid) tok2 + --tok2 <- getClientAuthToken + keycloakDelete ("authz/protection/resource_set/" <> rid) tok return () +deleteAllResources :: Token -> Keycloak ()+deleteAllResources tok = do+ debug "Deleting all Keycloak resources..."+ ids <- getAllResourceIds+ mapM_ (\rid -> deleteResource rid tok) ids+ debug $ "Deleted " ++ (show $ L.length ids) ++ " resources from Keycloak" +getResource :: ResourceId -> Keycloak Resource+getResource (ResourceId rid) = do+ tok2 <- getClientAuthToken + body <- keycloakGet ("authz/protection/resource_set/" <> rid) 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)++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 r tok = createResource r tok+ -- * 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 max first username tok = do- let query = maybe [] (\l -> [("limit", Just $ convertString $ show l)]) max- ++ maybe [] (\m -> [("max", Just $ convertString $ show m)]) first+ let query = maybe [] (\m -> [("max", Just $ convertString $ show m)]) max+ ++ 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: " ++ (show body) + debug $ "Keycloak success" case eitherDecode body of Right ret -> do debug $ "Keycloak success: " ++ (show ret) @@ -209,7 +239,7 @@ 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) + --debug $ " headers: " ++ (show $ opts ^. W.headers) eRes <- C.try $ liftIO $ W.postWith opts url dat case eRes of Right res -> do@@ -226,7 +256,7 @@ 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) + --debug $ " headers: " ++ (show $ opts ^. W.headers) eRes <- C.try $ liftIO $ W.postWith opts url dat case eRes of Right res -> do@@ -251,6 +281,22 @@ 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@@ -274,7 +320,7 @@ 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) + --debug $ " headers: " ++ (show $ opts ^. W.headers) eRes <- C.try $ liftIO $ W.postWith opts url dat case eRes of Right res -> do
src/Keycloak/Types.hs view
@@ -35,6 +35,7 @@ data KCError = HTTPError HttpException -- ^ Keycloak returned an HTTP error. | ParseError Text -- ^ Failed when parsing the response | EmptyError -- ^ Empty error to serve as a zero element for Monoid.+ deriving (Show) -- | Configuration of Keycloak. data KCConfig = KCConfig {@@ -218,7 +219,7 @@ -- | A resource owner data Owner = Owner { ownId :: Maybe Text,- ownName :: Username+ ownName :: Maybe Username } deriving (Generic, Show) instance FromJSON Owner where@@ -231,6 +232,7 @@ -- * Resource type ResourceName = Text+type ResourceType = Text -- | A resource Id newtype ResourceId = ResourceId {unResId :: Text} deriving (Show, Eq, Generic)@@ -246,7 +248,7 @@ data Resource = Resource { resId :: Maybe ResourceId, resName :: ResourceName,- resType :: Maybe Text,+ resType :: Maybe ResourceType, resUris :: [Text], resScopes :: [Scope], resOwner :: Owner,@@ -264,11 +266,14 @@ rOwn <- v .: "owner" rOMA <- v .: "ownerManagedAccess" rAtt <- v .:? "attributes"- return $ Resource rId rName rType rUris rScopes rOwn rOMA (maybe [] fromJust rAtt)+ let atts = if isJust rAtt then toList $ fromJust rAtt else []+ return $ Resource rId rName rType rUris rScopes rOwn rOMA (map (\(a, b) -> Attribute a b) atts) instance ToJSON Resource where toJSON (Resource id name typ uris scopes own uma attrs) =- object ["name" .= toJSON name,+ object ["_id" .= toJSON id,+ "name" .= toJSON name,+ "type" .= toJSON typ, "uris" .= toJSON uris, "scopes" .= toJSON scopes, "owner" .= (toJSON $ ownName own),