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

module Keycloak.Utils where

import           Control.Lens hiding ((.=))
import           Control.Monad.Reader as R
import qualified Control.Monad.Catch as C
import           Control.Monad.Except (throwError, catchError, MonadError)
import           Data.Aeson as JSON
import           Data.Text as T hiding (head, tail, map)
import           Data.Maybe
import           Data.List as L
import           Data.String.Conversions
import qualified Data.ByteString.Lazy as BL
import           Keycloak.Types
import           Network.HTTP.Client as HC hiding (responseBody, path)
import           Network.HTTP.Types.Status
import           Network.Wreq as W hiding (statusCode)
import           Network.Wreq.Types
import           System.Log.Logger
import           Crypto.JWT as JWT

-- | Perform post to Keycloak.
keycloakPost :: (Postable dat, Show dat) => Path -> dat -> JWT -> Keycloak BL.ByteString
keycloakPost :: Path -> dat -> JWT -> Keycloak ByteString
keycloakPost Path
path dat
dat JWT
jwt = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
W.header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JWT -> ByteString
forall a. ToCompact a => a -> ByteString
encodeCompact JWT
jwt)]
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK POST with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  data: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (dat -> String
forall a. Show a => a -> String
show dat
dat) 
  --debug $ "  headers: " ++ (show $ opts ^. W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> dat -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
W.postWith Options
opts String
url dat
dat
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
res -> do
      ByteString -> Keycloak ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Keycloak ByteString)
-> ByteString -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting (First ByteString) (Response ByteString) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First ByteString) (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> Keycloak ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak ByteString) -> KCError -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er

-- | Perform post to Keycloak, without token.
keycloakPost' :: (Postable dat, Show dat) => Path -> dat -> Keycloak BL.ByteString
keycloakPost' :: Path -> dat -> Keycloak ByteString
keycloakPost' Path
path dat
dat = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK POST with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  data: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (dat -> String
forall a. Show a => a -> String
show dat
dat) 
  --debug $ "  headers: " ++ (show $ opts ^. W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> dat -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
W.postWith Options
opts String
url dat
dat
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
res -> do
      ByteString -> Keycloak ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Keycloak ByteString)
-> ByteString -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting (First ByteString) (Response ByteString) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First ByteString) (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> Keycloak ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak ByteString) -> KCError -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er

-- | Perform delete to Keycloak.
keycloakDelete :: Path -> JWT -> Keycloak ()
keycloakDelete :: Path -> JWT -> ReaderT KCConfig (ExceptT KCError IO) ()
keycloakDelete Path
path JWT
jwt = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
W.header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JWT -> ByteString
forall a. ToCompact a => a -> ByteString
encodeCompact JWT
jwt)]
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK DELETE with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  headers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Header] -> String
forall a. Show a => a -> String
show ([Header] -> String) -> [Header] -> String
forall a b. (a -> b) -> a -> b
$ Options
opts Options -> Getting [Header] Options [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] Options [Header]
Lens' Options [Header]
W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
W.deleteWith Options
opts String
url
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
_ -> () -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> ReaderT KCConfig (ExceptT KCError IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> ReaderT KCConfig (ExceptT KCError IO) ())
-> KCError -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er

-- | Perform get to Keycloak on admin API
keycloakGet :: Path -> JWT -> Keycloak BL.ByteString
keycloakGet :: Path -> JWT -> Keycloak ByteString
keycloakGet Path
path JWT
tok = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
W.header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JWT -> ByteString
forall a. ToCompact a => a -> ByteString
encodeCompact JWT
tok)]
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK GET with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  headers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Header] -> String
forall a. Show a => a -> String
show ([Header] -> String) -> [Header] -> String
forall a b. (a -> b) -> a -> b
$ Options
opts Options -> Getting [Header] Options [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] Options [Header]
Lens' Options [Header]
W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
W.getWith Options
opts String
url
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
res -> do
      ByteString -> Keycloak ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Keycloak ByteString)
-> ByteString -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting (First ByteString) (Response ByteString) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First ByteString) (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> Keycloak ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak ByteString) -> KCError -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er

-- | Perform get to Keycloak on admin API, without token
keycloakGet' :: Path -> Keycloak BL.ByteString
keycloakGet' :: Path -> Keycloak ByteString
keycloakGet' Path
path = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK GET with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  headers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Header] -> String
forall a. Show a => a -> String
show ([Header] -> String) -> [Header] -> String
forall a b. (a -> b) -> a -> b
$ Options
opts Options -> Getting [Header] Options [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] Options [Header]
Lens' Options [Header]
W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
W.getWith Options
opts String
url
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
res -> do
      ByteString -> Keycloak ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Keycloak ByteString)
-> ByteString -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting (First ByteString) (Response ByteString) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First ByteString) (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> Keycloak ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak ByteString) -> KCError -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er


-- | Perform get to Keycloak on admin API
keycloakAdminGet :: Path -> JWT -> Keycloak BL.ByteString
keycloakAdminGet :: Path -> JWT -> Keycloak ByteString
keycloakAdminGet Path
path JWT
tok = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
W.header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JWT -> ByteString
forall a. ToCompact a => a -> ByteString
encodeCompact JWT
tok)]
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/admin/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK GET with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  headers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Header] -> String
forall a. Show a => a -> String
show ([Header] -> String) -> [Header] -> String
forall a b. (a -> b) -> a -> b
$ Options
opts Options -> Getting [Header] Options [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] Options [Header]
Lens' Options [Header]
W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
W.getWith Options
opts String
url
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
res -> do
      ByteString -> Keycloak ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Keycloak ByteString)
-> ByteString -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting (First ByteString) (Response ByteString) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First ByteString) (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> Keycloak ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak ByteString) -> KCError -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er

-- | Perform post to Keycloak.
keycloakAdminPost :: (Postable dat, Show dat) => Path -> dat -> JWT -> Keycloak BL.ByteString
keycloakAdminPost :: Path -> dat -> JWT -> Keycloak ByteString
keycloakAdminPost Path
path dat
dat JWT
tok = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
W.header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JWT -> ByteString
forall a. ToCompact a => a -> ByteString
encodeCompact JWT
tok)]
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/admin/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK POST with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  data: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (dat -> String
forall a. Show a => a -> String
show dat
dat) 
  --debug $ "  headers: " ++ (show $ opts ^. W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> dat -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
W.postWith Options
opts String
url dat
dat
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
res -> 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
$ (Either HttpException (Response ByteString) -> String
forall a. Show a => a -> String
show Either HttpException (Response ByteString)
eRes)
      let hs :: [Header]
hs = Maybe [Header] -> [Header]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Header] -> [Header]) -> Maybe [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ Response ByteString
res Response ByteString
-> Getting (First [Header]) (Response ByteString) [Header]
-> Maybe [Header]
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First [Header]) (Response ByteString) [Header]
forall body. Lens' (Response body) [Header]
W.responseHeaders
      ByteString -> Keycloak ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Keycloak ByteString)
-> ByteString -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ Path -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (Path -> ByteString) -> Path -> ByteString
forall a b. (a -> b) -> a -> b
$ [Path] -> Path
forall a. [a] -> a
L.last ([Path] -> Path) -> [Path] -> Path
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Path -> [Path]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (Path -> [Path]) -> Path -> [Path]
forall a b. (a -> b) -> a -> b
$ ByteString -> Path
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> Path) -> ByteString -> Path
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Location" [Header]
hs
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> Keycloak ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak ByteString) -> KCError -> Keycloak ByteString
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er

-- | Perform put to Keycloak.
keycloakAdminPut :: (Putable dat, Show dat) => Path -> dat -> JWT -> Keycloak ()
keycloakAdminPut :: Path -> dat -> JWT -> ReaderT KCConfig (ExceptT KCError IO) ()
keycloakAdminPut Path
path dat
dat JWT
tok = do 
  (KCConfig Path
baseUrl Path
realm Path
_ Path
_) <- ReaderT KCConfig (ExceptT KCError IO) KCConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
W.header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JWT -> ByteString
forall a. ToCompact a => a -> ByteString
encodeCompact JWT
tok)]
  let url :: String
url = (Path -> String
unpack (Path -> String) -> Path -> String
forall a b. (a -> b) -> a -> b
$ Path
baseUrl Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/admin/realms/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
realm Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
"/" Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
path) 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Issuing KEYCLOAK PUT with url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
url) 
  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
"  data: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (dat -> String
forall a. Show a => a -> String
show dat
dat) 
  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
"  headers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Header] -> String
forall a. Show a => a -> String
show ([Header] -> String) -> [Header] -> String
forall a b. (a -> b) -> a -> b
$ Options
opts Options -> Getting [Header] Options [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] Options [Header]
Lens' Options [Header]
W.headers) 
  Either HttpException (Response ByteString)
eRes <- ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
C.try (ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
 -> ReaderT
      KCConfig
      (ExceptT KCError IO)
      (Either HttpException (Response ByteString)))
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
-> ReaderT
     KCConfig
     (ExceptT KCError IO)
     (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString))
-> IO (Response ByteString)
-> ReaderT KCConfig (ExceptT KCError IO) (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> dat -> IO (Response ByteString)
forall a.
Putable a =>
Options -> String -> a -> IO (Response ByteString)
W.putWith Options
opts String
url dat
dat
  case Either HttpException (Response ByteString)
eRes of 
    Right Response ByteString
_ -> () -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Left HttpException
er -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
warn (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak HTTP error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HttpException -> String
forall a. Show a => a -> String
show HttpException
er)
      KCError -> ReaderT KCConfig (ExceptT KCError IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> ReaderT KCConfig (ExceptT KCError IO) ())
-> KCError -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ HttpException -> KCError
HTTPError HttpException
er


-- * Helpers

readString :: Value -> Maybe Text
readString :: Value -> Maybe Path
readString (String Path
a) = Path -> Maybe Path
forall a. a -> Maybe a
Just Path
a
readString Value
_ = Maybe Path
forall a. Maybe a
Nothing

debug, warn, info, err :: (MonadIO m) => String -> m ()
debug :: String -> m ()
debug String
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
debugM String
"Keycloak" String
s
info :: String -> m ()
info String
s  = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
infoM String
"Keycloak" String
s
warn :: String -> m ()
warn String
s  = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
warningM String
"Keycloak" String
s
err :: String -> m ()
err String
s   = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
errorM String
"Keycloak" String
s

getErrorStatus :: KCError -> Maybe Status 
getErrorStatus :: KCError -> Maybe Status
getErrorStatus (HTTPError (HttpExceptionRequest Request
_ (StatusCodeException Response ()
r ByteString
_))) = Status -> Maybe Status
forall a. a -> Maybe a
Just (Status -> Maybe Status) -> Status -> Maybe Status
forall a b. (a -> b) -> a -> b
$ Response () -> Status
forall body. Response body -> Status
HC.responseStatus Response ()
r
getErrorStatus KCError
_ = Maybe Status
forall a. Maybe a
Nothing

try :: MonadError a m => m b -> m (Either a b)
try :: m b -> m (Either a b)
try m b
act = m (Either a b) -> (a -> m (Either a b)) -> m (Either a b)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
act) (Either a b -> m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> m (Either a b))
-> (a -> Either a b) -> a -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left)