{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

-- | This module contains several categories of SCIM-related types:
--
-- * Extensions for @hscim@ types (like 'ScimUserExtra').
-- * Our wrappers over @hscim@ types (like 'ValidScimUser').
-- * Servant-based API types.
-- * Request and response types for SCIM-related endpoints.
module Wire.API.User.Scim where

import Control.Lens (makeLenses, mapped, to, (.~), (?~), (^.))
import Control.Monad.Except (throwError)
import Crypto.Hash (hash)
import Crypto.Hash.Algorithms (SHA512)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.Attoparsec.ByteString (string)
import Data.Binary.Builder qualified as BB
import Data.ByteArray.Encoding (Base (..), convertToBase)
import Data.ByteString.Conversion (FromByteString (..), ToByteString (..))
import Data.CaseInsensitive qualified as CI
import Data.Code as Code
import Data.Handle (Handle)
import Data.Id (ScimTokenId, TeamId, UserId)
import Data.Json.Util ((#))
import Data.Map qualified as Map
import Data.Misc (PlainTextPassword6)
import Data.OpenApi hiding (Operation)
import Data.Proxy
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.These
import Data.These.Combinators
import Data.Time.Clock (UTCTime)
import Imports
import SAML2.WebSSO qualified as SAML
import SAML2.WebSSO.Test.Arbitrary ()
import Servant.API (FromHttpApiData (..), ToHttpApiData (..))
import Test.QuickCheck (Gen)
import Test.QuickCheck qualified as QC
import Web.HttpApiData (parseHeaderWithPrefix)
import Web.Scim.AttrName (AttrName (..))
import Web.Scim.Class.Auth qualified as Scim.Auth
import Web.Scim.Class.Group qualified as Scim.Group
import Web.Scim.Class.User qualified as Scim.User
import Web.Scim.Filter (AttrPath (..))
import Web.Scim.Schema.Common qualified as Scim
import Web.Scim.Schema.Error qualified as Scim
import Web.Scim.Schema.PatchOp (Operation (..), Path (NormalPath))
import Web.Scim.Schema.PatchOp qualified as Scim
import Web.Scim.Schema.Schema (Schema (CustomSchema))
import Web.Scim.Schema.Schema qualified as Scim
import Web.Scim.Schema.User qualified as Scim
import Web.Scim.Schema.User qualified as Scim.User
import Wire.API.Locale
import Wire.API.Team.Role (Role)
import Wire.API.User.EmailAddress (EmailAddress, fromEmail)
import Wire.API.User.Profile as BT
import Wire.API.User.RichInfo qualified as RI
import Wire.API.User.Saml ()
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

----------------------------------------------------------------------------
-- Schemas

userSchemas :: [Scim.Schema]
userSchemas :: [Schema]
userSchemas =
  [ Item [Schema]
Schema
Scim.User20,
    Text -> Schema
Scim.CustomSchema Text
forall s. IsString s => s
RI.richInfoAssocListURN,
    Text -> Schema
Scim.CustomSchema Text
forall s. IsString s => s
RI.richInfoMapURN
  ]

----------------------------------------------------------------------------
-- Token

-- | > docs/reference/provisioning/scim-token.md {#RefScimToken}
--
-- A bearer token that authorizes a provisioning tool to perform actions with a team. Each
-- token corresponds to one team.
--
-- For SCIM authentication and token handling logic, see "Spar.Scim.Auth".
newtype ScimToken = ScimToken {ScimToken -> Text
fromScimToken :: Text}
  deriving (ScimToken -> ScimToken -> Bool
(ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool) -> Eq ScimToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimToken -> ScimToken -> Bool
== :: ScimToken -> ScimToken -> Bool
$c/= :: ScimToken -> ScimToken -> Bool
/= :: ScimToken -> ScimToken -> Bool
Eq, Eq ScimToken
Eq ScimToken =>
(ScimToken -> ScimToken -> Ordering)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> Bool)
-> (ScimToken -> ScimToken -> ScimToken)
-> (ScimToken -> ScimToken -> ScimToken)
-> Ord ScimToken
ScimToken -> ScimToken -> Bool
ScimToken -> ScimToken -> Ordering
ScimToken -> ScimToken -> ScimToken
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
$ccompare :: ScimToken -> ScimToken -> Ordering
compare :: ScimToken -> ScimToken -> Ordering
$c< :: ScimToken -> ScimToken -> Bool
< :: ScimToken -> ScimToken -> Bool
$c<= :: ScimToken -> ScimToken -> Bool
<= :: ScimToken -> ScimToken -> Bool
$c> :: ScimToken -> ScimToken -> Bool
> :: ScimToken -> ScimToken -> Bool
$c>= :: ScimToken -> ScimToken -> Bool
>= :: ScimToken -> ScimToken -> Bool
$cmax :: ScimToken -> ScimToken -> ScimToken
max :: ScimToken -> ScimToken -> ScimToken
$cmin :: ScimToken -> ScimToken -> ScimToken
min :: ScimToken -> ScimToken -> ScimToken
Ord, Int -> ScimToken -> ShowS
[ScimToken] -> ShowS
ScimToken -> String
(Int -> ScimToken -> ShowS)
-> (ScimToken -> String)
-> ([ScimToken] -> ShowS)
-> Show ScimToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScimToken -> ShowS
showsPrec :: Int -> ScimToken -> ShowS
$cshow :: ScimToken -> String
show :: ScimToken -> String
$cshowList :: [ScimToken] -> ShowS
showList :: [ScimToken] -> ShowS
Show, Value -> Parser [ScimToken]
Value -> Parser ScimToken
(Value -> Parser ScimToken)
-> (Value -> Parser [ScimToken]) -> FromJSON ScimToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ScimToken
parseJSON :: Value -> Parser ScimToken
$cparseJSONList :: Value -> Parser [ScimToken]
parseJSONList :: Value -> Parser [ScimToken]
FromJSON, [ScimToken] -> Value
[ScimToken] -> Encoding
ScimToken -> Value
ScimToken -> Encoding
(ScimToken -> Value)
-> (ScimToken -> Encoding)
-> ([ScimToken] -> Value)
-> ([ScimToken] -> Encoding)
-> ToJSON ScimToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ScimToken -> Value
toJSON :: ScimToken -> Value
$ctoEncoding :: ScimToken -> Encoding
toEncoding :: ScimToken -> Encoding
$ctoJSONList :: [ScimToken] -> Value
toJSONList :: [ScimToken] -> Value
$ctoEncodingList :: [ScimToken] -> Encoding
toEncodingList :: [ScimToken] -> Encoding
ToJSON, Parser ScimToken
Parser ScimToken -> FromByteString ScimToken
forall a. Parser a -> FromByteString a
$cparser :: Parser ScimToken
parser :: Parser ScimToken
FromByteString, ScimToken -> Builder
(ScimToken -> Builder) -> ToByteString ScimToken
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: ScimToken -> Builder
builder :: ScimToken -> Builder
ToByteString)

newtype ScimTokenHash = ScimTokenHash {ScimTokenHash -> Text
fromScimTokenHash :: Text}
  deriving (ScimTokenHash -> ScimTokenHash -> Bool
(ScimTokenHash -> ScimTokenHash -> Bool)
-> (ScimTokenHash -> ScimTokenHash -> Bool) -> Eq ScimTokenHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimTokenHash -> ScimTokenHash -> Bool
== :: ScimTokenHash -> ScimTokenHash -> Bool
$c/= :: ScimTokenHash -> ScimTokenHash -> Bool
/= :: ScimTokenHash -> ScimTokenHash -> Bool
Eq, Int -> ScimTokenHash -> ShowS
[ScimTokenHash] -> ShowS
ScimTokenHash -> String
(Int -> ScimTokenHash -> ShowS)
-> (ScimTokenHash -> String)
-> ([ScimTokenHash] -> ShowS)
-> Show ScimTokenHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScimTokenHash -> ShowS
showsPrec :: Int -> ScimTokenHash -> ShowS
$cshow :: ScimTokenHash -> String
show :: ScimTokenHash -> String
$cshowList :: [ScimTokenHash] -> ShowS
showList :: [ScimTokenHash] -> ShowS
Show)

instance FromByteString ScimTokenHash where
  parser :: Parser ScimTokenHash
parser = ByteString -> Parser ByteString
string ByteString
"sha512:" Parser ByteString -> Parser ScimTokenHash -> Parser ScimTokenHash
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ScimTokenHash
ScimTokenHash (Text -> ScimTokenHash) -> Parser Text -> Parser ScimTokenHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
forall a. FromByteString a => Parser a
parser)

instance ToByteString ScimTokenHash where
  builder :: ScimTokenHash -> Builder
builder (ScimTokenHash Text
t) = ByteString -> Builder
BB.fromByteString ByteString
"sha512:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToByteString a => a -> Builder
builder Text
t

data ScimTokenLookupKey
  = ScimTokenLookupKeyHashed ScimTokenHash
  | ScimTokenLookupKeyPlaintext ScimToken
  deriving (ScimTokenLookupKey -> ScimTokenLookupKey -> Bool
(ScimTokenLookupKey -> ScimTokenLookupKey -> Bool)
-> (ScimTokenLookupKey -> ScimTokenLookupKey -> Bool)
-> Eq ScimTokenLookupKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimTokenLookupKey -> ScimTokenLookupKey -> Bool
== :: ScimTokenLookupKey -> ScimTokenLookupKey -> Bool
$c/= :: ScimTokenLookupKey -> ScimTokenLookupKey -> Bool
/= :: ScimTokenLookupKey -> ScimTokenLookupKey -> Bool
Eq, Int -> ScimTokenLookupKey -> ShowS
[ScimTokenLookupKey] -> ShowS
ScimTokenLookupKey -> String
(Int -> ScimTokenLookupKey -> ShowS)
-> (ScimTokenLookupKey -> String)
-> ([ScimTokenLookupKey] -> ShowS)
-> Show ScimTokenLookupKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScimTokenLookupKey -> ShowS
showsPrec :: Int -> ScimTokenLookupKey -> ShowS
$cshow :: ScimTokenLookupKey -> String
show :: ScimTokenLookupKey -> String
$cshowList :: [ScimTokenLookupKey] -> ShowS
showList :: [ScimTokenLookupKey] -> ShowS
Show)

hashScimToken :: ScimToken -> ScimTokenHash
hashScimToken :: ScimToken -> ScimTokenHash
hashScimToken ScimToken
token =
  let digest :: Digest SHA512
digest = forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @ByteString @SHA512 (Text -> ByteString
encodeUtf8 (ScimToken -> Text
fromScimToken ScimToken
token))
   in Text -> ScimTokenHash
ScimTokenHash (ByteString -> Text
decodeUtf8 (Base -> Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64 Digest SHA512
digest))

-- | Metadata that we store about each token.
data ScimTokenInfo = ScimTokenInfo
  { -- | Which team can be managed with the token
    ScimTokenInfo -> TeamId
stiTeam :: !TeamId,
    -- | Token ID, can be used to eg. delete the token
    ScimTokenInfo -> ScimTokenId
stiId :: !ScimTokenId,
    -- | Time of token creation
    ScimTokenInfo -> UTCTime
stiCreatedAt :: !UTCTime,
    -- | IdP that created users will "belong" to
    ScimTokenInfo -> Maybe IdPId
stiIdP :: !(Maybe SAML.IdPId),
    -- | Free-form token description, can be set
    --   by the token creator as a mental aid
    ScimTokenInfo -> Text
stiDescr :: !Text
  }
  deriving (ScimTokenInfo -> ScimTokenInfo -> Bool
(ScimTokenInfo -> ScimTokenInfo -> Bool)
-> (ScimTokenInfo -> ScimTokenInfo -> Bool) -> Eq ScimTokenInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimTokenInfo -> ScimTokenInfo -> Bool
== :: ScimTokenInfo -> ScimTokenInfo -> Bool
$c/= :: ScimTokenInfo -> ScimTokenInfo -> Bool
/= :: ScimTokenInfo -> ScimTokenInfo -> Bool
Eq, Int -> ScimTokenInfo -> ShowS
[ScimTokenInfo] -> ShowS
ScimTokenInfo -> String
(Int -> ScimTokenInfo -> ShowS)
-> (ScimTokenInfo -> String)
-> ([ScimTokenInfo] -> ShowS)
-> Show ScimTokenInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScimTokenInfo -> ShowS
showsPrec :: Int -> ScimTokenInfo -> ShowS
$cshow :: ScimTokenInfo -> String
show :: ScimTokenInfo -> String
$cshowList :: [ScimTokenInfo] -> ShowS
showList :: [ScimTokenInfo] -> ShowS
Show)

instance FromHttpApiData ScimToken where
  parseHeader :: ByteString -> Either Text ScimToken
parseHeader ByteString
h = Text -> ScimToken
ScimToken (Text -> ScimToken) -> Either Text Text -> Either Text ScimToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> Either Text Text
forall a.
FromHttpApiData a =>
ByteString -> ByteString -> Either Text a
parseHeaderWithPrefix ByteString
"Bearer " ByteString
h
  parseQueryParam :: Text -> Either Text ScimToken
parseQueryParam Text
p = Text -> ScimToken
ScimToken (Text -> ScimToken) -> Either Text Text -> Either Text ScimToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
p

instance ToHttpApiData ScimToken where
  toHeader :: ScimToken -> ByteString
toHeader (ScimToken Text
s) = ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
s
  toQueryParam :: ScimToken -> Text
toQueryParam (ScimToken Text
s) = Text -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Text
s

instance FromJSON ScimTokenInfo where
  parseJSON :: Value -> Parser ScimTokenInfo
parseJSON = String
-> (Object -> Parser ScimTokenInfo)
-> Value
-> Parser ScimTokenInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ScimTokenInfo" ((Object -> Parser ScimTokenInfo) -> Value -> Parser ScimTokenInfo)
-> (Object -> Parser ScimTokenInfo)
-> Value
-> Parser ScimTokenInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    TeamId
stiTeam <- Object
o Object -> Key -> Parser TeamId
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"team"
    ScimTokenId
stiId <- Object
o Object -> Key -> Parser ScimTokenId
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"id"
    UTCTime
stiCreatedAt <- Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"created_at"
    Maybe IdPId
stiIdP <- Object
o Object -> Key -> Parser (Maybe IdPId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"idp"
    Text
stiDescr <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"description"
    ScimTokenInfo -> Parser ScimTokenInfo
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScimTokenInfo {Maybe IdPId
Text
UTCTime
ScimTokenId
TeamId
$sel:stiTeam:ScimTokenInfo :: TeamId
$sel:stiId:ScimTokenInfo :: ScimTokenId
$sel:stiCreatedAt:ScimTokenInfo :: UTCTime
$sel:stiIdP:ScimTokenInfo :: Maybe IdPId
$sel:stiDescr:ScimTokenInfo :: Text
stiTeam :: TeamId
stiId :: ScimTokenId
stiCreatedAt :: UTCTime
stiIdP :: Maybe IdPId
stiDescr :: Text
..}

instance ToJSON ScimTokenInfo where
  toJSON :: ScimTokenInfo -> Value
toJSON ScimTokenInfo
s =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      Key
"team"
        Key -> TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ScimTokenInfo -> TeamId
stiTeam ScimTokenInfo
s
        # "id"
        A..= stiId s
        # "created_at"
        A..= stiCreatedAt s
        # "idp"
        A..= stiIdP s
        # "description"
        A..= stiDescr s
        # []

----------------------------------------------------------------------------
-- @hscim@ extensions and wrappers

data SparTag

instance Scim.User.UserTypes SparTag where
  type UserId SparTag = UserId
  type UserExtra SparTag = ScimUserExtra
  supportedSchemas :: [Schema]
supportedSchemas = [Schema]
userSchemas

instance Scim.Group.GroupTypes SparTag where
  type GroupId SparTag = ()

instance Scim.Auth.AuthTypes SparTag where
  type AuthData SparTag = ScimToken
  type AuthInfo SparTag = ScimTokenInfo

-- | Wrapper to work around complications with type synonym family application in instances.
--
-- Background: 'SparTag' is used to instantiate the open type families in the classes
-- @Scim.UserTypes@, @Scim.GroupTypes@, @Scim.AuthTypes@.  Those type families are not
-- injective, and in general they shouldn't be: it should be possible to map two tags to
-- different user ids, but the same extra user info.  This makes the type of the 'Cql'
-- instance for @'Scim.StoredUser' tag@ undecidable: if the type checker encounters a
-- constraint that gives it the user id and extra info, it can't compute the tag from that to
-- look up the instance.
--
-- Possible solutions:
--
-- * what we're doing here: wrap the type synonyms we can't instantiate into newtypes in the
--   code using hscim.
--
-- * do not instantiate the type synonym, but its value (in this case
--   @Web.Scim.Schema.Meta.WithMeta (Web.Scim.Schema.Common.WithId (Id U) (Scim.User tag))@
--
-- * Use newtypes instead type in hscim.  This will carry around the tag as a data type rather
--   than applying it, which in turn will enable ghc to type-check instances like @Cql
--   (Scim.StoredUser tag)@.
--
-- * make the type classes parametric in not only the tag, but also all the values of the type
--   families, and add functional dependencies, like this: @class UserInfo tag uid extrainfo |
--   (uid, extrainfo) -> tag, tag -> (uid, extrainfo)@.  this will make writing the instances
--   only a little more awkward, but the rest of the code should change very little, as long
--   as we just apply the type families rather than explicitly imposing the class constraints.
--
-- * given a lot of time: extend ghc with something vaguely similar to @AllowAmbigiousTypes@,
--   where the instance typechecks, and non-injectivity errors are raised when checking the
--   constraint that "calls" the instance.  :)
newtype WrappedScimStoredUser tag = WrappedScimStoredUser
  {forall tag. WrappedScimStoredUser tag -> StoredUser tag
fromWrappedScimStoredUser :: Scim.User.StoredUser tag}

-- | See 'WrappedScimStoredUser'.
newtype WrappedScimUser tag = WrappedScimUser
  {forall tag. WrappedScimUser tag -> User tag
fromWrappedScimUser :: Scim.User.User tag}

-- | Extra Wire-specific data contained in a SCIM user profile.
data ScimUserExtra = ScimUserExtra
  { ScimUserExtra -> RichInfo
_sueRichInfo :: RI.RichInfo
  }
  deriving (ScimUserExtra -> ScimUserExtra -> Bool
(ScimUserExtra -> ScimUserExtra -> Bool)
-> (ScimUserExtra -> ScimUserExtra -> Bool) -> Eq ScimUserExtra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimUserExtra -> ScimUserExtra -> Bool
== :: ScimUserExtra -> ScimUserExtra -> Bool
$c/= :: ScimUserExtra -> ScimUserExtra -> Bool
/= :: ScimUserExtra -> ScimUserExtra -> Bool
Eq, Int -> ScimUserExtra -> ShowS
[ScimUserExtra] -> ShowS
ScimUserExtra -> String
(Int -> ScimUserExtra -> ShowS)
-> (ScimUserExtra -> String)
-> ([ScimUserExtra] -> ShowS)
-> Show ScimUserExtra
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScimUserExtra -> ShowS
showsPrec :: Int -> ScimUserExtra -> ShowS
$cshow :: ScimUserExtra -> String
show :: ScimUserExtra -> String
$cshowList :: [ScimUserExtra] -> ShowS
showList :: [ScimUserExtra] -> ShowS
Show)

makeLenses ''ScimUserExtra

instance A.FromJSON ScimUserExtra where
  parseJSON :: Value -> Parser ScimUserExtra
parseJSON Value
v = RichInfo -> ScimUserExtra
ScimUserExtra (RichInfo -> ScimUserExtra)
-> Parser RichInfo -> Parser ScimUserExtra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser RichInfo
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v

instance A.ToJSON ScimUserExtra where
  toJSON :: ScimUserExtra -> Value
toJSON (ScimUserExtra RichInfo
rif) = RichInfo -> Value
forall a. ToJSON a => a -> Value
A.toJSON RichInfo
rif

instance QC.Arbitrary ScimUserExtra where
  arbitrary :: Gen ScimUserExtra
arbitrary = RichInfo -> ScimUserExtra
ScimUserExtra (RichInfo -> ScimUserExtra) -> Gen RichInfo -> Gen ScimUserExtra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RichInfo
forall a. Arbitrary a => Gen a
QC.arbitrary

instance QC.Arbitrary (Scim.User SparTag) where
  arbitrary :: Gen (User SparTag)
arbitrary =
    User SparTag -> Gen (User SparTag)
forall tag. User tag -> Gen (User tag)
addFields (User SparTag -> Gen (User SparTag))
-> Gen (User SparTag) -> Gen (User SparTag)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Schema] -> Text -> UserExtra SparTag -> User SparTag
[Schema] -> Text -> ScimUserExtra -> User SparTag
forall tag. [Schema] -> Text -> UserExtra tag -> User tag
Scim.empty ([Schema] -> Text -> ScimUserExtra -> User SparTag)
-> Gen [Schema] -> Gen (Text -> ScimUserExtra -> User SparTag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Schema]
genSchemas Gen (Text -> ScimUserExtra -> User SparTag)
-> Gen Text -> Gen (ScimUserExtra -> User SparTag)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
genUserName Gen (ScimUserExtra -> User SparTag)
-> Gen ScimUserExtra -> Gen (User SparTag)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ScimUserExtra
genExtra)
    where
      addFields :: Scim.User.User tag -> QC.Gen (Scim.User.User tag)
      addFields :: forall tag. User tag -> Gen (User tag)
addFields User tag
usr = do
        Maybe Text
gexternalId <- String -> Text
T.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
QC.getPrintableString (PrintableString -> Text)
-> Gen (Maybe PrintableString) -> Gen (Maybe Text)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Gen (Maybe PrintableString)
forall a. Arbitrary a => Gen a
QC.arbitrary
        Maybe Text
gdisplayName <- String -> Text
T.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
QC.getPrintableString (PrintableString -> Text)
-> Gen (Maybe PrintableString) -> Gen (Maybe Text)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Gen (Maybe PrintableString)
forall a. Arbitrary a => Gen a
QC.arbitrary
        Maybe ScimBool
gactive <- ScimBool -> Maybe ScimBool
forall a. a -> Maybe a
Just (ScimBool -> Maybe ScimBool)
-> (Bool -> ScimBool) -> Bool -> Maybe ScimBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ScimBool
Scim.ScimBool (Bool -> Maybe ScimBool) -> Gen Bool -> Gen (Maybe ScimBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
QC.arbitrary -- (`Nothing` maps on `Just True` and was in the way of a unit test.)
        [Email]
gemails <- [Maybe Email] -> [Email]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Email] -> [Email]) -> Gen [Maybe Email] -> Gen [Email]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe Email
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe Email)
-> Gen [ByteString] -> Gen [Maybe Email]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Gen ByteString -> Gen [ByteString]
forall a. Gen a -> Gen [a]
QC.listOf ([ByteString] -> Gen ByteString
forall a. [a] -> Gen a
QC.elements [ByteString
Item [ByteString]
"a@b.c", ByteString
Item [ByteString]
"x@y,z", ByteString
Item [ByteString]
"roland@st.uv"]))
        User tag -> Gen (User tag)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          User tag
usr
            { Scim.User.externalId = gexternalId,
              Scim.User.displayName = gdisplayName,
              Scim.User.active = gactive,
              Scim.User.emails = gemails
            }

      genSchemas :: QC.Gen [Scim.Schema]
      genSchemas :: Gen [Schema]
genSchemas = Gen Schema -> Gen [Schema]
forall a. Gen a -> Gen [a]
QC.listOf1 (Gen Schema -> Gen [Schema]) -> Gen Schema -> Gen [Schema]
forall a b. (a -> b) -> a -> b
$ [Schema] -> Gen Schema
forall a. [a] -> Gen a
QC.elements [Schema]
Scim.fakeEnumSchema

      genUserName :: QC.Gen Text
      genUserName :: Gen Text
genUserName = String -> Text
T.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
QC.getPrintableString (PrintableString -> Text) -> Gen PrintableString -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PrintableString
forall a. Arbitrary a => Gen a
QC.arbitrary

      genExtra :: QC.Gen ScimUserExtra
      genExtra :: Gen ScimUserExtra
genExtra = Gen ScimUserExtra
forall a. Arbitrary a => Gen a
QC.arbitrary

instance Scim.Patchable ScimUserExtra where
  applyOperation :: forall (m :: * -> *).
MonadError ScimError m =>
ScimUserExtra -> Operation -> m ScimUserExtra
applyOperation (ScimUserExtra (RI.RichInfo RichInfoAssocList
rinfRaw)) (Operation Op
o (Just (NormalPath (AttrPath (Just (CustomSchema Text
sch)) (AttrName (Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk -> CI Text
ciAttrName)) Maybe SubAttr
Nothing))) Maybe Value
val)
    | Text
sch Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall s. IsString s => s
RI.richInfoMapURN =
        let rinf :: Map (CI Text) Text
rinf = RichInfoMapAndList -> Map (CI Text) Text
RI.richInfoMap (RichInfoMapAndList -> Map (CI Text) Text)
-> RichInfoMapAndList -> Map (CI Text) Text
forall a b. (a -> b) -> a -> b
$ RichInfoAssocList -> RichInfoMapAndList
RI.fromRichInfoAssocList RichInfoAssocList
rinfRaw
            unrinf :: Map (CI Text) Text -> ScimUserExtra
unrinf = RichInfo -> ScimUserExtra
ScimUserExtra (RichInfo -> ScimUserExtra)
-> (Map (CI Text) Text -> RichInfo)
-> Map (CI Text) Text
-> ScimUserExtra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichInfoAssocList -> RichInfo
RI.RichInfo (RichInfoAssocList -> RichInfo)
-> (Map (CI Text) Text -> RichInfoAssocList)
-> Map (CI Text) Text
-> RichInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichInfoMapAndList -> RichInfoAssocList
RI.toRichInfoAssocList (RichInfoMapAndList -> RichInfoAssocList)
-> (Map (CI Text) Text -> RichInfoMapAndList)
-> Map (CI Text) Text
-> RichInfoAssocList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RichField] -> RichInfoMapAndList
RI.mkRichInfoMapAndList ([RichField] -> RichInfoMapAndList)
-> (Map (CI Text) Text -> [RichField])
-> Map (CI Text) Text
-> RichInfoMapAndList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI Text, Text) -> RichField) -> [(CI Text, Text)] -> [RichField]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CI Text -> Text -> RichField) -> (CI Text, Text) -> RichField
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CI Text -> Text -> RichField
RI.RichField) ([(CI Text, Text)] -> [RichField])
-> (Map (CI Text) Text -> [(CI Text, Text)])
-> Map (CI Text) Text
-> [RichField]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (CI Text) Text -> [(CI Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.assocs
         in Map (CI Text) Text -> ScimUserExtra
unrinf (Map (CI Text) Text -> ScimUserExtra)
-> m (Map (CI Text) Text) -> m ScimUserExtra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Op
o of
              Op
Scim.Remove ->
                Map (CI Text) Text -> m (Map (CI Text) Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (CI Text) Text -> m (Map (CI Text) Text))
-> Map (CI Text) Text -> m (Map (CI Text) Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> Map (CI Text) Text -> Map (CI Text) Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete CI Text
ciAttrName Map (CI Text) Text
rinf
              Op
_AddOrReplace ->
                case Maybe Value
val of
                  (Just (A.String Text
textVal)) ->
                    Map (CI Text) Text -> m (Map (CI Text) Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (CI Text) Text -> m (Map (CI Text) Text))
-> Map (CI Text) Text -> m (Map (CI Text) Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> Text -> Map (CI Text) Text -> Map (CI Text) Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CI Text
ciAttrName Text
textVal Map (CI Text) Text
rinf
                  Maybe Value
_ -> ScimError -> m (Map (CI Text) Text)
forall a. ScimError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScimError -> m (Map (CI Text) Text))
-> ScimError -> m (Map (CI Text) Text)
forall a b. (a -> b) -> a -> b
$ ScimErrorType -> Maybe Text -> ScimError
Scim.badRequest ScimErrorType
Scim.InvalidValue (Maybe Text -> ScimError) -> Maybe Text -> ScimError
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rich info values can only be text"
    | Text
sch Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall s. IsString s => s
RI.richInfoAssocListURN =
        let rinf :: [RichField]
rinf = RichInfoMapAndList -> [RichField]
RI.richInfoAssocList (RichInfoMapAndList -> [RichField])
-> RichInfoMapAndList -> [RichField]
forall a b. (a -> b) -> a -> b
$ RichInfoAssocList -> RichInfoMapAndList
RI.fromRichInfoAssocList RichInfoAssocList
rinfRaw
            unrinf :: [RichField] -> ScimUserExtra
unrinf = RichInfo -> ScimUserExtra
ScimUserExtra (RichInfo -> ScimUserExtra)
-> ([RichField] -> RichInfo) -> [RichField] -> ScimUserExtra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichInfoAssocList -> RichInfo
RI.RichInfo (RichInfoAssocList -> RichInfo)
-> ([RichField] -> RichInfoAssocList) -> [RichField] -> RichInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichInfoMapAndList -> RichInfoAssocList
RI.toRichInfoAssocList (RichInfoMapAndList -> RichInfoAssocList)
-> ([RichField] -> RichInfoMapAndList)
-> [RichField]
-> RichInfoAssocList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RichField] -> RichInfoMapAndList
RI.mkRichInfoMapAndList
            matchesAttrName :: RichField -> Bool
matchesAttrName (RI.RichField CI Text
k Text
_) = CI Text
k CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
== CI Text
ciAttrName
         in [RichField] -> ScimUserExtra
unrinf ([RichField] -> ScimUserExtra) -> m [RichField] -> m ScimUserExtra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Op
o of
              Op
Scim.Remove ->
                [RichField] -> m [RichField]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([RichField] -> m [RichField]) -> [RichField] -> m [RichField]
forall a b. (a -> b) -> a -> b
$ (RichField -> Bool) -> [RichField] -> [RichField]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (RichField -> Bool) -> RichField -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichField -> Bool
matchesAttrName) [RichField]
rinf
              Op
_AddOrReplace ->
                case Maybe Value
val of
                  (Just (A.String Text
textVal)) ->
                    let newField :: RichField
newField = CI Text -> Text -> RichField
RI.RichField CI Text
ciAttrName Text
textVal
                        replaceIfMatchesAttrName :: RichField -> RichField
replaceIfMatchesAttrName RichField
f = if RichField -> Bool
matchesAttrName RichField
f then RichField
newField else RichField
f
                        newRichInfo :: [RichField]
newRichInfo =
                          if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (RichField -> Bool) -> [RichField] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RichField -> Bool
matchesAttrName [RichField]
rinf
                            then [RichField]
rinf [RichField] -> [RichField] -> [RichField]
forall a. [a] -> [a] -> [a]
++ [Item [RichField]
RichField
newField]
                            else (RichField -> RichField) -> [RichField] -> [RichField]
forall a b. (a -> b) -> [a] -> [b]
map RichField -> RichField
replaceIfMatchesAttrName [RichField]
rinf
                     in [RichField] -> m [RichField]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RichField]
newRichInfo
                  Maybe Value
_ -> ScimError -> m [RichField]
forall a. ScimError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScimError -> m [RichField]) -> ScimError -> m [RichField]
forall a b. (a -> b) -> a -> b
$ ScimErrorType -> Maybe Text -> ScimError
Scim.badRequest ScimErrorType
Scim.InvalidValue (Maybe Text -> ScimError) -> Maybe Text -> ScimError
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rich info values can only be text"
    | Bool
otherwise = ScimError -> m ScimUserExtra
forall a. ScimError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScimError -> m ScimUserExtra) -> ScimError -> m ScimUserExtra
forall a b. (a -> b) -> a -> b
$ ScimErrorType -> Maybe Text -> ScimError
Scim.badRequest ScimErrorType
Scim.InvalidValue (Maybe Text -> ScimError) -> Maybe Text -> ScimError
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"unknown schema, cannot patch"
  applyOperation ScimUserExtra
_ Operation
_ = ScimError -> m ScimUserExtra
forall a. ScimError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScimError -> m ScimUserExtra) -> ScimError -> m ScimUserExtra
forall a b. (a -> b) -> a -> b
$ ScimErrorType -> Maybe Text -> ScimError
Scim.badRequest ScimErrorType
Scim.InvalidValue (Maybe Text -> ScimError) -> Maybe Text -> ScimError
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"invalid patch op for rich info"

-- | SCIM user with all the data spar is actively processing.  Constructed by
-- 'validateScimUser', or manually from data obtained from brig to pass them on to scim peers.
-- The idea is that the type we get back from hscim is too general, and
-- we need a second round of parsing (aka validation), of which 'ValidScimUser' is the result.
--
-- Data contained in '_vsuHandle' and '_vsuName' is guaranteed to a) correspond to the data in
-- the 'Scim.User.User' and b) be valid in regard to our own user schema requirements (only
-- certain characters allowed in handles, etc).
--
-- Note that it's ok for us to ignore parts of the content sent to us, as explained
-- [here](https://tools.ietf.org/html/rfc7644#section-3.3): "Since the server is free to alter
-- and/or ignore POSTed content, returning the full representation can be useful to the
-- client, enabling it to correlate the client's and server's views of the new resource."
data ValidScimUser = ValidScimUser
  { ValidScimUser -> ValidScimId
externalId :: ValidScimId,
    ValidScimUser -> Handle
handle :: Handle,
    ValidScimUser -> Name
name :: BT.Name,
    ValidScimUser -> [EmailAddress]
emails :: [EmailAddress],
    ValidScimUser -> RichInfo
richInfo :: RI.RichInfo,
    ValidScimUser -> Bool
active :: Bool,
    ValidScimUser -> Maybe Locale
locale :: Maybe Locale,
    ValidScimUser -> Maybe Role
role :: Maybe Role
  }
  deriving (ValidScimUser -> ValidScimUser -> Bool
(ValidScimUser -> ValidScimUser -> Bool)
-> (ValidScimUser -> ValidScimUser -> Bool) -> Eq ValidScimUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidScimUser -> ValidScimUser -> Bool
== :: ValidScimUser -> ValidScimUser -> Bool
$c/= :: ValidScimUser -> ValidScimUser -> Bool
/= :: ValidScimUser -> ValidScimUser -> Bool
Eq, Int -> ValidScimUser -> ShowS
[ValidScimUser] -> ShowS
ValidScimUser -> String
(Int -> ValidScimUser -> ShowS)
-> (ValidScimUser -> String)
-> ([ValidScimUser] -> ShowS)
-> Show ValidScimUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidScimUser -> ShowS
showsPrec :: Int -> ValidScimUser -> ShowS
$cshow :: ValidScimUser -> String
show :: ValidScimUser -> String
$cshowList :: [ValidScimUser] -> ShowS
showList :: [ValidScimUser] -> ShowS
Show)

-- | This type carries externalId, plus email address (validated if present, unvalidated if not) and saml credentials,
-- because those are sometimes derived from the externalId field.
data ValidScimId = ValidScimId
  { ValidScimId -> Text
validScimIdExternal :: Text,
    ValidScimId -> These EmailAddress UserRef
validScimIdAuthInfo :: These EmailAddress SAML.UserRef
  }
  deriving (ValidScimId -> ValidScimId -> Bool
(ValidScimId -> ValidScimId -> Bool)
-> (ValidScimId -> ValidScimId -> Bool) -> Eq ValidScimId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidScimId -> ValidScimId -> Bool
== :: ValidScimId -> ValidScimId -> Bool
$c/= :: ValidScimId -> ValidScimId -> Bool
/= :: ValidScimId -> ValidScimId -> Bool
Eq, Int -> ValidScimId -> ShowS
[ValidScimId] -> ShowS
ValidScimId -> String
(Int -> ValidScimId -> ShowS)
-> (ValidScimId -> String)
-> ([ValidScimId] -> ShowS)
-> Show ValidScimId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidScimId -> ShowS
showsPrec :: Int -> ValidScimId -> ShowS
$cshow :: ValidScimId -> String
show :: ValidScimId -> String
$cshowList :: [ValidScimId] -> ShowS
showList :: [ValidScimId] -> ShowS
Show, (forall x. ValidScimId -> Rep ValidScimId x)
-> (forall x. Rep ValidScimId x -> ValidScimId)
-> Generic ValidScimId
forall x. Rep ValidScimId x -> ValidScimId
forall x. ValidScimId -> Rep ValidScimId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValidScimId -> Rep ValidScimId x
from :: forall x. ValidScimId -> Rep ValidScimId x
$cto :: forall x. Rep ValidScimId x -> ValidScimId
to :: forall x. Rep ValidScimId x -> ValidScimId
Generic)

instance Arbitrary ValidScimId where
  arbitrary :: Gen ValidScimId
arbitrary =
    (EmailAddress -> Gen ValidScimId)
-> (UserRef -> Gen ValidScimId)
-> (EmailAddress -> UserRef -> Gen ValidScimId)
-> These EmailAddress UserRef
-> Gen ValidScimId
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these EmailAddress -> Gen ValidScimId
onlyThis (ValidScimId -> Gen ValidScimId
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidScimId -> Gen ValidScimId)
-> (UserRef -> ValidScimId) -> UserRef -> Gen ValidScimId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserRef -> ValidScimId
onlyThat) (\EmailAddress
_ UserRef
uref -> ValidScimId -> Gen ValidScimId
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserRef -> ValidScimId
onlyThat UserRef
uref)) (These EmailAddress UserRef -> Gen ValidScimId)
-> Gen (These EmailAddress UserRef) -> Gen ValidScimId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen (These EmailAddress UserRef)
forall a. Arbitrary a => Gen a
QC.arbitrary
    where
      onlyThis :: EmailAddress -> Gen ValidScimId
      onlyThis :: EmailAddress -> Gen ValidScimId
onlyThis EmailAddress
em = do
        Text
extIdNick <- String -> Text
T.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
QC.getPrintableString (PrintableString -> Text) -> Gen PrintableString -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PrintableString
forall a. Arbitrary a => Gen a
QC.arbitrary
        Text
extId <- [Text] -> Gen Text
forall a. [a] -> Gen a
QC.elements [Text
Item [Text]
extIdNick, EmailAddress -> Text
fromEmail EmailAddress
em]
        ValidScimId -> Gen ValidScimId
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidScimId -> Gen ValidScimId) -> ValidScimId -> Gen ValidScimId
forall a b. (a -> b) -> a -> b
$ ValidScimId {$sel:validScimIdExternal:ValidScimId :: Text
validScimIdExternal = Text
extId, $sel:validScimIdAuthInfo:ValidScimId :: These EmailAddress UserRef
validScimIdAuthInfo = EmailAddress -> These EmailAddress UserRef
forall a b. a -> These a b
This EmailAddress
em}

      -- `unsafeShowNameID` can name clash, if this is a problem consider using `arbitraryValidScimIdNoNameIDQualifiers`
      onlyThat :: SAML.UserRef -> ValidScimId
      onlyThat :: UserRef -> ValidScimId
onlyThat UserRef
uref = ValidScimId {$sel:validScimIdExternal:ValidScimId :: Text
validScimIdExternal = UserRef
uref UserRef -> Getting Text UserRef Text -> Text
forall s a. s -> Getting a s a -> a
^. (NameID -> Const Text NameID) -> UserRef -> Const Text UserRef
Lens' UserRef NameID
SAML.uidSubject ((NameID -> Const Text NameID) -> UserRef -> Const Text UserRef)
-> ((Text -> Const Text Text) -> NameID -> Const Text NameID)
-> Getting Text UserRef Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameID -> CI Text)
-> (CI Text -> Const Text (CI Text)) -> NameID -> Const Text NameID
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NameID -> CI Text
SAML.unsafeShowNameID ((CI Text -> Const Text (CI Text)) -> NameID -> Const Text NameID)
-> ((Text -> Const Text Text) -> CI Text -> Const Text (CI Text))
-> (Text -> Const Text Text)
-> NameID
-> Const Text NameID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI Text -> Text)
-> (Text -> Const Text Text) -> CI Text -> Const Text (CI Text)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CI Text -> Text
forall s. CI s -> s
CI.original, $sel:validScimIdAuthInfo:ValidScimId :: These EmailAddress UserRef
validScimIdAuthInfo = UserRef -> These EmailAddress UserRef
forall a b. b -> These a b
That UserRef
uref}

newtype ValidScimIdNoNameIDQualifiers = ValidScimIdNoNameIDQualifiers ValidScimId
  deriving (ValidScimIdNoNameIDQualifiers
-> ValidScimIdNoNameIDQualifiers -> Bool
(ValidScimIdNoNameIDQualifiers
 -> ValidScimIdNoNameIDQualifiers -> Bool)
-> (ValidScimIdNoNameIDQualifiers
    -> ValidScimIdNoNameIDQualifiers -> Bool)
-> Eq ValidScimIdNoNameIDQualifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidScimIdNoNameIDQualifiers
-> ValidScimIdNoNameIDQualifiers -> Bool
== :: ValidScimIdNoNameIDQualifiers
-> ValidScimIdNoNameIDQualifiers -> Bool
$c/= :: ValidScimIdNoNameIDQualifiers
-> ValidScimIdNoNameIDQualifiers -> Bool
/= :: ValidScimIdNoNameIDQualifiers
-> ValidScimIdNoNameIDQualifiers -> Bool
Eq, Int -> ValidScimIdNoNameIDQualifiers -> ShowS
[ValidScimIdNoNameIDQualifiers] -> ShowS
ValidScimIdNoNameIDQualifiers -> String
(Int -> ValidScimIdNoNameIDQualifiers -> ShowS)
-> (ValidScimIdNoNameIDQualifiers -> String)
-> ([ValidScimIdNoNameIDQualifiers] -> ShowS)
-> Show ValidScimIdNoNameIDQualifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidScimIdNoNameIDQualifiers -> ShowS
showsPrec :: Int -> ValidScimIdNoNameIDQualifiers -> ShowS
$cshow :: ValidScimIdNoNameIDQualifiers -> String
show :: ValidScimIdNoNameIDQualifiers -> String
$cshowList :: [ValidScimIdNoNameIDQualifiers] -> ShowS
showList :: [ValidScimIdNoNameIDQualifiers] -> ShowS
Show)

instance Arbitrary ValidScimIdNoNameIDQualifiers where
  arbitrary :: Gen ValidScimIdNoNameIDQualifiers
arbitrary = ValidScimId -> ValidScimIdNoNameIDQualifiers
ValidScimIdNoNameIDQualifiers (ValidScimId -> ValidScimIdNoNameIDQualifiers)
-> Gen ValidScimId -> Gen ValidScimIdNoNameIDQualifiers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ValidScimId
arbitraryValidScimIdNoNameIDQualifiers

arbitraryValidScimIdNoNameIDQualifiers :: QC.Gen ValidScimId
arbitraryValidScimIdNoNameIDQualifiers :: Gen ValidScimId
arbitraryValidScimIdNoNameIDQualifiers = do
  ValidScimId
veid :: ValidScimId <- Gen ValidScimId
forall a. Arbitrary a => Gen a
QC.arbitrary
  ValidScimId -> Gen ValidScimId
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidScimId -> Gen ValidScimId) -> ValidScimId -> Gen ValidScimId
forall a b. (a -> b) -> a -> b
$ Text -> These EmailAddress UserRef -> ValidScimId
ValidScimId ValidScimId
veid.validScimIdExternal (ValidScimId
veid.validScimIdAuthInfo These EmailAddress UserRef
-> (These EmailAddress UserRef -> These EmailAddress UserRef)
-> These EmailAddress UserRef
forall a b. a -> (a -> b) -> b
& (UserRef -> UserRef)
-> These EmailAddress UserRef -> These EmailAddress UserRef
forall b d a. (b -> d) -> These a b -> These a d
mapThere UserRef -> UserRef
removeQualifiers)
  where
    removeQualifiers :: SAML.UserRef -> SAML.UserRef
    removeQualifiers :: UserRef -> UserRef
removeQualifiers =
      ((NameID -> Identity NameID) -> UserRef -> Identity UserRef
Lens' UserRef NameID
SAML.uidSubject ((NameID -> Identity NameID) -> UserRef -> Identity UserRef)
-> ((Maybe XmlText -> Identity (Maybe XmlText))
    -> NameID -> Identity NameID)
-> (Maybe XmlText -> Identity (Maybe XmlText))
-> UserRef
-> Identity UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe XmlText -> Identity (Maybe XmlText))
-> NameID -> Identity NameID
Lens' NameID (Maybe XmlText)
SAML.nameIDNameQ ((Maybe XmlText -> Identity (Maybe XmlText))
 -> UserRef -> Identity UserRef)
-> Maybe XmlText -> UserRef -> UserRef
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe XmlText
forall a. Maybe a
Nothing)
        (UserRef -> UserRef) -> (UserRef -> UserRef) -> UserRef -> UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NameID -> Identity NameID) -> UserRef -> Identity UserRef
Lens' UserRef NameID
SAML.uidSubject ((NameID -> Identity NameID) -> UserRef -> Identity UserRef)
-> ((Maybe XmlText -> Identity (Maybe XmlText))
    -> NameID -> Identity NameID)
-> (Maybe XmlText -> Identity (Maybe XmlText))
-> UserRef
-> Identity UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe XmlText -> Identity (Maybe XmlText))
-> NameID -> Identity NameID
Lens' NameID (Maybe XmlText)
SAML.nameIDSPProvidedID ((Maybe XmlText -> Identity (Maybe XmlText))
 -> UserRef -> Identity UserRef)
-> Maybe XmlText -> UserRef -> UserRef
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe XmlText
forall a. Maybe a
Nothing)
        (UserRef -> UserRef) -> (UserRef -> UserRef) -> UserRef -> UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NameID -> Identity NameID) -> UserRef -> Identity UserRef
Lens' UserRef NameID
SAML.uidSubject ((NameID -> Identity NameID) -> UserRef -> Identity UserRef)
-> ((Maybe XmlText -> Identity (Maybe XmlText))
    -> NameID -> Identity NameID)
-> (Maybe XmlText -> Identity (Maybe XmlText))
-> UserRef
-> Identity UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe XmlText -> Identity (Maybe XmlText))
-> NameID -> Identity NameID
Lens' NameID (Maybe XmlText)
SAML.nameIDSPNameQ ((Maybe XmlText -> Identity (Maybe XmlText))
 -> UserRef -> Identity UserRef)
-> Maybe XmlText -> UserRef -> UserRef
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe XmlText
forall a. Maybe a
Nothing)

veidUref :: ValidScimId -> Maybe SAML.UserRef
veidUref :: ValidScimId -> Maybe UserRef
veidUref = These EmailAddress UserRef -> Maybe UserRef
forall a b. These a b -> Maybe b
justThere (These EmailAddress UserRef -> Maybe UserRef)
-> (ValidScimId -> These EmailAddress UserRef)
-> ValidScimId
-> Maybe UserRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidScimId -> These EmailAddress UserRef
validScimIdAuthInfo

makeLenses ''ValidScimUser
makeLenses ''ValidScimId

----------------------------------------------------------------------------
-- Request and response types

-- | Type used for request parameters to 'APIScimTokenCreate'.
data CreateScimToken = CreateScimToken
  { -- | Token description (as memory aid for whoever is creating the token)
    CreateScimToken -> Text
createScimTokenDescr :: !Text,
    -- | User password, which we ask for because creating a token is a "powerful" operation
    CreateScimToken -> Maybe PlainTextPassword6
createScimTokenPassword :: !(Maybe PlainTextPassword6),
    -- | User code (sent by email), for 2nd factor to 'createScimTokenPassword'
    CreateScimToken -> Maybe Value
createScimTokenCode :: !(Maybe Code.Value)
  }
  deriving (CreateScimToken -> CreateScimToken -> Bool
(CreateScimToken -> CreateScimToken -> Bool)
-> (CreateScimToken -> CreateScimToken -> Bool)
-> Eq CreateScimToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateScimToken -> CreateScimToken -> Bool
== :: CreateScimToken -> CreateScimToken -> Bool
$c/= :: CreateScimToken -> CreateScimToken -> Bool
/= :: CreateScimToken -> CreateScimToken -> Bool
Eq, Int -> CreateScimToken -> ShowS
[CreateScimToken] -> ShowS
CreateScimToken -> String
(Int -> CreateScimToken -> ShowS)
-> (CreateScimToken -> String)
-> ([CreateScimToken] -> ShowS)
-> Show CreateScimToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateScimToken -> ShowS
showsPrec :: Int -> CreateScimToken -> ShowS
$cshow :: CreateScimToken -> String
show :: CreateScimToken -> String
$cshowList :: [CreateScimToken] -> ShowS
showList :: [CreateScimToken] -> ShowS
Show, (forall x. CreateScimToken -> Rep CreateScimToken x)
-> (forall x. Rep CreateScimToken x -> CreateScimToken)
-> Generic CreateScimToken
forall x. Rep CreateScimToken x -> CreateScimToken
forall x. CreateScimToken -> Rep CreateScimToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateScimToken -> Rep CreateScimToken x
from :: forall x. CreateScimToken -> Rep CreateScimToken x
$cto :: forall x. Rep CreateScimToken x -> CreateScimToken
to :: forall x. Rep CreateScimToken x -> CreateScimToken
Generic)
  deriving (Gen CreateScimToken
Gen CreateScimToken
-> (CreateScimToken -> [CreateScimToken])
-> Arbitrary CreateScimToken
CreateScimToken -> [CreateScimToken]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CreateScimToken
arbitrary :: Gen CreateScimToken
$cshrink :: CreateScimToken -> [CreateScimToken]
shrink :: CreateScimToken -> [CreateScimToken]
Arbitrary) via (GenericUniform CreateScimToken)

instance A.FromJSON CreateScimToken where
  parseJSON :: Value -> Parser CreateScimToken
parseJSON = String
-> (Object -> Parser CreateScimToken)
-> Value
-> Parser CreateScimToken
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CreateScimToken" ((Object -> Parser CreateScimToken)
 -> Value -> Parser CreateScimToken)
-> (Object -> Parser CreateScimToken)
-> Value
-> Parser CreateScimToken
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
createScimTokenDescr <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"description"
    Maybe PlainTextPassword6
createScimTokenPassword <- Object
o Object -> Key -> Parser (Maybe PlainTextPassword6)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"password"
    Maybe Value
createScimTokenCode <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"verification_code"
    CreateScimToken -> Parser CreateScimToken
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateScimToken {Maybe PlainTextPassword6
Maybe Value
Text
$sel:createScimTokenDescr:CreateScimToken :: Text
$sel:createScimTokenPassword:CreateScimToken :: Maybe PlainTextPassword6
$sel:createScimTokenCode:CreateScimToken :: Maybe Value
createScimTokenDescr :: Text
createScimTokenPassword :: Maybe PlainTextPassword6
createScimTokenCode :: Maybe Value
..}

-- Used for integration tests
instance A.ToJSON CreateScimToken where
  toJSON :: CreateScimToken -> Value
toJSON CreateScimToken {Maybe PlainTextPassword6
Maybe Value
Text
$sel:createScimTokenDescr:CreateScimToken :: CreateScimToken -> Text
$sel:createScimTokenPassword:CreateScimToken :: CreateScimToken -> Maybe PlainTextPassword6
$sel:createScimTokenCode:CreateScimToken :: CreateScimToken -> Maybe Value
createScimTokenDescr :: Text
createScimTokenPassword :: Maybe PlainTextPassword6
createScimTokenCode :: Maybe Value
..} =
    [Pair] -> Value
A.object
      [ Key
"description" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
createScimTokenDescr,
        Key
"password" Key -> Maybe PlainTextPassword6 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Maybe PlainTextPassword6
createScimTokenPassword,
        Key
"verification_code" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Maybe Value
createScimTokenCode
      ]

-- | Type used for the response of 'APIScimTokenCreate'.
data CreateScimTokenResponse = CreateScimTokenResponse
  { CreateScimTokenResponse -> ScimToken
createScimTokenResponseToken :: ScimToken,
    CreateScimTokenResponse -> ScimTokenInfo
createScimTokenResponseInfo :: ScimTokenInfo
  }
  deriving (CreateScimTokenResponse -> CreateScimTokenResponse -> Bool
(CreateScimTokenResponse -> CreateScimTokenResponse -> Bool)
-> (CreateScimTokenResponse -> CreateScimTokenResponse -> Bool)
-> Eq CreateScimTokenResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateScimTokenResponse -> CreateScimTokenResponse -> Bool
== :: CreateScimTokenResponse -> CreateScimTokenResponse -> Bool
$c/= :: CreateScimTokenResponse -> CreateScimTokenResponse -> Bool
/= :: CreateScimTokenResponse -> CreateScimTokenResponse -> Bool
Eq, Int -> CreateScimTokenResponse -> ShowS
[CreateScimTokenResponse] -> ShowS
CreateScimTokenResponse -> String
(Int -> CreateScimTokenResponse -> ShowS)
-> (CreateScimTokenResponse -> String)
-> ([CreateScimTokenResponse] -> ShowS)
-> Show CreateScimTokenResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateScimTokenResponse -> ShowS
showsPrec :: Int -> CreateScimTokenResponse -> ShowS
$cshow :: CreateScimTokenResponse -> String
show :: CreateScimTokenResponse -> String
$cshowList :: [CreateScimTokenResponse] -> ShowS
showList :: [CreateScimTokenResponse] -> ShowS
Show)

-- Used for integration tests
instance A.FromJSON CreateScimTokenResponse where
  parseJSON :: Value -> Parser CreateScimTokenResponse
parseJSON = String
-> (Object -> Parser CreateScimTokenResponse)
-> Value
-> Parser CreateScimTokenResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CreateScimTokenResponse" ((Object -> Parser CreateScimTokenResponse)
 -> Value -> Parser CreateScimTokenResponse)
-> (Object -> Parser CreateScimTokenResponse)
-> Value
-> Parser CreateScimTokenResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ScimToken
createScimTokenResponseToken <- Object
o Object -> Key -> Parser ScimToken
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"token"
    ScimTokenInfo
createScimTokenResponseInfo <- Object
o Object -> Key -> Parser ScimTokenInfo
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"info"
    CreateScimTokenResponse -> Parser CreateScimTokenResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateScimTokenResponse {ScimTokenInfo
ScimToken
$sel:createScimTokenResponseToken:CreateScimTokenResponse :: ScimToken
$sel:createScimTokenResponseInfo:CreateScimTokenResponse :: ScimTokenInfo
createScimTokenResponseToken :: ScimToken
createScimTokenResponseInfo :: ScimTokenInfo
..}

instance A.ToJSON CreateScimTokenResponse where
  toJSON :: CreateScimTokenResponse -> Value
toJSON CreateScimTokenResponse {ScimTokenInfo
ScimToken
$sel:createScimTokenResponseToken:CreateScimTokenResponse :: CreateScimTokenResponse -> ScimToken
$sel:createScimTokenResponseInfo:CreateScimTokenResponse :: CreateScimTokenResponse -> ScimTokenInfo
createScimTokenResponseToken :: ScimToken
createScimTokenResponseInfo :: ScimTokenInfo
..} =
    [Pair] -> Value
A.object
      [ Key
"token" Key -> ScimToken -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ScimToken
createScimTokenResponseToken,
        Key
"info" Key -> ScimTokenInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ScimTokenInfo
createScimTokenResponseInfo
      ]

-- | Type used for responses of endpoints that return a list of SCIM tokens.
-- Wrapped into an object to allow extensibility later on.
--
-- We don't show tokens once they have been created – only their metadata.
data ScimTokenList = ScimTokenList
  { ScimTokenList -> [ScimTokenInfo]
scimTokenListTokens :: [ScimTokenInfo]
  }
  deriving (ScimTokenList -> ScimTokenList -> Bool
(ScimTokenList -> ScimTokenList -> Bool)
-> (ScimTokenList -> ScimTokenList -> Bool) -> Eq ScimTokenList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScimTokenList -> ScimTokenList -> Bool
== :: ScimTokenList -> ScimTokenList -> Bool
$c/= :: ScimTokenList -> ScimTokenList -> Bool
/= :: ScimTokenList -> ScimTokenList -> Bool
Eq, Int -> ScimTokenList -> ShowS
[ScimTokenList] -> ShowS
ScimTokenList -> String
(Int -> ScimTokenList -> ShowS)
-> (ScimTokenList -> String)
-> ([ScimTokenList] -> ShowS)
-> Show ScimTokenList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScimTokenList -> ShowS
showsPrec :: Int -> ScimTokenList -> ShowS
$cshow :: ScimTokenList -> String
show :: ScimTokenList -> String
$cshowList :: [ScimTokenList] -> ShowS
showList :: [ScimTokenList] -> ShowS
Show)

instance A.FromJSON ScimTokenList where
  parseJSON :: Value -> Parser ScimTokenList
parseJSON = String
-> (Object -> Parser ScimTokenList)
-> Value
-> Parser ScimTokenList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ScimTokenList" ((Object -> Parser ScimTokenList) -> Value -> Parser ScimTokenList)
-> (Object -> Parser ScimTokenList)
-> Value
-> Parser ScimTokenList
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [ScimTokenInfo]
scimTokenListTokens <- Object
o Object -> Key -> Parser [ScimTokenInfo]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"tokens"
    ScimTokenList -> Parser ScimTokenList
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScimTokenList {[ScimTokenInfo]
$sel:scimTokenListTokens:ScimTokenList :: [ScimTokenInfo]
scimTokenListTokens :: [ScimTokenInfo]
..}

instance A.ToJSON ScimTokenList where
  toJSON :: ScimTokenList -> Value
toJSON ScimTokenList {[ScimTokenInfo]
$sel:scimTokenListTokens:ScimTokenList :: ScimTokenList -> [ScimTokenInfo]
scimTokenListTokens :: [ScimTokenInfo]
..} =
    [Pair] -> Value
A.object
      [ Key
"tokens" Key -> [ScimTokenInfo] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= [ScimTokenInfo]
scimTokenListTokens
      ]

-- Swagger

instance ToParamSchema ScimToken where
  toParamSchema :: Proxy ScimToken -> Schema
toParamSchema Proxy ScimToken
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance ToSchema ScimToken where
  declareNamedSchema :: Proxy ScimToken -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ScimToken
_ =
    Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)
      Declare (Definitions Schema) NamedSchema
-> (Declare (Definitions Schema) NamedSchema
    -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
forall a b. a -> (a -> b) -> b
& (NamedSchema -> Identity NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Identity (Declare (Definitions Schema) NamedSchema)
Setter
  (Declare (Definitions Schema) NamedSchema)
  (Declare (Definitions Schema) NamedSchema)
  NamedSchema
  NamedSchema
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((NamedSchema -> Identity NamedSchema)
 -> Declare (Definitions Schema) NamedSchema
 -> Identity (Declare (Definitions Schema) NamedSchema))
-> ((Maybe Text -> Identity (Maybe Text))
    -> NamedSchema -> Identity NamedSchema)
-> (Maybe Text -> Identity (Maybe Text))
-> Declare (Definitions Schema) NamedSchema
-> Identity (Declare (Definitions Schema) NamedSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Identity Schema) -> NamedSchema -> Identity NamedSchema
forall s a. HasSchema s a => Lens' s a
Lens' NamedSchema Schema
schema ((Schema -> Identity Schema)
 -> NamedSchema -> Identity NamedSchema)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> NamedSchema
-> Identity NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> Declare (Definitions Schema) NamedSchema
 -> Identity (Declare (Definitions Schema) NamedSchema))
-> Text
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Authentication token"

instance ToSchema ScimTokenInfo where
  declareNamedSchema :: Proxy ScimTokenInfo -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ScimTokenInfo
_ = do
    Referenced Schema
teamSchema <- Proxy TeamId -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @TeamId)
    Referenced Schema
idSchema <- Proxy ScimTokenId
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ScimTokenId)
    Referenced Schema
createdAtSchema <- Proxy UTCTime -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @UTCTime)
    Referenced Schema
idpSchema <- Proxy IdPId -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SAML.IdPId)
    Referenced Schema
descrSchema <- Proxy Text -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ScimTokenInfo") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
properties
            ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ (Text
"team", Referenced Schema
teamSchema),
                 (Text
"id", Referenced Schema
idSchema),
                 (Text
"created_at", Referenced Schema
createdAtSchema),
                 (Text
"idp", Referenced Schema
idpSchema),
                 (Text
"description", Referenced Schema
descrSchema)
               ]
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
Lens' Schema [Text]
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item [Text]
"team", Item [Text]
"id", Item [Text]
"created_at", Item [Text]
"description"]

instance ToSchema CreateScimToken where
  declareNamedSchema :: Proxy CreateScimToken -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CreateScimToken
_ = do
    Referenced Schema
textSchema <- Proxy Text -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"CreateScimToken") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
properties
            ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ (Text
"description", Referenced Schema
textSchema),
                 (Text
"password", Referenced Schema
textSchema),
                 (Text
"verification_code", Referenced Schema
textSchema)
               ]
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
Lens' Schema [Text]
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item [Text]
"description"]

instance ToSchema CreateScimTokenResponse where
  declareNamedSchema :: Proxy CreateScimTokenResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CreateScimTokenResponse
_ = do
    Referenced Schema
tokenSchema <- Proxy ScimToken -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ScimToken)
    Referenced Schema
infoSchema <- Proxy ScimTokenInfo
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ScimTokenInfo)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"CreateScimTokenResponse") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
properties
            ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ (Text
"token", Referenced Schema
tokenSchema),
                 (Text
"info", Referenced Schema
infoSchema)
               ]
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
Lens' Schema [Text]
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item [Text]
"token", Item [Text]
"info"]

instance ToSchema ScimTokenList where
  declareNamedSchema :: Proxy ScimTokenList -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ScimTokenList
_ = do
    Referenced Schema
infoListSchema <- Proxy [ScimTokenInfo]
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[ScimTokenInfo])
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ScimTokenList") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
properties
            ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ (Text
"tokens", Referenced Schema
infoListSchema)
               ]
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
Lens' Schema [Text]
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item [Text]
"tokens"]