{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}

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.Lens hiding ((.=))
import           GHC.Generics (Generic)
import           Network.HTTP.Client as HC hiding (responseBody)
import           Crypto.JWT as JWT

type JWT = SignedJWT

-- * Keycloak Monad

-- | Keycloak Monad stack: a simple Reader monad containing the config, and an ExceptT to handle HTTPErrors and parse errors.
type Keycloak a = ReaderT KCConfig (ExceptT KCError IO) a

-- | 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 (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


-- | Configuration of Keycloak.
data KCConfig = KCConfig {
  KCConfig -> Text
_confBaseUrl       :: Text,
  KCConfig -> Text
_confRealm         :: Text,
  KCConfig -> Text
_confClientId      :: Text,
  KCConfig -> Text
_confClientSecret  :: Text} 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)

-- | Default configuration
defaultKCConfig :: KCConfig
defaultKCConfig :: KCConfig
defaultKCConfig = KCConfig :: Text -> Text -> Text -> Text -> KCConfig
KCConfig {
  _confBaseUrl :: Text
_confBaseUrl       = Text
"http://localhost:8080/auth",
  _confRealm :: Text
_confRealm         = Text
"waziup",
  _confClientId :: Text
_confClientId      = Text
"api-server",
  _confClientSecret :: Text
_confClientSecret  = Text
"4e9dcb80-efcd-484c-b3d7-1e95a0096ac0"}

-- | Run a Keycloak monad within IO.
runKeycloak :: Keycloak a -> KCConfig -> IO (Either KCError a)
runKeycloak :: Keycloak a -> KCConfig -> IO (Either KCError a)
runKeycloak Keycloak a
kc KCConfig
conf = ExceptT KCError IO a -> IO (Either KCError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT KCError IO a -> IO (Either KCError a))
-> ExceptT KCError IO a -> IO (Either KCError a)
forall a b. (a -> b) -> a -> b
$ Keycloak a -> KCConfig -> ExceptT KCError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Keycloak 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 (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
newtype ScopeName = ScopeName {ScopeName -> Text
unScopeName :: Text} deriving (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, 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}

-- | Keycloak permission on a resource
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, -- Resrouce Name
    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}

-- | permission request
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)



-- * 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 (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, 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
data Resource = Resource {
     Resource -> Maybe ResourceId
resId                 :: Maybe ResourceId,
     Resource -> Text
resName               :: ResourceName,
     Resource -> Maybe Text
resType               :: Maybe ResourceType,
     Resource -> [Text]
resUris               :: [Text],
     Resource -> [Scope]
resScopes             :: [Scope],
     Resource -> Owner
resOwner              :: Owner,
     Resource -> Bool
resOwnerManagedAccess :: Bool,
     Resource -> [Attribute]
resAttributes         :: [Attribute]
  } 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