keycloak-hs 0.0.0.4 → 0.0.0.5
raw patch · 4 files changed
+99/−56 lines, 4 filesdep −keycloak-hs
Dependencies removed: keycloak-hs
Files
- keycloak-hs.cabal +1/−13
- src/Keycloak/Client.hs +64/−13
- src/Keycloak/Types.hs +34/−28
- test/Spec.hs +0/−2
keycloak-hs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: keycloak-hs-version: 0.0.0.4+version: 0.0.0.5 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@@ -49,15 +49,3 @@ default-language: Haskell2010 -test-suite keycloak-hs-test- type: exitcode-stdio-1.0- main-is: Spec.hs- other-modules:- Paths_keycloak_hs- hs-source-dirs:- test- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends:- base >=4.7 && <5- , keycloak-hs- default-language: Haskell2010
src/Keycloak/Client.hs view
@@ -11,11 +11,11 @@ import Control.Monad.Except (throwError, catchError, MonadError) import Data.Aeson as JSON import Data.Aeson.Types hiding ((.=))-import Data.Text hiding (head, tail, map)+import Data.Text as T hiding (head, tail, map, lookup) import Data.Text.Encoding import Data.Maybe-import Data.Map hiding (map)-import Data.ByteString.Base64 as B64+import Data.List as L+import Data.Map hiding (map, lookup) import Data.String.Conversions import Data.Monoid hiding (First) import qualified Data.ByteString.Char8 as BS@@ -118,8 +118,8 @@ -- | Extract user name from a token getUsername :: Token -> Maybe Username getUsername (Token tok) = do - case JWT.decode $ (traceShowId (convertString tok)) of- Just t -> case (traceShowId (unClaimsMap $ unregisteredClaims $ claims t)) !? "preferred_username" of+ case JWT.decode $ convertString tok of+ Just t -> case (unClaimsMap $ unregisteredClaims $ claims t) !? "preferred_username" of Just (String un) -> Just un _ -> Nothing Nothing -> do@@ -133,7 +133,10 @@ 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+ -- The user token might not be suitable because it can use another client (such as "dashboard"). + -- however we need "api-server" as client because it's the resource authorization server.+ tok2 <- getClientAuthToken + body <- keycloakPost "authz/protection/resource_set" (toJSON r) tok2 debug $ convertString $ "Created resource: " ++ convertString body case eitherDecode body of Right ret -> do@@ -146,17 +149,19 @@ -- | Delete the resource deleteResource :: ResourceId -> Token -> Keycloak () deleteResource (ResourceId rid) tok = do- keycloakDelete ("authz/protection/resource_set/" <> rid) tok + tok2 <- getClientAuthToken + keycloakDelete ("authz/protection/resource_set/" <> rid) tok2 return () -- * 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 -> Token -> Keycloak [User]-getUsers max first tok = do+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+ ++ maybe [] (\u -> [("username", Just $ convertString u)]) username body <- keycloakAdminGet ("users" <> (convertString $ renderQuery True query)) tok debug $ "Keycloak success: " ++ (show body) case eitherDecode body of@@ -180,7 +185,20 @@ debug $ "Keycloak parse error: " ++ (show err2) throwError $ ParseError $ pack (show err2) +-- | Get a single user, based on his Id+postUser :: User -> Token -> Keycloak UserId+postUser 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+putUser :: UserId -> User -> Token -> Keycloak ()+putUser (UserId id) user tok = do+ keycloakAdminPut ("users/" <> (convertString id)) (toJSON user) tok + return ()++ -- * Keycloak basic requests -- | Perform post to Keycloak.@@ -248,14 +266,47 @@ 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 "API" s-info s = liftIO $ infoM "API" s-warn s = liftIO $ warningM "API" s-err s = liftIO $ errorM "API" s+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
src/Keycloak/Types.hs view
@@ -12,7 +12,9 @@ import Data.Text hiding (head, tail, map, toLower, drop) import Data.Text.Encoding import Data.Monoid+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, _colon, toLower) import Data.Char@@ -61,6 +63,9 @@ -- | 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@@ -80,32 +85,32 @@ -- | 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";+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";+tokAddress = "address";+tokUpdateAt = "updated_at";+tokClaimsLocales = "claims_locales";+tokACR = "acr"; -- | Token reply from Keycloak data TokenRep = TokenRep {@@ -192,7 +197,8 @@ , userUsername :: Username -- ^ Username , userFirstName :: Maybe Text -- ^ First name , userLastName :: Maybe Text -- ^ Last name- , userEmail :: Maybe Text -- ^ Email + , userEmail :: Maybe Text -- ^ Email+ , userAttributes :: Maybe (Map Text [Text]) } deriving (Show, Eq, Generic) unCapitalize :: String -> String@@ -203,7 +209,7 @@ parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = unCapitalize . drop 4} instance ToJSON User where- toJSON = genericToJSON defaultOptions {fieldLabelModifier = drop 4, omitNothingFields = True}+ toJSON = genericToJSON defaultOptions {fieldLabelModifier = unCapitalize . drop 4, omitNothingFields = True} @@ -265,7 +271,7 @@ object ["name" .= toJSON name, "uris" .= toJSON uris, "scopes" .= toJSON scopes,- "owner" .= toJSON own,+ "owner" .= (toJSON $ ownName own), "ownerManagedAccess" .= toJSON uma, "attributes" .= object (map (\(Attribute name vals) -> name .= toJSON vals) attrs)]
− test/Spec.hs
@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"