{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Keycloak.Authorizations where
import Control.Monad.Reader as R
import Data.Aeson as JSON
import Data.Text as T hiding (head, tail, map)
import Data.Either
import Data.List as L
import Data.String.Conversions
import Keycloak.Types
import Keycloak.Tokens
import Keycloak.Utils as U
import Control.Lens
import Network.HTTP.Types.Status
import Network.Wreq as W hiding (statusCode)
import Safe
isAuthorized :: MonadIO m => ResourceId -> ScopeName -> JWT -> KeycloakT m Bool
isAuthorized :: ResourceId -> ScopeName -> JWT -> KeycloakT m Bool
isAuthorized ResourceId
res ScopeName
scope JWT
tok = do
Either KCError ()
r <- KeycloakT m () -> KeycloakT m (Either KCError ())
forall (m :: * -> *) b.
Monad m =>
KeycloakT m b -> KeycloakT m (Either KCError b)
U.try (KeycloakT m () -> KeycloakT m (Either KCError ()))
-> KeycloakT m () -> KeycloakT m (Either KCError ())
forall a b. (a -> b) -> a -> b
$ ResourceId -> ScopeName -> JWT -> KeycloakT m ()
forall (m :: * -> *).
MonadIO m =>
ResourceId -> ScopeName -> JWT -> KeycloakT m ()
checkPermission ResourceId
res ScopeName
scope JWT
tok
case Either KCError ()
r of
Right ()
_ -> Bool -> KeycloakT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Left KCError
e | (Status -> Int
statusCode (Status -> Int) -> Maybe Status -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KCError -> Maybe Status
U.getErrorStatus KCError
e) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
403 -> Bool -> KeycloakT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Left KCError
e -> KCError -> KeycloakT m Bool
forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError KCError
e
getPermissions :: MonadIO m => [PermReq] -> JWT -> KeycloakT m [Permission]
getPermissions :: [PermReq] -> JWT -> KeycloakT m [Permission]
getPermissions [PermReq]
reqs JWT
tok = do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"Get all permissions"
ClientId
client <- Getting ClientId KCConfig ClientId -> KeycloakT m ClientId
forall (m :: * -> *) b.
Monad m =>
Getting b KCConfig b -> KeycloakT m b
viewConfig (Getting ClientId KCConfig ClientId -> KeycloakT m ClientId)
-> Getting ClientId KCConfig ClientId -> KeycloakT m ClientId
forall a b. (a -> b) -> a -> b
$ (AdapterConfig -> Const ClientId AdapterConfig)
-> KCConfig -> Const ClientId KCConfig
Lens' KCConfig AdapterConfig
confAdapterConfig((AdapterConfig -> Const ClientId AdapterConfig)
-> KCConfig -> Const ClientId KCConfig)
-> ((ClientId -> Const ClientId ClientId)
-> AdapterConfig -> Const ClientId AdapterConfig)
-> Getting ClientId KCConfig ClientId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ClientId -> Const ClientId ClientId)
-> AdapterConfig -> Const ClientId AdapterConfig
Lens' AdapterConfig ClientId
confResource
let dat :: [FormParam]
dat = [ByteString
"grant_type" ByteString -> ClientId -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (ClientId
"urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),
ByteString
"audience" ByteString -> ClientId -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= ClientId
client,
ByteString
"response_mode" ByteString -> ClientId -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (ClientId
"permissions" :: Text)]
[FormParam] -> [FormParam] -> [FormParam]
forall a. Semigroup a => a -> a -> a
<> (ClientId -> FormParam) -> [ClientId] -> [FormParam]
forall a b. (a -> b) -> [a] -> [b]
map (\ClientId
p -> ByteString
"permission" ByteString -> ClientId -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= ClientId
p) ([[ClientId]] -> [ClientId]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[ClientId]] -> [ClientId]) -> [[ClientId]] -> [ClientId]
forall a b. (a -> b) -> a -> b
$ (PermReq -> [ClientId]) -> [PermReq] -> [[ClientId]]
forall a b. (a -> b) -> [a] -> [b]
map PermReq -> [ClientId]
getPermString [PermReq]
reqs)
ByteString
body <- ClientId -> [FormParam] -> JWT -> KeycloakT m ByteString
forall dat (m :: * -> *).
(Postable dat, Show dat, MonadIO m) =>
ClientId -> dat -> JWT -> KeycloakT m ByteString
keycloakPost ClientId
"protocol/openid-connect/token" [FormParam]
dat JWT
tok
case ByteString -> Either String [Permission]
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
Right [Permission]
ret -> do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak returned perms: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Permission] -> String
forall a. Show a => a -> String
show [Permission]
ret)
[Permission] -> KeycloakT m [Permission]
forall (m :: * -> *) a. Monad m => a -> m a
return [Permission]
ret
Left (String
err2 :: String) -> do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
err2)
KCError -> KeycloakT m [Permission]
forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError (KCError -> KeycloakT m [Permission])
-> KCError -> KeycloakT m [Permission]
forall a b. (a -> b) -> a -> b
$ ClientId -> KCError
ParseError (ClientId -> KCError) -> ClientId -> KCError
forall a b. (a -> b) -> a -> b
$ String -> ClientId
pack (String -> String
forall a. Show a => a -> String
show String
err2)
where
getPermString :: PermReq -> [Text]
getPermString :: PermReq -> [ClientId]
getPermString (PermReq (Just (ResourceId ClientId
rid)) []) = [ClientId
rid]
getPermString (PermReq (Just (ResourceId ClientId
rid)) [ScopeName]
scopes) = (ScopeName -> ClientId) -> [ScopeName] -> [ClientId]
forall a b. (a -> b) -> [a] -> [b]
map (\(ScopeName ClientId
s) -> (ClientId
rid ClientId -> ClientId -> ClientId
forall a. Semigroup a => a -> a -> a
<> ClientId
"#" ClientId -> ClientId -> ClientId
forall a. Semigroup a => a -> a -> a
<> ClientId
s)) [ScopeName]
scopes
getPermString (PermReq Maybe ResourceId
Nothing [ScopeName]
scopes) = (ScopeName -> ClientId) -> [ScopeName] -> [ClientId]
forall a b. (a -> b) -> [a] -> [b]
map (\(ScopeName ClientId
s) -> (ClientId
"#" ClientId -> ClientId -> ClientId
forall a. Semigroup a => a -> a -> a
<> ClientId
s)) [ScopeName]
scopes
checkPermission :: MonadIO m => ResourceId -> ScopeName -> JWT -> KeycloakT m ()
checkPermission :: ResourceId -> ScopeName -> JWT -> KeycloakT m ()
checkPermission (ResourceId ClientId
res) (ScopeName ClientId
scope) JWT
tok = do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Checking permissions: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ClientId -> String
forall a. Show a => a -> String
show ClientId
res) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ClientId -> String
forall a. Show a => a -> String
show ClientId
scope)
ClientId
client <- Getting ClientId KCConfig ClientId -> KeycloakT m ClientId
forall (m :: * -> *) b.
Monad m =>
Getting b KCConfig b -> KeycloakT m b
viewConfig (Getting ClientId KCConfig ClientId -> KeycloakT m ClientId)
-> Getting ClientId KCConfig ClientId -> KeycloakT m ClientId
forall a b. (a -> b) -> a -> b
$ (AdapterConfig -> Const ClientId AdapterConfig)
-> KCConfig -> Const ClientId KCConfig
Lens' KCConfig AdapterConfig
confAdapterConfig((AdapterConfig -> Const ClientId AdapterConfig)
-> KCConfig -> Const ClientId KCConfig)
-> ((ClientId -> Const ClientId ClientId)
-> AdapterConfig -> Const ClientId AdapterConfig)
-> Getting ClientId KCConfig ClientId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ClientId -> Const ClientId ClientId)
-> AdapterConfig -> Const ClientId AdapterConfig
Lens' AdapterConfig ClientId
confResource
let dat :: [FormParam]
dat = [ByteString
"grant_type" ByteString -> ClientId -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (ClientId
"urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),
ByteString
"audience" ByteString -> ClientId -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= ClientId
client,
ByteString
"permission" ByteString -> ClientId -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= ClientId
res ClientId -> ClientId -> ClientId
forall a. Semigroup a => a -> a -> a
<> ClientId
"#" ClientId -> ClientId -> ClientId
forall a. Semigroup a => a -> a -> a
<> ClientId
scope]
KeycloakT m ByteString -> KeycloakT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (KeycloakT m ByteString -> KeycloakT m ())
-> KeycloakT m ByteString -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ ClientId -> [FormParam] -> JWT -> KeycloakT m ByteString
forall dat (m :: * -> *).
(Postable dat, Show dat, MonadIO m) =>
ClientId -> dat -> JWT -> KeycloakT m ByteString
keycloakPost ClientId
"protocol/openid-connect/token" [FormParam]
dat JWT
tok
createResource :: MonadIO m => Resource -> JWT -> KeycloakT m ResourceId
createResource :: Resource -> JWT -> KeycloakT m ResourceId
createResource Resource
r JWT
tok = do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
"Creating resource: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Resource -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode Resource
r)
ByteString
body <- ClientId -> Value -> JWT -> KeycloakT m ByteString
forall dat (m :: * -> *).
(Postable dat, Show dat, MonadIO m) =>
ClientId -> dat -> JWT -> KeycloakT m ByteString
keycloakPost ClientId
"authz/protection/resource_set" (Resource -> Value
forall a. ToJSON a => a -> Value
toJSON Resource
r) JWT
tok
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String -> String
forall a b. ConvertibleStrings a b => a -> b
convertString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Created resource: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
convertString ByteString
body
case ByteString -> Either String Resource
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
Right Resource
ret -> do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Resource -> String
forall a. Show a => a -> String
show Resource
ret)
ResourceId -> KeycloakT m ResourceId
forall (m :: * -> *) a. Monad m => a -> m a
return (ResourceId -> KeycloakT m ResourceId)
-> ResourceId -> KeycloakT m ResourceId
forall a b. (a -> b) -> a -> b
$ String -> Maybe ResourceId -> ResourceId
forall a. Partial => String -> Maybe a -> a
fromJustNote String
"create" (Maybe ResourceId -> ResourceId) -> Maybe ResourceId -> ResourceId
forall a b. (a -> b) -> a -> b
$ Resource -> Maybe ResourceId
resId Resource
ret
Left String
err2 -> do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
err2)
KCError -> KeycloakT m ResourceId
forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError (KCError -> KeycloakT m ResourceId)
-> KCError -> KeycloakT m ResourceId
forall a b. (a -> b) -> a -> b
$ ClientId -> KCError
ParseError (ClientId -> KCError) -> ClientId -> KCError
forall a b. (a -> b) -> a -> b
$ String -> ClientId
pack (String -> String
forall a. Show a => a -> String
show String
err2)
deleteResource :: MonadIO m => ResourceId -> JWT -> KeycloakT m ()
deleteResource :: ResourceId -> JWT -> KeycloakT m ()
deleteResource (ResourceId ClientId
rid) JWT
tok = do
ClientId -> JWT -> KeycloakT m ()
forall (m :: * -> *).
MonadIO m =>
ClientId -> JWT -> KeycloakT m ()
keycloakDelete (ClientId
"authz/protection/resource_set/" ClientId -> ClientId -> ClientId
forall a. Semigroup a => a -> a -> a
<> ClientId
rid) JWT
tok
() -> KeycloakT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
deleteAllResources :: MonadIO m => JWT -> KeycloakT m ()
deleteAllResources :: JWT -> KeycloakT m ()
deleteAllResources JWT
tok = do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"Deleting all Keycloak resources..."
[ResourceId]
ids <- KeycloakT m [ResourceId]
forall (m :: * -> *). MonadIO m => KeycloakT m [ResourceId]
getAllResourceIds
[Either KCError ()]
res <- (ResourceId -> KeycloakT m (Either KCError ()))
-> [ResourceId] -> KeycloakT m [Either KCError ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ResourceId
rid -> KeycloakT m () -> KeycloakT m (Either KCError ())
forall (m :: * -> *) b.
Monad m =>
KeycloakT m b -> KeycloakT m (Either KCError b)
try (KeycloakT m () -> KeycloakT m (Either KCError ()))
-> KeycloakT m () -> KeycloakT m (Either KCError ())
forall a b. (a -> b) -> a -> b
$ ResourceId -> JWT -> KeycloakT m ()
forall (m :: * -> *).
MonadIO m =>
ResourceId -> JWT -> KeycloakT m ()
deleteResource ResourceId
rid JWT
tok) [ResourceId]
ids
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Deleted " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([()] -> Int) -> [()] -> Int
forall a b. (a -> b) -> a -> b
$ [Either KCError ()] -> [()]
forall a b. [Either a b] -> [b]
rights [Either KCError ()]
res) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" resources out of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [ResourceId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [ResourceId]
ids)
getResource :: MonadIO m => ResourceId -> JWT -> KeycloakT m Resource
getResource :: ResourceId -> JWT -> KeycloakT m Resource
getResource (ResourceId ClientId
rid) JWT
tok = do
ByteString
body <- ClientId -> JWT -> KeycloakT m ByteString
forall (m :: * -> *).
MonadIO m =>
ClientId -> JWT -> KeycloakT m ByteString
keycloakGet (ClientId
"authz/protection/resource_set/" ClientId -> ClientId -> ClientId
forall a. Semigroup a => a -> a -> a
<> ClientId
rid) JWT
tok
case ByteString -> Either String Resource
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
Right Resource
ret -> do
Resource -> KeycloakT m Resource
forall (m :: * -> *) a. Monad m => a -> m a
return Resource
ret
Left (String
err2 :: String) -> do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
err2)
KCError -> KeycloakT m Resource
forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError (KCError -> KeycloakT m Resource)
-> KCError -> KeycloakT m Resource
forall a b. (a -> b) -> a -> b
$ ClientId -> KCError
ParseError (ClientId -> KCError) -> ClientId -> KCError
forall a b. (a -> b) -> a -> b
$ String -> ClientId
pack (String -> String
forall a. Show a => a -> String
show String
err2)
getAllResourceIds :: MonadIO m => KeycloakT m [ResourceId]
getAllResourceIds :: KeycloakT m [ResourceId]
getAllResourceIds = do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"Get all resources"
JWT
tok2 <- KeycloakT m JWT
forall (m :: * -> *). MonadIO m => KeycloakT m JWT
getClientJWT
ByteString
body <- ClientId -> JWT -> KeycloakT m ByteString
forall (m :: * -> *).
MonadIO m =>
ClientId -> JWT -> KeycloakT m ByteString
keycloakGet (ClientId
"authz/protection/resource_set?max=1000") JWT
tok2
case ByteString -> Either String [ResourceId]
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
Right [ResourceId]
ret -> do
[ResourceId] -> KeycloakT m [ResourceId]
forall (m :: * -> *) a. Monad m => a -> m a
return [ResourceId]
ret
Left (String
err2 :: String) -> do
String -> KeycloakT m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> KeycloakT m ()) -> String -> KeycloakT m ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
err2)
KCError -> KeycloakT m [ResourceId]
forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError (KCError -> KeycloakT m [ResourceId])
-> KCError -> KeycloakT m [ResourceId]
forall a b. (a -> b) -> a -> b
$ ClientId -> KCError
ParseError (ClientId -> KCError) -> ClientId -> KCError
forall a b. (a -> b) -> a -> b
$ String -> ClientId
pack (String -> String
forall a. Show a => a -> String
show String
err2)
updateResource :: MonadIO m => Resource -> JWT -> KeycloakT m ResourceId
updateResource :: Resource -> JWT -> KeycloakT m ResourceId
updateResource = Resource -> JWT -> KeycloakT m ResourceId
forall (m :: * -> *).
MonadIO m =>
Resource -> JWT -> KeycloakT m ResourceId
createResource