{-# 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.IO.Class
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 :: MonadIO m => Maybe Max -> Maybe First -> Maybe Username -> JWT ->  KeycloakT m [User]
getUsers :: Maybe Max
-> Maybe Max -> Maybe Username -> JWT -> KeycloakT m [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 -> KeycloakT m ByteString
forall (m :: * -> *).
MonadIO m =>
Username -> JWT -> KeycloakT m 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 -> 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" 
  case ByteString -> Either String [User]
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
    Right [User]
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]
++ ([User] -> String
forall a. Show a => a -> String
show [User]
ret) 
      [User] -> KeycloakT m [User]
forall (m :: * -> *) a. Monad m => a -> m a
return [User]
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 [User]
forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError (KCError -> KeycloakT m [User]) -> KCError -> KeycloakT m [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 :: MonadIO m => UserId -> JWT ->  KeycloakT m User
getUser :: UserId -> JWT -> KeycloakT m User
getUser (UserId Username
uid) JWT
tok = do
  ByteString
body <- Username -> JWT -> KeycloakT m ByteString
forall (m :: * -> *).
MonadIO m =>
Username -> JWT -> KeycloakT m 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 -> 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]
++ (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 -> 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]
++ (User -> String
forall a. Show a => a -> String
show User
ret) 
      User -> KeycloakT m User
forall (m :: * -> *) a. Monad m => a -> m a
return User
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 User
forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError (KCError -> KeycloakT m User) -> KCError -> KeycloakT m 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 :: MonadIO m => User -> JWT ->  KeycloakT m UserId
createUser :: User -> JWT -> KeycloakT m UserId
createUser User
user JWT
tok = do
  ByteString
res <- Username -> Value -> JWT -> KeycloakT m ByteString
forall dat (m :: * -> *).
(Postable dat, Show dat, MonadIO m) =>
Username -> dat -> JWT -> KeycloakT m ByteString
keycloakAdminPost (Username
"users/") (User -> Value
forall a. ToJSON a => a -> Value
toJSON User
user) 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
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString -> String
forall a. Show a => a -> String
show ByteString
res) 
  UserId -> KeycloakT m UserId
forall (m :: * -> *) a. Monad m => a -> m a
return (UserId -> KeycloakT m UserId) -> UserId -> KeycloakT m 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 :: MonadIO m => UserId -> User -> JWT ->  KeycloakT m ()
updateUser :: UserId -> User -> JWT -> KeycloakT m ()
updateUser (UserId Username
uid) User
user JWT
tok = do
  Username -> Value -> JWT -> KeycloakT m ()
forall dat (m :: * -> *).
(Putable dat, Show dat, MonadIO m) =>
Username -> dat -> JWT -> KeycloakT m ()
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 
  () -> KeycloakT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()