diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. 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.0 +version: 0.0.0.1 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 diff --git a/src/Keycloak/Client.hs b/src/Keycloak/Client.hs --- a/src/Keycloak/Client.hs +++ b/src/Keycloak/Client.hs @@ -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 diff --git a/src/Keycloak/Types.hs b/src/Keycloak/Types.hs --- a/src/Keycloak/Types.hs +++ b/src/Keycloak/Types.hs @@ -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]