{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

{-|
This module helps you manage users in Keycloak.
You can create, read and update users.
To activate this, you need to give the role "manage users" to your user in Keycloak.
For this, go in your user, select the "Role mappings" tab.
Then in "client Roles", select "realm management" and assign the role "manage-users".

Example usage:

@
-- Get a JWT from Keycloak. A JWT can then be used to authenticate yourself.
jwt <- getJWT "demo" "demo" 

users <- getUsers Nothing Nothing Nothing jwt
liftIO $ putStrLn $ "All Users: " ++ (show users)
@

-}

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)

-- * 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 -> 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)

-- | Get a single user, based on his Id
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)

-- | Create a user
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

-- | Get a single user, based on his Id
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 ()