keycloak-hs 0.0.0.0 → 0.0.0.1

raw patch · 4 files changed

+85/−85 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +1/−1
• keycloak-hs.cabal +1/−1
• src/Keycloak/Client.hs +24/−24
• src/Keycloak/Types.hs +59/−59

@@ -1,7 +1,7 @@ keycloak-hs =========== -keycloak-hs is a library for connecting to Keycloak made in Haskell.+keycloak-hs is a library for connecting to [Keycloak](https://www.keycloak.org/) made in Haskell. Keycloak allows to authenticate users and protect resources.  Warning: This package is experimental and still under development.

@@ -1,6 +1,6 @@ cabal-version: 1.12 name:           keycloak-hs-version:        0.0.0.0+version:        0.0.0.1 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

@@ -32,11 +32,9 @@ import           System.IO.Unsafe  ----------------------- * Permissions ----------------------+-- * Permissions --- Checks is a scope is permitted on a resource. An HTTP Exception 403 will be thrown if not.+-- |Checks is 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)@@ -47,6 +45,7 @@   keycloakPost "protocol/openid-connect/token" dat tok   return () +-- | Returns true id 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@@ -55,6 +54,7 @@     Left e | (statusCode <$> getErrorStatus e) == Just 403 -> return False     Left e -> throwError e --rethrow the error +-- | Return the permissions for all resources, under the given scopes. getAllPermissions :: [ScopeName] -> Token -> Keycloak [Permission] getAllPermissions scopes tok = do   debug "Get all permissions"@@ -73,11 +73,10 @@       throwError $ ParseError $ pack (show err2)  ------------------ * Tokens ------------------  -getUserAuthToken :: Text -> Text -> Keycloak Token+-- * Tokens++-- | Retrieve the user's token+getUserAuthToken :: Username -> Password -> Keycloak Token getUserAuthToken username password = do    debug "Get user token"   client <- asks _clientId@@ -97,6 +96,7 @@       debug $ "Keycloak parse error: " ++ (show err2)        throwError $ ParseError $ pack (show err2) +-- | return a Client token getClientAuthToken :: Keycloak Token getClientAuthToken = do   debug "Get client token"@@ -121,6 +121,7 @@       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@@ -129,10 +130,10 @@       traceM $ "Error while decoding token: " ++ (show e)       Nothing -------------------- * Resource ------------------- +-- * Resource++-- | Create a resource. createResource :: Resource -> Token -> Keycloak ResourceId createResource r tok = do   debug $ convertString $ "Creating resource: " <> (JSON.encode r)@@ -146,16 +147,16 @@       debug $ "Keycloak parse error: " ++ (show err2)        throwError $ ParseError $ pack (show err2) +-- | Delete the resource deleteResource :: ResourceId -> Token -> Keycloak () deleteResource (ResourceId rid) tok = do   keycloakDelete ("authz/protection/resource_set/" <> rid) tok    return ()  ----------------- * Users ----------------+-- * 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   let query = maybe [] (\l -> [("limit", Just $ convertString $ show l)]) max@@ -170,6 +171,7 @@       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 id) tok = do   body <- keycloakAdminGet ("users/" <> (convertString id)) tok @@ -183,10 +185,9 @@       throwError $ ParseError $ pack (show err2)  ----------------------------- * Keycloak requests ------------------------------- Perform post to Keycloak.+-- * 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@@ -203,6 +204,7 @@       warn $ "Keycloak HTTP error: " ++ (show err)       throwError $ HTTPError err +-- | Perform post to Keycloak, without token. keycloakPost' :: (Postable dat, Show dat) => Path -> dat -> Keycloak BL.ByteString keycloakPost' path dat = do    (KCConfig baseUrl realm _ _) <- ask@@ -219,7 +221,7 @@       warn $ "Keycloak HTTP error: " ++ (show err)       throwError $ HTTPError err --- Perform delete to Keycloak.+-- | Perform delete to Keycloak. keycloakDelete :: Path -> Token -> Keycloak () keycloakDelete path tok = do    (KCConfig baseUrl realm _ _) <- ask@@ -234,7 +236,7 @@       warn $ "Keycloak HTTP error: " ++ (show err)       throwError $ HTTPError err --- Perform get to Keycloak on admin API+-- | Perform get to Keycloak on admin API keycloakAdminGet :: Path -> Token -> Keycloak BL.ByteString keycloakAdminGet path tok = do    (KCConfig baseUrl realm _ _) <- ask@@ -251,9 +253,7 @@       throwError $ HTTPError err  ------------------- * Helpers ------------------+-- * Helpers  debug, warn, info, err :: (MonadIO m) => String -> m () debug s = liftIO $ debugM "API" s

@@ -17,7 +17,7 @@ import qualified Data.ByteString as BS import qualified Data.Word8 as W8 (isSpace, _colon, toLower) import           Data.Char-import           Control.Monad.Except (ExceptT)+import           Control.Monad.Except (ExceptT, runExceptT) import           Control.Monad.Reader as R import           Control.Lens hiding ((.=)) import           GHC.Generics (Generic)@@ -25,44 +25,41 @@ import           Network.HTTP.Client as HC hiding (responseBody)  -------------------------- * Keycloak Monad -------------------------+-- * Keycloak Monad +-- | Keycloak Monad stack: a simple Reader monad containing the config, and an ExceptT to handle HTTPErrors and parse errors. type Keycloak a = ReaderT KCConfig (ExceptT KCError IO) a +-- | Contains HTTP errors and parse errors. 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. +-- | Configuration of Keycloak. data KCConfig = KCConfig {   _baseUrl       :: Text,   _realm         :: Text,   _clientId      :: Text,   _clientSecret  :: Text} deriving (Eq, Show)---  _adminLogin    :: Username,---  _adminPassword :: Password,---  _guestLogin    :: Username,---  _guestPassword :: Password} +-- | Default configuration defaultKCConfig :: KCConfig defaultKCConfig = KCConfig {   _baseUrl       = "http://localhost:8080/auth",   _realm         = "waziup",   _clientId      = "api-server",   _clientSecret  = "4e9dcb80-efcd-484c-b3d7-1e95a0096ac0"}---  _adminLogin    = "cdupont",---  _adminPassword = "password",- -- _guestLogin    = "guest",- -- _guestPassword = "guest"} +-- | Run a Keycloak monad within IO.+runKeycloak :: Keycloak a -> KCConfig -> IO (Either KCError a)+runKeycloak kc conf = runExceptT $ runReaderT kc conf+ type Path = Text  ----------------- * Token ----------------+-- * Token +-- | Wrapper for tokens. newtype Token = Token {unToken :: BS.ByteString} deriving (Eq, Show, Generic)  instance FromJSON Token where@@ -84,29 +81,30 @@  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,+  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+  givenName         :: Text,+  familyName        :: Text,+  email             :: Text   } deriving (Generic, Show)  parseTokenDec :: Parse e TokenDec@@ -133,12 +131,13 @@     AB.key "family_name" asText <*>     AB.key "email" asText ---------------------- * Permission --------------------- +-- * Permission++-- | Scope name type ScopeName = Text +-- | Scope Id newtype ScopeId = ScopeId {unScopeId :: Text} deriving (Show, Eq, Generic)  --JSON instances@@ -148,6 +147,7 @@ instance FromJSON ScopeId where   parseJSON = genericParseJSON (defaultOptions {unwrapUnaryRecords = True}) +-- | Keycloak scope data Scope = Scope {   scopeId   :: Maybe ScopeId,   scopeName :: ScopeName@@ -159,6 +159,7 @@ instance FromJSON Scope where   parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = unCapitalize . drop 5} +-- | Keycloak permission on a resource data Permission = Permission    { rsname :: ResourceName,     rsid   :: ResourceId,@@ -171,18 +172,15 @@ instance FromJSON Permission where   parseJSON = genericParseJSON defaultOptions -type Username = Text-type Password = Text ----------------- * User ---------------+-- * User +type Username = Text+type Password = Text type First = Int type Max = Int --- Id of a user+-- | Id of a user newtype UserId = UserId {unUserId :: Text} deriving (Show, Eq, Generic)  --JSON instances@@ -211,10 +209,11 @@ instance ToJSON User where   toJSON = genericToJSON defaultOptions {fieldLabelModifier = drop 4, omitNothingFields = True} ----------------- * Owner ---------------- ++-- * Owner++-- | A resource owner data Owner = Owner {   ownId   :: Maybe Text,   ownName :: Username@@ -227,12 +226,11 @@   toJSON = genericToJSON $ (aesonDrop 3 snakeCase) {omitNothingFields = True}  -------------------- * Resource -------------------+-- * Resource  type ResourceName = Text +-- | A resource Id newtype ResourceId = ResourceId {unResId :: Text} deriving (Show, Eq, Generic)  -- JSON instances@@ -242,15 +240,16 @@ instance FromJSON ResourceId where   parseJSON = genericParseJSON (defaultOptions {unwrapUnaryRecords = True}) +-- | A complete resource data Resource = Resource {-     resId      :: Maybe ResourceId,-     resName    :: ResourceName,-     resType    :: Maybe Text,-     resUris    :: [Text],-     resScopes  :: [Scope],-     resOwner   :: Owner,+     resId                 :: Maybe ResourceId,+     resName               :: ResourceName,+     resType               :: Maybe Text,+     resUris               :: [Text],+     resScopes             :: [Scope],+     resOwner              :: Owner,      resOwnerManagedAccess :: Bool,-     resAttributes :: [Attribute]+     resAttributes         :: [Attribute]   } deriving (Generic, Show)  instance FromJSON Resource where@@ -274,6 +273,7 @@             "ownerManagedAccess" .= toJSON uma,             "attributes"         .= object (map (\(Attribute name vals) -> name .= toJSON vals) attrs)] +-- | A resource attribute data Attribute = Attribute {   attName   :: Text,   attValues :: [Text]