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

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

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

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

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


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

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

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

kcError :: Monad m => KCError -> KeycloakT m a
kcError :: forall (m :: * -> *) a. Monad m => KCError -> KeycloakT m a
kcError = forall (m :: * -> *) a.
ReaderT KCConfig (ExceptT KCError m) a -> KeycloakT m a
KeycloakT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

viewRealmAndUrl :: Monad m => KeycloakT m (Realm,ServerURL)
viewRealmAndUrl :: forall (m :: * -> *). Monad m => KeycloakT m (Path, Path)
viewRealmAndUrl = do
  Path
realm <- forall (m :: * -> *) b.
Monad m =>
Getting b KCConfig b -> KeycloakT m b
viewConfig (Lens' KCConfig AdapterConfig
confAdapterConfigforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' AdapterConfig Path
confRealm)
  Path
baseUrl <- forall (m :: * -> *) b.
Monad m =>
Getting b KCConfig b -> KeycloakT m b
viewConfig (Lens' KCConfig AdapterConfig
confAdapterConfigforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' AdapterConfig Path
confAuthServerUrl)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path
realm,Path
baseUrl)

viewConfig :: Monad m => Getting b KCConfig b -> KeycloakT m b
viewConfig :: forall (m :: * -> *) b.
Monad m =>
Getting b KCConfig b -> KeycloakT m b
viewConfig = forall (m :: * -> *) a.
ReaderT KCConfig (ExceptT KCError m) a -> KeycloakT m a
KeycloakT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view

-- * Helpers

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

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

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