{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Keycloak.Types where

import           Data.Aeson
import           Data.Aeson.Casing
import           Data.Hashable
import           Data.Text hiding (head, tail, map, toLower, drop)
import           Data.String.Conversions
import           Data.Maybe
import           Data.Map hiding (drop, map)
import qualified Data.HashMap.Strict as HM
import           Data.Char
import           Control.Monad.Except (ExceptT, runExceptT)
import           Control.Monad.Reader as R
import           Control.Monad.Time (MonadTime)
import           Control.Lens hiding ((.=))
import           GHC.Generics (Generic)
import           Network.HTTP.Client as HC hiding (responseBody)
import           Crypto.JWT as JWT

-- | Our Json Web Token as returned by Keycloak
type JWT = SignedJWT

-- * Keycloak Monad

-- | Keycloak Monad stack: a simple Reader monad containing the config, and an ExceptT to handle HTTPErrors and parse errors.
-- You can extract the value using 'runKeycloak'.
-- Example: @keys <- runKeycloak getJWKs defaultKCConfig@
type Keycloak a = KeycloakT IO a

newtype KeycloakT m a = KeycloakT { KeycloakT m a -> ReaderT KCConfig (ExceptT KCError m) a
unKeycloakT :: ReaderT KCConfig (ExceptT KCError m) a }
    deriving newtype (Applicative (KeycloakT m)
a -> KeycloakT m a
Applicative (KeycloakT m)
-> (forall a b.
    KeycloakT m a -> (a -> KeycloakT m b) -> KeycloakT m b)
-> (forall a b. KeycloakT m a -> KeycloakT m b -> KeycloakT m b)
-> (forall a. a -> KeycloakT m a)
-> Monad (KeycloakT m)
KeycloakT m a -> (a -> KeycloakT m b) -> KeycloakT m b
KeycloakT m a -> KeycloakT m b -> KeycloakT m b
forall a. a -> KeycloakT m a
forall a b. KeycloakT m a -> KeycloakT m b -> KeycloakT m b
forall a b. KeycloakT m a -> (a -> KeycloakT m b) -> KeycloakT m b
forall (m :: * -> *). Monad m => Applicative (KeycloakT m)
forall (m :: * -> *) a. Monad m => a -> KeycloakT m a
forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> KeycloakT m b -> KeycloakT m b
forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> (a -> KeycloakT m b) -> KeycloakT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> KeycloakT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> KeycloakT m a
>> :: KeycloakT m a -> KeycloakT m b -> KeycloakT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> KeycloakT m b -> KeycloakT m b
>>= :: KeycloakT m a -> (a -> KeycloakT m b) -> KeycloakT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> (a -> KeycloakT m b) -> KeycloakT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (KeycloakT m)
Monad, Functor (KeycloakT m)
a -> KeycloakT m a
Functor (KeycloakT m)
-> (forall a. a -> KeycloakT m a)
-> (forall a b.
    KeycloakT m (a -> b) -> KeycloakT m a -> KeycloakT m b)
-> (forall a b c.
    (a -> b -> c) -> KeycloakT m a -> KeycloakT m b -> KeycloakT m c)
-> (forall a b. KeycloakT m a -> KeycloakT m b -> KeycloakT m b)
-> (forall a b. KeycloakT m a -> KeycloakT m b -> KeycloakT m a)
-> Applicative (KeycloakT m)
KeycloakT m a -> KeycloakT m b -> KeycloakT m b
KeycloakT m a -> KeycloakT m b -> KeycloakT m a
KeycloakT m (a -> b) -> KeycloakT m a -> KeycloakT m b
(a -> b -> c) -> KeycloakT m a -> KeycloakT m b -> KeycloakT m c
forall a. a -> KeycloakT m a
forall a b. KeycloakT m a -> KeycloakT m b -> KeycloakT m a
forall a b. KeycloakT m a -> KeycloakT m b -> KeycloakT m b
forall a b. KeycloakT m (a -> b) -> KeycloakT m a -> KeycloakT m b
forall a b c.
(a -> b -> c) -> KeycloakT m a -> KeycloakT m b -> KeycloakT m c
forall (m :: * -> *). Monad m => Functor (KeycloakT m)
forall (m :: * -> *) a. Monad m => a -> KeycloakT m a
forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> KeycloakT m b -> KeycloakT m a
forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> KeycloakT m b -> KeycloakT m b
forall (m :: * -> *) a b.
Monad m =>
KeycloakT m (a -> b) -> KeycloakT m a -> KeycloakT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> KeycloakT m a -> KeycloakT m b -> KeycloakT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: KeycloakT m a -> KeycloakT m b -> KeycloakT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> KeycloakT m b -> KeycloakT m a
*> :: KeycloakT m a -> KeycloakT m b -> KeycloakT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
KeycloakT m a -> KeycloakT m b -> KeycloakT m b
liftA2 :: (a -> b -> c) -> KeycloakT m a -> KeycloakT m b -> KeycloakT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> KeycloakT m a -> KeycloakT m b -> KeycloakT m c
<*> :: KeycloakT m (a -> b) -> KeycloakT m a -> KeycloakT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
KeycloakT m (a -> b) -> KeycloakT m a -> KeycloakT m b
pure :: a -> KeycloakT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> KeycloakT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (KeycloakT m)
Applicative, a -> KeycloakT m b -> KeycloakT m a
(a -> b) -> KeycloakT m a -> KeycloakT m b
(forall a b. (a -> b) -> KeycloakT m a -> KeycloakT m b)
-> (forall a b. a -> KeycloakT m b -> KeycloakT m a)
-> Functor (KeycloakT m)
forall a b. a -> KeycloakT m b -> KeycloakT m a
forall a b. (a -> b) -> KeycloakT m a -> KeycloakT m b
forall (m :: * -> *) a b.
Functor m =>
a -> KeycloakT m b -> KeycloakT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> KeycloakT m a -> KeycloakT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> KeycloakT m b -> KeycloakT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> KeycloakT m b -> KeycloakT m a
fmap :: (a -> b) -> KeycloakT m a -> KeycloakT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> KeycloakT m a -> KeycloakT m b
Functor, Monad (KeycloakT m)
Monad (KeycloakT m)
-> (forall a. IO a -> KeycloakT m a) -> MonadIO (KeycloakT m)
IO a -> KeycloakT m a
forall a. IO a -> KeycloakT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (KeycloakT m)
forall (m :: * -> *) a. MonadIO m => IO a -> KeycloakT m a
liftIO :: IO a -> KeycloakT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> KeycloakT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (KeycloakT m)
MonadIO, Monad (KeycloakT m)
KeycloakT m UTCTime
Monad (KeycloakT m)
-> KeycloakT m UTCTime -> MonadTime (KeycloakT m)
forall (m :: * -> *). Monad m -> m UTCTime -> MonadTime m
forall (m :: * -> *). MonadTime m => Monad (KeycloakT m)
forall (m :: * -> *). MonadTime m => KeycloakT m UTCTime
currentTime :: KeycloakT m UTCTime
$ccurrentTime :: forall (m :: * -> *). MonadTime m => KeycloakT m UTCTime
$cp1MonadTime :: forall (m :: * -> *). MonadTime m => Monad (KeycloakT m)
MonadTime)

instance MonadTrans KeycloakT where
    lift :: m a -> KeycloakT m a
lift = ReaderT KCConfig (ExceptT KCError m) a -> KeycloakT m a
forall (m :: * -> *) a.
ReaderT KCConfig (ExceptT KCError m) a -> KeycloakT m a
KeycloakT (ReaderT KCConfig (ExceptT KCError m) a -> KeycloakT m a)
-> (m a -> ReaderT KCConfig (ExceptT KCError m) a)
-> m a
-> KeycloakT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT KCError m a -> ReaderT KCConfig (ExceptT KCError m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT KCError m a -> ReaderT KCConfig (ExceptT KCError m) a)
-> (m a -> ExceptT KCError m a)
-> m a
-> ReaderT KCConfig (ExceptT KCError m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT KCError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Contains HTTP errors and parse errors.
data KCError = HTTPError HttpException  -- ^ Keycloak returned an HTTP error.
             | ParseError Text          -- ^ Failed when parsing the response
             | JWTError JWTError        -- ^ Failed to decode the token
             | EmptyError               -- ^ Empty error to serve as a zero element for Monoid.
             deriving stock (Int -> KCError -> ShowS
[KCError] -> ShowS
KCError -> String
(Int -> KCError -> ShowS)
-> (KCError -> String) -> ([KCError] -> ShowS) -> Show KCError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KCError] -> ShowS
$cshowList :: [KCError] -> ShowS
show :: KCError -> String
$cshow :: KCError -> String
showsPrec :: Int -> KCError -> ShowS
$cshowsPrec :: Int -> KCError -> ShowS
Show)

instance AsJWTError KCError where
  _JWTError :: p JWTError (f JWTError) -> p KCError (f KCError)
_JWTError = (JWTError -> KCError)
-> (KCError -> Maybe JWTError) -> Prism' KCError JWTError
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' JWTError -> KCError
JWTError KCError -> Maybe JWTError
up where
    up :: KCError -> Maybe JWTError
up (JWTError JWTError
e) = JWTError -> Maybe JWTError
forall a. a -> Maybe a
Just JWTError
e
    up KCError
_ = Maybe JWTError
forall a. Maybe a
Nothing

instance AsError KCError where
  _Error :: p Error (f Error) -> p KCError (f KCError)
_Error = p Error (f Error) -> p KCError (f KCError)
forall r. AsJWTError r => Prism' r Error
_JWSError


data KCConfig = KCConfig {
  KCConfig -> AdapterConfig
_confAdapterConfig :: AdapterConfig,
  KCConfig -> [JWK]
_confJWKs :: [JWK]}
  deriving (KCConfig -> KCConfig -> Bool
(KCConfig -> KCConfig -> Bool)
-> (KCConfig -> KCConfig -> Bool) -> Eq KCConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KCConfig -> KCConfig -> Bool
$c/= :: KCConfig -> KCConfig -> Bool
== :: KCConfig -> KCConfig -> Bool
$c== :: KCConfig -> KCConfig -> Bool
Eq, Int -> KCConfig -> ShowS
[KCConfig] -> ShowS
KCConfig -> String
(Int -> KCConfig -> ShowS)
-> (KCConfig -> String) -> ([KCConfig] -> ShowS) -> Show KCConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KCConfig] -> ShowS
$cshowList :: [KCConfig] -> ShowS
show :: KCConfig -> String
$cshow :: KCConfig -> String
showsPrec :: Int -> KCConfig -> ShowS
$cshowsPrec :: Int -> KCConfig -> ShowS
Show, (forall x. KCConfig -> Rep KCConfig x)
-> (forall x. Rep KCConfig x -> KCConfig) -> Generic KCConfig
forall x. Rep KCConfig x -> KCConfig
forall x. KCConfig -> Rep KCConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KCConfig x -> KCConfig
$cfrom :: forall x. KCConfig -> Rep KCConfig x
Generic)

type Realm = Text
type ClientId = Text
type ServerURL = Text

-- | Configuration of Keycloak.
data AdapterConfig = AdapterConfig {
  AdapterConfig -> Text
_confRealm         :: Realm,              -- ^ realm to use
  AdapterConfig -> Text
_confAuthServerUrl :: ServerURL,          -- ^ Base url where Keycloak resides
  AdapterConfig -> Text
_confResource      :: ClientId,           -- ^ client id
  AdapterConfig -> ClientCredentials
_confCredentials   :: ClientCredentials}  -- ^ client secret, found in Client/Credentials tab
  deriving stock (AdapterConfig -> AdapterConfig -> Bool
(AdapterConfig -> AdapterConfig -> Bool)
-> (AdapterConfig -> AdapterConfig -> Bool) -> Eq AdapterConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdapterConfig -> AdapterConfig -> Bool
$c/= :: AdapterConfig -> AdapterConfig -> Bool
== :: AdapterConfig -> AdapterConfig -> Bool
$c== :: AdapterConfig -> AdapterConfig -> Bool
Eq, Int -> AdapterConfig -> ShowS
[AdapterConfig] -> ShowS
AdapterConfig -> String
(Int -> AdapterConfig -> ShowS)
-> (AdapterConfig -> String)
-> ([AdapterConfig] -> ShowS)
-> Show AdapterConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdapterConfig] -> ShowS
$cshowList :: [AdapterConfig] -> ShowS
show :: AdapterConfig -> String
$cshow :: AdapterConfig -> String
showsPrec :: Int -> AdapterConfig -> ShowS
$cshowsPrec :: Int -> AdapterConfig -> ShowS
Show, (forall x. AdapterConfig -> Rep AdapterConfig x)
-> (forall x. Rep AdapterConfig x -> AdapterConfig)
-> Generic AdapterConfig
forall x. Rep AdapterConfig x -> AdapterConfig
forall x. AdapterConfig -> Rep AdapterConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AdapterConfig x -> AdapterConfig
$cfrom :: forall x. AdapterConfig -> Rep AdapterConfig x
Generic)

instance ToJSON AdapterConfig where
  toJSON :: AdapterConfig -> Value
toJSON = Options -> AdapterConfig -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> AdapterConfig -> Value)
-> Options -> AdapterConfig -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Options
trainDrop Int
5

instance FromJSON AdapterConfig where
  parseJSON :: Value -> Parser AdapterConfig
parseJSON = Options -> Value -> Parser AdapterConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser AdapterConfig)
-> Options -> Value -> Parser AdapterConfig
forall a b. (a -> b) -> a -> b
$ Int -> Options
trainDrop Int
5

data ClientCredentials = ClientCredentials {
  ClientCredentials -> Text
_confSecret :: Text}
  deriving stock (ClientCredentials -> ClientCredentials -> Bool
(ClientCredentials -> ClientCredentials -> Bool)
-> (ClientCredentials -> ClientCredentials -> Bool)
-> Eq ClientCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientCredentials -> ClientCredentials -> Bool
$c/= :: ClientCredentials -> ClientCredentials -> Bool
== :: ClientCredentials -> ClientCredentials -> Bool
$c== :: ClientCredentials -> ClientCredentials -> Bool
Eq, Int -> ClientCredentials -> ShowS
[ClientCredentials] -> ShowS
ClientCredentials -> String
(Int -> ClientCredentials -> ShowS)
-> (ClientCredentials -> String)
-> ([ClientCredentials] -> ShowS)
-> Show ClientCredentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientCredentials] -> ShowS
$cshowList :: [ClientCredentials] -> ShowS
show :: ClientCredentials -> String
$cshow :: ClientCredentials -> String
showsPrec :: Int -> ClientCredentials -> ShowS
$cshowsPrec :: Int -> ClientCredentials -> ShowS
Show, (forall x. ClientCredentials -> Rep ClientCredentials x)
-> (forall x. Rep ClientCredentials x -> ClientCredentials)
-> Generic ClientCredentials
forall x. Rep ClientCredentials x -> ClientCredentials
forall x. ClientCredentials -> Rep ClientCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientCredentials x -> ClientCredentials
$cfrom :: forall x. ClientCredentials -> Rep ClientCredentials x
Generic)

instance ToJSON ClientCredentials where
  toJSON :: ClientCredentials -> Value
toJSON = Options -> ClientCredentials -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ClientCredentials -> Value)
-> Options -> ClientCredentials -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Options
trainDrop Int
5

instance FromJSON ClientCredentials where
  parseJSON :: Value -> Parser ClientCredentials
parseJSON = Options -> Value -> Parser ClientCredentials
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ClientCredentials)
-> Options -> Value -> Parser ClientCredentials
forall a b. (a -> b) -> a -> b
$ Int -> Options
trainDrop Int
5

trainDrop :: Int -> Options
trainDrop :: Int -> Options
trainDrop Int
n = Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
trainCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
n, omitNothingFields :: Bool
omitNothingFields = Bool
True}

-- | Default configuration
defaultAdapterConfig :: AdapterConfig
defaultAdapterConfig :: AdapterConfig
defaultAdapterConfig = AdapterConfig :: Text -> Text -> Text -> ClientCredentials -> AdapterConfig
AdapterConfig {
  _confRealm :: Text
_confRealm         = Text
"waziup",
  _confAuthServerUrl :: Text
_confAuthServerUrl = Text
"http://localhost:8080/auth",
  _confResource :: Text
_confResource      = Text
"api-server",
  _confCredentials :: ClientCredentials
_confCredentials   = Text -> ClientCredentials
ClientCredentials Text
"4e9dcb80-efcd-484c-b3d7-1e95a0096ac0"}

-- | Run a Keycloak monad within IO.
runKeycloak :: Monad m => KeycloakT m a -> KCConfig -> m (Either KCError a)
runKeycloak :: KeycloakT m a -> KCConfig -> m (Either KCError a)
runKeycloak KeycloakT m a
kc KCConfig
conf = ExceptT KCError m a -> m (Either KCError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT KCError m a -> m (Either KCError a))
-> ExceptT KCError m a -> m (Either KCError a)
forall a b. (a -> b) -> a -> b
$ ReaderT KCConfig (ExceptT KCError m) a
-> KCConfig -> ExceptT KCError m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (KeycloakT m a -> ReaderT KCConfig (ExceptT KCError m) a
forall (m :: * -> *) a.
KeycloakT m a -> ReaderT KCConfig (ExceptT KCError m) a
unKeycloakT KeycloakT m a
kc) KCConfig
conf

type Path = Text


-- * Token

-- | Token reply from Keycloak
data TokenRep = TokenRep {
  TokenRep -> Text
accessToken       :: Text,
  TokenRep -> Int
expiresIn         :: Int,
  TokenRep -> Int
refreshExpriresIn :: Int,
  TokenRep -> Text
refreshToken      :: Text,
  TokenRep -> Text
tokenType         :: Text,
  TokenRep -> Int
notBeforePolicy   :: Int,
  TokenRep -> Text
sessionState      :: Text,
  TokenRep -> Text
tokenScope        :: Text} deriving stock (Int -> TokenRep -> ShowS
[TokenRep] -> ShowS
TokenRep -> String
(Int -> TokenRep -> ShowS)
-> (TokenRep -> String) -> ([TokenRep] -> ShowS) -> Show TokenRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenRep] -> ShowS
$cshowList :: [TokenRep] -> ShowS
show :: TokenRep -> String
$cshow :: TokenRep -> String
showsPrec :: Int -> TokenRep -> ShowS
$cshowsPrec :: Int -> TokenRep -> ShowS
Show, TokenRep -> TokenRep -> Bool
(TokenRep -> TokenRep -> Bool)
-> (TokenRep -> TokenRep -> Bool) -> Eq TokenRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenRep -> TokenRep -> Bool
$c/= :: TokenRep -> TokenRep -> Bool
== :: TokenRep -> TokenRep -> Bool
$c== :: TokenRep -> TokenRep -> Bool
Eq)

instance FromJSON TokenRep where
  parseJSON :: Value -> Parser TokenRep
parseJSON (Object Object
v) = Text
-> Int -> Int -> Text -> Text -> Int -> Text -> Text -> TokenRep
TokenRep (Text
 -> Int -> Int -> Text -> Text -> Int -> Text -> Text -> TokenRep)
-> Parser Text
-> Parser
     (Int -> Int -> Text -> Text -> Int -> Text -> Text -> TokenRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"access_token"
                                  Parser
  (Int -> Int -> Text -> Text -> Int -> Text -> Text -> TokenRep)
-> Parser Int
-> Parser (Int -> Text -> Text -> Int -> Text -> Text -> TokenRep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expires_in"
                                  Parser (Int -> Text -> Text -> Int -> Text -> Text -> TokenRep)
-> Parser Int
-> Parser (Text -> Text -> Int -> Text -> Text -> TokenRep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"refresh_expires_in"
                                  Parser (Text -> Text -> Int -> Text -> Text -> TokenRep)
-> Parser Text -> Parser (Text -> Int -> Text -> Text -> TokenRep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"refresh_token"
                                  Parser (Text -> Int -> Text -> Text -> TokenRep)
-> Parser Text -> Parser (Int -> Text -> Text -> TokenRep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"token_type"
                                  Parser (Int -> Text -> Text -> TokenRep)
-> Parser Int -> Parser (Text -> Text -> TokenRep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"not-before-policy"
                                  Parser (Text -> Text -> TokenRep)
-> Parser Text -> Parser (Text -> TokenRep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"session_state"
                                  Parser (Text -> TokenRep) -> Parser Text -> Parser TokenRep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"scope"
  parseJSON Value
_ = String -> Parser TokenRep
forall a. HasCallStack => String -> a
error String
"Not an object"

-- * Permissions

-- | Scope name, such as "houses:view"
-- You need to create the scopes in Client/Authorization panel/Authorization scopes tab
newtype ScopeName = ScopeName {ScopeName -> Text
unScopeName :: Text}
    deriving stock (ScopeName -> ScopeName -> Bool
(ScopeName -> ScopeName -> Bool)
-> (ScopeName -> ScopeName -> Bool) -> Eq ScopeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopeName -> ScopeName -> Bool
$c/= :: ScopeName -> ScopeName -> Bool
== :: ScopeName -> ScopeName -> Bool
$c== :: ScopeName -> ScopeName -> Bool
Eq, (forall x. ScopeName -> Rep ScopeName x)
-> (forall x. Rep ScopeName x -> ScopeName) -> Generic ScopeName
forall x. Rep ScopeName x -> ScopeName
forall x. ScopeName -> Rep ScopeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScopeName x -> ScopeName
$cfrom :: forall x. ScopeName -> Rep ScopeName x
Generic, Eq ScopeName
Eq ScopeName
-> (ScopeName -> ScopeName -> Ordering)
-> (ScopeName -> ScopeName -> Bool)
-> (ScopeName -> ScopeName -> Bool)
-> (ScopeName -> ScopeName -> Bool)
-> (ScopeName -> ScopeName -> Bool)
-> (ScopeName -> ScopeName -> ScopeName)
-> (ScopeName -> ScopeName -> ScopeName)
-> Ord ScopeName
ScopeName -> ScopeName -> Bool
ScopeName -> ScopeName -> Ordering
ScopeName -> ScopeName -> ScopeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScopeName -> ScopeName -> ScopeName
$cmin :: ScopeName -> ScopeName -> ScopeName
max :: ScopeName -> ScopeName -> ScopeName
$cmax :: ScopeName -> ScopeName -> ScopeName
>= :: ScopeName -> ScopeName -> Bool
$c>= :: ScopeName -> ScopeName -> Bool
> :: ScopeName -> ScopeName -> Bool
$c> :: ScopeName -> ScopeName -> Bool
<= :: ScopeName -> ScopeName -> Bool
$c<= :: ScopeName -> ScopeName -> Bool
< :: ScopeName -> ScopeName -> Bool
$c< :: ScopeName -> ScopeName -> Bool
compare :: ScopeName -> ScopeName -> Ordering
$ccompare :: ScopeName -> ScopeName -> Ordering
$cp1Ord :: Eq ScopeName
Ord)
    deriving newtype (Int -> ScopeName -> Int
ScopeName -> Int
(Int -> ScopeName -> Int)
-> (ScopeName -> Int) -> Hashable ScopeName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ScopeName -> Int
$chash :: ScopeName -> Int
hashWithSalt :: Int -> ScopeName -> Int
$chashWithSalt :: Int -> ScopeName -> Int
Hashable)

--JSON instances
instance ToJSON ScopeName where
  toJSON :: ScopeName -> Value
toJSON = Options -> ScopeName -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

instance FromJSON ScopeName where
  parseJSON :: Value -> Parser ScopeName
parseJSON = Options -> Value -> Parser ScopeName
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

instance Show ScopeName where
  show :: ScopeName -> String
show (ScopeName Text
s) = Text -> String
forall a b. ConvertibleStrings a b => a -> b
convertString Text
s

-- | Scope Id
newtype ScopeId = ScopeId {ScopeId -> Text
unScopeId :: Text} deriving (Int -> ScopeId -> ShowS
[ScopeId] -> ShowS
ScopeId -> String
(Int -> ScopeId -> ShowS)
-> (ScopeId -> String) -> ([ScopeId] -> ShowS) -> Show ScopeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopeId] -> ShowS
$cshowList :: [ScopeId] -> ShowS
show :: ScopeId -> String
$cshow :: ScopeId -> String
showsPrec :: Int -> ScopeId -> ShowS
$cshowsPrec :: Int -> ScopeId -> ShowS
Show, ScopeId -> ScopeId -> Bool
(ScopeId -> ScopeId -> Bool)
-> (ScopeId -> ScopeId -> Bool) -> Eq ScopeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopeId -> ScopeId -> Bool
$c/= :: ScopeId -> ScopeId -> Bool
== :: ScopeId -> ScopeId -> Bool
$c== :: ScopeId -> ScopeId -> Bool
Eq, (forall x. ScopeId -> Rep ScopeId x)
-> (forall x. Rep ScopeId x -> ScopeId) -> Generic ScopeId
forall x. Rep ScopeId x -> ScopeId
forall x. ScopeId -> Rep ScopeId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScopeId x -> ScopeId
$cfrom :: forall x. ScopeId -> Rep ScopeId x
Generic)

--JSON instances
instance ToJSON ScopeId where
  toJSON :: ScopeId -> Value
toJSON = Options -> ScopeId -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

instance FromJSON ScopeId where
  parseJSON :: Value -> Parser ScopeId
parseJSON = Options -> Value -> Parser ScopeId
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

-- | Keycloak scope
data Scope = Scope {
  Scope -> Maybe ScopeId
scopeId   :: Maybe ScopeId,
  Scope -> ScopeName
scopeName :: ScopeName
  } deriving ((forall x. Scope -> Rep Scope x)
-> (forall x. Rep Scope x -> Scope) -> Generic Scope
forall x. Rep Scope x -> Scope
forall x. Scope -> Rep Scope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scope x -> Scope
$cfrom :: forall x. Scope -> Rep Scope x
Generic, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq)

instance ToJSON Scope where
  toJSON :: Scope -> Value
toJSON = Options -> Scope -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
unCapitalize ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
5, omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON Scope where
  parseJSON :: Value -> Parser Scope
parseJSON = Options -> Value -> Parser Scope
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
unCapitalize ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
5}

-- | permission request
-- You can perform a request on a specific resourse, or on all resources.
-- You can request permission on multiple scopes at once.
-- 
data PermReq = PermReq 
  { PermReq -> Maybe ResourceId
permReqResourceId :: Maybe ResourceId, -- ^ Requested ressource Ids. Nothing means "All resources".
    PermReq -> [ScopeName]
permReqScopes     :: [ScopeName]       -- ^ Scopes requested. [] means "all scopes".
  } deriving ((forall x. PermReq -> Rep PermReq x)
-> (forall x. Rep PermReq x -> PermReq) -> Generic PermReq
forall x. Rep PermReq x -> PermReq
forall x. PermReq -> Rep PermReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PermReq x -> PermReq
$cfrom :: forall x. PermReq -> Rep PermReq x
Generic, PermReq -> PermReq -> Bool
(PermReq -> PermReq -> Bool)
-> (PermReq -> PermReq -> Bool) -> Eq PermReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PermReq -> PermReq -> Bool
$c/= :: PermReq -> PermReq -> Bool
== :: PermReq -> PermReq -> Bool
$c== :: PermReq -> PermReq -> Bool
Eq, Eq PermReq
Eq PermReq
-> (PermReq -> PermReq -> Ordering)
-> (PermReq -> PermReq -> Bool)
-> (PermReq -> PermReq -> Bool)
-> (PermReq -> PermReq -> Bool)
-> (PermReq -> PermReq -> Bool)
-> (PermReq -> PermReq -> PermReq)
-> (PermReq -> PermReq -> PermReq)
-> Ord PermReq
PermReq -> PermReq -> Bool
PermReq -> PermReq -> Ordering
PermReq -> PermReq -> PermReq
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PermReq -> PermReq -> PermReq
$cmin :: PermReq -> PermReq -> PermReq
max :: PermReq -> PermReq -> PermReq
$cmax :: PermReq -> PermReq -> PermReq
>= :: PermReq -> PermReq -> Bool
$c>= :: PermReq -> PermReq -> Bool
> :: PermReq -> PermReq -> Bool
$c> :: PermReq -> PermReq -> Bool
<= :: PermReq -> PermReq -> Bool
$c<= :: PermReq -> PermReq -> Bool
< :: PermReq -> PermReq -> Bool
$c< :: PermReq -> PermReq -> Bool
compare :: PermReq -> PermReq -> Ordering
$ccompare :: PermReq -> PermReq -> Ordering
$cp1Ord :: Eq PermReq
Ord, Int -> PermReq -> Int
PermReq -> Int
(Int -> PermReq -> Int) -> (PermReq -> Int) -> Hashable PermReq
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PermReq -> Int
$chash :: PermReq -> Int
hashWithSalt :: Int -> PermReq -> Int
$chashWithSalt :: Int -> PermReq -> Int
Hashable)

instance Show PermReq where
  show :: PermReq -> String
show (PermReq (Just (ResourceId Text
res1)) [ScopeName]
scopes) = (Text -> String
forall a. Show a => a -> String
show Text
res1) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([ScopeName] -> String
forall a. Show a => a -> String
show [ScopeName]
scopes)
  show (PermReq Maybe ResourceId
Nothing [ScopeName]
scopes)                  = String
"none " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([ScopeName] -> String
forall a. Show a => a -> String
show [ScopeName]
scopes)

-- | Keycloak permission on a resource
-- Returned by Keycloak after a permission request is made.
-- 
data Permission = Permission 
  { Permission -> Maybe ResourceId
permRsid   :: Maybe ResourceId,   -- ^ Resource ID, can be Nothing in case of scope-only permission request
    Permission -> Maybe Text
permRsname :: Maybe ResourceName, -- ^ Resource Name, can be Nothing in case of scope-only permission request
    Permission -> [ScopeName]
permScopes :: [ScopeName]         -- ^ Scopes that are accessible (Non empty)
  } deriving ((forall x. Permission -> Rep Permission x)
-> (forall x. Rep Permission x -> Permission) -> Generic Permission
forall x. Rep Permission x -> Permission
forall x. Permission -> Rep Permission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Permission x -> Permission
$cfrom :: forall x. Permission -> Rep Permission x
Generic, Int -> Permission -> ShowS
[Permission] -> ShowS
Permission -> String
(Int -> Permission -> ShowS)
-> (Permission -> String)
-> ([Permission] -> ShowS)
-> Show Permission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Permission] -> ShowS
$cshowList :: [Permission] -> ShowS
show :: Permission -> String
$cshow :: Permission -> String
showsPrec :: Int -> Permission -> ShowS
$cshowsPrec :: Int -> Permission -> ShowS
Show, Permission -> Permission -> Bool
(Permission -> Permission -> Bool)
-> (Permission -> Permission -> Bool) -> Eq Permission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Permission -> Permission -> Bool
$c/= :: Permission -> Permission -> Bool
== :: Permission -> Permission -> Bool
$c== :: Permission -> Permission -> Bool
Eq)

instance ToJSON Permission where
  toJSON :: Permission -> Value
toJSON = Options -> Permission -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
unCapitalize ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4, omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON Permission where
  parseJSON :: Value -> Parser Permission
parseJSON = Options -> Value -> Parser Permission
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
unCapitalize ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4}



-- * User

type Username = Text
type Password = Text
type First = Int
type Max = Int

-- | Id of a user
newtype UserId = UserId {UserId -> Text
unUserId :: Text} deriving (Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> String
$cshow :: UserId -> String
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
Show, UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
Eq, (forall x. UserId -> Rep UserId x)
-> (forall x. Rep UserId x -> UserId) -> Generic UserId
forall x. Rep UserId x -> UserId
forall x. UserId -> Rep UserId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserId x -> UserId
$cfrom :: forall x. UserId -> Rep UserId x
Generic)

--JSON instances
instance ToJSON UserId where
  toJSON :: UserId -> Value
toJSON = Options -> UserId -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

instance FromJSON UserId where
  parseJSON :: Value -> Parser UserId
parseJSON = Options -> Value -> Parser UserId
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

-- | User 
data User = User
  { User -> Maybe UserId
userId         :: Maybe UserId   -- ^ The unique user ID 
  , User -> Text
userUsername   :: Username       -- ^ Username
  , User -> Maybe Text
userFirstName  :: Maybe Text     -- ^ First name
  , User -> Maybe Text
userLastName   :: Maybe Text     -- ^ Last name
  , User -> Maybe Text
userEmail      :: Maybe Text     -- ^ Email
  , User -> Maybe Object
userAttributes :: Maybe (HM.HashMap Text Value)
  } deriving (Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep User x -> User
$cfrom :: forall x. User -> Rep User x
Generic)

unCapitalize :: String -> String
unCapitalize :: ShowS
unCapitalize (Char
a:String
as) = Char -> Char
toLower Char
a Char -> ShowS
forall a. a -> [a] -> [a]
: String
as
unCapitalize [] = []

instance FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON = Options -> Value -> Parser User
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
unCapitalize ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4}

instance ToJSON User where
  toJSON :: User -> Value
toJSON = Options -> User -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
unCapitalize ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4, omitNothingFields :: Bool
omitNothingFields = Bool
True}



-- * Owner

-- | A resource owner
data Owner = Owner {
  Owner -> Maybe Text
ownId   :: Maybe Text,
  Owner -> Maybe Text
ownName :: Maybe Username
  } deriving ((forall x. Owner -> Rep Owner x)
-> (forall x. Rep Owner x -> Owner) -> Generic Owner
forall x. Rep Owner x -> Owner
forall x. Owner -> Rep Owner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Owner x -> Owner
$cfrom :: forall x. Owner -> Rep Owner x
Generic, Int -> Owner -> ShowS
[Owner] -> ShowS
Owner -> String
(Int -> Owner -> ShowS)
-> (Owner -> String) -> ([Owner] -> ShowS) -> Show Owner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Owner] -> ShowS
$cshowList :: [Owner] -> ShowS
show :: Owner -> String
$cshow :: Owner -> String
showsPrec :: Int -> Owner -> ShowS
$cshowsPrec :: Int -> Owner -> ShowS
Show)

instance FromJSON Owner where
  parseJSON :: Value -> Parser Owner
parseJSON = Options -> Value -> Parser Owner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Owner)
-> Options -> Value -> Parser Owner
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> Options
aesonDrop Int
3 ShowS
snakeCase 

instance ToJSON Owner where
  toJSON :: Owner -> Value
toJSON = Options -> Owner -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Owner -> Value) -> Options -> Owner -> Value
forall a b. (a -> b) -> a -> b
$ (Int -> ShowS -> Options
aesonDrop Int
3 ShowS
snakeCase) {omitNothingFields :: Bool
omitNothingFields = Bool
True}


-- * Resource

type ResourceName = Text
type ResourceType = Text

-- | A resource Id
newtype ResourceId = ResourceId {ResourceId -> Text
unResId :: Text}
    deriving stock (Int -> ResourceId -> ShowS
[ResourceId] -> ShowS
ResourceId -> String
(Int -> ResourceId -> ShowS)
-> (ResourceId -> String)
-> ([ResourceId] -> ShowS)
-> Show ResourceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceId] -> ShowS
$cshowList :: [ResourceId] -> ShowS
show :: ResourceId -> String
$cshow :: ResourceId -> String
showsPrec :: Int -> ResourceId -> ShowS
$cshowsPrec :: Int -> ResourceId -> ShowS
Show, ResourceId -> ResourceId -> Bool
(ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool) -> Eq ResourceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceId -> ResourceId -> Bool
$c/= :: ResourceId -> ResourceId -> Bool
== :: ResourceId -> ResourceId -> Bool
$c== :: ResourceId -> ResourceId -> Bool
Eq, (forall x. ResourceId -> Rep ResourceId x)
-> (forall x. Rep ResourceId x -> ResourceId) -> Generic ResourceId
forall x. Rep ResourceId x -> ResourceId
forall x. ResourceId -> Rep ResourceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResourceId x -> ResourceId
$cfrom :: forall x. ResourceId -> Rep ResourceId x
Generic, Eq ResourceId
Eq ResourceId
-> (ResourceId -> ResourceId -> Ordering)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> ResourceId)
-> (ResourceId -> ResourceId -> ResourceId)
-> Ord ResourceId
ResourceId -> ResourceId -> Bool
ResourceId -> ResourceId -> Ordering
ResourceId -> ResourceId -> ResourceId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ResourceId -> ResourceId -> ResourceId
$cmin :: ResourceId -> ResourceId -> ResourceId
max :: ResourceId -> ResourceId -> ResourceId
$cmax :: ResourceId -> ResourceId -> ResourceId
>= :: ResourceId -> ResourceId -> Bool
$c>= :: ResourceId -> ResourceId -> Bool
> :: ResourceId -> ResourceId -> Bool
$c> :: ResourceId -> ResourceId -> Bool
<= :: ResourceId -> ResourceId -> Bool
$c<= :: ResourceId -> ResourceId -> Bool
< :: ResourceId -> ResourceId -> Bool
$c< :: ResourceId -> ResourceId -> Bool
compare :: ResourceId -> ResourceId -> Ordering
$ccompare :: ResourceId -> ResourceId -> Ordering
$cp1Ord :: Eq ResourceId
Ord)
    deriving newtype (Int -> ResourceId -> Int
ResourceId -> Int
(Int -> ResourceId -> Int)
-> (ResourceId -> Int) -> Hashable ResourceId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ResourceId -> Int
$chash :: ResourceId -> Int
hashWithSalt :: Int -> ResourceId -> Int
$chashWithSalt :: Int -> ResourceId -> Int
Hashable)

-- JSON instances
instance ToJSON ResourceId where
  toJSON :: ResourceId -> Value
toJSON = Options -> ResourceId -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

instance FromJSON ResourceId where
  parseJSON :: Value -> Parser ResourceId
parseJSON = Options -> Value -> Parser ResourceId
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True})

-- | A complete resource
-- Resources are created in Keycloak in Client/
-- You can create resources in Client/Authorization panel/Resources scopes tab
data Resource = Resource {
     Resource -> Maybe ResourceId
resId                 :: Maybe ResourceId,   -- ^ the Keycloak resource ID
     Resource -> Text
resName               :: ResourceName,       -- ^ the Keycloak resource name
     Resource -> Maybe Text
resType               :: Maybe ResourceType, -- ^ Optional resource type
     Resource -> [Text]
resUris               :: [Text],             -- ^ Optional resource URI
     Resource -> [Scope]
resScopes             :: [Scope],            -- ^ All the possible scopes for that resource
     Resource -> Owner
resOwner              :: Owner,              -- ^ The Owner or the resource
     Resource -> Bool
resOwnerManagedAccess :: Bool,               -- ^ Whether the owner can manage his own resources (e.g. resource sharing with others)
     Resource -> [Attribute]
resAttributes         :: [Attribute]         -- ^ Resource attributes
  } deriving ((forall x. Resource -> Rep Resource x)
-> (forall x. Rep Resource x -> Resource) -> Generic Resource
forall x. Rep Resource x -> Resource
forall x. Resource -> Rep Resource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Resource x -> Resource
$cfrom :: forall x. Resource -> Rep Resource x
Generic, Int -> Resource -> ShowS
[Resource] -> ShowS
Resource -> String
(Int -> Resource -> ShowS)
-> (Resource -> String) -> ([Resource] -> ShowS) -> Show Resource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resource] -> ShowS
$cshowList :: [Resource] -> ShowS
show :: Resource -> String
$cshow :: Resource -> String
showsPrec :: Int -> Resource -> ShowS
$cshowsPrec :: Int -> Resource -> ShowS
Show)

instance FromJSON Resource where
  parseJSON :: Value -> Parser Resource
parseJSON (Object Object
v) = do
    Maybe ResourceId
rId     <- Object
v Object -> Text -> Parser (Maybe ResourceId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"_id"
    Text
rName   <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name"
    Maybe Text
rType   <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"type"
    [Text]
rUris   <- Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"uris"
    [Scope]
rScopes <- Object
v Object -> Text -> Parser [Scope]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"scopes"
    Owner
rOwn    <- Object
v Object -> Text -> Parser Owner
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"owner"
    Bool
rOMA    <- Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"ownerManagedAccess"
    Maybe (Map Text [Text])
rAtt    <- Object
v Object -> Text -> Parser (Maybe (Map Text [Text]))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"attributes"
    let atts :: [(Text, [Text])]
atts = if Maybe (Map Text [Text]) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Map Text [Text])
rAtt then Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
toList (Map Text [Text] -> [(Text, [Text])])
-> Map Text [Text] -> [(Text, [Text])]
forall a b. (a -> b) -> a -> b
$ Maybe (Map Text [Text]) -> Map Text [Text]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Map Text [Text])
rAtt else []
    Resource -> Parser Resource
forall (m :: * -> *) a. Monad m => a -> m a
return (Resource -> Parser Resource) -> Resource -> Parser Resource
forall a b. (a -> b) -> a -> b
$ Maybe ResourceId
-> Text
-> Maybe Text
-> [Text]
-> [Scope]
-> Owner
-> Bool
-> [Attribute]
-> Resource
Resource Maybe ResourceId
rId Text
rName Maybe Text
rType [Text]
rUris [Scope]
rScopes Owner
rOwn Bool
rOMA (((Text, [Text]) -> Attribute) -> [(Text, [Text])] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a, [Text]
b) -> Text -> [Text] -> Attribute
Attribute Text
a [Text]
b) [(Text, [Text])]
atts)
  parseJSON Value
_ = String -> Parser Resource
forall a. HasCallStack => String -> a
error String
"not an object"

instance ToJSON Resource where
  toJSON :: Resource -> Value
toJSON (Resource Maybe ResourceId
rid Text
name Maybe Text
typ [Text]
uris [Scope]
scopes Owner
own Bool
uma [Attribute]
attrs) =
    [Pair] -> Value
object [Text
"_id"                Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ResourceId -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe ResourceId
rid,
            Text
"name"               Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
name,
            Text
"type"               Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Text
typ,
            Text
"uris"               Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
uris,
            Text
"scopes"             Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Scope] -> Value
forall a. ToJSON a => a -> Value
toJSON [Scope]
scopes,
            Text
"owner"              Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$ Owner -> Maybe Text
ownName Owner
own),
            Text
"ownerManagedAccess" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
uma,
            Text
"attributes"         Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object ((Attribute -> Pair) -> [Attribute] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (\(Attribute Text
aname [Text]
vals) -> Text
aname Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
vals) [Attribute]
attrs)]

-- | A resource attribute
data Attribute = Attribute {
  Attribute -> Text
attName   :: Text,
  Attribute -> [Text]
attValues :: [Text]
  } deriving ((forall x. Attribute -> Rep Attribute x)
-> (forall x. Rep Attribute x -> Attribute) -> Generic Attribute
forall x. Rep Attribute x -> Attribute
forall x. Attribute -> Rep Attribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attribute x -> Attribute
$cfrom :: forall x. Attribute -> Rep Attribute x
Generic, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show)

instance FromJSON Attribute where
  parseJSON :: Value -> Parser Attribute
parseJSON = Options -> Value -> Parser Attribute
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Attribute)
-> Options -> Value -> Parser Attribute
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> Options
aesonDrop Int
3 ShowS
camelCase 

instance ToJSON Attribute where
  toJSON :: Attribute -> Value
toJSON (Attribute Text
name [Text]
vals) = [Pair] -> Value
object [Text
name Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
vals] 



makeLenses ''KCConfig
makeLenses ''ClientCredentials
makeLenses ''AdapterConfig