{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Keycloak.Users where
import Control.Monad.Except (throwError)
import Data.Aeson as JSON
import Data.Text as T hiding (head, tail, map)
import Data.String.Conversions
import Keycloak.Types
import Keycloak.Utils as U
import Network.HTTP.Types (renderQuery)
getUsers :: Maybe Max -> Maybe First -> Maybe Username -> JWT -> Keycloak [User]
getUsers :: Maybe Max -> Maybe Max -> Maybe Username -> JWT -> Keycloak [User]
getUsers Maybe Max
mmax Maybe Max
first Maybe Username
username JWT
tok = do
let query :: [(ByteString, Maybe ByteString)]
query = [(ByteString, Maybe ByteString)]
-> (Max -> [(ByteString, Maybe ByteString)])
-> Maybe Max
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Max
m -> [(ByteString
"max", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Max -> String
forall a. Show a => a -> String
show Max
m)]) Maybe Max
mmax
[(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
-> (Max -> [(ByteString, Maybe ByteString)])
-> Maybe Max
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Max
f -> [(ByteString
"first", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Max -> String
forall a. Show a => a -> String
show Max
f)]) Maybe Max
first
[(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
-> (Username -> [(ByteString, Maybe ByteString)])
-> Maybe Username
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Username
u -> [(ByteString
"username", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Username -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString Username
u)]) Maybe Username
username
ByteString
body <- Username -> JWT -> Keycloak ByteString
keycloakAdminGet (Username
"users" Username -> Username -> Username
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Username
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> Username) -> ByteString -> Username
forall a b. (a -> b) -> a -> b
$ Bool -> [(ByteString, Maybe ByteString)] -> ByteString
renderQuery Bool
True [(ByteString, Maybe ByteString)]
query)) JWT
tok
String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success"
case ByteString -> Either String [User]
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
Right [User]
ret -> do
String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([User] -> String
forall a. Show a => a -> String
show [User]
ret)
[User] -> Keycloak [User]
forall (m :: * -> *) a. Monad m => a -> m a
return [User]
ret
Left (String
err2 :: String) -> do
String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
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 -> Keycloak [User]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak [User]) -> KCError -> Keycloak [User]
forall a b. (a -> b) -> a -> b
$ Username -> KCError
ParseError (Username -> KCError) -> Username -> KCError
forall a b. (a -> b) -> a -> b
$ String -> Username
pack (String -> String
forall a. Show a => a -> String
show String
err2)
getUser :: UserId -> JWT -> Keycloak User
getUser :: UserId -> JWT -> Keycloak User
getUser (UserId Username
uid) JWT
tok = do
ByteString
body <- Username -> JWT -> Keycloak ByteString
keycloakAdminGet (Username
"users/" Username -> Username -> Username
forall a. Semigroup a => a -> a -> a
<> (Username -> Username
forall a b. ConvertibleStrings a b => a -> b
convertString Username
uid)) JWT
tok
String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString -> String
forall a. Show a => a -> String
show ByteString
body)
case ByteString -> Either String User
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
Right User
ret -> do
String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (User -> String
forall a. Show a => a -> String
show User
ret)
User -> Keycloak User
forall (m :: * -> *) a. Monad m => a -> m a
return User
ret
Left (String
err2 :: String) -> do
String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
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 -> Keycloak User
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak User) -> KCError -> Keycloak User
forall a b. (a -> b) -> a -> b
$ Username -> KCError
ParseError (Username -> KCError) -> Username -> KCError
forall a b. (a -> b) -> a -> b
$ String -> Username
pack (String -> String
forall a. Show a => a -> String
show String
err2)
createUser :: User -> JWT -> Keycloak UserId
createUser :: User -> JWT -> Keycloak UserId
createUser User
user JWT
tok = do
ByteString
res <- Username -> Value -> JWT -> Keycloak ByteString
forall dat.
(Postable dat, Show dat) =>
Username -> dat -> JWT -> Keycloak ByteString
keycloakAdminPost (Username
"users/") (User -> Value
forall a. ToJSON a => a -> Value
toJSON User
user) JWT
tok
String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString -> String
forall a. Show a => a -> String
show ByteString
res)
UserId -> Keycloak UserId
forall (m :: * -> *) a. Monad m => a -> m a
return (UserId -> Keycloak UserId) -> UserId -> Keycloak UserId
forall a b. (a -> b) -> a -> b
$ Username -> UserId
UserId (Username -> UserId) -> Username -> UserId
forall a b. (a -> b) -> a -> b
$ ByteString -> Username
forall a b. ConvertibleStrings a b => a -> b
convertString ByteString
res
updateUser :: UserId -> User -> JWT -> Keycloak ()
updateUser :: UserId -> User -> JWT -> ReaderT KCConfig (ExceptT KCError IO) ()
updateUser (UserId Username
uid) User
user JWT
tok = do
Username
-> Value -> JWT -> ReaderT KCConfig (ExceptT KCError IO) ()
forall dat.
(Putable dat, Show dat) =>
Username -> dat -> JWT -> ReaderT KCConfig (ExceptT KCError IO) ()
keycloakAdminPut (Username
"users/" Username -> Username -> Username
forall a. Semigroup a => a -> a -> a
<> (Username -> Username
forall a b. ConvertibleStrings a b => a -> b
convertString Username
uid)) (User -> Value
forall a. ToJSON a => a -> Value
toJSON User
user) JWT
tok
() -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()