{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

-- 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/>.

module Wire.API.User.Profile
  ( Name (..),
    mkName,
    TextStatus,
    mkTextStatus,
    fromTextStatus,
    ColourId (..),
    defaultAccentId,

    -- * Asset
    Asset (..),
    AssetSize (..),

    -- * ManagedBy
    ManagedBy (..),
    defaultManagedBy,

    -- * Deprecated
    Pict (..),
    noPict,
  )
where

import Cassandra qualified as C
import Control.Error (note)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.Attoparsec.ByteString.Char8 (takeByteString)
import Data.ByteString.Conversion
import Data.OpenApi qualified as S
import Data.Range
import Data.Schema
import Imports
import Wire.API.Asset (AssetKey (..))
import Wire.API.User.Orphans ()
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- Name

-- | Usually called display name.
-- Length is between 1 and 128 characters.
newtype Name = Name
  {Name -> Text
fromName :: Text}
  deriving stock (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show, (forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Name -> Rep Name x
from :: forall x. Name -> Rep Name x
$cto :: forall x. Rep Name x -> Name
to :: forall x. Rep Name x -> Name
Generic)
  deriving newtype (Parser Name
Parser Name -> FromByteString Name
forall a. Parser a -> FromByteString a
$cparser :: Parser Name
parser :: Parser Name
FromByteString, Name -> Builder
(Name -> Builder) -> ToByteString Name
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: Name -> Builder
builder :: Name -> Builder
ToByteString)
  deriving (Gen Name
Gen Name -> (Name -> [Name]) -> Arbitrary Name
Name -> [Name]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Name
arbitrary :: Gen Name
$cshrink :: Name -> [Name]
shrink :: Name -> [Name]
Arbitrary) via (Ranged 1 128 Text)
  deriving (Value -> Parser [Name]
Value -> Parser Name
(Value -> Parser Name) -> (Value -> Parser [Name]) -> FromJSON Name
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Name
parseJSON :: Value -> Parser Name
$cparseJSONList :: Value -> Parser [Name]
parseJSONList :: Value -> Parser [Name]
FromJSON, [Name] -> Value
[Name] -> Encoding
Name -> Value
Name -> Encoding
(Name -> Value)
-> (Name -> Encoding)
-> ([Name] -> Value)
-> ([Name] -> Encoding)
-> ToJSON Name
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Name -> Value
toJSON :: Name -> Value
$ctoEncoding :: Name -> Encoding
toEncoding :: Name -> Encoding
$ctoJSONList :: [Name] -> Value
toJSONList :: [Name] -> Value
$ctoEncodingList :: [Name] -> Encoding
toEncodingList :: [Name] -> Encoding
ToJSON, Typeable Name
Typeable Name =>
(Proxy Name -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Name
Proxy Name -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Name -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Name -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Name

mkName :: Text -> Either String Name
mkName :: Text -> Either String Name
mkName Text
txt = Text -> Name
Name (Text -> Name)
-> (Range 1 128 Text -> Text) -> Range 1 128 Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 1 128 Text -> Text
forall (n :: Natural) (m :: Natural) a. Range n m a -> a
fromRange (Range 1 128 Text -> Name)
-> Either String (Range 1 128 Text) -> Either String Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (n :: Natural) (m :: Natural).
(KnownNat n, KnownNat m, Within a n m) =>
String -> a -> Either String (Range n m a)
checkedEitherMsg @_ @1 @128 String
"Name" Text
txt

instance ToSchema Name where
  schema :: ValueSchema NamedSwaggerDoc Name
schema = Text -> Name
Name (Text -> Name)
-> SchemaP NamedSwaggerDoc Value Value Name Text
-> ValueSchema NamedSwaggerDoc Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Text
fromName (Name -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value Name Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Integer
-> Integer
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
forall d v w a b.
HasRangedSchemaDocModifier d b =>
Integer -> Integer -> SchemaP d v w a b -> SchemaP d v w a b
untypedRangedSchema Integer
1 Integer
128 SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

deriving instance C.Cql Name

--------------------------------------------------------------------------------
-- TextStatus

-- Length is between 1 and 256 characters.
newtype TextStatus = TextStatus
  {TextStatus -> Text
fromTextStatus :: Text}
  deriving stock (TextStatus -> TextStatus -> Bool
(TextStatus -> TextStatus -> Bool)
-> (TextStatus -> TextStatus -> Bool) -> Eq TextStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextStatus -> TextStatus -> Bool
== :: TextStatus -> TextStatus -> Bool
$c/= :: TextStatus -> TextStatus -> Bool
/= :: TextStatus -> TextStatus -> Bool
Eq, Eq TextStatus
Eq TextStatus =>
(TextStatus -> TextStatus -> Ordering)
-> (TextStatus -> TextStatus -> Bool)
-> (TextStatus -> TextStatus -> Bool)
-> (TextStatus -> TextStatus -> Bool)
-> (TextStatus -> TextStatus -> Bool)
-> (TextStatus -> TextStatus -> TextStatus)
-> (TextStatus -> TextStatus -> TextStatus)
-> Ord TextStatus
TextStatus -> TextStatus -> Bool
TextStatus -> TextStatus -> Ordering
TextStatus -> TextStatus -> TextStatus
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 :: TextStatus -> TextStatus -> Ordering
compare :: TextStatus -> TextStatus -> Ordering
$c< :: TextStatus -> TextStatus -> Bool
< :: TextStatus -> TextStatus -> Bool
$c<= :: TextStatus -> TextStatus -> Bool
<= :: TextStatus -> TextStatus -> Bool
$c> :: TextStatus -> TextStatus -> Bool
> :: TextStatus -> TextStatus -> Bool
$c>= :: TextStatus -> TextStatus -> Bool
>= :: TextStatus -> TextStatus -> Bool
$cmax :: TextStatus -> TextStatus -> TextStatus
max :: TextStatus -> TextStatus -> TextStatus
$cmin :: TextStatus -> TextStatus -> TextStatus
min :: TextStatus -> TextStatus -> TextStatus
Ord, Int -> TextStatus -> ShowS
[TextStatus] -> ShowS
TextStatus -> String
(Int -> TextStatus -> ShowS)
-> (TextStatus -> String)
-> ([TextStatus] -> ShowS)
-> Show TextStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextStatus -> ShowS
showsPrec :: Int -> TextStatus -> ShowS
$cshow :: TextStatus -> String
show :: TextStatus -> String
$cshowList :: [TextStatus] -> ShowS
showList :: [TextStatus] -> ShowS
Show, (forall x. TextStatus -> Rep TextStatus x)
-> (forall x. Rep TextStatus x -> TextStatus) -> Generic TextStatus
forall x. Rep TextStatus x -> TextStatus
forall x. TextStatus -> Rep TextStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextStatus -> Rep TextStatus x
from :: forall x. TextStatus -> Rep TextStatus x
$cto :: forall x. Rep TextStatus x -> TextStatus
to :: forall x. Rep TextStatus x -> TextStatus
Generic)
  deriving newtype (Parser TextStatus
Parser TextStatus -> FromByteString TextStatus
forall a. Parser a -> FromByteString a
$cparser :: Parser TextStatus
parser :: Parser TextStatus
FromByteString, TextStatus -> Builder
(TextStatus -> Builder) -> ToByteString TextStatus
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: TextStatus -> Builder
builder :: TextStatus -> Builder
ToByteString)
  deriving (Gen TextStatus
Gen TextStatus
-> (TextStatus -> [TextStatus]) -> Arbitrary TextStatus
TextStatus -> [TextStatus]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen TextStatus
arbitrary :: Gen TextStatus
$cshrink :: TextStatus -> [TextStatus]
shrink :: TextStatus -> [TextStatus]
Arbitrary) via (Ranged 1 256 Text)
  deriving (Value -> Parser [TextStatus]
Value -> Parser TextStatus
(Value -> Parser TextStatus)
-> (Value -> Parser [TextStatus]) -> FromJSON TextStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TextStatus
parseJSON :: Value -> Parser TextStatus
$cparseJSONList :: Value -> Parser [TextStatus]
parseJSONList :: Value -> Parser [TextStatus]
FromJSON, [TextStatus] -> Value
[TextStatus] -> Encoding
TextStatus -> Value
TextStatus -> Encoding
(TextStatus -> Value)
-> (TextStatus -> Encoding)
-> ([TextStatus] -> Value)
-> ([TextStatus] -> Encoding)
-> ToJSON TextStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TextStatus -> Value
toJSON :: TextStatus -> Value
$ctoEncoding :: TextStatus -> Encoding
toEncoding :: TextStatus -> Encoding
$ctoJSONList :: [TextStatus] -> Value
toJSONList :: [TextStatus] -> Value
$ctoEncodingList :: [TextStatus] -> Encoding
toEncodingList :: [TextStatus] -> Encoding
ToJSON, Typeable TextStatus
Typeable TextStatus =>
(Proxy TextStatus -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TextStatus
Proxy TextStatus -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy TextStatus -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy TextStatus -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema TextStatus

mkTextStatus :: Text -> Either String TextStatus
mkTextStatus :: Text -> Either String TextStatus
mkTextStatus Text
txt = Text -> TextStatus
TextStatus (Text -> TextStatus)
-> (Range 1 256 Text -> Text) -> Range 1 256 Text -> TextStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 1 256 Text -> Text
forall (n :: Natural) (m :: Natural) a. Range n m a -> a
fromRange (Range 1 256 Text -> TextStatus)
-> Either String (Range 1 256 Text) -> Either String TextStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (n :: Natural) (m :: Natural).
(KnownNat n, KnownNat m, Within a n m) =>
String -> a -> Either String (Range n m a)
checkedEitherMsg @_ @1 @256 String
"TextStatus" Text
txt

instance ToSchema TextStatus where
  schema :: ValueSchema NamedSwaggerDoc TextStatus
schema = Text -> TextStatus
TextStatus (Text -> TextStatus)
-> SchemaP NamedSwaggerDoc Value Value TextStatus Text
-> ValueSchema NamedSwaggerDoc TextStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextStatus -> Text
fromTextStatus (TextStatus -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value TextStatus Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Integer
-> Integer
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
forall d v w a b.
HasRangedSchemaDocModifier d b =>
Integer -> Integer -> SchemaP d v w a b -> SchemaP d v w a b
untypedRangedSchema Integer
1 Integer
256 SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

deriving instance C.Cql TextStatus

--------------------------------------------------------------------------------
-- Colour

newtype ColourId = ColourId {ColourId -> Int32
fromColourId :: Int32}
  deriving stock (ColourId -> ColourId -> Bool
(ColourId -> ColourId -> Bool)
-> (ColourId -> ColourId -> Bool) -> Eq ColourId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColourId -> ColourId -> Bool
== :: ColourId -> ColourId -> Bool
$c/= :: ColourId -> ColourId -> Bool
/= :: ColourId -> ColourId -> Bool
Eq, Eq ColourId
Eq ColourId =>
(ColourId -> ColourId -> Ordering)
-> (ColourId -> ColourId -> Bool)
-> (ColourId -> ColourId -> Bool)
-> (ColourId -> ColourId -> Bool)
-> (ColourId -> ColourId -> Bool)
-> (ColourId -> ColourId -> ColourId)
-> (ColourId -> ColourId -> ColourId)
-> Ord ColourId
ColourId -> ColourId -> Bool
ColourId -> ColourId -> Ordering
ColourId -> ColourId -> ColourId
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 :: ColourId -> ColourId -> Ordering
compare :: ColourId -> ColourId -> Ordering
$c< :: ColourId -> ColourId -> Bool
< :: ColourId -> ColourId -> Bool
$c<= :: ColourId -> ColourId -> Bool
<= :: ColourId -> ColourId -> Bool
$c> :: ColourId -> ColourId -> Bool
> :: ColourId -> ColourId -> Bool
$c>= :: ColourId -> ColourId -> Bool
>= :: ColourId -> ColourId -> Bool
$cmax :: ColourId -> ColourId -> ColourId
max :: ColourId -> ColourId -> ColourId
$cmin :: ColourId -> ColourId -> ColourId
min :: ColourId -> ColourId -> ColourId
Ord, Int -> ColourId -> ShowS
[ColourId] -> ShowS
ColourId -> String
(Int -> ColourId -> ShowS)
-> (ColourId -> String) -> ([ColourId] -> ShowS) -> Show ColourId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColourId -> ShowS
showsPrec :: Int -> ColourId -> ShowS
$cshow :: ColourId -> String
show :: ColourId -> String
$cshowList :: [ColourId] -> ShowS
showList :: [ColourId] -> ShowS
Show, (forall x. ColourId -> Rep ColourId x)
-> (forall x. Rep ColourId x -> ColourId) -> Generic ColourId
forall x. Rep ColourId x -> ColourId
forall x. ColourId -> Rep ColourId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColourId -> Rep ColourId x
from :: forall x. ColourId -> Rep ColourId x
$cto :: forall x. Rep ColourId x -> ColourId
to :: forall x. Rep ColourId x -> ColourId
Generic)
  deriving newtype (Integer -> ColourId
ColourId -> ColourId
ColourId -> ColourId -> ColourId
(ColourId -> ColourId -> ColourId)
-> (ColourId -> ColourId -> ColourId)
-> (ColourId -> ColourId -> ColourId)
-> (ColourId -> ColourId)
-> (ColourId -> ColourId)
-> (ColourId -> ColourId)
-> (Integer -> ColourId)
-> Num ColourId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ColourId -> ColourId -> ColourId
+ :: ColourId -> ColourId -> ColourId
$c- :: ColourId -> ColourId -> ColourId
- :: ColourId -> ColourId -> ColourId
$c* :: ColourId -> ColourId -> ColourId
* :: ColourId -> ColourId -> ColourId
$cnegate :: ColourId -> ColourId
negate :: ColourId -> ColourId
$cabs :: ColourId -> ColourId
abs :: ColourId -> ColourId
$csignum :: ColourId -> ColourId
signum :: ColourId -> ColourId
$cfromInteger :: Integer -> ColourId
fromInteger :: Integer -> ColourId
Num, ValueSchema NamedSwaggerDoc ColourId
ValueSchema NamedSwaggerDoc ColourId -> ToSchema ColourId
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: ValueSchema NamedSwaggerDoc ColourId
schema :: ValueSchema NamedSwaggerDoc ColourId
ToSchema, Gen ColourId
Gen ColourId -> (ColourId -> [ColourId]) -> Arbitrary ColourId
ColourId -> [ColourId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ColourId
arbitrary :: Gen ColourId
$cshrink :: ColourId -> [ColourId]
shrink :: ColourId -> [ColourId]
Arbitrary)
  deriving (Value -> Parser [ColourId]
Value -> Parser ColourId
(Value -> Parser ColourId)
-> (Value -> Parser [ColourId]) -> FromJSON ColourId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ColourId
parseJSON :: Value -> Parser ColourId
$cparseJSONList :: Value -> Parser [ColourId]
parseJSONList :: Value -> Parser [ColourId]
FromJSON, [ColourId] -> Value
[ColourId] -> Encoding
ColourId -> Value
ColourId -> Encoding
(ColourId -> Value)
-> (ColourId -> Encoding)
-> ([ColourId] -> Value)
-> ([ColourId] -> Encoding)
-> ToJSON ColourId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ColourId -> Value
toJSON :: ColourId -> Value
$ctoEncoding :: ColourId -> Encoding
toEncoding :: ColourId -> Encoding
$ctoJSONList :: [ColourId] -> Value
toJSONList :: [ColourId] -> Value
$ctoEncodingList :: [ColourId] -> Encoding
toEncodingList :: [ColourId] -> Encoding
ToJSON, Typeable ColourId
Typeable ColourId =>
(Proxy ColourId -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ColourId
Proxy ColourId -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ColourId -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ColourId -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ColourId

defaultAccentId :: ColourId
defaultAccentId :: ColourId
defaultAccentId = Int32 -> ColourId
ColourId Int32
0

deriving instance C.Cql ColourId

--------------------------------------------------------------------------------
-- Asset

-- Note: Intended to be turned into a sum type to add further asset types.
data Asset = ImageAsset
  { Asset -> AssetKey
assetKey :: AssetKey,
    Asset -> Maybe AssetSize
assetSize :: Maybe AssetSize
  }
  deriving stock (Asset -> Asset -> Bool
(Asset -> Asset -> Bool) -> (Asset -> Asset -> Bool) -> Eq Asset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Asset -> Asset -> Bool
== :: Asset -> Asset -> Bool
$c/= :: Asset -> Asset -> Bool
/= :: Asset -> Asset -> Bool
Eq, Eq Asset
Eq Asset =>
(Asset -> Asset -> Ordering)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Asset)
-> (Asset -> Asset -> Asset)
-> Ord Asset
Asset -> Asset -> Bool
Asset -> Asset -> Ordering
Asset -> Asset -> Asset
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 :: Asset -> Asset -> Ordering
compare :: Asset -> Asset -> Ordering
$c< :: Asset -> Asset -> Bool
< :: Asset -> Asset -> Bool
$c<= :: Asset -> Asset -> Bool
<= :: Asset -> Asset -> Bool
$c> :: Asset -> Asset -> Bool
> :: Asset -> Asset -> Bool
$c>= :: Asset -> Asset -> Bool
>= :: Asset -> Asset -> Bool
$cmax :: Asset -> Asset -> Asset
max :: Asset -> Asset -> Asset
$cmin :: Asset -> Asset -> Asset
min :: Asset -> Asset -> Asset
Ord, Int -> Asset -> ShowS
[Asset] -> ShowS
Asset -> String
(Int -> Asset -> ShowS)
-> (Asset -> String) -> ([Asset] -> ShowS) -> Show Asset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Asset -> ShowS
showsPrec :: Int -> Asset -> ShowS
$cshow :: Asset -> String
show :: Asset -> String
$cshowList :: [Asset] -> ShowS
showList :: [Asset] -> ShowS
Show, (forall x. Asset -> Rep Asset x)
-> (forall x. Rep Asset x -> Asset) -> Generic Asset
forall x. Rep Asset x -> Asset
forall x. Asset -> Rep Asset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Asset -> Rep Asset x
from :: forall x. Asset -> Rep Asset x
$cto :: forall x. Rep Asset x -> Asset
to :: forall x. Rep Asset x -> Asset
Generic)
  deriving (Gen Asset
Gen Asset -> (Asset -> [Asset]) -> Arbitrary Asset
Asset -> [Asset]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Asset
arbitrary :: Gen Asset
$cshrink :: Asset -> [Asset]
shrink :: Asset -> [Asset]
Arbitrary) via (GenericUniform Asset)
  deriving (Value -> Parser [Asset]
Value -> Parser Asset
(Value -> Parser Asset)
-> (Value -> Parser [Asset]) -> FromJSON Asset
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Asset
parseJSON :: Value -> Parser Asset
$cparseJSONList :: Value -> Parser [Asset]
parseJSONList :: Value -> Parser [Asset]
FromJSON, [Asset] -> Value
[Asset] -> Encoding
Asset -> Value
Asset -> Encoding
(Asset -> Value)
-> (Asset -> Encoding)
-> ([Asset] -> Value)
-> ([Asset] -> Encoding)
-> ToJSON Asset
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Asset -> Value
toJSON :: Asset -> Value
$ctoEncoding :: Asset -> Encoding
toEncoding :: Asset -> Encoding
$ctoJSONList :: [Asset] -> Value
toJSONList :: [Asset] -> Value
$ctoEncodingList :: [Asset] -> Encoding
toEncodingList :: [Asset] -> Encoding
ToJSON, Typeable Asset
Typeable Asset =>
(Proxy Asset -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Asset
Proxy Asset -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Asset -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Asset -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Asset

instance ToSchema Asset where
  schema :: ValueSchema NamedSwaggerDoc Asset
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Asset Asset
-> ValueSchema NamedSwaggerDoc Asset
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserAsset" (SchemaP SwaggerDoc Object [Pair] Asset Asset
 -> ValueSchema NamedSwaggerDoc Asset)
-> SchemaP SwaggerDoc Object [Pair] Asset Asset
-> ValueSchema NamedSwaggerDoc Asset
forall a b. (a -> b) -> a -> b
$
      AssetKey -> Maybe AssetSize -> Asset
ImageAsset
        (AssetKey -> Maybe AssetSize -> Asset)
-> SchemaP SwaggerDoc Object [Pair] Asset AssetKey
-> SchemaP
     SwaggerDoc Object [Pair] Asset (Maybe AssetSize -> Asset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Asset -> AssetKey
assetKey (Asset -> AssetKey)
-> SchemaP SwaggerDoc Object [Pair] AssetKey AssetKey
-> SchemaP SwaggerDoc Object [Pair] Asset AssetKey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
-> SchemaP SwaggerDoc Object [Pair] AssetKey AssetKey
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"key" SchemaP NamedSwaggerDoc Value Value AssetKey AssetKey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP SwaggerDoc Object [Pair] Asset (Maybe AssetSize -> Asset)
-> SchemaP SwaggerDoc Object [Pair] Asset (Maybe AssetSize)
-> SchemaP SwaggerDoc Object [Pair] Asset Asset
forall a b.
SchemaP SwaggerDoc Object [Pair] Asset (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Asset a
-> SchemaP SwaggerDoc Object [Pair] Asset b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Asset -> Maybe AssetSize
assetSize (Asset -> Maybe AssetSize)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe AssetSize) (Maybe AssetSize)
-> SchemaP SwaggerDoc Object [Pair] Asset (Maybe AssetSize)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] AssetSize (Maybe AssetSize)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe AssetSize) (Maybe AssetSize)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value AssetSize AssetSize
-> SchemaP SwaggerDoc Object [Pair] AssetSize (Maybe AssetSize)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"size" SchemaP NamedSwaggerDoc Value Value AssetSize AssetSize
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] Asset Asset
-> SchemaP SwaggerDoc Object [Pair] Asset ()
-> SchemaP SwaggerDoc Object [Pair] Asset Asset
forall a b.
SchemaP SwaggerDoc Object [Pair] Asset a
-> SchemaP SwaggerDoc Object [Pair] Asset b
-> SchemaP SwaggerDoc Object [Pair] Asset a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* () -> Asset -> ()
forall a b. a -> b -> a
const () (Asset -> ())
-> SchemaP SwaggerDoc Object [Pair] () ()
-> SchemaP SwaggerDoc Object [Pair] Asset ()
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value () ()
-> SchemaP SwaggerDoc Object [Pair] () ()
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"type" SchemaP NamedSwaggerDoc Value Value () ()
typeSchema
    where
      typeSchema :: ValueSchema NamedSwaggerDoc ()
      typeSchema :: SchemaP NamedSwaggerDoc Value Value () ()
typeSchema =
        forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text @NamedSwaggerDoc Text
"AssetType" (SchemaP [Value] Text (Alt Maybe Text) () ()
 -> SchemaP NamedSwaggerDoc Value Value () ())
-> SchemaP [Value] Text (Alt Maybe Text) () ()
-> SchemaP NamedSwaggerDoc Value Value () ()
forall a b. (a -> b) -> a -> b
$
          Text -> () -> SchemaP [Value] Text (Alt Maybe Text) () ()
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"image" ()

instance C.Cql Asset where
  -- Note: Type name and column names and types must match up with the
  --       Cassandra schema definition. New fields may only be added
  --       (appended) but no fields may be removed.
  ctype :: Tagged Asset ColumnType
ctype =
    ColumnType -> Tagged Asset ColumnType
forall a b. b -> Tagged a b
C.Tagged
      ( Text -> [(Text, ColumnType)] -> ColumnType
C.UdtColumn
          Text
"asset"
          [ (Text
"typ", ColumnType
C.IntColumn),
            (Text
"key", ColumnType
C.TextColumn),
            (Text
"size", ColumnType -> ColumnType
C.MaybeColumn ColumnType
C.IntColumn)
          ]
      )

  fromCql :: Value -> Either String Asset
fromCql (C.CqlUdt [(Text, Value)]
fs) = do
    Int32
t <- Text -> Either String Int32
forall r. Cql r => Text -> Either String r
required Text
"typ"
    AssetKey
k <- Text -> Either String AssetKey
forall r. Cql r => Text -> Either String r
required Text
"key"
    Maybe AssetSize
s <- Text -> Either String (Maybe AssetSize)
notrequired Text
"size"
    case (Int32
t :: Int32) of
      Int32
0 -> Asset -> Either String Asset
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Asset -> Either String Asset) -> Asset -> Either String Asset
forall a b. (a -> b) -> a -> b
$! AssetKey -> Maybe AssetSize -> Asset
ImageAsset AssetKey
k Maybe AssetSize
s
      Int32
_ -> String -> Either String Asset
forall a b. a -> Either a b
Left (String -> Either String Asset) -> String -> Either String Asset
forall a b. (a -> b) -> a -> b
$ String
"unexpected user asset type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
t
    where
      required :: (C.Cql r) => Text -> Either String r
      required :: forall r. Cql r => Text -> Either String r
required Text
f =
        Either String r
-> (Value -> Either String r) -> Maybe Value -> Either String r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (String -> Either String r
forall a b. a -> Either a b
Left (String
"Asset: Missing required field '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"))
          Value -> Either String r
forall a. Cql a => Value -> Either String a
C.fromCql
          (Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
f [(Text, Value)]
fs)
      notrequired :: Text -> Either String (Maybe AssetSize)
notrequired Text
f = Either String (Maybe AssetSize)
-> (Value -> Either String (Maybe AssetSize))
-> Maybe Value
-> Either String (Maybe AssetSize)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe AssetSize -> Either String (Maybe AssetSize)
forall a b. b -> Either a b
Right Maybe AssetSize
forall a. Maybe a
Nothing) Value -> Either String (Maybe AssetSize)
forall a. Cql a => Value -> Either String a
C.fromCql (Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
f [(Text, Value)]
fs)
  fromCql Value
_ = String -> Either String Asset
forall a b. a -> Either a b
Left String
"UserAsset: UDT expected"

  -- Note: Order must match up with the 'ctype' definition.
  toCql :: Asset -> Value
toCql (ImageAsset AssetKey
k Maybe AssetSize
s) =
    [(Text, Value)] -> Value
C.CqlUdt
      [ (Text
"typ", Int32 -> Value
C.CqlInt Int32
0),
        (Text
"key", AssetKey -> Value
forall a. Cql a => a -> Value
C.toCql AssetKey
k),
        (Text
"size", Maybe AssetSize -> Value
forall a. Cql a => a -> Value
C.toCql Maybe AssetSize
s)
      ]

data AssetSize = AssetComplete | AssetPreview
  deriving stock (AssetSize -> AssetSize -> Bool
(AssetSize -> AssetSize -> Bool)
-> (AssetSize -> AssetSize -> Bool) -> Eq AssetSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetSize -> AssetSize -> Bool
== :: AssetSize -> AssetSize -> Bool
$c/= :: AssetSize -> AssetSize -> Bool
/= :: AssetSize -> AssetSize -> Bool
Eq, Eq AssetSize
Eq AssetSize =>
(AssetSize -> AssetSize -> Ordering)
-> (AssetSize -> AssetSize -> Bool)
-> (AssetSize -> AssetSize -> Bool)
-> (AssetSize -> AssetSize -> Bool)
-> (AssetSize -> AssetSize -> Bool)
-> (AssetSize -> AssetSize -> AssetSize)
-> (AssetSize -> AssetSize -> AssetSize)
-> Ord AssetSize
AssetSize -> AssetSize -> Bool
AssetSize -> AssetSize -> Ordering
AssetSize -> AssetSize -> AssetSize
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 :: AssetSize -> AssetSize -> Ordering
compare :: AssetSize -> AssetSize -> Ordering
$c< :: AssetSize -> AssetSize -> Bool
< :: AssetSize -> AssetSize -> Bool
$c<= :: AssetSize -> AssetSize -> Bool
<= :: AssetSize -> AssetSize -> Bool
$c> :: AssetSize -> AssetSize -> Bool
> :: AssetSize -> AssetSize -> Bool
$c>= :: AssetSize -> AssetSize -> Bool
>= :: AssetSize -> AssetSize -> Bool
$cmax :: AssetSize -> AssetSize -> AssetSize
max :: AssetSize -> AssetSize -> AssetSize
$cmin :: AssetSize -> AssetSize -> AssetSize
min :: AssetSize -> AssetSize -> AssetSize
Ord, Int -> AssetSize -> ShowS
[AssetSize] -> ShowS
AssetSize -> String
(Int -> AssetSize -> ShowS)
-> (AssetSize -> String)
-> ([AssetSize] -> ShowS)
-> Show AssetSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetSize -> ShowS
showsPrec :: Int -> AssetSize -> ShowS
$cshow :: AssetSize -> String
show :: AssetSize -> String
$cshowList :: [AssetSize] -> ShowS
showList :: [AssetSize] -> ShowS
Show, (forall x. AssetSize -> Rep AssetSize x)
-> (forall x. Rep AssetSize x -> AssetSize) -> Generic AssetSize
forall x. Rep AssetSize x -> AssetSize
forall x. AssetSize -> Rep AssetSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AssetSize -> Rep AssetSize x
from :: forall x. AssetSize -> Rep AssetSize x
$cto :: forall x. Rep AssetSize x -> AssetSize
to :: forall x. Rep AssetSize x -> AssetSize
Generic)
  deriving (Gen AssetSize
Gen AssetSize -> (AssetSize -> [AssetSize]) -> Arbitrary AssetSize
AssetSize -> [AssetSize]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AssetSize
arbitrary :: Gen AssetSize
$cshrink :: AssetSize -> [AssetSize]
shrink :: AssetSize -> [AssetSize]
Arbitrary) via (GenericUniform AssetSize)
  deriving (Value -> Parser [AssetSize]
Value -> Parser AssetSize
(Value -> Parser AssetSize)
-> (Value -> Parser [AssetSize]) -> FromJSON AssetSize
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AssetSize
parseJSON :: Value -> Parser AssetSize
$cparseJSONList :: Value -> Parser [AssetSize]
parseJSONList :: Value -> Parser [AssetSize]
FromJSON, [AssetSize] -> Value
[AssetSize] -> Encoding
AssetSize -> Value
AssetSize -> Encoding
(AssetSize -> Value)
-> (AssetSize -> Encoding)
-> ([AssetSize] -> Value)
-> ([AssetSize] -> Encoding)
-> ToJSON AssetSize
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AssetSize -> Value
toJSON :: AssetSize -> Value
$ctoEncoding :: AssetSize -> Encoding
toEncoding :: AssetSize -> Encoding
$ctoJSONList :: [AssetSize] -> Value
toJSONList :: [AssetSize] -> Value
$ctoEncodingList :: [AssetSize] -> Encoding
toEncodingList :: [AssetSize] -> Encoding
ToJSON, Typeable AssetSize
Typeable AssetSize =>
(Proxy AssetSize -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AssetSize
Proxy AssetSize -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AssetSize -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AssetSize -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema AssetSize

instance ToSchema AssetSize where
  schema :: SchemaP NamedSwaggerDoc Value Value AssetSize AssetSize
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"AssetSize" (SchemaP [Value] Text (Alt Maybe Text) AssetSize AssetSize
 -> SchemaP NamedSwaggerDoc Value Value AssetSize AssetSize)
-> SchemaP [Value] Text (Alt Maybe Text) AssetSize AssetSize
-> SchemaP NamedSwaggerDoc Value Value AssetSize AssetSize
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) AssetSize AssetSize]
-> SchemaP [Value] Text (Alt Maybe Text) AssetSize AssetSize
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> AssetSize
-> SchemaP [Value] Text (Alt Maybe Text) AssetSize AssetSize
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"preview" AssetSize
AssetPreview,
          Text
-> AssetSize
-> SchemaP [Value] Text (Alt Maybe Text) AssetSize AssetSize
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"complete" AssetSize
AssetComplete
        ]

instance C.Cql AssetSize where
  ctype :: Tagged AssetSize ColumnType
ctype = ColumnType -> Tagged AssetSize ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.IntColumn

  fromCql :: Value -> Either String AssetSize
fromCql (C.CqlInt Int32
0) = AssetSize -> Either String AssetSize
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetSize
AssetPreview
  fromCql (C.CqlInt Int32
1) = AssetSize -> Either String AssetSize
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetSize
AssetComplete
  fromCql Value
n = String -> Either String AssetSize
forall a b. a -> Either a b
Left (String -> Either String AssetSize)
-> String -> Either String AssetSize
forall a b. (a -> b) -> a -> b
$ String
"Unexpected asset size: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
n

  toCql :: AssetSize -> Value
toCql AssetSize
AssetPreview = Int32 -> Value
C.CqlInt Int32
0
  toCql AssetSize
AssetComplete = Int32 -> Value
C.CqlInt Int32
1

--------------------------------------------------------------------------------
-- ManagedBy

-- | Who controls changes to the user profile (where the profile is defined as "all
-- user-editable, user-visible attributes").  See {#SparBrainDump}.
data ManagedBy
  = -- | The profile can be changed in-app; user doesn't show up via SCIM at all.
    ManagedByWire
  | -- | The profile can only be changed via SCIM, with several exceptions:
    --
    --   1. User properties can still be set (because they are used internally by clients
    --      and none of them can be modified via SCIM now or in the future).
    --
    --   2. Password can be changed by the user (SCIM doesn't support setting passwords yet,
    --      but currently SCIM only works with SSO-users who don't even have passwords).
    --
    --   3. The user can still be deleted normally (SCIM doesn't support deleting users yet;
    --      but it's questionable whether this should even count as a /change/ of a user
    --      profile).
    --
    -- There are some other things that SCIM can't do yet, like setting accent IDs, but they
    -- are not essential, unlike e.g. passwords.
    ManagedByScim
  deriving stock (ManagedBy -> ManagedBy -> Bool
(ManagedBy -> ManagedBy -> Bool)
-> (ManagedBy -> ManagedBy -> Bool) -> Eq ManagedBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ManagedBy -> ManagedBy -> Bool
== :: ManagedBy -> ManagedBy -> Bool
$c/= :: ManagedBy -> ManagedBy -> Bool
/= :: ManagedBy -> ManagedBy -> Bool
Eq, Eq ManagedBy
Eq ManagedBy =>
(ManagedBy -> ManagedBy -> Ordering)
-> (ManagedBy -> ManagedBy -> Bool)
-> (ManagedBy -> ManagedBy -> Bool)
-> (ManagedBy -> ManagedBy -> Bool)
-> (ManagedBy -> ManagedBy -> Bool)
-> (ManagedBy -> ManagedBy -> ManagedBy)
-> (ManagedBy -> ManagedBy -> ManagedBy)
-> Ord ManagedBy
ManagedBy -> ManagedBy -> Bool
ManagedBy -> ManagedBy -> Ordering
ManagedBy -> ManagedBy -> ManagedBy
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 :: ManagedBy -> ManagedBy -> Ordering
compare :: ManagedBy -> ManagedBy -> Ordering
$c< :: ManagedBy -> ManagedBy -> Bool
< :: ManagedBy -> ManagedBy -> Bool
$c<= :: ManagedBy -> ManagedBy -> Bool
<= :: ManagedBy -> ManagedBy -> Bool
$c> :: ManagedBy -> ManagedBy -> Bool
> :: ManagedBy -> ManagedBy -> Bool
$c>= :: ManagedBy -> ManagedBy -> Bool
>= :: ManagedBy -> ManagedBy -> Bool
$cmax :: ManagedBy -> ManagedBy -> ManagedBy
max :: ManagedBy -> ManagedBy -> ManagedBy
$cmin :: ManagedBy -> ManagedBy -> ManagedBy
min :: ManagedBy -> ManagedBy -> ManagedBy
Ord, ManagedBy
ManagedBy -> ManagedBy -> Bounded ManagedBy
forall a. a -> a -> Bounded a
$cminBound :: ManagedBy
minBound :: ManagedBy
$cmaxBound :: ManagedBy
maxBound :: ManagedBy
Bounded, Int -> ManagedBy
ManagedBy -> Int
ManagedBy -> [ManagedBy]
ManagedBy -> ManagedBy
ManagedBy -> ManagedBy -> [ManagedBy]
ManagedBy -> ManagedBy -> ManagedBy -> [ManagedBy]
(ManagedBy -> ManagedBy)
-> (ManagedBy -> ManagedBy)
-> (Int -> ManagedBy)
-> (ManagedBy -> Int)
-> (ManagedBy -> [ManagedBy])
-> (ManagedBy -> ManagedBy -> [ManagedBy])
-> (ManagedBy -> ManagedBy -> [ManagedBy])
-> (ManagedBy -> ManagedBy -> ManagedBy -> [ManagedBy])
-> Enum ManagedBy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ManagedBy -> ManagedBy
succ :: ManagedBy -> ManagedBy
$cpred :: ManagedBy -> ManagedBy
pred :: ManagedBy -> ManagedBy
$ctoEnum :: Int -> ManagedBy
toEnum :: Int -> ManagedBy
$cfromEnum :: ManagedBy -> Int
fromEnum :: ManagedBy -> Int
$cenumFrom :: ManagedBy -> [ManagedBy]
enumFrom :: ManagedBy -> [ManagedBy]
$cenumFromThen :: ManagedBy -> ManagedBy -> [ManagedBy]
enumFromThen :: ManagedBy -> ManagedBy -> [ManagedBy]
$cenumFromTo :: ManagedBy -> ManagedBy -> [ManagedBy]
enumFromTo :: ManagedBy -> ManagedBy -> [ManagedBy]
$cenumFromThenTo :: ManagedBy -> ManagedBy -> ManagedBy -> [ManagedBy]
enumFromThenTo :: ManagedBy -> ManagedBy -> ManagedBy -> [ManagedBy]
Enum, Int -> ManagedBy -> ShowS
[ManagedBy] -> ShowS
ManagedBy -> String
(Int -> ManagedBy -> ShowS)
-> (ManagedBy -> String)
-> ([ManagedBy] -> ShowS)
-> Show ManagedBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManagedBy -> ShowS
showsPrec :: Int -> ManagedBy -> ShowS
$cshow :: ManagedBy -> String
show :: ManagedBy -> String
$cshowList :: [ManagedBy] -> ShowS
showList :: [ManagedBy] -> ShowS
Show, (forall x. ManagedBy -> Rep ManagedBy x)
-> (forall x. Rep ManagedBy x -> ManagedBy) -> Generic ManagedBy
forall x. Rep ManagedBy x -> ManagedBy
forall x. ManagedBy -> Rep ManagedBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ManagedBy -> Rep ManagedBy x
from :: forall x. ManagedBy -> Rep ManagedBy x
$cto :: forall x. Rep ManagedBy x -> ManagedBy
to :: forall x. Rep ManagedBy x -> ManagedBy
Generic)
  deriving (Gen ManagedBy
Gen ManagedBy -> (ManagedBy -> [ManagedBy]) -> Arbitrary ManagedBy
ManagedBy -> [ManagedBy]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ManagedBy
arbitrary :: Gen ManagedBy
$cshrink :: ManagedBy -> [ManagedBy]
shrink :: ManagedBy -> [ManagedBy]
Arbitrary) via (GenericUniform ManagedBy)
  deriving ([ManagedBy] -> Value
[ManagedBy] -> Encoding
ManagedBy -> Value
ManagedBy -> Encoding
(ManagedBy -> Value)
-> (ManagedBy -> Encoding)
-> ([ManagedBy] -> Value)
-> ([ManagedBy] -> Encoding)
-> ToJSON ManagedBy
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ManagedBy -> Value
toJSON :: ManagedBy -> Value
$ctoEncoding :: ManagedBy -> Encoding
toEncoding :: ManagedBy -> Encoding
$ctoJSONList :: [ManagedBy] -> Value
toJSONList :: [ManagedBy] -> Value
$ctoEncodingList :: [ManagedBy] -> Encoding
toEncodingList :: [ManagedBy] -> Encoding
ToJSON, Value -> Parser [ManagedBy]
Value -> Parser ManagedBy
(Value -> Parser ManagedBy)
-> (Value -> Parser [ManagedBy]) -> FromJSON ManagedBy
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ManagedBy
parseJSON :: Value -> Parser ManagedBy
$cparseJSONList :: Value -> Parser [ManagedBy]
parseJSONList :: Value -> Parser [ManagedBy]
FromJSON, Typeable ManagedBy
Typeable ManagedBy =>
(Proxy ManagedBy -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ManagedBy
Proxy ManagedBy -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ManagedBy -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ManagedBy -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema ManagedBy)

instance ToSchema ManagedBy where
  schema :: ValueSchema NamedSwaggerDoc ManagedBy
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"ManagedBy" (SchemaP [Value] Text (Alt Maybe Text) ManagedBy ManagedBy
 -> ValueSchema NamedSwaggerDoc ManagedBy)
-> SchemaP [Value] Text (Alt Maybe Text) ManagedBy ManagedBy
-> ValueSchema NamedSwaggerDoc ManagedBy
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) ManagedBy ManagedBy]
-> SchemaP [Value] Text (Alt Maybe Text) ManagedBy ManagedBy
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> ManagedBy
-> SchemaP [Value] Text (Alt Maybe Text) ManagedBy ManagedBy
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"wire" ManagedBy
ManagedByWire,
          Text
-> ManagedBy
-> SchemaP [Value] Text (Alt Maybe Text) ManagedBy ManagedBy
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"scim" ManagedBy
ManagedByScim
        ]

instance ToByteString ManagedBy where
  builder :: ManagedBy -> Builder
builder ManagedBy
ManagedByWire = Builder
"wire"
  builder ManagedBy
ManagedByScim = Builder
"scim"

instance FromByteString ManagedBy where
  parser :: Parser ManagedBy
parser =
    Parser ByteString
takeByteString Parser ByteString
-> (ByteString -> Parser ManagedBy) -> Parser ManagedBy
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ByteString
"wire" -> ManagedBy -> Parser ManagedBy
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ManagedBy
ManagedByWire
      ByteString
"scim" -> ManagedBy -> Parser ManagedBy
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ManagedBy
ManagedByScim
      ByteString
x -> String -> Parser ManagedBy
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ManagedBy) -> String -> Parser ManagedBy
forall a b. (a -> b) -> a -> b
$ String
"Invalid ManagedBy value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
x

instance C.Cql ManagedBy where
  ctype :: Tagged ManagedBy ColumnType
ctype = ColumnType -> Tagged ManagedBy ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.IntColumn

  fromCql :: Value -> Either String ManagedBy
fromCql (C.CqlInt Int32
0) = ManagedBy -> Either String ManagedBy
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ManagedBy
ManagedByWire
  fromCql (C.CqlInt Int32
1) = ManagedBy -> Either String ManagedBy
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ManagedBy
ManagedByScim
  fromCql Value
n = String -> Either String ManagedBy
forall a b. a -> Either a b
Left (String -> Either String ManagedBy)
-> String -> Either String ManagedBy
forall a b. (a -> b) -> a -> b
$ String
"Unexpected ManagedBy: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
n

  toCql :: ManagedBy -> Value
toCql ManagedBy
ManagedByWire = Int32 -> Value
C.CqlInt Int32
0
  toCql ManagedBy
ManagedByScim = Int32 -> Value
C.CqlInt Int32
1

defaultManagedBy :: ManagedBy
defaultManagedBy :: ManagedBy
defaultManagedBy = ManagedBy
ManagedByWire

--------------------------------------------------------------------------------
-- Deprecated

-- | DEPRECATED
newtype Pict = Pict {Pict -> [Object]
fromPict :: [A.Object]}
  deriving stock (Pict -> Pict -> Bool
(Pict -> Pict -> Bool) -> (Pict -> Pict -> Bool) -> Eq Pict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pict -> Pict -> Bool
== :: Pict -> Pict -> Bool
$c/= :: Pict -> Pict -> Bool
/= :: Pict -> Pict -> Bool
Eq, Eq Pict
Eq Pict =>
(Pict -> Pict -> Ordering)
-> (Pict -> Pict -> Bool)
-> (Pict -> Pict -> Bool)
-> (Pict -> Pict -> Bool)
-> (Pict -> Pict -> Bool)
-> (Pict -> Pict -> Pict)
-> (Pict -> Pict -> Pict)
-> Ord Pict
Pict -> Pict -> Bool
Pict -> Pict -> Ordering
Pict -> Pict -> Pict
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 :: Pict -> Pict -> Ordering
compare :: Pict -> Pict -> Ordering
$c< :: Pict -> Pict -> Bool
< :: Pict -> Pict -> Bool
$c<= :: Pict -> Pict -> Bool
<= :: Pict -> Pict -> Bool
$c> :: Pict -> Pict -> Bool
> :: Pict -> Pict -> Bool
$c>= :: Pict -> Pict -> Bool
>= :: Pict -> Pict -> Bool
$cmax :: Pict -> Pict -> Pict
max :: Pict -> Pict -> Pict
$cmin :: Pict -> Pict -> Pict
min :: Pict -> Pict -> Pict
Ord, Int -> Pict -> ShowS
[Pict] -> ShowS
Pict -> String
(Int -> Pict -> ShowS)
-> (Pict -> String) -> ([Pict] -> ShowS) -> Show Pict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pict -> ShowS
showsPrec :: Int -> Pict -> ShowS
$cshow :: Pict -> String
show :: Pict -> String
$cshowList :: [Pict] -> ShowS
showList :: [Pict] -> ShowS
Show, (forall x. Pict -> Rep Pict x)
-> (forall x. Rep Pict x -> Pict) -> Generic Pict
forall x. Rep Pict x -> Pict
forall x. Pict -> Rep Pict x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pict -> Rep Pict x
from :: forall x. Pict -> Rep Pict x
$cto :: forall x. Rep Pict x -> Pict
to :: forall x. Rep Pict x -> Pict
Generic)
  deriving (Value -> Parser [Pict]
Value -> Parser Pict
(Value -> Parser Pict) -> (Value -> Parser [Pict]) -> FromJSON Pict
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Pict
parseJSON :: Value -> Parser Pict
$cparseJSONList :: Value -> Parser [Pict]
parseJSONList :: Value -> Parser [Pict]
FromJSON, [Pict] -> Value
[Pict] -> Encoding
Pict -> Value
Pict -> Encoding
(Pict -> Value)
-> (Pict -> Encoding)
-> ([Pict] -> Value)
-> ([Pict] -> Encoding)
-> ToJSON Pict
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Pict -> Value
toJSON :: Pict -> Value
$ctoEncoding :: Pict -> Encoding
toEncoding :: Pict -> Encoding
$ctoJSONList :: [Pict] -> Value
toJSONList :: [Pict] -> Value
$ctoEncodingList :: [Pict] -> Encoding
toEncodingList :: [Pict] -> Encoding
ToJSON, Typeable Pict
Typeable Pict =>
(Proxy Pict -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Pict
Proxy Pict -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Pict -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Pict -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Pict

instance ToSchema Pict where
  schema :: ValueSchema NamedSwaggerDoc Pict
schema =
    Text
-> SchemaP SwaggerDoc Value Value Pict Pict
-> ValueSchema NamedSwaggerDoc Pict
forall doc doc' v m a b.
HasObject doc doc' =>
Text -> SchemaP doc v m a b -> SchemaP doc' v m a b
named Text
"Pict" (SchemaP SwaggerDoc Value Value Pict Pict
 -> ValueSchema NamedSwaggerDoc Pict)
-> SchemaP SwaggerDoc Value Value Pict Pict
-> ValueSchema NamedSwaggerDoc Pict
forall a b. (a -> b) -> a -> b
$
      [Object] -> Pict
Pict ([Object] -> Pict)
-> SchemaP SwaggerDoc Value Value Pict [Object]
-> SchemaP SwaggerDoc Value Value Pict Pict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pict -> [Object]
fromPict (Pict -> [Object])
-> SchemaP SwaggerDoc Value Value [Object] [Object]
-> SchemaP SwaggerDoc Value Value Pict [Object]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Integer
-> Integer
-> SchemaP SwaggerDoc Value Value [Object] [Object]
-> SchemaP SwaggerDoc Value Value [Object] [Object]
forall d v w a b.
HasRangedSchemaDocModifier d b =>
Integer -> Integer -> SchemaP d v w a b -> SchemaP d v w a b
untypedRangedSchema Integer
0 Integer
10 (ValueSchema SwaggerDoc Object
-> SchemaP SwaggerDoc Value Value [Object] [Object]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema SwaggerDoc Object
jsonObject)

instance Arbitrary Pict where
  arbitrary :: Gen Pict
arbitrary = Pict -> Gen Pict
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pict -> Gen Pict) -> Pict -> Gen Pict
forall a b. (a -> b) -> a -> b
$ [Object] -> Pict
Pict []

instance C.Cql Pict where
  ctype :: Tagged Pict ColumnType
ctype = ColumnType -> Tagged Pict ColumnType
forall a b. b -> Tagged a b
C.Tagged (ColumnType -> ColumnType
C.ListColumn ColumnType
C.BlobColumn)

  fromCql :: Value -> Either String Pict
fromCql (C.CqlList [Value]
l) = do
    [ByteString]
vs <- (Blob -> ByteString) -> [Blob] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(C.Blob ByteString
lbs) -> ByteString
lbs) ([Blob] -> [ByteString])
-> Either String [Blob] -> Either String [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either String Blob) -> [Value] -> Either String [Blob]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Either String Blob
forall a. Cql a => Value -> Either String a
C.fromCql [Value]
l
    [Object]
as <- (ByteString -> Either String Object)
-> [ByteString] -> Either String [Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> Maybe Object -> Either String Object
forall a b. a -> Maybe b -> Either a b
note String
"Failed to read asset" (Maybe Object -> Either String Object)
-> (ByteString -> Maybe Object)
-> ByteString
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Object
forall a. FromJSON a => ByteString -> Maybe a
A.decode) [ByteString]
vs
    Pict -> Either String Pict
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pict -> Either String Pict) -> Pict -> Either String Pict
forall a b. (a -> b) -> a -> b
$ [Object] -> Pict
Pict [Object]
as
  fromCql Value
_ = Pict -> Either String Pict
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pict
noPict

  toCql :: Pict -> Value
toCql = [Blob] -> Value
forall a. Cql a => a -> Value
C.toCql ([Blob] -> Value) -> (Pict -> [Blob]) -> Pict -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Blob) -> [Object] -> [Blob]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Blob
C.Blob (ByteString -> Blob) -> (Object -> ByteString) -> Object -> Blob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode) ([Object] -> [Blob]) -> (Pict -> [Object]) -> Pict -> [Blob]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pict -> [Object]
fromPict

noPict :: Pict
noPict :: Pict
noPict = [Object] -> Pict
Pict []