diff --git a/keycloak-hs.cabal b/keycloak-hs.cabal --- a/keycloak-hs.cabal +++ b/keycloak-hs.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: keycloak-hs -version: 0.0.0.2 +version: 0.0.0.3 description: Please see the README on GitHub at homepage: https://github.com/cdupont/keycloak-hs#readme bug-reports: https://github.com/cdupont/keycloak-hs/issues @@ -37,7 +37,6 @@ , text , aeson , aeson-casing - , aeson-better-errors , http-api-data , http-types , hslogger @@ -45,6 +44,8 @@ , wreq , base64-bytestring , exceptions + , jwt + , containers default-language: Haskell2010 diff --git a/src/Keycloak/Client.hs b/src/Keycloak/Client.hs --- a/src/Keycloak/Client.hs +++ b/src/Keycloak/Client.hs @@ -11,10 +11,10 @@ import Control.Monad.Except (throwError, catchError, MonadError) import Data.Aeson as JSON import Data.Aeson.Types hiding ((.=)) -import Data.Aeson.BetterErrors as AB import Data.Text hiding (head, tail, map) import Data.Text.Encoding import Data.Maybe +import Data.Map hiding (map) import Data.ByteString.Base64 as B64 import Data.String.Conversions import Data.Monoid hiding (First) @@ -30,11 +30,11 @@ import System.Log.Logger import Debug.Trace import System.IO.Unsafe - +import Web.JWT as JWT -- * Permissions --- |Checks is a scope is permitted on a resource. An HTTP Exception 403 will be thrown if not. +-- | 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) scope tok = do debug $ "Checking permissions: " ++ (show res) ++ " " ++ (show scope) @@ -91,7 +91,7 @@ case eitherDecode body of Right ret -> do debug $ "Keycloak success: " ++ (show ret) - return ret + return $ Token $ convertString $ accessToken ret Left err2 -> do debug $ "Keycloak parse error: " ++ (show err2) throwError $ ParseError $ pack (show err2) @@ -109,25 +109,21 @@ case eitherDecode body of Right ret -> do debug $ "Keycloak success: " ++ (show ret) - return $ ret + return $ Token $ convertString $ accessToken ret Left err2 -> do debug $ "Keycloak parse error: " ++ (show err2) throwError $ ParseError $ pack (show err2) -decodeToken :: Token -> Either String TokenDec -decodeToken (Token tok) = case (BS.split '.' tok) ^? element 1 of - Nothing -> Left "Token is not formed correctly" - Just part2 -> case AB.parse parseTokenDec (traceShowId $ convertString $ B64.decodeLenient $ traceShowId part2) of - Right td -> Right td - Left (e :: ParseError String) -> Left $ show e -- | Extract user name from a token getUsername :: Token -> Maybe Username -getUsername tok = do - case decodeToken tok of - Right t -> Just $ preferredUsername t - Left e -> do - traceM $ "Error while decoding token: " ++ (show e) +getUsername (Token tok) = do + case JWT.decode $ (traceShowId (convertString tok)) of + Just t -> case (traceShowId (unClaimsMap $ unregisteredClaims $ claims t)) !? "preferred_username" of + Just (String un) -> Just un + _ -> Nothing + Nothing -> do + traceM $ "Error while decoding token" Nothing diff --git a/src/Keycloak/Types.hs b/src/Keycloak/Types.hs --- a/src/Keycloak/Types.hs +++ b/src/Keycloak/Types.hs @@ -13,7 +13,6 @@ import Data.Text.Encoding import Data.Monoid import Data.Maybe -import Data.Aeson.BetterErrors as AB import qualified Data.ByteString as BS import qualified Data.Word8 as W8 (isSpace, _colon, toLower) import Data.Char @@ -62,11 +61,7 @@ -- | Wrapper for tokens. newtype Token = Token {unToken :: BS.ByteString} deriving (Eq, Show, Generic) -instance FromJSON Token where - parseJSON (Object v) = do - t <- v .: "access_token" - return $ Token $ encodeUtf8 t - +-- | perser for Authorization header instance FromHttpApiData Token where parseQueryParam = parseHeader . encodeUtf8 parseHeader (extractBearerAuth -> Just tok) = Right $ Token tok @@ -79,58 +74,59 @@ then Just $ BS.dropWhile W8.isSpace y else Nothing +-- | Create Authorization header instance ToHttpApiData Token where toQueryParam (Token token) = "Bearer " <> (decodeUtf8 token) --- | Token description returned by Keycloak -data TokenDec = TokenDec { - jti :: Text, - exp :: Int, - nbf :: Int, - iat :: Int, - iss :: Text, - aud :: Text, - sub :: Text, - typ :: Text, - azp :: Text, - authTime :: Int, - sessionState :: Text, - acr :: Text, - allowedOrigins :: Value, - realmAccess :: Value, - ressourceAccess :: Value, - scope :: Text, - name :: Text, - preferredUsername :: Text, - givenName :: Text, - familyName :: Text, - email :: Text - } deriving (Generic, Show) +-- | 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"; -parseTokenDec :: Parse e TokenDec -parseTokenDec = TokenDec <$> - AB.key "jti" asText <*> - AB.key "exp" asIntegral <*> - AB.key "nbf" asIntegral <*> - AB.key "iat" asIntegral <*> - AB.key "iss" asText <*> - AB.key "aud" asText <*> - AB.key "sub" asText <*> - AB.key "typ" asText <*> - AB.key "azp" asText <*> - AB.key "auth_time" asIntegral <*> - AB.key "session_state" asText <*> - AB.key "acr" asText <*> - AB.key "allowed-origins" asValue <*> - AB.key "realm_access" asValue <*> - AB.key "resource_access" asValue <*> - AB.key "scope" asText <*> - AB.key "name" asText <*> - AB.key "preferred_username" asText <*> - AB.key "given_name" asText <*> - AB.key "family_name" asText <*> - AB.key "email" asText +-- | Token reply from Keycloak +data TokenRep = TokenRep { + accessToken :: Text, + expiresIn :: Int, + refreshExpriresIn :: Int, + refreshToken :: Text, + tokenType :: Text, + notBeforePolicy :: Int, + sessionState :: Text, + scope :: Text} deriving (Show, Eq) +instance FromJSON TokenRep where + parseJSON (Object v) = TokenRep <$> v .: "access_token" + <*> v .: "expires_in" + <*> v .: "refresh_expires_in" + <*> v .: "refresh_token" + <*> v .: "token_type" + <*> v .: "not-before-policy" + <*> v .: "session_state" + <*> v .: "scope" -- * Permission