keycloak-hs 0.0.0.2 → 0.0.0.3

raw patch · 3 files changed

+64/−71 lines, 3 filesdep +containersdep +jwtdep −aeson-better-errorsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers, jwt

Dependencies removed: aeson-better-errors

API changes (from Hackage documentation)

Files

• keycloak-hs.cabal +3/−2
• src/Keycloak/Client.hs +12/−16
• src/Keycloak/Types.hs +49/−53

@@ -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 <https://github.com/cdupont/keycloak-hs#readme> 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  

@@ -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  

@@ -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