{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- 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.Team.Feature
  ( FeatureStatus (..),
    featureName,
    featureNameBS,
    LockStatus (..),
    DbFeature (..),
    dbFeatureLockStatus,
    dbFeatureStatus,
    dbFeatureConfig,
    dbFeatureModConfig,
    LockableFeature (..),
    defUnlockedFeature,
    defLockedFeature,
    LockableFeaturePatch (..),
    Feature (..),
    forgetLock,
    withLockStatus,
    FeatureTTL,
    FeatureTTLDays,
    FeatureTTL' (..),
    FeatureTTLUnit (..),
    EnforceAppLock (..),
    genericComputeFeature,
    IsFeatureConfig (..),
    FeatureSingleton (..),
    DeprecatedFeatureName,
    LockStatusResponse (..),
    One2OneCalls (..),
    -- Features
    LegalholdConfig (..),
    SSOConfig (..),
    SearchVisibilityAvailableConfig (..),
    SelfDeletingMessagesConfig (..),
    ValidateSAMLEmailsConfig (..),
    DigitalSignaturesConfig (..),
    ConferenceCallingConfig (..),
    GuestLinksConfig (..),
    ExposeInvitationURLsToTeamAdminConfig (..),
    SndFactorPasswordChallengeConfig (..),
    SearchVisibilityInboundConfig (..),
    ClassifiedDomainsConfig (..),
    AppLockConfig (..),
    FileSharingConfig (..),
    MLSConfig (..),
    OutlookCalIntegrationConfig (..),
    MlsE2EIdConfig (..),
    MlsMigrationConfig (..),
    EnforceFileDownloadLocationConfig (..),
    LimitedEventFanoutConfig (..),
    Features,
    AllFeatures,
    NpProject (..),
    npProject,
    NpUpdate (..),
    npUpdate,
    AllTeamFeatures,
  )
where

import Cassandra.CQL qualified as Cass
import Control.Lens ((?~))
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Attoparsec.ByteString qualified as Parser
import Data.ByteString (fromStrict)
import Data.ByteString.Conversion
import Data.ByteString.UTF8 qualified as UTF8
import Data.Default
import Data.Domain (Domain)
import Data.Either.Extra (maybeToEither)
import Data.Id
import Data.Json.Util
import Data.Kind
import Data.Misc (HttpsUrl)
import Data.Monoid
import Data.OpenApi qualified as S
import Data.Proxy
import Data.SOP
import Data.Schema
import Data.Scientific (toBoundedInteger)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Encoding.Error
import Data.Text.Lazy qualified as TL
import Data.Time
import Deriving.Aeson
import GHC.TypeLits
import Imports
import Servant (FromHttpApiData (..), ToHttpApiData (..))
import Test.QuickCheck (getPrintableString)
import Test.QuickCheck.Arbitrary (arbitrary)
import Test.QuickCheck.Gen (suchThat)
import Wire.API.Conversation.Protocol
import Wire.API.MLS.CipherSuite (CipherSuiteTag (MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519))
import Wire.API.Routes.Named
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

----------------------------------------------------------------------
-- FeatureTag

-- | Checklist for adding a new feature
--
-- Assume we want to add a new feature called @dummy@. Every appearance of
-- @dummy@ or @Dummy@ in the following has to be replaced with the actual name
-- of the feature being added.
--
-- 1. Create a new type in this module for the feature configuration, called
-- @DummyConfig@. If your feature doesn't have a config besides being 'status'
-- and 'lockStatus', then the config should be a unit type, e.g. @data
-- DummyConfig = DummyConfig@. Derive 'Eq', 'Show', 'Generic', 'Arbitrary',
-- 'RenderableSymbol', 'FromJSON', 'ToJSON' and 'S.ToSchema'. Implement a
-- 'ToSchema' instance. Add a singleton. Add the config type to 'Features'.
--
-- 2. Create a schema migration in galley, adding a column for each
-- configurable value of the feature. The new columns must contain all the
-- information needed to reconstruct a value of type 'LockableFeature
-- DummyConfig'.
--
-- 3. In 'Galley.Cassandra.MakeFeature', implement the 'MakeFeature' type
-- class: set 'FeatureRow' to the list of types of the rows added by the
-- migration. If the lock status is configurable (it should be in most cases),
-- it must be the first in the list. Set 'featureColumns' to the names of the
-- columns, in the same order. Implement `rowToFeature` and `featureToRow`.
--
-- 4. Implement 'GetFeatureConfig' and 'SetFeatureConfig' in
-- 'Galley.API.Teams.Features'. Empty instances will work fine unless this
-- feature requires custom logic.
--
-- 5. Add a public route to 'Wire.API.Routes.Public.Galley.Feature' and the
-- corresponding implementation in 'Galley.API.Public.Feature'.
--
-- 6. Add an internal route in 'Wire.API.Routes.Internal.Galley' and the
-- corresponding implementation in 'Galley.API.Internal'.
--
-- 7. If the feature should be configurable via Stern add routes to Stern.API.
-- Manually check that the swagger looks okay and works.
--
-- 8. In 'Galley.Types.Team', add a new data instance @DummyDefaults@ to
-- represent the server-wide feature defaults read from the configuration file.
-- In most cases, this should be a newtype over 'LockableFeature DummyConfig'.
-- Then derive all the instances like for the other features in that module.
-- Note that 'ParseFeatureDefaults' can be derived either via 'OptionalField'
-- or 'RequiredField', depending on whether the feature configuration should be
-- optional or required.
--
-- 9. If necessary, add configuration for the feature in
-- 'galley.integration.yaml', update the config map in
-- 'charts/galley/templates/configmap.yaml' and set defaults in
-- 'charts/galley/values.yaml'. Make sure that the configuration for CI matches
-- the local one, or adjust 'hack/helm_vars/wire-server/values.yaml'
-- accordingly.
--
-- 10. Add the default values of this feature in 'testAllFeatures'
-- ('Test.FeatureFlags'). Add feature-specific integration tests.
--
-- 11. Add a section to the documentation at an appropriate place
-- (e.g. 'docs/src/developer/reference/config-options.md' (if applicable) or
-- 'docs/src/understand/team-feature-settings.md')
class
  ( Default cfg,
    ToSchema cfg,
    Default (LockableFeature cfg),
    KnownSymbol (FeatureSymbol cfg),
    NpProject cfg Features
  ) =>
  IsFeatureConfig cfg
  where
  type FeatureSymbol cfg :: Symbol
  featureSingleton :: FeatureSingleton cfg

  objectSchema ::
    -- | Should be "pure MyFeatureConfig" if the feature doesn't have config,
    -- which results in a trivial empty schema and the "config" field being
    -- omitted/ignored in the JSON encoder / parser.
    ObjectSchema SwaggerDoc cfg

data FeatureSingleton cfg where
  FeatureSingletonGuestLinksConfig :: FeatureSingleton GuestLinksConfig
  FeatureSingletonLegalholdConfig :: FeatureSingleton LegalholdConfig
  FeatureSingletonSSOConfig :: FeatureSingleton SSOConfig
  FeatureSingletonSearchVisibilityAvailableConfig :: FeatureSingleton SearchVisibilityAvailableConfig
  FeatureSingletonValidateSAMLEmailsConfig :: FeatureSingleton ValidateSAMLEmailsConfig
  FeatureSingletonDigitalSignaturesConfig :: FeatureSingleton DigitalSignaturesConfig
  FeatureSingletonConferenceCallingConfig :: FeatureSingleton ConferenceCallingConfig
  FeatureSingletonSndFactorPasswordChallengeConfig :: FeatureSingleton SndFactorPasswordChallengeConfig
  FeatureSingletonSearchVisibilityInboundConfig :: FeatureSingleton SearchVisibilityInboundConfig
  FeatureSingletonClassifiedDomainsConfig :: FeatureSingleton ClassifiedDomainsConfig
  FeatureSingletonAppLockConfig :: FeatureSingleton AppLockConfig
  FeatureSingletonSelfDeletingMessagesConfig :: FeatureSingleton SelfDeletingMessagesConfig
  FeatureSingletonFileSharingConfig :: FeatureSingleton FileSharingConfig
  FeatureSingletonMLSConfig :: FeatureSingleton MLSConfig
  FeatureSingletonExposeInvitationURLsToTeamAdminConfig :: FeatureSingleton ExposeInvitationURLsToTeamAdminConfig
  FeatureSingletonOutlookCalIntegrationConfig :: FeatureSingleton OutlookCalIntegrationConfig
  FeatureSingletonMlsE2EIdConfig :: FeatureSingleton MlsE2EIdConfig
  FeatureSingletonMlsMigrationConfig :: FeatureSingleton MlsMigrationConfig
  FeatureSingletonEnforceFileDownloadLocationConfig :: FeatureSingleton EnforceFileDownloadLocationConfig
  FeatureSingletonLimitedEventFanoutConfig :: FeatureSingleton LimitedEventFanoutConfig

type family DeprecatedFeatureName cfg :: Symbol

featureName :: forall cfg. (IsFeatureConfig cfg) => Text
featureName :: forall cfg. IsFeatureConfig cfg => Text
featureName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy (FeatureSymbol cfg) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(FeatureSymbol cfg))

featureNameBS :: forall cfg. (IsFeatureConfig cfg) => ByteString
featureNameBS :: forall cfg. IsFeatureConfig cfg => ByteString
featureNameBS = String -> ByteString
UTF8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy (FeatureSymbol cfg) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(FeatureSymbol cfg))

--------------------------------------------------------------------------------
-- DbFeature

-- | Feature data stored in the database, as a function of its default values.
newtype DbFeature cfg = DbFeature
  {forall cfg.
DbFeature cfg -> LockableFeature cfg -> LockableFeature cfg
applyDbFeature :: LockableFeature cfg -> LockableFeature cfg}
  deriving (NonEmpty (DbFeature cfg) -> DbFeature cfg
DbFeature cfg -> DbFeature cfg -> DbFeature cfg
(DbFeature cfg -> DbFeature cfg -> DbFeature cfg)
-> (NonEmpty (DbFeature cfg) -> DbFeature cfg)
-> (forall b. Integral b => b -> DbFeature cfg -> DbFeature cfg)
-> Semigroup (DbFeature cfg)
forall b. Integral b => b -> DbFeature cfg -> DbFeature cfg
forall cfg. NonEmpty (DbFeature cfg) -> DbFeature cfg
forall cfg. DbFeature cfg -> DbFeature cfg -> DbFeature cfg
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall cfg b. Integral b => b -> DbFeature cfg -> DbFeature cfg
$c<> :: forall cfg. DbFeature cfg -> DbFeature cfg -> DbFeature cfg
<> :: DbFeature cfg -> DbFeature cfg -> DbFeature cfg
$csconcat :: forall cfg. NonEmpty (DbFeature cfg) -> DbFeature cfg
sconcat :: NonEmpty (DbFeature cfg) -> DbFeature cfg
$cstimes :: forall cfg b. Integral b => b -> DbFeature cfg -> DbFeature cfg
stimes :: forall b. Integral b => b -> DbFeature cfg -> DbFeature cfg
Semigroup, Semigroup (DbFeature cfg)
DbFeature cfg
Semigroup (DbFeature cfg) =>
DbFeature cfg
-> (DbFeature cfg -> DbFeature cfg -> DbFeature cfg)
-> ([DbFeature cfg] -> DbFeature cfg)
-> Monoid (DbFeature cfg)
[DbFeature cfg] -> DbFeature cfg
DbFeature cfg -> DbFeature cfg -> DbFeature cfg
forall cfg. Semigroup (DbFeature cfg)
forall cfg. DbFeature cfg
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall cfg. [DbFeature cfg] -> DbFeature cfg
forall cfg. DbFeature cfg -> DbFeature cfg -> DbFeature cfg
$cmempty :: forall cfg. DbFeature cfg
mempty :: DbFeature cfg
$cmappend :: forall cfg. DbFeature cfg -> DbFeature cfg -> DbFeature cfg
mappend :: DbFeature cfg -> DbFeature cfg -> DbFeature cfg
$cmconcat :: forall cfg. [DbFeature cfg] -> DbFeature cfg
mconcat :: [DbFeature cfg] -> DbFeature cfg
Monoid) via Endo (LockableFeature cfg)

dbFeatureLockStatus :: LockStatus -> DbFeature cfg
dbFeatureLockStatus :: forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus LockStatus
s = (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall cfg.
(LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
DbFeature ((LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg)
-> (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall a b. (a -> b) -> a -> b
$ \LockableFeature cfg
w -> LockableFeature cfg
w {lockStatus = s}

dbFeatureStatus :: FeatureStatus -> DbFeature cfg
dbFeatureStatus :: forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus FeatureStatus
s = (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall cfg.
(LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
DbFeature ((LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg)
-> (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall a b. (a -> b) -> a -> b
$ \LockableFeature cfg
w -> LockableFeature cfg
w {status = s}

dbFeatureConfig :: cfg -> DbFeature cfg
dbFeatureConfig :: forall cfg. cfg -> DbFeature cfg
dbFeatureConfig cfg
c = (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall cfg.
(LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
DbFeature ((LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg)
-> (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall a b. (a -> b) -> a -> b
$ \LockableFeature cfg
w -> LockableFeature cfg
w {config = c}

dbFeatureModConfig :: (cfg -> cfg) -> DbFeature cfg
dbFeatureModConfig :: forall cfg. (cfg -> cfg) -> DbFeature cfg
dbFeatureModConfig cfg -> cfg
f = (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall cfg.
(LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
DbFeature ((LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg)
-> (LockableFeature cfg -> LockableFeature cfg) -> DbFeature cfg
forall a b. (a -> b) -> a -> b
$ \LockableFeature cfg
w -> LockableFeature cfg
w {config = f w.config}

----------------------------------------------------------------------
-- LockableFeature

-- [Note: unsettable features]
--
-- Some feature flags (e.g. sso) don't have a lock status stored in the
-- database. Instead, they are considered unlocked by default, but behave as if
-- they were locked, since they lack a public PUT endpoint.
--
-- This trick has caused a lot of confusion in the past, and cannot be extended
-- to flags that have non-trivial configuration. For this reason, we are in the
-- process of changing this mechanism to make it work like every other feature.
--
-- That means that such features will afterwards be toggled by setting their
-- lock status instead. And we'll have some logic in place to make the default
-- status when unlocked be enabled. This achieves a similar behaviour but with
-- fewer exceptional code paths.
--
-- See the implementation of 'computeFeature' for 'ConferenceCallingConfig' for
-- an example of this mechanism in practice.

data LockableFeature cfg = LockableFeature
  { forall cfg. LockableFeature cfg -> FeatureStatus
status :: FeatureStatus,
    forall cfg. LockableFeature cfg -> LockStatus
lockStatus :: LockStatus,
    forall cfg. LockableFeature cfg -> cfg
config :: cfg
  }
  deriving stock (LockableFeature cfg -> LockableFeature cfg -> Bool
(LockableFeature cfg -> LockableFeature cfg -> Bool)
-> (LockableFeature cfg -> LockableFeature cfg -> Bool)
-> Eq (LockableFeature cfg)
forall cfg.
Eq cfg =>
LockableFeature cfg -> LockableFeature cfg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall cfg.
Eq cfg =>
LockableFeature cfg -> LockableFeature cfg -> Bool
== :: LockableFeature cfg -> LockableFeature cfg -> Bool
$c/= :: forall cfg.
Eq cfg =>
LockableFeature cfg -> LockableFeature cfg -> Bool
/= :: LockableFeature cfg -> LockableFeature cfg -> Bool
Eq, Int -> LockableFeature cfg -> ShowS
[LockableFeature cfg] -> ShowS
LockableFeature cfg -> String
(Int -> LockableFeature cfg -> ShowS)
-> (LockableFeature cfg -> String)
-> ([LockableFeature cfg] -> ShowS)
-> Show (LockableFeature cfg)
forall cfg. Show cfg => Int -> LockableFeature cfg -> ShowS
forall cfg. Show cfg => [LockableFeature cfg] -> ShowS
forall cfg. Show cfg => LockableFeature cfg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall cfg. Show cfg => Int -> LockableFeature cfg -> ShowS
showsPrec :: Int -> LockableFeature cfg -> ShowS
$cshow :: forall cfg. Show cfg => LockableFeature cfg -> String
show :: LockableFeature cfg -> String
$cshowList :: forall cfg. Show cfg => [LockableFeature cfg] -> ShowS
showList :: [LockableFeature cfg] -> ShowS
Show)
  deriving ([LockableFeature cfg] -> Value
[LockableFeature cfg] -> Encoding
LockableFeature cfg -> Value
LockableFeature cfg -> Encoding
(LockableFeature cfg -> Value)
-> (LockableFeature cfg -> Encoding)
-> ([LockableFeature cfg] -> Value)
-> ([LockableFeature cfg] -> Encoding)
-> ToJSON (LockableFeature cfg)
forall cfg. IsFeatureConfig cfg => [LockableFeature cfg] -> Value
forall cfg.
IsFeatureConfig cfg =>
[LockableFeature cfg] -> Encoding
forall cfg. IsFeatureConfig cfg => LockableFeature cfg -> Value
forall cfg. IsFeatureConfig cfg => LockableFeature cfg -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall cfg. IsFeatureConfig cfg => LockableFeature cfg -> Value
toJSON :: LockableFeature cfg -> Value
$ctoEncoding :: forall cfg. IsFeatureConfig cfg => LockableFeature cfg -> Encoding
toEncoding :: LockableFeature cfg -> Encoding
$ctoJSONList :: forall cfg. IsFeatureConfig cfg => [LockableFeature cfg] -> Value
toJSONList :: [LockableFeature cfg] -> Value
$ctoEncodingList :: forall cfg.
IsFeatureConfig cfg =>
[LockableFeature cfg] -> Encoding
toEncodingList :: [LockableFeature cfg] -> Encoding
ToJSON, Value -> Parser [LockableFeature cfg]
Value -> Parser (LockableFeature cfg)
(Value -> Parser (LockableFeature cfg))
-> (Value -> Parser [LockableFeature cfg])
-> FromJSON (LockableFeature cfg)
forall cfg.
IsFeatureConfig cfg =>
Value -> Parser [LockableFeature cfg]
forall cfg.
IsFeatureConfig cfg =>
Value -> Parser (LockableFeature cfg)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall cfg.
IsFeatureConfig cfg =>
Value -> Parser (LockableFeature cfg)
parseJSON :: Value -> Parser (LockableFeature cfg)
$cparseJSONList :: forall cfg.
IsFeatureConfig cfg =>
Value -> Parser [LockableFeature cfg]
parseJSONList :: Value -> Parser [LockableFeature cfg]
FromJSON, Typeable (LockableFeature cfg)
Typeable (LockableFeature cfg) =>
(Proxy (LockableFeature cfg)
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (LockableFeature cfg)
Proxy (LockableFeature cfg)
-> Declare (Definitions Schema) NamedSchema
forall cfg.
(Typeable cfg, IsFeatureConfig cfg) =>
Typeable (LockableFeature cfg)
forall cfg.
(Typeable cfg, IsFeatureConfig cfg) =>
Proxy (LockableFeature cfg)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: forall cfg.
(Typeable cfg, IsFeatureConfig cfg) =>
Proxy (LockableFeature cfg)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (LockableFeature cfg)
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema (LockableFeature cfg)

instance (Default (LockableFeature cfg)) => Default (Feature cfg) where
  def :: Feature cfg
def = LockableFeature cfg -> Feature cfg
forall a. LockableFeature a -> Feature a
forgetLock LockableFeature cfg
forall a. Default a => a
def

-- | A feature that is disabled and locked.
defLockedFeature :: (Default cfg) => LockableFeature cfg
defLockedFeature :: forall cfg. Default cfg => LockableFeature cfg
defLockedFeature =
  LockableFeature
    { status :: FeatureStatus
status = FeatureStatus
FeatureStatusDisabled,
      lockStatus :: LockStatus
lockStatus = LockStatus
LockStatusLocked,
      $sel:config:LockableFeature :: cfg
config = cfg
forall a. Default a => a
def
    }

-- | A feature that is enabled and unlocked.
defUnlockedFeature :: (Default cfg) => LockableFeature cfg
defUnlockedFeature :: forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature =
  LockableFeature
    { status :: FeatureStatus
status = FeatureStatus
FeatureStatusEnabled,
      lockStatus :: LockStatus
lockStatus = LockStatus
LockStatusUnlocked,
      $sel:config:LockableFeature :: cfg
config = cfg
forall a. Default a => a
def
    }

instance (IsFeatureConfig cfg) => ToSchema (LockableFeature cfg) where
  schema :: ValueSchema NamedSwaggerDoc (LockableFeature cfg)
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeature cfg)
     (LockableFeature cfg)
-> ValueSchema NamedSwaggerDoc (LockableFeature cfg)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
name (SchemaP
   SwaggerDoc
   Object
   [Pair]
   (LockableFeature cfg)
   (LockableFeature cfg)
 -> ValueSchema NamedSwaggerDoc (LockableFeature cfg))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeature cfg)
     (LockableFeature cfg)
-> ValueSchema NamedSwaggerDoc (LockableFeature cfg)
forall a b. (a -> b) -> a -> b
$
      FeatureStatus -> LockStatus -> cfg -> LockableFeature cfg
forall cfg.
FeatureStatus -> LockStatus -> cfg -> LockableFeature cfg
LockableFeature
        (FeatureStatus -> LockStatus -> cfg -> LockableFeature cfg)
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeature cfg) FeatureStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeature cfg)
     (LockStatus -> cfg -> LockableFeature cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.status) (LockableFeature cfg -> FeatureStatus)
-> SchemaP SwaggerDoc Object [Pair] FeatureStatus FeatureStatus
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeature cfg) FeatureStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
-> SchemaP SwaggerDoc Object [Pair] FeatureStatus FeatureStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LockableFeature cfg)
  (LockStatus -> cfg -> LockableFeature cfg)
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeature cfg) LockStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeature cfg)
     (cfg -> LockableFeature cfg)
forall a b.
SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) a
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.lockStatus) (LockableFeature cfg -> LockStatus)
-> SchemaP SwaggerDoc Object [Pair] LockStatus LockStatus
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeature cfg) LockStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus
-> SchemaP SwaggerDoc Object [Pair] LockStatus LockStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"lockStatus" SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LockableFeature cfg)
  (cfg -> LockableFeature cfg)
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) cfg
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeature cfg)
     (LockableFeature cfg)
forall a b.
SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) a
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.config) (LockableFeature cfg -> cfg)
-> SchemaP SwaggerDoc Object [Pair] cfg cfg
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) cfg
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema @cfg
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LockableFeature cfg)
  (LockableFeature cfg)
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeature cfg) (Maybe FeatureTTL)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeature cfg)
     (LockableFeature cfg)
forall a b.
SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) a
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) b
-> SchemaP SwaggerDoc Object [Pair] (LockableFeature cfg) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* FeatureTTL -> LockableFeature cfg -> FeatureTTL
forall a b. a -> b -> a
const FeatureTTL
forall (u :: FeatureTTLUnit). FeatureTTL' u
FeatureTTLUnlimited
          (LockableFeature cfg -> FeatureTTL)
-> SchemaP SwaggerDoc Object [Pair] FeatureTTL (Maybe FeatureTTL)
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeature cfg) (Maybe FeatureTTL)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
-> SchemaP SwaggerDoc Object [Pair] FeatureTTL (Maybe FeatureTTL)
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
"ttl"
            (SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema :: ValueSchema NamedSwaggerDoc FeatureTTL)
    where
      inner :: ValueSchema NamedSwaggerDoc cfg
inner = forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema @cfg
      name :: Text
name = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (NamedSwaggerDoc -> Maybe Text
forall doc. HasName doc => doc -> Maybe Text
getName (ValueSchema NamedSwaggerDoc cfg -> NamedSwaggerDoc
forall ss v m a b. SchemaP ss v m a b -> ss
schemaDoc ValueSchema NamedSwaggerDoc cfg
inner)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".LockableFeature"

instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (LockableFeature cfg) where
  arbitrary :: Gen (LockableFeature cfg)
arbitrary = FeatureStatus -> LockStatus -> cfg -> LockableFeature cfg
forall cfg.
FeatureStatus -> LockStatus -> cfg -> LockableFeature cfg
LockableFeature (FeatureStatus -> LockStatus -> cfg -> LockableFeature cfg)
-> Gen FeatureStatus
-> Gen (LockStatus -> cfg -> LockableFeature cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen FeatureStatus
forall a. Arbitrary a => Gen a
arbitrary Gen (LockStatus -> cfg -> LockableFeature cfg)
-> Gen LockStatus -> Gen (cfg -> LockableFeature cfg)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen LockStatus
forall a. Arbitrary a => Gen a
arbitrary Gen (cfg -> LockableFeature cfg)
-> Gen cfg -> Gen (LockableFeature cfg)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen cfg
forall a. Arbitrary a => Gen a
arbitrary

----------------------------------------------------------------------
-- LockableFeaturePatch

data LockableFeaturePatch (cfg :: Type) = LockableFeaturePatch
  { forall cfg. LockableFeaturePatch cfg -> Maybe FeatureStatus
status :: Maybe FeatureStatus,
    forall cfg. LockableFeaturePatch cfg -> Maybe LockStatus
lockStatus :: Maybe LockStatus,
    forall cfg. LockableFeaturePatch cfg -> Maybe cfg
config :: Maybe cfg
  }
  deriving stock (LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool
(LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool)
-> (LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool)
-> Eq (LockableFeaturePatch cfg)
forall cfg.
Eq cfg =>
LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall cfg.
Eq cfg =>
LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool
== :: LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool
$c/= :: forall cfg.
Eq cfg =>
LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool
/= :: LockableFeaturePatch cfg -> LockableFeaturePatch cfg -> Bool
Eq, Int -> LockableFeaturePatch cfg -> ShowS
[LockableFeaturePatch cfg] -> ShowS
LockableFeaturePatch cfg -> String
(Int -> LockableFeaturePatch cfg -> ShowS)
-> (LockableFeaturePatch cfg -> String)
-> ([LockableFeaturePatch cfg] -> ShowS)
-> Show (LockableFeaturePatch cfg)
forall cfg. Show cfg => Int -> LockableFeaturePatch cfg -> ShowS
forall cfg. Show cfg => [LockableFeaturePatch cfg] -> ShowS
forall cfg. Show cfg => LockableFeaturePatch cfg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall cfg. Show cfg => Int -> LockableFeaturePatch cfg -> ShowS
showsPrec :: Int -> LockableFeaturePatch cfg -> ShowS
$cshow :: forall cfg. Show cfg => LockableFeaturePatch cfg -> String
show :: LockableFeaturePatch cfg -> String
$cshowList :: forall cfg. Show cfg => [LockableFeaturePatch cfg] -> ShowS
showList :: [LockableFeaturePatch cfg] -> ShowS
Show)
  deriving ([LockableFeaturePatch cfg] -> Value
[LockableFeaturePatch cfg] -> Encoding
LockableFeaturePatch cfg -> Value
LockableFeaturePatch cfg -> Encoding
(LockableFeaturePatch cfg -> Value)
-> (LockableFeaturePatch cfg -> Encoding)
-> ([LockableFeaturePatch cfg] -> Value)
-> ([LockableFeaturePatch cfg] -> Encoding)
-> ToJSON (LockableFeaturePatch cfg)
forall cfg. ToSchema cfg => [LockableFeaturePatch cfg] -> Value
forall cfg. ToSchema cfg => [LockableFeaturePatch cfg] -> Encoding
forall cfg. ToSchema cfg => LockableFeaturePatch cfg -> Value
forall cfg. ToSchema cfg => LockableFeaturePatch cfg -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall cfg. ToSchema cfg => LockableFeaturePatch cfg -> Value
toJSON :: LockableFeaturePatch cfg -> Value
$ctoEncoding :: forall cfg. ToSchema cfg => LockableFeaturePatch cfg -> Encoding
toEncoding :: LockableFeaturePatch cfg -> Encoding
$ctoJSONList :: forall cfg. ToSchema cfg => [LockableFeaturePatch cfg] -> Value
toJSONList :: [LockableFeaturePatch cfg] -> Value
$ctoEncodingList :: forall cfg. ToSchema cfg => [LockableFeaturePatch cfg] -> Encoding
toEncodingList :: [LockableFeaturePatch cfg] -> Encoding
ToJSON, Value -> Parser [LockableFeaturePatch cfg]
Value -> Parser (LockableFeaturePatch cfg)
(Value -> Parser (LockableFeaturePatch cfg))
-> (Value -> Parser [LockableFeaturePatch cfg])
-> FromJSON (LockableFeaturePatch cfg)
forall cfg.
ToSchema cfg =>
Value -> Parser [LockableFeaturePatch cfg]
forall cfg.
ToSchema cfg =>
Value -> Parser (LockableFeaturePatch cfg)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall cfg.
ToSchema cfg =>
Value -> Parser (LockableFeaturePatch cfg)
parseJSON :: Value -> Parser (LockableFeaturePatch cfg)
$cparseJSONList :: forall cfg.
ToSchema cfg =>
Value -> Parser [LockableFeaturePatch cfg]
parseJSONList :: Value -> Parser [LockableFeaturePatch cfg]
FromJSON, Typeable (LockableFeaturePatch cfg)
Typeable (LockableFeaturePatch cfg) =>
(Proxy (LockableFeaturePatch cfg)
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (LockableFeaturePatch cfg)
Proxy (LockableFeaturePatch cfg)
-> Declare (Definitions Schema) NamedSchema
forall cfg.
(Typeable cfg, ToSchema cfg) =>
Typeable (LockableFeaturePatch cfg)
forall cfg.
(Typeable cfg, ToSchema cfg) =>
Proxy (LockableFeaturePatch cfg)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: forall cfg.
(Typeable cfg, ToSchema cfg) =>
Proxy (LockableFeaturePatch cfg)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (LockableFeaturePatch cfg)
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema (LockableFeaturePatch cfg))

-- | The ToJSON implementation of `LockableFeaturePatch` will encode the trivial config as `"config": {}`
-- when the value is a `Just`, if it's `Nothing` it will be omitted, which is the important part.
instance (ToSchema cfg) => ToSchema (LockableFeaturePatch cfg) where
  schema :: ValueSchema NamedSwaggerDoc (LockableFeaturePatch cfg)
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (LockableFeaturePatch cfg)
-> ValueSchema NamedSwaggerDoc (LockableFeaturePatch cfg)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
name (SchemaP
   SwaggerDoc
   Object
   [Pair]
   (LockableFeaturePatch cfg)
   (LockableFeaturePatch cfg)
 -> ValueSchema NamedSwaggerDoc (LockableFeaturePatch cfg))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (LockableFeaturePatch cfg)
-> ValueSchema NamedSwaggerDoc (LockableFeaturePatch cfg)
forall a b. (a -> b) -> a -> b
$
      Maybe FeatureStatus
-> Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg
forall cfg.
Maybe FeatureStatus
-> Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg
LockableFeaturePatch
        (Maybe FeatureStatus
 -> Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe FeatureStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.status) (LockableFeaturePatch cfg -> Maybe FeatureStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe FeatureStatus)
     (Maybe FeatureStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe FeatureStatus)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] FeatureStatus (Maybe FeatureStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe FeatureStatus)
     (Maybe FeatureStatus)
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 FeatureStatus FeatureStatus
-> SchemaP
     SwaggerDoc Object [Pair] FeatureStatus (Maybe FeatureStatus)
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
"status" SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LockableFeaturePatch cfg)
  (Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe LockStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe cfg -> LockableFeaturePatch cfg)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) a
-> SchemaP SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.lockStatus) (LockableFeaturePatch cfg -> Maybe LockStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe LockStatus) (Maybe LockStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe LockStatus)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] LockStatus (Maybe LockStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe LockStatus) (Maybe LockStatus)
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 LockStatus LockStatus
-> SchemaP SwaggerDoc Object [Pair] LockStatus (Maybe LockStatus)
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
"lockStatus" SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LockableFeaturePatch cfg)
  (Maybe cfg -> LockableFeaturePatch cfg)
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) (Maybe cfg)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (LockableFeaturePatch cfg)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) a
-> SchemaP SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.config) (LockableFeaturePatch cfg -> Maybe cfg)
-> SchemaP SwaggerDoc Object [Pair] (Maybe cfg) (Maybe cfg)
-> SchemaP
     SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) (Maybe cfg)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] cfg (Maybe cfg)
-> SchemaP SwaggerDoc Object [Pair] (Maybe cfg) (Maybe cfg)
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 cfg cfg
-> SchemaP SwaggerDoc Object [Pair] cfg (Maybe cfg)
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
"config" SchemaP NamedSwaggerDoc Value Value cfg cfg
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LockableFeaturePatch cfg)
  (LockableFeaturePatch cfg)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe FeatureTTL)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (LockableFeaturePatch cfg)
forall a b.
SchemaP SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) a
-> SchemaP SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) b
-> SchemaP SwaggerDoc Object [Pair] (LockableFeaturePatch cfg) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* FeatureTTL -> LockableFeaturePatch cfg -> FeatureTTL
forall a b. a -> b -> a
const FeatureTTL
forall (u :: FeatureTTLUnit). FeatureTTL' u
FeatureTTLUnlimited
          (LockableFeaturePatch cfg -> FeatureTTL)
-> SchemaP SwaggerDoc Object [Pair] FeatureTTL (Maybe FeatureTTL)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeaturePatch cfg)
     (Maybe FeatureTTL)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
-> SchemaP SwaggerDoc Object [Pair] FeatureTTL (Maybe FeatureTTL)
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
"ttl"
            (SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema :: ValueSchema NamedSwaggerDoc FeatureTTL)
    where
      inner :: SchemaP NamedSwaggerDoc Value Value cfg cfg
inner = forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema @cfg
      name :: Text
name = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (NamedSwaggerDoc -> Maybe Text
forall doc. HasName doc => doc -> Maybe Text
getName (SchemaP NamedSwaggerDoc Value Value cfg cfg -> NamedSwaggerDoc
forall ss v m a b. SchemaP ss v m a b -> ss
schemaDoc SchemaP NamedSwaggerDoc Value Value cfg cfg
inner)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".LockableFeaturePatch"

instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (LockableFeaturePatch cfg) where
  arbitrary :: Gen (LockableFeaturePatch cfg)
arbitrary = Maybe FeatureStatus
-> Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg
forall cfg.
Maybe FeatureStatus
-> Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg
LockableFeaturePatch (Maybe FeatureStatus
 -> Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg)
-> Gen (Maybe FeatureStatus)
-> Gen (Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe FeatureStatus)
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe LockStatus -> Maybe cfg -> LockableFeaturePatch cfg)
-> Gen (Maybe LockStatus)
-> Gen (Maybe cfg -> LockableFeaturePatch cfg)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe LockStatus)
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe cfg -> LockableFeaturePatch cfg)
-> Gen (Maybe cfg) -> Gen (LockableFeaturePatch cfg)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe cfg)
forall a. Arbitrary a => Gen a
arbitrary

----------------------------------------------------------------------
-- Feature

data Feature (cfg :: Type) = Feature
  { forall cfg. Feature cfg -> FeatureStatus
status :: FeatureStatus,
    forall cfg. Feature cfg -> cfg
config :: cfg
  }
  deriving stock (Feature cfg -> Feature cfg -> Bool
(Feature cfg -> Feature cfg -> Bool)
-> (Feature cfg -> Feature cfg -> Bool) -> Eq (Feature cfg)
forall cfg. Eq cfg => Feature cfg -> Feature cfg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall cfg. Eq cfg => Feature cfg -> Feature cfg -> Bool
== :: Feature cfg -> Feature cfg -> Bool
$c/= :: forall cfg. Eq cfg => Feature cfg -> Feature cfg -> Bool
/= :: Feature cfg -> Feature cfg -> Bool
Eq, Int -> Feature cfg -> ShowS
[Feature cfg] -> ShowS
Feature cfg -> String
(Int -> Feature cfg -> ShowS)
-> (Feature cfg -> String)
-> ([Feature cfg] -> ShowS)
-> Show (Feature cfg)
forall cfg. Show cfg => Int -> Feature cfg -> ShowS
forall cfg. Show cfg => [Feature cfg] -> ShowS
forall cfg. Show cfg => Feature cfg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall cfg. Show cfg => Int -> Feature cfg -> ShowS
showsPrec :: Int -> Feature cfg -> ShowS
$cshow :: forall cfg. Show cfg => Feature cfg -> String
show :: Feature cfg -> String
$cshowList :: forall cfg. Show cfg => [Feature cfg] -> ShowS
showList :: [Feature cfg] -> ShowS
Show, (forall x. Feature cfg -> Rep (Feature cfg) x)
-> (forall x. Rep (Feature cfg) x -> Feature cfg)
-> Generic (Feature cfg)
forall x. Rep (Feature cfg) x -> Feature cfg
forall x. Feature cfg -> Rep (Feature cfg) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall cfg x. Rep (Feature cfg) x -> Feature cfg
forall cfg x. Feature cfg -> Rep (Feature cfg) x
$cfrom :: forall cfg x. Feature cfg -> Rep (Feature cfg) x
from :: forall x. Feature cfg -> Rep (Feature cfg) x
$cto :: forall cfg x. Rep (Feature cfg) x -> Feature cfg
to :: forall x. Rep (Feature cfg) x -> Feature cfg
Generic, Typeable, (forall a b. (a -> b) -> Feature a -> Feature b)
-> (forall a b. a -> Feature b -> Feature a) -> Functor Feature
forall a b. a -> Feature b -> Feature a
forall a b. (a -> b) -> Feature a -> Feature b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Feature a -> Feature b
fmap :: forall a b. (a -> b) -> Feature a -> Feature b
$c<$ :: forall a b. a -> Feature b -> Feature a
<$ :: forall a b. a -> Feature b -> Feature a
Functor)
  deriving ([Feature cfg] -> Value
[Feature cfg] -> Encoding
Feature cfg -> Value
Feature cfg -> Encoding
(Feature cfg -> Value)
-> (Feature cfg -> Encoding)
-> ([Feature cfg] -> Value)
-> ([Feature cfg] -> Encoding)
-> ToJSON (Feature cfg)
forall cfg. IsFeatureConfig cfg => [Feature cfg] -> Value
forall cfg. IsFeatureConfig cfg => [Feature cfg] -> Encoding
forall cfg. IsFeatureConfig cfg => Feature cfg -> Value
forall cfg. IsFeatureConfig cfg => Feature cfg -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall cfg. IsFeatureConfig cfg => Feature cfg -> Value
toJSON :: Feature cfg -> Value
$ctoEncoding :: forall cfg. IsFeatureConfig cfg => Feature cfg -> Encoding
toEncoding :: Feature cfg -> Encoding
$ctoJSONList :: forall cfg. IsFeatureConfig cfg => [Feature cfg] -> Value
toJSONList :: [Feature cfg] -> Value
$ctoEncodingList :: forall cfg. IsFeatureConfig cfg => [Feature cfg] -> Encoding
toEncodingList :: [Feature cfg] -> Encoding
ToJSON, Value -> Parser [Feature cfg]
Value -> Parser (Feature cfg)
(Value -> Parser (Feature cfg))
-> (Value -> Parser [Feature cfg]) -> FromJSON (Feature cfg)
forall cfg. IsFeatureConfig cfg => Value -> Parser [Feature cfg]
forall cfg. IsFeatureConfig cfg => Value -> Parser (Feature cfg)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall cfg. IsFeatureConfig cfg => Value -> Parser (Feature cfg)
parseJSON :: Value -> Parser (Feature cfg)
$cparseJSONList :: forall cfg. IsFeatureConfig cfg => Value -> Parser [Feature cfg]
parseJSONList :: Value -> Parser [Feature cfg]
FromJSON, Typeable (Feature cfg)
Typeable (Feature cfg) =>
(Proxy (Feature cfg) -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (Feature cfg)
Proxy (Feature cfg) -> Declare (Definitions Schema) NamedSchema
forall cfg.
(Typeable cfg, IsFeatureConfig cfg) =>
Typeable (Feature cfg)
forall cfg.
(Typeable cfg, IsFeatureConfig cfg) =>
Proxy (Feature cfg) -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: forall cfg.
(Typeable cfg, IsFeatureConfig cfg) =>
Proxy (Feature cfg) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (Feature cfg) -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema (Feature cfg))

instance (Arbitrary cfg) => Arbitrary (Feature cfg) where
  arbitrary :: Gen (Feature cfg)
arbitrary = FeatureStatus -> cfg -> Feature cfg
forall cfg. FeatureStatus -> cfg -> Feature cfg
Feature (FeatureStatus -> cfg -> Feature cfg)
-> Gen FeatureStatus -> Gen (cfg -> Feature cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen FeatureStatus
forall a. Arbitrary a => Gen a
arbitrary Gen (cfg -> Feature cfg) -> Gen cfg -> Gen (Feature cfg)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen cfg
forall a. Arbitrary a => Gen a
arbitrary

forgetLock :: LockableFeature a -> Feature a
forgetLock :: forall a. LockableFeature a -> Feature a
forgetLock LockableFeature a
ws = FeatureStatus -> a -> Feature a
forall cfg. FeatureStatus -> cfg -> Feature cfg
Feature LockableFeature a
ws.status LockableFeature a
ws.config

withLockStatus :: LockStatus -> Feature a -> LockableFeature a
withLockStatus :: forall a. LockStatus -> Feature a -> LockableFeature a
withLockStatus LockStatus
ls (Feature FeatureStatus
s a
c) = FeatureStatus -> LockStatus -> a -> LockableFeature a
forall cfg.
FeatureStatus -> LockStatus -> cfg -> LockableFeature cfg
LockableFeature FeatureStatus
s LockStatus
ls a
c

instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (Feature cfg) where
  schema :: ValueSchema NamedSwaggerDoc (Feature cfg)
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) (Feature cfg)
-> ValueSchema NamedSwaggerDoc (Feature cfg)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
name (SchemaP SwaggerDoc Object [Pair] (Feature cfg) (Feature cfg)
 -> ValueSchema NamedSwaggerDoc (Feature cfg))
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) (Feature cfg)
-> ValueSchema NamedSwaggerDoc (Feature cfg)
forall a b. (a -> b) -> a -> b
$
      FeatureStatus -> cfg -> Feature cfg
forall cfg. FeatureStatus -> cfg -> Feature cfg
Feature
        (FeatureStatus -> cfg -> Feature cfg)
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) FeatureStatus
-> SchemaP
     SwaggerDoc Object [Pair] (Feature cfg) (cfg -> Feature cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.status) (Feature cfg -> FeatureStatus)
-> SchemaP SwaggerDoc Object [Pair] FeatureStatus FeatureStatus
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) FeatureStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
-> SchemaP SwaggerDoc Object [Pair] FeatureStatus FeatureStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP SwaggerDoc Object [Pair] (Feature cfg) (cfg -> Feature cfg)
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) cfg
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) (Feature cfg)
forall a b.
SchemaP SwaggerDoc Object [Pair] (Feature cfg) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) a
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.config) (Feature cfg -> cfg)
-> SchemaP SwaggerDoc Object [Pair] cfg cfg
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) cfg
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema @cfg
        SchemaP SwaggerDoc Object [Pair] (Feature cfg) (Feature cfg)
-> SchemaP
     SwaggerDoc Object [Pair] (Feature cfg) (Maybe FeatureTTL)
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) (Feature cfg)
forall a b.
SchemaP SwaggerDoc Object [Pair] (Feature cfg) a
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) b
-> SchemaP SwaggerDoc Object [Pair] (Feature cfg) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* FeatureTTL -> Feature cfg -> FeatureTTL
forall a b. a -> b -> a
const FeatureTTL
forall (u :: FeatureTTLUnit). FeatureTTL' u
FeatureTTLUnlimited
          (Feature cfg -> FeatureTTL)
-> SchemaP SwaggerDoc Object [Pair] FeatureTTL (Maybe FeatureTTL)
-> SchemaP
     SwaggerDoc Object [Pair] (Feature cfg) (Maybe FeatureTTL)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
-> SchemaP SwaggerDoc Object [Pair] FeatureTTL (Maybe FeatureTTL)
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
"ttl"
            (SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema :: ValueSchema NamedSwaggerDoc FeatureTTL)
    where
      inner :: ValueSchema NamedSwaggerDoc cfg
inner = forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema @cfg
      name :: Text
name = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (NamedSwaggerDoc -> Maybe Text
forall doc. HasName doc => doc -> Maybe Text
getName (ValueSchema NamedSwaggerDoc cfg -> NamedSwaggerDoc
forall ss v m a b. SchemaP ss v m a b -> ss
schemaDoc ValueSchema NamedSwaggerDoc cfg
inner)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Feature"

----------------------------------------------------------------------
-- FeatureTTL

-- Using Word to avoid dealing with negative numbers.
-- Ideally we would also not support zero.
-- Currently a TTL=0 is ignored on the cassandra side.
data FeatureTTL' (u :: FeatureTTLUnit)
  = -- | actually, unit depends on phantom type.
    FeatureTTLSeconds Word
  | FeatureTTLUnlimited
  deriving stock (FeatureTTL' u -> FeatureTTL' u -> Bool
(FeatureTTL' u -> FeatureTTL' u -> Bool)
-> (FeatureTTL' u -> FeatureTTL' u -> Bool) -> Eq (FeatureTTL' u)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (u :: FeatureTTLUnit).
FeatureTTL' u -> FeatureTTL' u -> Bool
$c== :: forall (u :: FeatureTTLUnit).
FeatureTTL' u -> FeatureTTL' u -> Bool
== :: FeatureTTL' u -> FeatureTTL' u -> Bool
$c/= :: forall (u :: FeatureTTLUnit).
FeatureTTL' u -> FeatureTTL' u -> Bool
/= :: FeatureTTL' u -> FeatureTTL' u -> Bool
Eq, Int -> FeatureTTL' u -> ShowS
[FeatureTTL' u] -> ShowS
FeatureTTL' u -> String
(Int -> FeatureTTL' u -> ShowS)
-> (FeatureTTL' u -> String)
-> ([FeatureTTL' u] -> ShowS)
-> Show (FeatureTTL' u)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (u :: FeatureTTLUnit). Int -> FeatureTTL' u -> ShowS
forall (u :: FeatureTTLUnit). [FeatureTTL' u] -> ShowS
forall (u :: FeatureTTLUnit). FeatureTTL' u -> String
$cshowsPrec :: forall (u :: FeatureTTLUnit). Int -> FeatureTTL' u -> ShowS
showsPrec :: Int -> FeatureTTL' u -> ShowS
$cshow :: forall (u :: FeatureTTLUnit). FeatureTTL' u -> String
show :: FeatureTTL' u -> String
$cshowList :: forall (u :: FeatureTTLUnit). [FeatureTTL' u] -> ShowS
showList :: [FeatureTTL' u] -> ShowS
Show, (forall x. FeatureTTL' u -> Rep (FeatureTTL' u) x)
-> (forall x. Rep (FeatureTTL' u) x -> FeatureTTL' u)
-> Generic (FeatureTTL' u)
forall x. Rep (FeatureTTL' u) x -> FeatureTTL' u
forall x. FeatureTTL' u -> Rep (FeatureTTL' u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (u :: FeatureTTLUnit) x.
Rep (FeatureTTL' u) x -> FeatureTTL' u
forall (u :: FeatureTTLUnit) x.
FeatureTTL' u -> Rep (FeatureTTL' u) x
$cfrom :: forall (u :: FeatureTTLUnit) x.
FeatureTTL' u -> Rep (FeatureTTL' u) x
from :: forall x. FeatureTTL' u -> Rep (FeatureTTL' u) x
$cto :: forall (u :: FeatureTTLUnit) x.
Rep (FeatureTTL' u) x -> FeatureTTL' u
to :: forall x. Rep (FeatureTTL' u) x -> FeatureTTL' u
Generic)

data FeatureTTLUnit = FeatureTTLUnitSeconds | FeatureTTLUnitDays

type FeatureTTL = FeatureTTL' 'FeatureTTLUnitSeconds

type FeatureTTLDays = FeatureTTL' 'FeatureTTLUnitDays

instance Arbitrary FeatureTTL where
  arbitrary :: Gen FeatureTTL
arbitrary =
    (Word -> FeatureTTL
forall {u :: FeatureTTLUnit}. Word -> FeatureTTL' u
nonZero (Word -> FeatureTTL) -> Gen Word -> Gen FeatureTTL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word
forall a. Arbitrary a => Gen a
arbitrary)
      Gen FeatureTTL -> (FeatureTTL -> Bool) -> Gen FeatureTTL
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ( \case
                     -- A very short TTL (<= 2) can cause race conditions in the integration tests
                     FeatureTTLSeconds Word
n -> Word
n Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
2
                     FeatureTTL
_ -> Bool
True
                 )
    where
      nonZero :: Word -> FeatureTTL' u
nonZero Word
0 = FeatureTTL' u
forall (u :: FeatureTTLUnit). FeatureTTL' u
FeatureTTLUnlimited
      nonZero Word
n = Word -> FeatureTTL' u
forall {u :: FeatureTTLUnit}. Word -> FeatureTTL' u
FeatureTTLSeconds Word
n

instance ToSchema FeatureTTL where
  schema :: SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
schema = NamedSwaggerDoc
-> (Value -> Parser FeatureTTL)
-> (FeatureTTL -> Maybe Value)
-> SchemaP NamedSwaggerDoc Value Value FeatureTTL FeatureTTL
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema NamedSwaggerDoc
ttlDoc Value -> Parser FeatureTTL
toTTL FeatureTTL -> Maybe Value
fromTTL
    where
      ttlDoc :: NamedSwaggerDoc
      ttlDoc :: NamedSwaggerDoc
ttlDoc = forall a. ToSchema a => NamedSwaggerDoc
swaggerDoc @Word NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& (Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Value -> Identity (Maybe Value))
    -> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Value -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"unlimited"

      toTTL :: A.Value -> A.Parser FeatureTTL
      toTTL :: Value -> Parser FeatureTTL
toTTL Value
v = Value -> Parser FeatureTTL
parseUnlimited Value
v Parser FeatureTTL -> Parser FeatureTTL -> Parser FeatureTTL
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser FeatureTTL
parseSeconds Value
v

      parseUnlimited :: A.Value -> A.Parser FeatureTTL
      parseUnlimited :: Value -> Parser FeatureTTL
parseUnlimited =
        String -> (Text -> Parser FeatureTTL) -> Value -> Parser FeatureTTL
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"FeatureTTL" ((Text -> Parser FeatureTTL) -> Value -> Parser FeatureTTL)
-> (Text -> Parser FeatureTTL) -> Value -> Parser FeatureTTL
forall a b. (a -> b) -> a -> b
$
          \Text
t ->
            if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"unlimited" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0"
              then FeatureTTL -> Parser FeatureTTL
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureTTL
forall (u :: FeatureTTLUnit). FeatureTTL' u
FeatureTTLUnlimited
              else String -> Parser FeatureTTL
forall a. String -> Parser a
A.parseFail String
"Expected ''unlimited' or '0'."

      parseSeconds :: A.Value -> A.Parser FeatureTTL
      parseSeconds :: Value -> Parser FeatureTTL
parseSeconds = String
-> (Scientific -> Parser FeatureTTL) -> Value -> Parser FeatureTTL
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
A.withScientific String
"FeatureTTL" ((Scientific -> Parser FeatureTTL) -> Value -> Parser FeatureTTL)
-> (Scientific -> Parser FeatureTTL) -> Value -> Parser FeatureTTL
forall a b. (a -> b) -> a -> b
$
        \Scientific
s -> case Scientific -> Maybe Word
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
s of
          Just Word
0 -> String -> Parser FeatureTTL
forall a. HasCallStack => String -> a
error String
"impossible (this would have parsed in `parseUnlimited` above)."
          Just Word
i -> FeatureTTL -> Parser FeatureTTL
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FeatureTTL -> Parser FeatureTTL)
-> (Word -> FeatureTTL) -> Word -> Parser FeatureTTL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> FeatureTTL
forall {u :: FeatureTTLUnit}. Word -> FeatureTTL' u
FeatureTTLSeconds (Word -> Parser FeatureTTL) -> Word -> Parser FeatureTTL
forall a b. (a -> b) -> a -> b
$ Word
i
          Maybe Word
Nothing -> String -> Parser FeatureTTL
forall a. String -> Parser a
A.parseFail String
"Expected an positive integer."

      fromTTL :: FeatureTTL -> Maybe A.Value
      fromTTL :: FeatureTTL -> Maybe Value
fromTTL FeatureTTL
FeatureTTLUnlimited = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"unlimited"
      fromTTL (FeatureTTLSeconds Word
0) = Maybe Value
forall a. Maybe a
Nothing -- Should be unlimited
      fromTTL (FeatureTTLSeconds Word
s) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Word -> Value
forall a. ToJSON a => a -> Value
A.toJSON Word
s

instance ToHttpApiData (FeatureTTL' u) where
  toQueryParam :: FeatureTTL' u -> Text
toQueryParam = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (FeatureTTL' u -> ByteString) -> FeatureTTL' u -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeatureTTL' u -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance FromHttpApiData (FeatureTTL' u) where
  parseQueryParam :: Text -> Either Text (FeatureTTL' u)
parseQueryParam = Text -> Maybe (FeatureTTL' u) -> Either Text (FeatureTTL' u)
forall a b. a -> Maybe b -> Either a b
maybeToEither Text
invalidTTLErrorString (Maybe (FeatureTTL' u) -> Either Text (FeatureTTL' u))
-> (Text -> Maybe (FeatureTTL' u))
-> Text
-> Either Text (FeatureTTL' u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (FeatureTTL' u)
forall a. FromByteString a => ByteString -> Maybe a
fromByteString (ByteString -> Maybe (FeatureTTL' u))
-> (Text -> ByteString) -> Text -> Maybe (FeatureTTL' u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

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

instance ToByteString (FeatureTTL' u) where
  builder :: FeatureTTL' u -> Builder
builder FeatureTTL' u
FeatureTTLUnlimited = Builder
"unlimited"
  builder (FeatureTTLSeconds Word
d) = (Text -> Builder
forall a. ToByteString a => a -> Builder
builder (Text -> Builder) -> (Word -> Text) -> Word -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack (String -> Text) -> (Word -> String) -> Word -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> String
forall a. Show a => a -> String
show) Word
d

instance FromByteString (FeatureTTL' u) where
  parser :: Parser (FeatureTTL' u)
parser =
    Parser ByteString
Parser.takeByteString Parser ByteString
-> (ByteString -> Parser (FeatureTTL' u)) -> Parser (FeatureTTL' u)
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
>>= \ByteString
b ->
      case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
b of
        Right Text
"unlimited" -> FeatureTTL' u -> Parser (FeatureTTL' u)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureTTL' u
forall (u :: FeatureTTLUnit). FeatureTTL' u
FeatureTTLUnlimited
        Right Text
d -> case String -> Either String Word
forall a. Read a => String -> Either String a
readEither (String -> Either String Word)
-> (Text -> String) -> Text -> Either String Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Either String Word) -> Text -> Either String Word
forall a b. (a -> b) -> a -> b
$ Text
d of
          Left String
_ -> String -> Parser (FeatureTTL' u)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FeatureTTL' u))
-> String -> Parser (FeatureTTL' u)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
invalidTTLErrorString
          Right Word
d' -> FeatureTTL' u -> Parser (FeatureTTL' u)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FeatureTTL' u -> Parser (FeatureTTL' u))
-> (Word -> FeatureTTL' u) -> Word -> Parser (FeatureTTL' u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> FeatureTTL' u
forall {u :: FeatureTTLUnit}. Word -> FeatureTTL' u
FeatureTTLSeconds (Word -> Parser (FeatureTTL' u)) -> Word -> Parser (FeatureTTL' u)
forall a b. (a -> b) -> a -> b
$ Word
d'
        Left UnicodeException
_ -> String -> Parser (FeatureTTL' u)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FeatureTTL' u))
-> String -> Parser (FeatureTTL' u)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
invalidTTLErrorString

instance Cass.Cql FeatureTTL where
  ctype :: Tagged FeatureTTL ColumnType
ctype = ColumnType -> Tagged FeatureTTL ColumnType
forall a b. b -> Tagged a b
Cass.Tagged ColumnType
Cass.IntColumn

  -- Passing TTL = 0 to Cassandra removes the TTL.
  -- It does not instantly revert back.
  fromCql :: Value -> Either String FeatureTTL
fromCql (Cass.CqlInt Int32
0) = FeatureTTL -> Either String FeatureTTL
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureTTL
forall (u :: FeatureTTLUnit). FeatureTTL' u
FeatureTTLUnlimited
  fromCql (Cass.CqlInt Int32
n) = FeatureTTL -> Either String FeatureTTL
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FeatureTTL -> Either String FeatureTTL)
-> (Int32 -> FeatureTTL) -> Int32 -> Either String FeatureTTL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> FeatureTTL
forall {u :: FeatureTTLUnit}. Word -> FeatureTTL' u
FeatureTTLSeconds (Word -> FeatureTTL) -> (Int32 -> Word) -> Int32 -> FeatureTTL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Either String FeatureTTL)
-> Int32 -> Either String FeatureTTL
forall a b. (a -> b) -> a -> b
$ Int32
n
  fromCql Value
_ = String -> Either String FeatureTTL
forall a b. a -> Either a b
Left String
"fromCql: TTLValue: CqlInt expected"

  toCql :: FeatureTTL -> Value
toCql FeatureTTL
FeatureTTLUnlimited = Int32 -> Value
Cass.CqlInt Int32
0
  toCql (FeatureTTLSeconds Word
d) = Int32 -> Value
Cass.CqlInt (Int32 -> Value) -> (Word -> Int32) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Value) -> Word -> Value
forall a b. (a -> b) -> a -> b
$ Word
d

invalidTTLErrorString :: Text
invalidTTLErrorString :: Text
invalidTTLErrorString = Text
"Invalid FeatureTTLSeconds: must be a positive integer or 'unlimited.'"

-- LockStatus

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

instance FromHttpApiData LockStatus where
  parseUrlPiece :: Text -> Either Text LockStatus
parseUrlPiece = Text -> Maybe LockStatus -> Either Text LockStatus
forall a b. a -> Maybe b -> Either a b
maybeToEither Text
"Invalid lock status" (Maybe LockStatus -> Either Text LockStatus)
-> (Text -> Maybe LockStatus) -> Text -> Either Text LockStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe LockStatus
forall a. FromByteString a => ByteString -> Maybe a
fromByteString (ByteString -> Maybe LockStatus)
-> (Text -> ByteString) -> Text -> Maybe LockStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance ToSchema LockStatus where
  schema :: SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus
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
"LockStatus" (SchemaP [Value] Text (Alt Maybe Text) LockStatus LockStatus
 -> SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus)
-> SchemaP [Value] Text (Alt Maybe Text) LockStatus LockStatus
-> SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) LockStatus LockStatus]
-> SchemaP [Value] Text (Alt Maybe Text) LockStatus LockStatus
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> LockStatus
-> SchemaP [Value] Text (Alt Maybe Text) LockStatus LockStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"locked" LockStatus
LockStatusLocked,
          Text
-> LockStatus
-> SchemaP [Value] Text (Alt Maybe Text) LockStatus LockStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"unlocked" LockStatus
LockStatusUnlocked
        ]

instance S.ToParamSchema LockStatus where
  toParamSchema :: Proxy LockStatus -> Schema
toParamSchema Proxy LockStatus
_ = 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)
S.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
S.OpenApiString Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
Lens' Schema (Maybe [Value])
S.enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Value
"locked", Value
"unlocked"]

instance ToByteString LockStatus where
  builder :: LockStatus -> Builder
builder LockStatus
LockStatusLocked = Builder
"locked"
  builder LockStatus
LockStatusUnlocked = Builder
"unlocked"

instance FromByteString LockStatus where
  parser :: Parser LockStatus
parser =
    Parser ByteString
Parser.takeByteString Parser ByteString
-> (ByteString -> Parser LockStatus) -> Parser LockStatus
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
>>= \ByteString
b ->
      case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
b of
        Right Text
"locked" -> LockStatus -> Parser LockStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockStatus
LockStatusLocked
        Right Text
"unlocked" -> LockStatus -> Parser LockStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockStatus
LockStatusUnlocked
        Right Text
t -> String -> Parser LockStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LockStatus) -> String -> Parser LockStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid LockStatus: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t
        Left UnicodeException
e -> String -> Parser LockStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LockStatus) -> String -> Parser LockStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid LockStatus: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e

instance Cass.Cql LockStatus where
  ctype :: Tagged LockStatus ColumnType
ctype = ColumnType -> Tagged LockStatus ColumnType
forall a b. b -> Tagged a b
Cass.Tagged ColumnType
Cass.IntColumn

  fromCql :: Value -> Either String LockStatus
fromCql (Cass.CqlInt Int32
n) = case Int32
n of
    Int32
0 -> LockStatus -> Either String LockStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockStatus
LockStatusLocked
    Int32
1 -> LockStatus -> Either String LockStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockStatus
LockStatusUnlocked
    Int32
_ -> String -> Either String LockStatus
forall a b. a -> Either a b
Left String
"fromCql: Invalid LockStatus"
  fromCql Value
_ = String -> Either String LockStatus
forall a b. a -> Either a b
Left String
"fromCql: LockStatus: CqlInt expected"

  toCql :: LockStatus -> Value
toCql LockStatus
LockStatusLocked = Int32 -> Value
Cass.CqlInt Int32
0
  toCql LockStatus
LockStatusUnlocked = Int32 -> Value
Cass.CqlInt Int32
1

newtype LockStatusResponse = LockStatusResponse {LockStatusResponse -> LockStatus
_unlockStatus :: LockStatus}
  deriving stock (LockStatusResponse -> LockStatusResponse -> Bool
(LockStatusResponse -> LockStatusResponse -> Bool)
-> (LockStatusResponse -> LockStatusResponse -> Bool)
-> Eq LockStatusResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LockStatusResponse -> LockStatusResponse -> Bool
== :: LockStatusResponse -> LockStatusResponse -> Bool
$c/= :: LockStatusResponse -> LockStatusResponse -> Bool
/= :: LockStatusResponse -> LockStatusResponse -> Bool
Eq, Int -> LockStatusResponse -> ShowS
[LockStatusResponse] -> ShowS
LockStatusResponse -> String
(Int -> LockStatusResponse -> ShowS)
-> (LockStatusResponse -> String)
-> ([LockStatusResponse] -> ShowS)
-> Show LockStatusResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LockStatusResponse -> ShowS
showsPrec :: Int -> LockStatusResponse -> ShowS
$cshow :: LockStatusResponse -> String
show :: LockStatusResponse -> String
$cshowList :: [LockStatusResponse] -> ShowS
showList :: [LockStatusResponse] -> ShowS
Show, (forall x. LockStatusResponse -> Rep LockStatusResponse x)
-> (forall x. Rep LockStatusResponse x -> LockStatusResponse)
-> Generic LockStatusResponse
forall x. Rep LockStatusResponse x -> LockStatusResponse
forall x. LockStatusResponse -> Rep LockStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LockStatusResponse -> Rep LockStatusResponse x
from :: forall x. LockStatusResponse -> Rep LockStatusResponse x
$cto :: forall x. Rep LockStatusResponse x -> LockStatusResponse
to :: forall x. Rep LockStatusResponse x -> LockStatusResponse
Generic)
  deriving (Gen LockStatusResponse
Gen LockStatusResponse
-> (LockStatusResponse -> [LockStatusResponse])
-> Arbitrary LockStatusResponse
LockStatusResponse -> [LockStatusResponse]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LockStatusResponse
arbitrary :: Gen LockStatusResponse
$cshrink :: LockStatusResponse -> [LockStatusResponse]
shrink :: LockStatusResponse -> [LockStatusResponse]
Arbitrary) via (GenericUniform LockStatus)
  deriving ([LockStatusResponse] -> Value
[LockStatusResponse] -> Encoding
LockStatusResponse -> Value
LockStatusResponse -> Encoding
(LockStatusResponse -> Value)
-> (LockStatusResponse -> Encoding)
-> ([LockStatusResponse] -> Value)
-> ([LockStatusResponse] -> Encoding)
-> ToJSON LockStatusResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LockStatusResponse -> Value
toJSON :: LockStatusResponse -> Value
$ctoEncoding :: LockStatusResponse -> Encoding
toEncoding :: LockStatusResponse -> Encoding
$ctoJSONList :: [LockStatusResponse] -> Value
toJSONList :: [LockStatusResponse] -> Value
$ctoEncodingList :: [LockStatusResponse] -> Encoding
toEncodingList :: [LockStatusResponse] -> Encoding
ToJSON, Value -> Parser [LockStatusResponse]
Value -> Parser LockStatusResponse
(Value -> Parser LockStatusResponse)
-> (Value -> Parser [LockStatusResponse])
-> FromJSON LockStatusResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LockStatusResponse
parseJSON :: Value -> Parser LockStatusResponse
$cparseJSONList :: Value -> Parser [LockStatusResponse]
parseJSONList :: Value -> Parser [LockStatusResponse]
FromJSON, Typeable LockStatusResponse
Typeable LockStatusResponse =>
(Proxy LockStatusResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema LockStatusResponse
Proxy LockStatusResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy LockStatusResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy LockStatusResponse
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema LockStatusResponse)

instance ToSchema LockStatusResponse where
  schema :: ValueSchema NamedSwaggerDoc LockStatusResponse
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] LockStatusResponse LockStatusResponse
-> ValueSchema NamedSwaggerDoc LockStatusResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"LockStatusResponse" (SchemaP
   SwaggerDoc Object [Pair] LockStatusResponse LockStatusResponse
 -> ValueSchema NamedSwaggerDoc LockStatusResponse)
-> SchemaP
     SwaggerDoc Object [Pair] LockStatusResponse LockStatusResponse
-> ValueSchema NamedSwaggerDoc LockStatusResponse
forall a b. (a -> b) -> a -> b
$
      LockStatus -> LockStatusResponse
LockStatusResponse
        (LockStatus -> LockStatusResponse)
-> SchemaP SwaggerDoc Object [Pair] LockStatusResponse LockStatus
-> SchemaP
     SwaggerDoc Object [Pair] LockStatusResponse LockStatusResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LockStatusResponse -> LockStatus
_unlockStatus (LockStatusResponse -> LockStatus)
-> SchemaP SwaggerDoc Object [Pair] LockStatus LockStatus
-> SchemaP SwaggerDoc Object [Pair] LockStatusResponse LockStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus
-> SchemaP SwaggerDoc Object [Pair] LockStatus LockStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"lockStatus" SchemaP NamedSwaggerDoc Value Value LockStatus LockStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | Convert a feature coming from the database to its public form. This can be
-- overridden on a feature basis by implementing the `computeFeature` method of
-- the `GetFeatureConfig` class.
genericComputeFeature :: forall cfg. LockableFeature cfg -> DbFeature cfg -> LockableFeature cfg
genericComputeFeature :: forall cfg.
LockableFeature cfg -> DbFeature cfg -> LockableFeature cfg
genericComputeFeature LockableFeature cfg
defFeature DbFeature cfg
dbFeature =
  let feat :: LockableFeature cfg
feat = DbFeature cfg -> LockableFeature cfg -> LockableFeature cfg
forall cfg.
DbFeature cfg -> LockableFeature cfg -> LockableFeature cfg
applyDbFeature DbFeature cfg
dbFeature LockableFeature cfg
defFeature
   in case LockableFeature cfg
feat.lockStatus of
        LockStatus
LockStatusLocked -> LockableFeature cfg
defFeature {lockStatus = LockStatusLocked}
        LockStatus
LockStatusUnlocked -> LockableFeature cfg
feat

--------------------------------------------------------------------------------
-- GuestLinks feature

data GuestLinksConfig = GuestLinksConfig
  deriving stock (GuestLinksConfig -> GuestLinksConfig -> Bool
(GuestLinksConfig -> GuestLinksConfig -> Bool)
-> (GuestLinksConfig -> GuestLinksConfig -> Bool)
-> Eq GuestLinksConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GuestLinksConfig -> GuestLinksConfig -> Bool
== :: GuestLinksConfig -> GuestLinksConfig -> Bool
$c/= :: GuestLinksConfig -> GuestLinksConfig -> Bool
/= :: GuestLinksConfig -> GuestLinksConfig -> Bool
Eq, Int -> GuestLinksConfig -> ShowS
[GuestLinksConfig] -> ShowS
GuestLinksConfig -> String
(Int -> GuestLinksConfig -> ShowS)
-> (GuestLinksConfig -> String)
-> ([GuestLinksConfig] -> ShowS)
-> Show GuestLinksConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuestLinksConfig -> ShowS
showsPrec :: Int -> GuestLinksConfig -> ShowS
$cshow :: GuestLinksConfig -> String
show :: GuestLinksConfig -> String
$cshowList :: [GuestLinksConfig] -> ShowS
showList :: [GuestLinksConfig] -> ShowS
Show, (forall x. GuestLinksConfig -> Rep GuestLinksConfig x)
-> (forall x. Rep GuestLinksConfig x -> GuestLinksConfig)
-> Generic GuestLinksConfig
forall x. Rep GuestLinksConfig x -> GuestLinksConfig
forall x. GuestLinksConfig -> Rep GuestLinksConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GuestLinksConfig -> Rep GuestLinksConfig x
from :: forall x. GuestLinksConfig -> Rep GuestLinksConfig x
$cto :: forall x. Rep GuestLinksConfig x -> GuestLinksConfig
to :: forall x. Rep GuestLinksConfig x -> GuestLinksConfig
Generic)
  deriving (Gen GuestLinksConfig
Gen GuestLinksConfig
-> (GuestLinksConfig -> [GuestLinksConfig])
-> Arbitrary GuestLinksConfig
GuestLinksConfig -> [GuestLinksConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GuestLinksConfig
arbitrary :: Gen GuestLinksConfig
$cshrink :: GuestLinksConfig -> [GuestLinksConfig]
shrink :: GuestLinksConfig -> [GuestLinksConfig]
Arbitrary) via (GenericUniform GuestLinksConfig)
  deriving (Text
Text -> RenderableSymbol GuestLinksConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName GuestLinksConfig)

instance Default GuestLinksConfig where
  def :: GuestLinksConfig
def = GuestLinksConfig
GuestLinksConfig

instance ToSchema GuestLinksConfig where
  schema :: ValueSchema NamedSwaggerDoc GuestLinksConfig
schema = Text
-> SchemaP
     SwaggerDoc Object [Pair] GuestLinksConfig GuestLinksConfig
-> ValueSchema NamedSwaggerDoc GuestLinksConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"GuestLinksConfig" SchemaP SwaggerDoc Object [Pair] GuestLinksConfig GuestLinksConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

instance Default (LockableFeature GuestLinksConfig) where
  def :: LockableFeature GuestLinksConfig
def = LockableFeature GuestLinksConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature

instance IsFeatureConfig GuestLinksConfig where
  type FeatureSymbol GuestLinksConfig = "conversationGuestLinks"
  featureSingleton :: FeatureSingleton GuestLinksConfig
featureSingleton = FeatureSingleton GuestLinksConfig
FeatureSingletonGuestLinksConfig

  objectSchema :: SchemaP SwaggerDoc Object [Pair] GuestLinksConfig GuestLinksConfig
objectSchema = GuestLinksConfig
-> SchemaP
     SwaggerDoc Object [Pair] GuestLinksConfig GuestLinksConfig
forall a. a -> SchemaP SwaggerDoc Object [Pair] GuestLinksConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GuestLinksConfig
GuestLinksConfig

--------------------------------------------------------------------------------
-- Legalhold feature

data LegalholdConfig = LegalholdConfig
  deriving stock (LegalholdConfig -> LegalholdConfig -> Bool
(LegalholdConfig -> LegalholdConfig -> Bool)
-> (LegalholdConfig -> LegalholdConfig -> Bool)
-> Eq LegalholdConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LegalholdConfig -> LegalholdConfig -> Bool
== :: LegalholdConfig -> LegalholdConfig -> Bool
$c/= :: LegalholdConfig -> LegalholdConfig -> Bool
/= :: LegalholdConfig -> LegalholdConfig -> Bool
Eq, Int -> LegalholdConfig -> ShowS
[LegalholdConfig] -> ShowS
LegalholdConfig -> String
(Int -> LegalholdConfig -> ShowS)
-> (LegalholdConfig -> String)
-> ([LegalholdConfig] -> ShowS)
-> Show LegalholdConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LegalholdConfig -> ShowS
showsPrec :: Int -> LegalholdConfig -> ShowS
$cshow :: LegalholdConfig -> String
show :: LegalholdConfig -> String
$cshowList :: [LegalholdConfig] -> ShowS
showList :: [LegalholdConfig] -> ShowS
Show, (forall x. LegalholdConfig -> Rep LegalholdConfig x)
-> (forall x. Rep LegalholdConfig x -> LegalholdConfig)
-> Generic LegalholdConfig
forall x. Rep LegalholdConfig x -> LegalholdConfig
forall x. LegalholdConfig -> Rep LegalholdConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LegalholdConfig -> Rep LegalholdConfig x
from :: forall x. LegalholdConfig -> Rep LegalholdConfig x
$cto :: forall x. Rep LegalholdConfig x -> LegalholdConfig
to :: forall x. Rep LegalholdConfig x -> LegalholdConfig
Generic)
  deriving (Gen LegalholdConfig
Gen LegalholdConfig
-> (LegalholdConfig -> [LegalholdConfig])
-> Arbitrary LegalholdConfig
LegalholdConfig -> [LegalholdConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LegalholdConfig
arbitrary :: Gen LegalholdConfig
$cshrink :: LegalholdConfig -> [LegalholdConfig]
shrink :: LegalholdConfig -> [LegalholdConfig]
Arbitrary) via (GenericUniform LegalholdConfig)
  deriving (Text
Text -> RenderableSymbol LegalholdConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName LegalholdConfig)

instance Default LegalholdConfig where
  def :: LegalholdConfig
def = LegalholdConfig
LegalholdConfig

instance Default (LockableFeature LegalholdConfig) where
  def :: LockableFeature LegalholdConfig
def = LockableFeature LegalholdConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature {status = FeatureStatusDisabled}

instance IsFeatureConfig LegalholdConfig where
  type FeatureSymbol LegalholdConfig = "legalhold"
  featureSingleton :: FeatureSingleton LegalholdConfig
featureSingleton = FeatureSingleton LegalholdConfig
FeatureSingletonLegalholdConfig
  objectSchema :: ObjectSchema SwaggerDoc LegalholdConfig
objectSchema = LegalholdConfig -> ObjectSchema SwaggerDoc LegalholdConfig
forall a. a -> SchemaP SwaggerDoc Object [Pair] LegalholdConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LegalholdConfig
LegalholdConfig

instance ToSchema LegalholdConfig where
  schema :: ValueSchema NamedSwaggerDoc LegalholdConfig
schema = Text
-> ObjectSchema SwaggerDoc LegalholdConfig
-> ValueSchema NamedSwaggerDoc LegalholdConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"LegalholdConfig" ObjectSchema SwaggerDoc LegalholdConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

--------------------------------------------------------------------------------
-- SSO feature

-- | This feature does not have a PUT endpoint. See [Note: unsettable features].
data SSOConfig = SSOConfig
  deriving stock (SSOConfig -> SSOConfig -> Bool
(SSOConfig -> SSOConfig -> Bool)
-> (SSOConfig -> SSOConfig -> Bool) -> Eq SSOConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SSOConfig -> SSOConfig -> Bool
== :: SSOConfig -> SSOConfig -> Bool
$c/= :: SSOConfig -> SSOConfig -> Bool
/= :: SSOConfig -> SSOConfig -> Bool
Eq, Int -> SSOConfig -> ShowS
[SSOConfig] -> ShowS
SSOConfig -> String
(Int -> SSOConfig -> ShowS)
-> (SSOConfig -> String)
-> ([SSOConfig] -> ShowS)
-> Show SSOConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SSOConfig -> ShowS
showsPrec :: Int -> SSOConfig -> ShowS
$cshow :: SSOConfig -> String
show :: SSOConfig -> String
$cshowList :: [SSOConfig] -> ShowS
showList :: [SSOConfig] -> ShowS
Show, (forall x. SSOConfig -> Rep SSOConfig x)
-> (forall x. Rep SSOConfig x -> SSOConfig) -> Generic SSOConfig
forall x. Rep SSOConfig x -> SSOConfig
forall x. SSOConfig -> Rep SSOConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SSOConfig -> Rep SSOConfig x
from :: forall x. SSOConfig -> Rep SSOConfig x
$cto :: forall x. Rep SSOConfig x -> SSOConfig
to :: forall x. Rep SSOConfig x -> SSOConfig
Generic)
  deriving (Gen SSOConfig
Gen SSOConfig -> (SSOConfig -> [SSOConfig]) -> Arbitrary SSOConfig
SSOConfig -> [SSOConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SSOConfig
arbitrary :: Gen SSOConfig
$cshrink :: SSOConfig -> [SSOConfig]
shrink :: SSOConfig -> [SSOConfig]
Arbitrary) via (GenericUniform SSOConfig)
  deriving (Text
Text -> RenderableSymbol SSOConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName SSOConfig)

instance Default SSOConfig where
  def :: SSOConfig
def = SSOConfig
SSOConfig

instance Default (LockableFeature SSOConfig) where
  def :: LockableFeature SSOConfig
def = LockableFeature SSOConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature {status = FeatureStatusDisabled}

instance IsFeatureConfig SSOConfig where
  type FeatureSymbol SSOConfig = "sso"
  featureSingleton :: FeatureSingleton SSOConfig
featureSingleton = FeatureSingleton SSOConfig
FeatureSingletonSSOConfig
  objectSchema :: ObjectSchema SwaggerDoc SSOConfig
objectSchema = SSOConfig -> ObjectSchema SwaggerDoc SSOConfig
forall a. a -> SchemaP SwaggerDoc Object [Pair] SSOConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SSOConfig
SSOConfig

instance ToSchema SSOConfig where
  schema :: ValueSchema NamedSwaggerDoc SSOConfig
schema = Text
-> ObjectSchema SwaggerDoc SSOConfig
-> ValueSchema NamedSwaggerDoc SSOConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SSOConfig" ObjectSchema SwaggerDoc SSOConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

--------------------------------------------------------------------------------
-- SearchVisibility available feature

-- | Wether a team is allowed to change search visibility
-- See the handle of PUT /teams/:tid/search-visibility
data SearchVisibilityAvailableConfig = SearchVisibilityAvailableConfig
  deriving stock (SearchVisibilityAvailableConfig
-> SearchVisibilityAvailableConfig -> Bool
(SearchVisibilityAvailableConfig
 -> SearchVisibilityAvailableConfig -> Bool)
-> (SearchVisibilityAvailableConfig
    -> SearchVisibilityAvailableConfig -> Bool)
-> Eq SearchVisibilityAvailableConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchVisibilityAvailableConfig
-> SearchVisibilityAvailableConfig -> Bool
== :: SearchVisibilityAvailableConfig
-> SearchVisibilityAvailableConfig -> Bool
$c/= :: SearchVisibilityAvailableConfig
-> SearchVisibilityAvailableConfig -> Bool
/= :: SearchVisibilityAvailableConfig
-> SearchVisibilityAvailableConfig -> Bool
Eq, Int -> SearchVisibilityAvailableConfig -> ShowS
[SearchVisibilityAvailableConfig] -> ShowS
SearchVisibilityAvailableConfig -> String
(Int -> SearchVisibilityAvailableConfig -> ShowS)
-> (SearchVisibilityAvailableConfig -> String)
-> ([SearchVisibilityAvailableConfig] -> ShowS)
-> Show SearchVisibilityAvailableConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchVisibilityAvailableConfig -> ShowS
showsPrec :: Int -> SearchVisibilityAvailableConfig -> ShowS
$cshow :: SearchVisibilityAvailableConfig -> String
show :: SearchVisibilityAvailableConfig -> String
$cshowList :: [SearchVisibilityAvailableConfig] -> ShowS
showList :: [SearchVisibilityAvailableConfig] -> ShowS
Show, (forall x.
 SearchVisibilityAvailableConfig
 -> Rep SearchVisibilityAvailableConfig x)
-> (forall x.
    Rep SearchVisibilityAvailableConfig x
    -> SearchVisibilityAvailableConfig)
-> Generic SearchVisibilityAvailableConfig
forall x.
Rep SearchVisibilityAvailableConfig x
-> SearchVisibilityAvailableConfig
forall x.
SearchVisibilityAvailableConfig
-> Rep SearchVisibilityAvailableConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SearchVisibilityAvailableConfig
-> Rep SearchVisibilityAvailableConfig x
from :: forall x.
SearchVisibilityAvailableConfig
-> Rep SearchVisibilityAvailableConfig x
$cto :: forall x.
Rep SearchVisibilityAvailableConfig x
-> SearchVisibilityAvailableConfig
to :: forall x.
Rep SearchVisibilityAvailableConfig x
-> SearchVisibilityAvailableConfig
Generic)
  deriving (Gen SearchVisibilityAvailableConfig
Gen SearchVisibilityAvailableConfig
-> (SearchVisibilityAvailableConfig
    -> [SearchVisibilityAvailableConfig])
-> Arbitrary SearchVisibilityAvailableConfig
SearchVisibilityAvailableConfig
-> [SearchVisibilityAvailableConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SearchVisibilityAvailableConfig
arbitrary :: Gen SearchVisibilityAvailableConfig
$cshrink :: SearchVisibilityAvailableConfig
-> [SearchVisibilityAvailableConfig]
shrink :: SearchVisibilityAvailableConfig
-> [SearchVisibilityAvailableConfig]
Arbitrary) via (GenericUniform SearchVisibilityAvailableConfig)
  deriving (Text
Text -> RenderableSymbol SearchVisibilityAvailableConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName SearchVisibilityAvailableConfig)

instance Default SearchVisibilityAvailableConfig where
  def :: SearchVisibilityAvailableConfig
def = SearchVisibilityAvailableConfig
SearchVisibilityAvailableConfig

instance Default (LockableFeature SearchVisibilityAvailableConfig) where
  def :: LockableFeature SearchVisibilityAvailableConfig
def = LockableFeature SearchVisibilityAvailableConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature {status = FeatureStatusDisabled}

instance IsFeatureConfig SearchVisibilityAvailableConfig where
  type FeatureSymbol SearchVisibilityAvailableConfig = "searchVisibility"
  featureSingleton :: FeatureSingleton SearchVisibilityAvailableConfig
featureSingleton = FeatureSingleton SearchVisibilityAvailableConfig
FeatureSingletonSearchVisibilityAvailableConfig
  objectSchema :: ObjectSchema SwaggerDoc SearchVisibilityAvailableConfig
objectSchema = SearchVisibilityAvailableConfig
-> ObjectSchema SwaggerDoc SearchVisibilityAvailableConfig
forall a.
a
-> SchemaP
     SwaggerDoc Object [Pair] SearchVisibilityAvailableConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchVisibilityAvailableConfig
SearchVisibilityAvailableConfig

instance ToSchema SearchVisibilityAvailableConfig where
  schema :: ValueSchema NamedSwaggerDoc SearchVisibilityAvailableConfig
schema = Text
-> ObjectSchema SwaggerDoc SearchVisibilityAvailableConfig
-> ValueSchema NamedSwaggerDoc SearchVisibilityAvailableConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SearchVisibilityAvailableConfig" ObjectSchema SwaggerDoc SearchVisibilityAvailableConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

type instance DeprecatedFeatureName SearchVisibilityAvailableConfig = "search-visibility"

--------------------------------------------------------------------------------
-- ValidateSAMLEmails feature

-- | This feature does not have a PUT endpoint. See [Note: unsettable features].
data ValidateSAMLEmailsConfig = ValidateSAMLEmailsConfig
  deriving stock (ValidateSAMLEmailsConfig -> ValidateSAMLEmailsConfig -> Bool
(ValidateSAMLEmailsConfig -> ValidateSAMLEmailsConfig -> Bool)
-> (ValidateSAMLEmailsConfig -> ValidateSAMLEmailsConfig -> Bool)
-> Eq ValidateSAMLEmailsConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidateSAMLEmailsConfig -> ValidateSAMLEmailsConfig -> Bool
== :: ValidateSAMLEmailsConfig -> ValidateSAMLEmailsConfig -> Bool
$c/= :: ValidateSAMLEmailsConfig -> ValidateSAMLEmailsConfig -> Bool
/= :: ValidateSAMLEmailsConfig -> ValidateSAMLEmailsConfig -> Bool
Eq, Int -> ValidateSAMLEmailsConfig -> ShowS
[ValidateSAMLEmailsConfig] -> ShowS
ValidateSAMLEmailsConfig -> String
(Int -> ValidateSAMLEmailsConfig -> ShowS)
-> (ValidateSAMLEmailsConfig -> String)
-> ([ValidateSAMLEmailsConfig] -> ShowS)
-> Show ValidateSAMLEmailsConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidateSAMLEmailsConfig -> ShowS
showsPrec :: Int -> ValidateSAMLEmailsConfig -> ShowS
$cshow :: ValidateSAMLEmailsConfig -> String
show :: ValidateSAMLEmailsConfig -> String
$cshowList :: [ValidateSAMLEmailsConfig] -> ShowS
showList :: [ValidateSAMLEmailsConfig] -> ShowS
Show, (forall x.
 ValidateSAMLEmailsConfig -> Rep ValidateSAMLEmailsConfig x)
-> (forall x.
    Rep ValidateSAMLEmailsConfig x -> ValidateSAMLEmailsConfig)
-> Generic ValidateSAMLEmailsConfig
forall x.
Rep ValidateSAMLEmailsConfig x -> ValidateSAMLEmailsConfig
forall x.
ValidateSAMLEmailsConfig -> Rep ValidateSAMLEmailsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ValidateSAMLEmailsConfig -> Rep ValidateSAMLEmailsConfig x
from :: forall x.
ValidateSAMLEmailsConfig -> Rep ValidateSAMLEmailsConfig x
$cto :: forall x.
Rep ValidateSAMLEmailsConfig x -> ValidateSAMLEmailsConfig
to :: forall x.
Rep ValidateSAMLEmailsConfig x -> ValidateSAMLEmailsConfig
Generic)
  deriving (Gen ValidateSAMLEmailsConfig
Gen ValidateSAMLEmailsConfig
-> (ValidateSAMLEmailsConfig -> [ValidateSAMLEmailsConfig])
-> Arbitrary ValidateSAMLEmailsConfig
ValidateSAMLEmailsConfig -> [ValidateSAMLEmailsConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ValidateSAMLEmailsConfig
arbitrary :: Gen ValidateSAMLEmailsConfig
$cshrink :: ValidateSAMLEmailsConfig -> [ValidateSAMLEmailsConfig]
shrink :: ValidateSAMLEmailsConfig -> [ValidateSAMLEmailsConfig]
Arbitrary) via (GenericUniform ValidateSAMLEmailsConfig)
  deriving (Text
Text -> RenderableSymbol ValidateSAMLEmailsConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName ValidateSAMLEmailsConfig)

instance Default ValidateSAMLEmailsConfig where
  def :: ValidateSAMLEmailsConfig
def = ValidateSAMLEmailsConfig
ValidateSAMLEmailsConfig

instance ToSchema ValidateSAMLEmailsConfig where
  schema :: ValueSchema NamedSwaggerDoc ValidateSAMLEmailsConfig
schema = Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ValidateSAMLEmailsConfig
     ValidateSAMLEmailsConfig
-> ValueSchema NamedSwaggerDoc ValidateSAMLEmailsConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ValidateSAMLEmailsConfig" SchemaP
  SwaggerDoc
  Object
  [Pair]
  ValidateSAMLEmailsConfig
  ValidateSAMLEmailsConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

instance Default (LockableFeature ValidateSAMLEmailsConfig) where
  def :: LockableFeature ValidateSAMLEmailsConfig
def = LockableFeature ValidateSAMLEmailsConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature

instance IsFeatureConfig ValidateSAMLEmailsConfig where
  type FeatureSymbol ValidateSAMLEmailsConfig = "validateSAMLemails"
  featureSingleton :: FeatureSingleton ValidateSAMLEmailsConfig
featureSingleton = FeatureSingleton ValidateSAMLEmailsConfig
FeatureSingletonValidateSAMLEmailsConfig
  objectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  ValidateSAMLEmailsConfig
  ValidateSAMLEmailsConfig
objectSchema = ValidateSAMLEmailsConfig
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ValidateSAMLEmailsConfig
     ValidateSAMLEmailsConfig
forall a.
a -> SchemaP SwaggerDoc Object [Pair] ValidateSAMLEmailsConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidateSAMLEmailsConfig
ValidateSAMLEmailsConfig

type instance DeprecatedFeatureName ValidateSAMLEmailsConfig = "validate-saml-emails"

--------------------------------------------------------------------------------
-- DigitalSignatures feature

-- | This feature does not have a PUT endpoint. See [Note: unsettable features].
data DigitalSignaturesConfig = DigitalSignaturesConfig
  deriving stock (DigitalSignaturesConfig -> DigitalSignaturesConfig -> Bool
(DigitalSignaturesConfig -> DigitalSignaturesConfig -> Bool)
-> (DigitalSignaturesConfig -> DigitalSignaturesConfig -> Bool)
-> Eq DigitalSignaturesConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DigitalSignaturesConfig -> DigitalSignaturesConfig -> Bool
== :: DigitalSignaturesConfig -> DigitalSignaturesConfig -> Bool
$c/= :: DigitalSignaturesConfig -> DigitalSignaturesConfig -> Bool
/= :: DigitalSignaturesConfig -> DigitalSignaturesConfig -> Bool
Eq, Int -> DigitalSignaturesConfig -> ShowS
[DigitalSignaturesConfig] -> ShowS
DigitalSignaturesConfig -> String
(Int -> DigitalSignaturesConfig -> ShowS)
-> (DigitalSignaturesConfig -> String)
-> ([DigitalSignaturesConfig] -> ShowS)
-> Show DigitalSignaturesConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DigitalSignaturesConfig -> ShowS
showsPrec :: Int -> DigitalSignaturesConfig -> ShowS
$cshow :: DigitalSignaturesConfig -> String
show :: DigitalSignaturesConfig -> String
$cshowList :: [DigitalSignaturesConfig] -> ShowS
showList :: [DigitalSignaturesConfig] -> ShowS
Show, (forall x.
 DigitalSignaturesConfig -> Rep DigitalSignaturesConfig x)
-> (forall x.
    Rep DigitalSignaturesConfig x -> DigitalSignaturesConfig)
-> Generic DigitalSignaturesConfig
forall x. Rep DigitalSignaturesConfig x -> DigitalSignaturesConfig
forall x. DigitalSignaturesConfig -> Rep DigitalSignaturesConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DigitalSignaturesConfig -> Rep DigitalSignaturesConfig x
from :: forall x. DigitalSignaturesConfig -> Rep DigitalSignaturesConfig x
$cto :: forall x. Rep DigitalSignaturesConfig x -> DigitalSignaturesConfig
to :: forall x. Rep DigitalSignaturesConfig x -> DigitalSignaturesConfig
Generic)
  deriving (Gen DigitalSignaturesConfig
Gen DigitalSignaturesConfig
-> (DigitalSignaturesConfig -> [DigitalSignaturesConfig])
-> Arbitrary DigitalSignaturesConfig
DigitalSignaturesConfig -> [DigitalSignaturesConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen DigitalSignaturesConfig
arbitrary :: Gen DigitalSignaturesConfig
$cshrink :: DigitalSignaturesConfig -> [DigitalSignaturesConfig]
shrink :: DigitalSignaturesConfig -> [DigitalSignaturesConfig]
Arbitrary) via (GenericUniform DigitalSignaturesConfig)
  deriving (Text
Text -> RenderableSymbol DigitalSignaturesConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName DigitalSignaturesConfig)

instance Default DigitalSignaturesConfig where
  def :: DigitalSignaturesConfig
def = DigitalSignaturesConfig
DigitalSignaturesConfig

instance Default (LockableFeature DigitalSignaturesConfig) where
  def :: LockableFeature DigitalSignaturesConfig
def = LockableFeature DigitalSignaturesConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature {status = FeatureStatusDisabled}

instance IsFeatureConfig DigitalSignaturesConfig where
  type FeatureSymbol DigitalSignaturesConfig = "digitalSignatures"
  featureSingleton :: FeatureSingleton DigitalSignaturesConfig
featureSingleton = FeatureSingleton DigitalSignaturesConfig
FeatureSingletonDigitalSignaturesConfig
  objectSchema :: ObjectSchema SwaggerDoc DigitalSignaturesConfig
objectSchema = DigitalSignaturesConfig
-> ObjectSchema SwaggerDoc DigitalSignaturesConfig
forall a.
a -> SchemaP SwaggerDoc Object [Pair] DigitalSignaturesConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DigitalSignaturesConfig
DigitalSignaturesConfig

type instance DeprecatedFeatureName DigitalSignaturesConfig = "digital-signatures"

instance ToSchema DigitalSignaturesConfig where
  schema :: ValueSchema NamedSwaggerDoc DigitalSignaturesConfig
schema = Text
-> ObjectSchema SwaggerDoc DigitalSignaturesConfig
-> ValueSchema NamedSwaggerDoc DigitalSignaturesConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"DigitalSignaturesConfig" ObjectSchema SwaggerDoc DigitalSignaturesConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

--------------------------------------------------------------------------------
-- ConferenceCalling feature

data One2OneCalls = One2OneCallsTurn | One2OneCallsSft
  deriving stock (One2OneCalls -> One2OneCalls -> Bool
(One2OneCalls -> One2OneCalls -> Bool)
-> (One2OneCalls -> One2OneCalls -> Bool) -> Eq One2OneCalls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: One2OneCalls -> One2OneCalls -> Bool
== :: One2OneCalls -> One2OneCalls -> Bool
$c/= :: One2OneCalls -> One2OneCalls -> Bool
/= :: One2OneCalls -> One2OneCalls -> Bool
Eq, Int -> One2OneCalls -> ShowS
[One2OneCalls] -> ShowS
One2OneCalls -> String
(Int -> One2OneCalls -> ShowS)
-> (One2OneCalls -> String)
-> ([One2OneCalls] -> ShowS)
-> Show One2OneCalls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> One2OneCalls -> ShowS
showsPrec :: Int -> One2OneCalls -> ShowS
$cshow :: One2OneCalls -> String
show :: One2OneCalls -> String
$cshowList :: [One2OneCalls] -> ShowS
showList :: [One2OneCalls] -> ShowS
Show, (forall x. One2OneCalls -> Rep One2OneCalls x)
-> (forall x. Rep One2OneCalls x -> One2OneCalls)
-> Generic One2OneCalls
forall x. Rep One2OneCalls x -> One2OneCalls
forall x. One2OneCalls -> Rep One2OneCalls x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. One2OneCalls -> Rep One2OneCalls x
from :: forall x. One2OneCalls -> Rep One2OneCalls x
$cto :: forall x. Rep One2OneCalls x -> One2OneCalls
to :: forall x. Rep One2OneCalls x -> One2OneCalls
Generic)
  deriving (Gen One2OneCalls
Gen One2OneCalls
-> (One2OneCalls -> [One2OneCalls]) -> Arbitrary One2OneCalls
One2OneCalls -> [One2OneCalls]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen One2OneCalls
arbitrary :: Gen One2OneCalls
$cshrink :: One2OneCalls -> [One2OneCalls]
shrink :: One2OneCalls -> [One2OneCalls]
Arbitrary) via (GenericUniform One2OneCalls)

one2OneCallsFromUseSftFlag :: Bool -> One2OneCalls
one2OneCallsFromUseSftFlag :: Bool -> One2OneCalls
one2OneCallsFromUseSftFlag Bool
False = One2OneCalls
One2OneCallsTurn
one2OneCallsFromUseSftFlag Bool
True = One2OneCalls
One2OneCallsSft

instance Default One2OneCalls where
  def :: One2OneCalls
def = One2OneCalls
One2OneCallsTurn

instance Cass.Cql One2OneCalls where
  ctype :: Tagged One2OneCalls ColumnType
ctype = ColumnType -> Tagged One2OneCalls ColumnType
forall a b. b -> Tagged a b
Cass.Tagged ColumnType
Cass.IntColumn

  fromCql :: Value -> Either String One2OneCalls
fromCql (Cass.CqlInt Int32
n) = case Int32
n of
    Int32
0 -> One2OneCalls -> Either String One2OneCalls
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure One2OneCalls
One2OneCallsTurn
    Int32
1 -> One2OneCalls -> Either String One2OneCalls
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure One2OneCalls
One2OneCallsSft
    Int32
_ -> String -> Either String One2OneCalls
forall a b. a -> Either a b
Left String
"fromCql: Invalid One2OneCalls"
  fromCql Value
_ = String -> Either String One2OneCalls
forall a b. a -> Either a b
Left String
"fromCql: One2OneCalls: CqlInt expected"

  toCql :: One2OneCalls -> Value
toCql One2OneCalls
One2OneCallsTurn = Int32 -> Value
Cass.CqlInt Int32
0
  toCql One2OneCalls
One2OneCallsSft = Int32 -> Value
Cass.CqlInt Int32
1

data ConferenceCallingConfig = ConferenceCallingConfig
  { ConferenceCallingConfig -> One2OneCalls
one2OneCalls :: One2OneCalls
  }
  deriving stock (ConferenceCallingConfig -> ConferenceCallingConfig -> Bool
(ConferenceCallingConfig -> ConferenceCallingConfig -> Bool)
-> (ConferenceCallingConfig -> ConferenceCallingConfig -> Bool)
-> Eq ConferenceCallingConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConferenceCallingConfig -> ConferenceCallingConfig -> Bool
== :: ConferenceCallingConfig -> ConferenceCallingConfig -> Bool
$c/= :: ConferenceCallingConfig -> ConferenceCallingConfig -> Bool
/= :: ConferenceCallingConfig -> ConferenceCallingConfig -> Bool
Eq, Int -> ConferenceCallingConfig -> ShowS
[ConferenceCallingConfig] -> ShowS
ConferenceCallingConfig -> String
(Int -> ConferenceCallingConfig -> ShowS)
-> (ConferenceCallingConfig -> String)
-> ([ConferenceCallingConfig] -> ShowS)
-> Show ConferenceCallingConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConferenceCallingConfig -> ShowS
showsPrec :: Int -> ConferenceCallingConfig -> ShowS
$cshow :: ConferenceCallingConfig -> String
show :: ConferenceCallingConfig -> String
$cshowList :: [ConferenceCallingConfig] -> ShowS
showList :: [ConferenceCallingConfig] -> ShowS
Show, (forall x.
 ConferenceCallingConfig -> Rep ConferenceCallingConfig x)
-> (forall x.
    Rep ConferenceCallingConfig x -> ConferenceCallingConfig)
-> Generic ConferenceCallingConfig
forall x. Rep ConferenceCallingConfig x -> ConferenceCallingConfig
forall x. ConferenceCallingConfig -> Rep ConferenceCallingConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConferenceCallingConfig -> Rep ConferenceCallingConfig x
from :: forall x. ConferenceCallingConfig -> Rep ConferenceCallingConfig x
$cto :: forall x. Rep ConferenceCallingConfig x -> ConferenceCallingConfig
to :: forall x. Rep ConferenceCallingConfig x -> ConferenceCallingConfig
Generic)
  deriving (Gen ConferenceCallingConfig
Gen ConferenceCallingConfig
-> (ConferenceCallingConfig -> [ConferenceCallingConfig])
-> Arbitrary ConferenceCallingConfig
ConferenceCallingConfig -> [ConferenceCallingConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConferenceCallingConfig
arbitrary :: Gen ConferenceCallingConfig
$cshrink :: ConferenceCallingConfig -> [ConferenceCallingConfig]
shrink :: ConferenceCallingConfig -> [ConferenceCallingConfig]
Arbitrary) via (GenericUniform ConferenceCallingConfig)
  deriving (Text
Text -> RenderableSymbol ConferenceCallingConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName ConferenceCallingConfig)

instance Default ConferenceCallingConfig where
  def :: ConferenceCallingConfig
def = ConferenceCallingConfig {$sel:one2OneCalls:ConferenceCallingConfig :: One2OneCalls
one2OneCalls = One2OneCalls
forall a. Default a => a
def}

instance Default (LockableFeature ConferenceCallingConfig) where
  def :: LockableFeature ConferenceCallingConfig
def = LockableFeature ConferenceCallingConfig
forall cfg. Default cfg => LockableFeature cfg
defLockedFeature {status = FeatureStatusEnabled}

instance IsFeatureConfig ConferenceCallingConfig where
  type FeatureSymbol ConferenceCallingConfig = "conferenceCalling"
  featureSingleton :: FeatureSingleton ConferenceCallingConfig
featureSingleton = FeatureSingleton ConferenceCallingConfig
FeatureSingletonConferenceCallingConfig
  objectSchema :: ObjectSchema SwaggerDoc ConferenceCallingConfig
objectSchema = ConferenceCallingConfig
-> Maybe ConferenceCallingConfig -> ConferenceCallingConfig
forall a. a -> Maybe a -> a
fromMaybe ConferenceCallingConfig
forall a. Default a => a
def (Maybe ConferenceCallingConfig -> ConferenceCallingConfig)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConferenceCallingConfig
     (Maybe ConferenceCallingConfig)
-> ObjectSchema SwaggerDoc ConferenceCallingConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     ConferenceCallingConfig
     ConferenceCallingConfig
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConferenceCallingConfig
     (Maybe ConferenceCallingConfig)
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
"config" SchemaP
  NamedSwaggerDoc
  Value
  Value
  ConferenceCallingConfig
  ConferenceCallingConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance ToSchema ConferenceCallingConfig where
  schema :: SchemaP
  NamedSwaggerDoc
  Value
  Value
  ConferenceCallingConfig
  ConferenceCallingConfig
schema =
    Text
-> ObjectSchema SwaggerDoc ConferenceCallingConfig
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     ConferenceCallingConfig
     ConferenceCallingConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ConferenceCallingConfig" (ObjectSchema SwaggerDoc ConferenceCallingConfig
 -> SchemaP
      NamedSwaggerDoc
      Value
      Value
      ConferenceCallingConfig
      ConferenceCallingConfig)
-> ObjectSchema SwaggerDoc ConferenceCallingConfig
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     ConferenceCallingConfig
     ConferenceCallingConfig
forall a b. (a -> b) -> a -> b
$
      One2OneCalls -> ConferenceCallingConfig
ConferenceCallingConfig
        (One2OneCalls -> ConferenceCallingConfig)
-> SchemaP
     SwaggerDoc Object [Pair] ConferenceCallingConfig One2OneCalls
-> ObjectSchema SwaggerDoc ConferenceCallingConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((One2OneCalls -> One2OneCalls -> Bool
forall a. Eq a => a -> a -> Bool
== One2OneCalls
One2OneCallsSft) (One2OneCalls -> Bool)
-> (ConferenceCallingConfig -> One2OneCalls)
-> ConferenceCallingConfig
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConferenceCallingConfig -> One2OneCalls
one2OneCalls)
          (ConferenceCallingConfig -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool One2OneCalls
-> SchemaP
     SwaggerDoc Object [Pair] ConferenceCallingConfig One2OneCalls
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ( One2OneCalls
-> (Bool -> One2OneCalls) -> Maybe Bool -> One2OneCalls
forall b a. b -> (a -> b) -> Maybe a -> b
maybe One2OneCalls
forall a. Default a => a
def Bool -> One2OneCalls
one2OneCallsFromUseSftFlag
                 (Maybe Bool -> One2OneCalls)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool One2OneCalls
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
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
"useSFTForOneToOneCalls" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
             )

--------------------------------------------------------------------------------
-- SndFactorPasswordChallenge feature

data SndFactorPasswordChallengeConfig = SndFactorPasswordChallengeConfig
  deriving stock (SndFactorPasswordChallengeConfig
-> SndFactorPasswordChallengeConfig -> Bool
(SndFactorPasswordChallengeConfig
 -> SndFactorPasswordChallengeConfig -> Bool)
-> (SndFactorPasswordChallengeConfig
    -> SndFactorPasswordChallengeConfig -> Bool)
-> Eq SndFactorPasswordChallengeConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SndFactorPasswordChallengeConfig
-> SndFactorPasswordChallengeConfig -> Bool
== :: SndFactorPasswordChallengeConfig
-> SndFactorPasswordChallengeConfig -> Bool
$c/= :: SndFactorPasswordChallengeConfig
-> SndFactorPasswordChallengeConfig -> Bool
/= :: SndFactorPasswordChallengeConfig
-> SndFactorPasswordChallengeConfig -> Bool
Eq, Int -> SndFactorPasswordChallengeConfig -> ShowS
[SndFactorPasswordChallengeConfig] -> ShowS
SndFactorPasswordChallengeConfig -> String
(Int -> SndFactorPasswordChallengeConfig -> ShowS)
-> (SndFactorPasswordChallengeConfig -> String)
-> ([SndFactorPasswordChallengeConfig] -> ShowS)
-> Show SndFactorPasswordChallengeConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SndFactorPasswordChallengeConfig -> ShowS
showsPrec :: Int -> SndFactorPasswordChallengeConfig -> ShowS
$cshow :: SndFactorPasswordChallengeConfig -> String
show :: SndFactorPasswordChallengeConfig -> String
$cshowList :: [SndFactorPasswordChallengeConfig] -> ShowS
showList :: [SndFactorPasswordChallengeConfig] -> ShowS
Show, (forall x.
 SndFactorPasswordChallengeConfig
 -> Rep SndFactorPasswordChallengeConfig x)
-> (forall x.
    Rep SndFactorPasswordChallengeConfig x
    -> SndFactorPasswordChallengeConfig)
-> Generic SndFactorPasswordChallengeConfig
forall x.
Rep SndFactorPasswordChallengeConfig x
-> SndFactorPasswordChallengeConfig
forall x.
SndFactorPasswordChallengeConfig
-> Rep SndFactorPasswordChallengeConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SndFactorPasswordChallengeConfig
-> Rep SndFactorPasswordChallengeConfig x
from :: forall x.
SndFactorPasswordChallengeConfig
-> Rep SndFactorPasswordChallengeConfig x
$cto :: forall x.
Rep SndFactorPasswordChallengeConfig x
-> SndFactorPasswordChallengeConfig
to :: forall x.
Rep SndFactorPasswordChallengeConfig x
-> SndFactorPasswordChallengeConfig
Generic)
  deriving (Gen SndFactorPasswordChallengeConfig
Gen SndFactorPasswordChallengeConfig
-> (SndFactorPasswordChallengeConfig
    -> [SndFactorPasswordChallengeConfig])
-> Arbitrary SndFactorPasswordChallengeConfig
SndFactorPasswordChallengeConfig
-> [SndFactorPasswordChallengeConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SndFactorPasswordChallengeConfig
arbitrary :: Gen SndFactorPasswordChallengeConfig
$cshrink :: SndFactorPasswordChallengeConfig
-> [SndFactorPasswordChallengeConfig]
shrink :: SndFactorPasswordChallengeConfig
-> [SndFactorPasswordChallengeConfig]
Arbitrary) via (GenericUniform SndFactorPasswordChallengeConfig)
  deriving (Text
Text -> RenderableSymbol SndFactorPasswordChallengeConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName SndFactorPasswordChallengeConfig)

instance Default SndFactorPasswordChallengeConfig where
  def :: SndFactorPasswordChallengeConfig
def = SndFactorPasswordChallengeConfig
SndFactorPasswordChallengeConfig

instance ToSchema SndFactorPasswordChallengeConfig where
  schema :: ValueSchema NamedSwaggerDoc SndFactorPasswordChallengeConfig
schema = Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SndFactorPasswordChallengeConfig
     SndFactorPasswordChallengeConfig
-> ValueSchema NamedSwaggerDoc SndFactorPasswordChallengeConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SndFactorPasswordChallengeConfig" SchemaP
  SwaggerDoc
  Object
  [Pair]
  SndFactorPasswordChallengeConfig
  SndFactorPasswordChallengeConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

instance Default (LockableFeature SndFactorPasswordChallengeConfig) where
  def :: LockableFeature SndFactorPasswordChallengeConfig
def = LockableFeature SndFactorPasswordChallengeConfig
forall cfg. Default cfg => LockableFeature cfg
defLockedFeature

instance IsFeatureConfig SndFactorPasswordChallengeConfig where
  type FeatureSymbol SndFactorPasswordChallengeConfig = "sndFactorPasswordChallenge"
  featureSingleton :: FeatureSingleton SndFactorPasswordChallengeConfig
featureSingleton = FeatureSingleton SndFactorPasswordChallengeConfig
FeatureSingletonSndFactorPasswordChallengeConfig
  objectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  SndFactorPasswordChallengeConfig
  SndFactorPasswordChallengeConfig
objectSchema = SndFactorPasswordChallengeConfig
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SndFactorPasswordChallengeConfig
     SndFactorPasswordChallengeConfig
forall a.
a
-> SchemaP
     SwaggerDoc Object [Pair] SndFactorPasswordChallengeConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndFactorPasswordChallengeConfig
SndFactorPasswordChallengeConfig

--------------------------------------------------------------------------------
-- SearchVisibilityInbound feature

data SearchVisibilityInboundConfig = SearchVisibilityInboundConfig
  deriving stock (SearchVisibilityInboundConfig
-> SearchVisibilityInboundConfig -> Bool
(SearchVisibilityInboundConfig
 -> SearchVisibilityInboundConfig -> Bool)
-> (SearchVisibilityInboundConfig
    -> SearchVisibilityInboundConfig -> Bool)
-> Eq SearchVisibilityInboundConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchVisibilityInboundConfig
-> SearchVisibilityInboundConfig -> Bool
== :: SearchVisibilityInboundConfig
-> SearchVisibilityInboundConfig -> Bool
$c/= :: SearchVisibilityInboundConfig
-> SearchVisibilityInboundConfig -> Bool
/= :: SearchVisibilityInboundConfig
-> SearchVisibilityInboundConfig -> Bool
Eq, Int -> SearchVisibilityInboundConfig -> ShowS
[SearchVisibilityInboundConfig] -> ShowS
SearchVisibilityInboundConfig -> String
(Int -> SearchVisibilityInboundConfig -> ShowS)
-> (SearchVisibilityInboundConfig -> String)
-> ([SearchVisibilityInboundConfig] -> ShowS)
-> Show SearchVisibilityInboundConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchVisibilityInboundConfig -> ShowS
showsPrec :: Int -> SearchVisibilityInboundConfig -> ShowS
$cshow :: SearchVisibilityInboundConfig -> String
show :: SearchVisibilityInboundConfig -> String
$cshowList :: [SearchVisibilityInboundConfig] -> ShowS
showList :: [SearchVisibilityInboundConfig] -> ShowS
Show, (forall x.
 SearchVisibilityInboundConfig
 -> Rep SearchVisibilityInboundConfig x)
-> (forall x.
    Rep SearchVisibilityInboundConfig x
    -> SearchVisibilityInboundConfig)
-> Generic SearchVisibilityInboundConfig
forall x.
Rep SearchVisibilityInboundConfig x
-> SearchVisibilityInboundConfig
forall x.
SearchVisibilityInboundConfig
-> Rep SearchVisibilityInboundConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SearchVisibilityInboundConfig
-> Rep SearchVisibilityInboundConfig x
from :: forall x.
SearchVisibilityInboundConfig
-> Rep SearchVisibilityInboundConfig x
$cto :: forall x.
Rep SearchVisibilityInboundConfig x
-> SearchVisibilityInboundConfig
to :: forall x.
Rep SearchVisibilityInboundConfig x
-> SearchVisibilityInboundConfig
Generic)
  deriving (Gen SearchVisibilityInboundConfig
Gen SearchVisibilityInboundConfig
-> (SearchVisibilityInboundConfig
    -> [SearchVisibilityInboundConfig])
-> Arbitrary SearchVisibilityInboundConfig
SearchVisibilityInboundConfig -> [SearchVisibilityInboundConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SearchVisibilityInboundConfig
arbitrary :: Gen SearchVisibilityInboundConfig
$cshrink :: SearchVisibilityInboundConfig -> [SearchVisibilityInboundConfig]
shrink :: SearchVisibilityInboundConfig -> [SearchVisibilityInboundConfig]
Arbitrary) via (GenericUniform SearchVisibilityInboundConfig)
  deriving (Typeable SearchVisibilityInboundConfig
Typeable SearchVisibilityInboundConfig =>
(Proxy SearchVisibilityInboundConfig
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SearchVisibilityInboundConfig
Proxy SearchVisibilityInboundConfig
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SearchVisibilityInboundConfig
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SearchVisibilityInboundConfig
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema SearchVisibilityInboundConfig
  deriving (Text
Text -> RenderableSymbol SearchVisibilityInboundConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName SearchVisibilityInboundConfig)

instance Default SearchVisibilityInboundConfig where
  def :: SearchVisibilityInboundConfig
def = SearchVisibilityInboundConfig
SearchVisibilityInboundConfig

instance Default (LockableFeature SearchVisibilityInboundConfig) where
  def :: LockableFeature SearchVisibilityInboundConfig
def = LockableFeature SearchVisibilityInboundConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature {status = FeatureStatusDisabled}

instance IsFeatureConfig SearchVisibilityInboundConfig where
  type FeatureSymbol SearchVisibilityInboundConfig = "searchVisibilityInbound"
  featureSingleton :: FeatureSingleton SearchVisibilityInboundConfig
featureSingleton = FeatureSingleton SearchVisibilityInboundConfig
FeatureSingletonSearchVisibilityInboundConfig
  objectSchema :: ObjectSchema SwaggerDoc SearchVisibilityInboundConfig
objectSchema = SearchVisibilityInboundConfig
-> ObjectSchema SwaggerDoc SearchVisibilityInboundConfig
forall a.
a
-> SchemaP SwaggerDoc Object [Pair] SearchVisibilityInboundConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchVisibilityInboundConfig
SearchVisibilityInboundConfig

instance ToSchema SearchVisibilityInboundConfig where
  schema :: ValueSchema NamedSwaggerDoc SearchVisibilityInboundConfig
schema = Text
-> ObjectSchema SwaggerDoc SearchVisibilityInboundConfig
-> ValueSchema NamedSwaggerDoc SearchVisibilityInboundConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SearchVisibilityInboundConfig" ObjectSchema SwaggerDoc SearchVisibilityInboundConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

----------------------------------------------------------------------
-- ClassifiedDomains feature

-- | This feature is quite special, in that it does not have any database
-- state. Its value cannot be updated dynamically, and is always set to the
-- server default taken from the backend configuration.
data ClassifiedDomainsConfig = ClassifiedDomainsConfig
  { ClassifiedDomainsConfig -> [Domain]
classifiedDomainsDomains :: [Domain]
  }
  deriving stock (Int -> ClassifiedDomainsConfig -> ShowS
[ClassifiedDomainsConfig] -> ShowS
ClassifiedDomainsConfig -> String
(Int -> ClassifiedDomainsConfig -> ShowS)
-> (ClassifiedDomainsConfig -> String)
-> ([ClassifiedDomainsConfig] -> ShowS)
-> Show ClassifiedDomainsConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClassifiedDomainsConfig -> ShowS
showsPrec :: Int -> ClassifiedDomainsConfig -> ShowS
$cshow :: ClassifiedDomainsConfig -> String
show :: ClassifiedDomainsConfig -> String
$cshowList :: [ClassifiedDomainsConfig] -> ShowS
showList :: [ClassifiedDomainsConfig] -> ShowS
Show, ClassifiedDomainsConfig -> ClassifiedDomainsConfig -> Bool
(ClassifiedDomainsConfig -> ClassifiedDomainsConfig -> Bool)
-> (ClassifiedDomainsConfig -> ClassifiedDomainsConfig -> Bool)
-> Eq ClassifiedDomainsConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClassifiedDomainsConfig -> ClassifiedDomainsConfig -> Bool
== :: ClassifiedDomainsConfig -> ClassifiedDomainsConfig -> Bool
$c/= :: ClassifiedDomainsConfig -> ClassifiedDomainsConfig -> Bool
/= :: ClassifiedDomainsConfig -> ClassifiedDomainsConfig -> Bool
Eq, (forall x.
 ClassifiedDomainsConfig -> Rep ClassifiedDomainsConfig x)
-> (forall x.
    Rep ClassifiedDomainsConfig x -> ClassifiedDomainsConfig)
-> Generic ClassifiedDomainsConfig
forall x. Rep ClassifiedDomainsConfig x -> ClassifiedDomainsConfig
forall x. ClassifiedDomainsConfig -> Rep ClassifiedDomainsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClassifiedDomainsConfig -> Rep ClassifiedDomainsConfig x
from :: forall x. ClassifiedDomainsConfig -> Rep ClassifiedDomainsConfig x
$cto :: forall x. Rep ClassifiedDomainsConfig x -> ClassifiedDomainsConfig
to :: forall x. Rep ClassifiedDomainsConfig x -> ClassifiedDomainsConfig
Generic)
  deriving ([ClassifiedDomainsConfig] -> Value
[ClassifiedDomainsConfig] -> Encoding
ClassifiedDomainsConfig -> Value
ClassifiedDomainsConfig -> Encoding
(ClassifiedDomainsConfig -> Value)
-> (ClassifiedDomainsConfig -> Encoding)
-> ([ClassifiedDomainsConfig] -> Value)
-> ([ClassifiedDomainsConfig] -> Encoding)
-> ToJSON ClassifiedDomainsConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ClassifiedDomainsConfig -> Value
toJSON :: ClassifiedDomainsConfig -> Value
$ctoEncoding :: ClassifiedDomainsConfig -> Encoding
toEncoding :: ClassifiedDomainsConfig -> Encoding
$ctoJSONList :: [ClassifiedDomainsConfig] -> Value
toJSONList :: [ClassifiedDomainsConfig] -> Value
$ctoEncodingList :: [ClassifiedDomainsConfig] -> Encoding
toEncodingList :: [ClassifiedDomainsConfig] -> Encoding
ToJSON, Value -> Parser [ClassifiedDomainsConfig]
Value -> Parser ClassifiedDomainsConfig
(Value -> Parser ClassifiedDomainsConfig)
-> (Value -> Parser [ClassifiedDomainsConfig])
-> FromJSON ClassifiedDomainsConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ClassifiedDomainsConfig
parseJSON :: Value -> Parser ClassifiedDomainsConfig
$cparseJSONList :: Value -> Parser [ClassifiedDomainsConfig]
parseJSONList :: Value -> Parser [ClassifiedDomainsConfig]
FromJSON, Typeable ClassifiedDomainsConfig
Typeable ClassifiedDomainsConfig =>
(Proxy ClassifiedDomainsConfig
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ClassifiedDomainsConfig
Proxy ClassifiedDomainsConfig
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ClassifiedDomainsConfig
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ClassifiedDomainsConfig
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema ClassifiedDomainsConfig)
  deriving (Text
Text -> RenderableSymbol ClassifiedDomainsConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName ClassifiedDomainsConfig)

instance Default ClassifiedDomainsConfig where
  def :: ClassifiedDomainsConfig
def = [Domain] -> ClassifiedDomainsConfig
ClassifiedDomainsConfig []

deriving via (GenericUniform ClassifiedDomainsConfig) instance Arbitrary ClassifiedDomainsConfig

instance ToSchema ClassifiedDomainsConfig where
  schema :: ValueSchema NamedSwaggerDoc ClassifiedDomainsConfig
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ClassifiedDomainsConfig
     ClassifiedDomainsConfig
-> ValueSchema NamedSwaggerDoc ClassifiedDomainsConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ClassifiedDomainsConfig" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   ClassifiedDomainsConfig
   ClassifiedDomainsConfig
 -> ValueSchema NamedSwaggerDoc ClassifiedDomainsConfig)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ClassifiedDomainsConfig
     ClassifiedDomainsConfig
-> ValueSchema NamedSwaggerDoc ClassifiedDomainsConfig
forall a b. (a -> b) -> a -> b
$
      [Domain] -> ClassifiedDomainsConfig
ClassifiedDomainsConfig
        ([Domain] -> ClassifiedDomainsConfig)
-> SchemaP
     SwaggerDoc Object [Pair] ClassifiedDomainsConfig [Domain]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ClassifiedDomainsConfig
     ClassifiedDomainsConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClassifiedDomainsConfig -> [Domain]
classifiedDomainsDomains (ClassifiedDomainsConfig -> [Domain])
-> SchemaP SwaggerDoc Object [Pair] [Domain] [Domain]
-> SchemaP
     SwaggerDoc Object [Pair] ClassifiedDomainsConfig [Domain]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Domain] [Domain]
-> SchemaP SwaggerDoc Object [Pair] [Domain] [Domain]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"domains" (ValueSchema NamedSwaggerDoc Domain
-> SchemaP SwaggerDoc Value Value [Domain] [Domain]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Domain
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance Default (LockableFeature ClassifiedDomainsConfig) where
  def :: LockableFeature ClassifiedDomainsConfig
def = LockableFeature ClassifiedDomainsConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature {status = FeatureStatusDisabled}

instance IsFeatureConfig ClassifiedDomainsConfig where
  type FeatureSymbol ClassifiedDomainsConfig = "classifiedDomains"

  featureSingleton :: FeatureSingleton ClassifiedDomainsConfig
featureSingleton = FeatureSingleton ClassifiedDomainsConfig
FeatureSingletonClassifiedDomainsConfig
  objectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  ClassifiedDomainsConfig
  ClassifiedDomainsConfig
objectSchema = Text
-> ValueSchema NamedSwaggerDoc ClassifiedDomainsConfig
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ClassifiedDomainsConfig
     ClassifiedDomainsConfig
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"config" ValueSchema NamedSwaggerDoc ClassifiedDomainsConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

----------------------------------------------------------------------
-- AppLock feature

data AppLockConfig = AppLockConfig
  { AppLockConfig -> EnforceAppLock
applockEnforceAppLock :: EnforceAppLock,
    AppLockConfig -> Int32
applockInactivityTimeoutSecs :: Int32
  }
  deriving stock (AppLockConfig -> AppLockConfig -> Bool
(AppLockConfig -> AppLockConfig -> Bool)
-> (AppLockConfig -> AppLockConfig -> Bool) -> Eq AppLockConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AppLockConfig -> AppLockConfig -> Bool
== :: AppLockConfig -> AppLockConfig -> Bool
$c/= :: AppLockConfig -> AppLockConfig -> Bool
/= :: AppLockConfig -> AppLockConfig -> Bool
Eq, Int -> AppLockConfig -> ShowS
[AppLockConfig] -> ShowS
AppLockConfig -> String
(Int -> AppLockConfig -> ShowS)
-> (AppLockConfig -> String)
-> ([AppLockConfig] -> ShowS)
-> Show AppLockConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppLockConfig -> ShowS
showsPrec :: Int -> AppLockConfig -> ShowS
$cshow :: AppLockConfig -> String
show :: AppLockConfig -> String
$cshowList :: [AppLockConfig] -> ShowS
showList :: [AppLockConfig] -> ShowS
Show, (forall x. AppLockConfig -> Rep AppLockConfig x)
-> (forall x. Rep AppLockConfig x -> AppLockConfig)
-> Generic AppLockConfig
forall x. Rep AppLockConfig x -> AppLockConfig
forall x. AppLockConfig -> Rep AppLockConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AppLockConfig -> Rep AppLockConfig x
from :: forall x. AppLockConfig -> Rep AppLockConfig x
$cto :: forall x. Rep AppLockConfig x -> AppLockConfig
to :: forall x. Rep AppLockConfig x -> AppLockConfig
Generic)
  deriving (Value -> Parser [AppLockConfig]
Value -> Parser AppLockConfig
(Value -> Parser AppLockConfig)
-> (Value -> Parser [AppLockConfig]) -> FromJSON AppLockConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AppLockConfig
parseJSON :: Value -> Parser AppLockConfig
$cparseJSONList :: Value -> Parser [AppLockConfig]
parseJSONList :: Value -> Parser [AppLockConfig]
FromJSON, [AppLockConfig] -> Value
[AppLockConfig] -> Encoding
AppLockConfig -> Value
AppLockConfig -> Encoding
(AppLockConfig -> Value)
-> (AppLockConfig -> Encoding)
-> ([AppLockConfig] -> Value)
-> ([AppLockConfig] -> Encoding)
-> ToJSON AppLockConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AppLockConfig -> Value
toJSON :: AppLockConfig -> Value
$ctoEncoding :: AppLockConfig -> Encoding
toEncoding :: AppLockConfig -> Encoding
$ctoJSONList :: [AppLockConfig] -> Value
toJSONList :: [AppLockConfig] -> Value
$ctoEncodingList :: [AppLockConfig] -> Encoding
toEncodingList :: [AppLockConfig] -> Encoding
ToJSON, Typeable AppLockConfig
Typeable AppLockConfig =>
(Proxy AppLockConfig -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AppLockConfig
Proxy AppLockConfig -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AppLockConfig -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AppLockConfig -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema AppLockConfig)
  deriving (Gen AppLockConfig
Gen AppLockConfig
-> (AppLockConfig -> [AppLockConfig]) -> Arbitrary AppLockConfig
AppLockConfig -> [AppLockConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AppLockConfig
arbitrary :: Gen AppLockConfig
$cshrink :: AppLockConfig -> [AppLockConfig]
shrink :: AppLockConfig -> [AppLockConfig]
Arbitrary) via (GenericUniform AppLockConfig)
  deriving (Text
Text -> RenderableSymbol AppLockConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName AppLockConfig)

instance Default AppLockConfig where
  def :: AppLockConfig
def = EnforceAppLock -> Int32 -> AppLockConfig
AppLockConfig (Bool -> EnforceAppLock
EnforceAppLock Bool
False) Int32
60

instance ToSchema AppLockConfig where
  schema :: ValueSchema NamedSwaggerDoc AppLockConfig
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig AppLockConfig
-> ValueSchema NamedSwaggerDoc AppLockConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AppLockConfig" (SchemaP SwaggerDoc Object [Pair] AppLockConfig AppLockConfig
 -> ValueSchema NamedSwaggerDoc AppLockConfig)
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig AppLockConfig
-> ValueSchema NamedSwaggerDoc AppLockConfig
forall a b. (a -> b) -> a -> b
$
      EnforceAppLock -> Int32 -> AppLockConfig
AppLockConfig
        (EnforceAppLock -> Int32 -> AppLockConfig)
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig EnforceAppLock
-> SchemaP
     SwaggerDoc Object [Pair] AppLockConfig (Int32 -> AppLockConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppLockConfig -> EnforceAppLock
applockEnforceAppLock (AppLockConfig -> EnforceAppLock)
-> SchemaP SwaggerDoc Object [Pair] EnforceAppLock EnforceAppLock
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig EnforceAppLock
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value EnforceAppLock EnforceAppLock
-> SchemaP SwaggerDoc Object [Pair] EnforceAppLock EnforceAppLock
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"enforceAppLock" SchemaP NamedSwaggerDoc Value Value EnforceAppLock EnforceAppLock
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] AppLockConfig (Int32 -> AppLockConfig)
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig Int32
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig AppLockConfig
forall a b.
SchemaP SwaggerDoc Object [Pair] AppLockConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig a
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AppLockConfig -> Int32
applockInactivityTimeoutSecs (AppLockConfig -> Int32)
-> SchemaP SwaggerDoc Object [Pair] Int32 Int32
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig Int32
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Int32 Int32
-> SchemaP SwaggerDoc Object [Pair] Int32 Int32
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"inactivityTimeoutSecs" SchemaP NamedSwaggerDoc Value Value Int32 Int32
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance Default (LockableFeature AppLockConfig) where
  def :: LockableFeature AppLockConfig
def = LockableFeature AppLockConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature

instance IsFeatureConfig AppLockConfig where
  type FeatureSymbol AppLockConfig = "appLock"

  featureSingleton :: FeatureSingleton AppLockConfig
featureSingleton = FeatureSingleton AppLockConfig
FeatureSingletonAppLockConfig
  objectSchema :: SchemaP SwaggerDoc Object [Pair] AppLockConfig AppLockConfig
objectSchema = Text
-> ValueSchema NamedSwaggerDoc AppLockConfig
-> SchemaP SwaggerDoc Object [Pair] AppLockConfig AppLockConfig
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"config" ValueSchema NamedSwaggerDoc AppLockConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

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

instance ToSchema EnforceAppLock where
  schema :: SchemaP NamedSwaggerDoc Value Value EnforceAppLock EnforceAppLock
schema = Bool -> EnforceAppLock
EnforceAppLock (Bool -> EnforceAppLock)
-> SchemaP NamedSwaggerDoc Value Value EnforceAppLock Bool
-> SchemaP
     NamedSwaggerDoc Value Value EnforceAppLock EnforceAppLock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\(EnforceAppLock Bool
v) -> Bool
v) (EnforceAppLock -> Bool)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP NamedSwaggerDoc Value Value EnforceAppLock Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- FileSharing feature

data FileSharingConfig = FileSharingConfig
  deriving stock (FileSharingConfig -> FileSharingConfig -> Bool
(FileSharingConfig -> FileSharingConfig -> Bool)
-> (FileSharingConfig -> FileSharingConfig -> Bool)
-> Eq FileSharingConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileSharingConfig -> FileSharingConfig -> Bool
== :: FileSharingConfig -> FileSharingConfig -> Bool
$c/= :: FileSharingConfig -> FileSharingConfig -> Bool
/= :: FileSharingConfig -> FileSharingConfig -> Bool
Eq, Int -> FileSharingConfig -> ShowS
[FileSharingConfig] -> ShowS
FileSharingConfig -> String
(Int -> FileSharingConfig -> ShowS)
-> (FileSharingConfig -> String)
-> ([FileSharingConfig] -> ShowS)
-> Show FileSharingConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileSharingConfig -> ShowS
showsPrec :: Int -> FileSharingConfig -> ShowS
$cshow :: FileSharingConfig -> String
show :: FileSharingConfig -> String
$cshowList :: [FileSharingConfig] -> ShowS
showList :: [FileSharingConfig] -> ShowS
Show, (forall x. FileSharingConfig -> Rep FileSharingConfig x)
-> (forall x. Rep FileSharingConfig x -> FileSharingConfig)
-> Generic FileSharingConfig
forall x. Rep FileSharingConfig x -> FileSharingConfig
forall x. FileSharingConfig -> Rep FileSharingConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileSharingConfig -> Rep FileSharingConfig x
from :: forall x. FileSharingConfig -> Rep FileSharingConfig x
$cto :: forall x. Rep FileSharingConfig x -> FileSharingConfig
to :: forall x. Rep FileSharingConfig x -> FileSharingConfig
Generic)
  deriving (Gen FileSharingConfig
Gen FileSharingConfig
-> (FileSharingConfig -> [FileSharingConfig])
-> Arbitrary FileSharingConfig
FileSharingConfig -> [FileSharingConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen FileSharingConfig
arbitrary :: Gen FileSharingConfig
$cshrink :: FileSharingConfig -> [FileSharingConfig]
shrink :: FileSharingConfig -> [FileSharingConfig]
Arbitrary) via (GenericUniform FileSharingConfig)
  deriving (Text
Text -> RenderableSymbol FileSharingConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName FileSharingConfig)

instance Default FileSharingConfig where
  def :: FileSharingConfig
def = FileSharingConfig
FileSharingConfig

instance Default (LockableFeature FileSharingConfig) where
  def :: LockableFeature FileSharingConfig
def = LockableFeature FileSharingConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature

instance IsFeatureConfig FileSharingConfig where
  type FeatureSymbol FileSharingConfig = "fileSharing"
  featureSingleton :: FeatureSingleton FileSharingConfig
featureSingleton = FeatureSingleton FileSharingConfig
FeatureSingletonFileSharingConfig
  objectSchema :: ObjectSchema SwaggerDoc FileSharingConfig
objectSchema = FileSharingConfig -> ObjectSchema SwaggerDoc FileSharingConfig
forall a. a -> SchemaP SwaggerDoc Object [Pair] FileSharingConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileSharingConfig
FileSharingConfig

instance ToSchema FileSharingConfig where
  schema :: ValueSchema NamedSwaggerDoc FileSharingConfig
schema = Text
-> ObjectSchema SwaggerDoc FileSharingConfig
-> ValueSchema NamedSwaggerDoc FileSharingConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"FileSharingConfig" ObjectSchema SwaggerDoc FileSharingConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

----------------------------------------------------------------------
-- SelfDeletingMessagesConfig

newtype SelfDeletingMessagesConfig = SelfDeletingMessagesConfig
  { SelfDeletingMessagesConfig -> Int32
sdmEnforcedTimeoutSeconds :: Int32
  }
  deriving stock (SelfDeletingMessagesConfig -> SelfDeletingMessagesConfig -> Bool
(SelfDeletingMessagesConfig -> SelfDeletingMessagesConfig -> Bool)
-> (SelfDeletingMessagesConfig
    -> SelfDeletingMessagesConfig -> Bool)
-> Eq SelfDeletingMessagesConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelfDeletingMessagesConfig -> SelfDeletingMessagesConfig -> Bool
== :: SelfDeletingMessagesConfig -> SelfDeletingMessagesConfig -> Bool
$c/= :: SelfDeletingMessagesConfig -> SelfDeletingMessagesConfig -> Bool
/= :: SelfDeletingMessagesConfig -> SelfDeletingMessagesConfig -> Bool
Eq, Int -> SelfDeletingMessagesConfig -> ShowS
[SelfDeletingMessagesConfig] -> ShowS
SelfDeletingMessagesConfig -> String
(Int -> SelfDeletingMessagesConfig -> ShowS)
-> (SelfDeletingMessagesConfig -> String)
-> ([SelfDeletingMessagesConfig] -> ShowS)
-> Show SelfDeletingMessagesConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelfDeletingMessagesConfig -> ShowS
showsPrec :: Int -> SelfDeletingMessagesConfig -> ShowS
$cshow :: SelfDeletingMessagesConfig -> String
show :: SelfDeletingMessagesConfig -> String
$cshowList :: [SelfDeletingMessagesConfig] -> ShowS
showList :: [SelfDeletingMessagesConfig] -> ShowS
Show, (forall x.
 SelfDeletingMessagesConfig -> Rep SelfDeletingMessagesConfig x)
-> (forall x.
    Rep SelfDeletingMessagesConfig x -> SelfDeletingMessagesConfig)
-> Generic SelfDeletingMessagesConfig
forall x.
Rep SelfDeletingMessagesConfig x -> SelfDeletingMessagesConfig
forall x.
SelfDeletingMessagesConfig -> Rep SelfDeletingMessagesConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SelfDeletingMessagesConfig -> Rep SelfDeletingMessagesConfig x
from :: forall x.
SelfDeletingMessagesConfig -> Rep SelfDeletingMessagesConfig x
$cto :: forall x.
Rep SelfDeletingMessagesConfig x -> SelfDeletingMessagesConfig
to :: forall x.
Rep SelfDeletingMessagesConfig x -> SelfDeletingMessagesConfig
Generic)
  deriving (Value -> Parser [SelfDeletingMessagesConfig]
Value -> Parser SelfDeletingMessagesConfig
(Value -> Parser SelfDeletingMessagesConfig)
-> (Value -> Parser [SelfDeletingMessagesConfig])
-> FromJSON SelfDeletingMessagesConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SelfDeletingMessagesConfig
parseJSON :: Value -> Parser SelfDeletingMessagesConfig
$cparseJSONList :: Value -> Parser [SelfDeletingMessagesConfig]
parseJSONList :: Value -> Parser [SelfDeletingMessagesConfig]
FromJSON, [SelfDeletingMessagesConfig] -> Value
[SelfDeletingMessagesConfig] -> Encoding
SelfDeletingMessagesConfig -> Value
SelfDeletingMessagesConfig -> Encoding
(SelfDeletingMessagesConfig -> Value)
-> (SelfDeletingMessagesConfig -> Encoding)
-> ([SelfDeletingMessagesConfig] -> Value)
-> ([SelfDeletingMessagesConfig] -> Encoding)
-> ToJSON SelfDeletingMessagesConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SelfDeletingMessagesConfig -> Value
toJSON :: SelfDeletingMessagesConfig -> Value
$ctoEncoding :: SelfDeletingMessagesConfig -> Encoding
toEncoding :: SelfDeletingMessagesConfig -> Encoding
$ctoJSONList :: [SelfDeletingMessagesConfig] -> Value
toJSONList :: [SelfDeletingMessagesConfig] -> Value
$ctoEncodingList :: [SelfDeletingMessagesConfig] -> Encoding
toEncodingList :: [SelfDeletingMessagesConfig] -> Encoding
ToJSON, Typeable SelfDeletingMessagesConfig
Typeable SelfDeletingMessagesConfig =>
(Proxy SelfDeletingMessagesConfig
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SelfDeletingMessagesConfig
Proxy SelfDeletingMessagesConfig
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SelfDeletingMessagesConfig
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SelfDeletingMessagesConfig
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema SelfDeletingMessagesConfig)
  deriving (Gen SelfDeletingMessagesConfig
Gen SelfDeletingMessagesConfig
-> (SelfDeletingMessagesConfig -> [SelfDeletingMessagesConfig])
-> Arbitrary SelfDeletingMessagesConfig
SelfDeletingMessagesConfig -> [SelfDeletingMessagesConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SelfDeletingMessagesConfig
arbitrary :: Gen SelfDeletingMessagesConfig
$cshrink :: SelfDeletingMessagesConfig -> [SelfDeletingMessagesConfig]
shrink :: SelfDeletingMessagesConfig -> [SelfDeletingMessagesConfig]
Arbitrary) via (GenericUniform SelfDeletingMessagesConfig)
  deriving (Text
Text -> RenderableSymbol SelfDeletingMessagesConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName SelfDeletingMessagesConfig)

instance Default SelfDeletingMessagesConfig where
  def :: SelfDeletingMessagesConfig
def = Int32 -> SelfDeletingMessagesConfig
SelfDeletingMessagesConfig Int32
0

instance ToSchema SelfDeletingMessagesConfig where
  schema :: ValueSchema NamedSwaggerDoc SelfDeletingMessagesConfig
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SelfDeletingMessagesConfig
     SelfDeletingMessagesConfig
-> ValueSchema NamedSwaggerDoc SelfDeletingMessagesConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SelfDeletingMessagesConfig" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   SelfDeletingMessagesConfig
   SelfDeletingMessagesConfig
 -> ValueSchema NamedSwaggerDoc SelfDeletingMessagesConfig)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SelfDeletingMessagesConfig
     SelfDeletingMessagesConfig
-> ValueSchema NamedSwaggerDoc SelfDeletingMessagesConfig
forall a b. (a -> b) -> a -> b
$
      Int32 -> SelfDeletingMessagesConfig
SelfDeletingMessagesConfig
        (Int32 -> SelfDeletingMessagesConfig)
-> SchemaP
     SwaggerDoc Object [Pair] SelfDeletingMessagesConfig Int32
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SelfDeletingMessagesConfig
     SelfDeletingMessagesConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelfDeletingMessagesConfig -> Int32
sdmEnforcedTimeoutSeconds (SelfDeletingMessagesConfig -> Int32)
-> SchemaP SwaggerDoc Object [Pair] Int32 Int32
-> SchemaP
     SwaggerDoc Object [Pair] SelfDeletingMessagesConfig Int32
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Int32 Int32
-> SchemaP SwaggerDoc Object [Pair] Int32 Int32
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"enforcedTimeoutSeconds" SchemaP NamedSwaggerDoc Value Value Int32 Int32
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance Default (LockableFeature SelfDeletingMessagesConfig) where
  def :: LockableFeature SelfDeletingMessagesConfig
def = LockableFeature SelfDeletingMessagesConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature

instance IsFeatureConfig SelfDeletingMessagesConfig where
  type FeatureSymbol SelfDeletingMessagesConfig = "selfDeletingMessages"
  featureSingleton :: FeatureSingleton SelfDeletingMessagesConfig
featureSingleton = FeatureSingleton SelfDeletingMessagesConfig
FeatureSingletonSelfDeletingMessagesConfig
  objectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  SelfDeletingMessagesConfig
  SelfDeletingMessagesConfig
objectSchema = Text
-> ValueSchema NamedSwaggerDoc SelfDeletingMessagesConfig
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SelfDeletingMessagesConfig
     SelfDeletingMessagesConfig
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"config" ValueSchema NamedSwaggerDoc SelfDeletingMessagesConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

----------------------------------------------------------------------
-- MLSConfig

data MLSConfig = MLSConfig
  { MLSConfig -> [UserId]
mlsProtocolToggleUsers :: [UserId],
    MLSConfig -> ProtocolTag
mlsDefaultProtocol :: ProtocolTag,
    MLSConfig -> [CipherSuiteTag]
mlsAllowedCipherSuites :: [CipherSuiteTag],
    MLSConfig -> CipherSuiteTag
mlsDefaultCipherSuite :: CipherSuiteTag,
    MLSConfig -> [ProtocolTag]
mlsSupportedProtocols :: [ProtocolTag]
  }
  deriving stock (MLSConfig -> MLSConfig -> Bool
(MLSConfig -> MLSConfig -> Bool)
-> (MLSConfig -> MLSConfig -> Bool) -> Eq MLSConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLSConfig -> MLSConfig -> Bool
== :: MLSConfig -> MLSConfig -> Bool
$c/= :: MLSConfig -> MLSConfig -> Bool
/= :: MLSConfig -> MLSConfig -> Bool
Eq, Int -> MLSConfig -> ShowS
[MLSConfig] -> ShowS
MLSConfig -> String
(Int -> MLSConfig -> ShowS)
-> (MLSConfig -> String)
-> ([MLSConfig] -> ShowS)
-> Show MLSConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLSConfig -> ShowS
showsPrec :: Int -> MLSConfig -> ShowS
$cshow :: MLSConfig -> String
show :: MLSConfig -> String
$cshowList :: [MLSConfig] -> ShowS
showList :: [MLSConfig] -> ShowS
Show, (forall x. MLSConfig -> Rep MLSConfig x)
-> (forall x. Rep MLSConfig x -> MLSConfig) -> Generic MLSConfig
forall x. Rep MLSConfig x -> MLSConfig
forall x. MLSConfig -> Rep MLSConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MLSConfig -> Rep MLSConfig x
from :: forall x. MLSConfig -> Rep MLSConfig x
$cto :: forall x. Rep MLSConfig x -> MLSConfig
to :: forall x. Rep MLSConfig x -> MLSConfig
Generic)
  deriving (Gen MLSConfig
Gen MLSConfig -> (MLSConfig -> [MLSConfig]) -> Arbitrary MLSConfig
MLSConfig -> [MLSConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen MLSConfig
arbitrary :: Gen MLSConfig
$cshrink :: MLSConfig -> [MLSConfig]
shrink :: MLSConfig -> [MLSConfig]
Arbitrary) via (GenericUniform MLSConfig)
  deriving (Text
Text -> RenderableSymbol MLSConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName MLSConfig)

instance Default MLSConfig where
  def :: MLSConfig
def =
    [UserId]
-> ProtocolTag
-> [CipherSuiteTag]
-> CipherSuiteTag
-> [ProtocolTag]
-> MLSConfig
MLSConfig
      []
      ProtocolTag
ProtocolProteusTag
      [CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519]
      CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
      [ProtocolTag
ProtocolProteusTag, ProtocolTag
ProtocolMLSTag]

instance ToSchema MLSConfig where
  schema :: ValueSchema NamedSwaggerDoc MLSConfig
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] MLSConfig MLSConfig
-> ValueSchema NamedSwaggerDoc MLSConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"MLSConfig" (SchemaP SwaggerDoc Object [Pair] MLSConfig MLSConfig
 -> ValueSchema NamedSwaggerDoc MLSConfig)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig MLSConfig
-> ValueSchema NamedSwaggerDoc MLSConfig
forall a b. (a -> b) -> a -> b
$
      [UserId]
-> ProtocolTag
-> [CipherSuiteTag]
-> CipherSuiteTag
-> [ProtocolTag]
-> MLSConfig
MLSConfig
        ([UserId]
 -> ProtocolTag
 -> [CipherSuiteTag]
 -> CipherSuiteTag
 -> [ProtocolTag]
 -> MLSConfig)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig [UserId]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MLSConfig
     (ProtocolTag
      -> [CipherSuiteTag]
      -> CipherSuiteTag
      -> [ProtocolTag]
      -> MLSConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MLSConfig -> [UserId]
mlsProtocolToggleUsers (MLSConfig -> [UserId])
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] MLSConfig [UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"protocolToggleUsers" ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"allowlist of users that may change protocols") (ValueSchema NamedSwaggerDoc UserId
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MLSConfig
  (ProtocolTag
   -> [CipherSuiteTag]
   -> CipherSuiteTag
   -> [ProtocolTag]
   -> MLSConfig)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig ProtocolTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MLSConfig
     ([CipherSuiteTag] -> CipherSuiteTag -> [ProtocolTag] -> MLSConfig)
forall a b.
SchemaP SwaggerDoc Object [Pair] MLSConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig a
-> SchemaP SwaggerDoc Object [Pair] MLSConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MLSConfig -> ProtocolTag
mlsDefaultProtocol (MLSConfig -> ProtocolTag)
-> SchemaP SwaggerDoc Object [Pair] ProtocolTag ProtocolTag
-> SchemaP SwaggerDoc Object [Pair] MLSConfig ProtocolTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ProtocolTag ProtocolTag
-> SchemaP SwaggerDoc Object [Pair] ProtocolTag ProtocolTag
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"defaultProtocol" SchemaP NamedSwaggerDoc Value Value ProtocolTag ProtocolTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MLSConfig
  ([CipherSuiteTag] -> CipherSuiteTag -> [ProtocolTag] -> MLSConfig)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig [CipherSuiteTag]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MLSConfig
     (CipherSuiteTag -> [ProtocolTag] -> MLSConfig)
forall a b.
SchemaP SwaggerDoc Object [Pair] MLSConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig a
-> SchemaP SwaggerDoc Object [Pair] MLSConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MLSConfig -> [CipherSuiteTag]
mlsAllowedCipherSuites (MLSConfig -> [CipherSuiteTag])
-> SchemaP
     SwaggerDoc Object [Pair] [CipherSuiteTag] [CipherSuiteTag]
-> SchemaP SwaggerDoc Object [Pair] MLSConfig [CipherSuiteTag]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [CipherSuiteTag] [CipherSuiteTag]
-> SchemaP
     SwaggerDoc Object [Pair] [CipherSuiteTag] [CipherSuiteTag]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"allowedCipherSuites" (ValueSchema NamedSwaggerDoc CipherSuiteTag
-> SchemaP SwaggerDoc Value Value [CipherSuiteTag] [CipherSuiteTag]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc CipherSuiteTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MLSConfig
  (CipherSuiteTag -> [ProtocolTag] -> MLSConfig)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig CipherSuiteTag
-> SchemaP
     SwaggerDoc Object [Pair] MLSConfig ([ProtocolTag] -> MLSConfig)
forall a b.
SchemaP SwaggerDoc Object [Pair] MLSConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig a
-> SchemaP SwaggerDoc Object [Pair] MLSConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MLSConfig -> CipherSuiteTag
mlsDefaultCipherSuite (MLSConfig -> CipherSuiteTag)
-> SchemaP SwaggerDoc Object [Pair] CipherSuiteTag CipherSuiteTag
-> SchemaP SwaggerDoc Object [Pair] MLSConfig CipherSuiteTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc CipherSuiteTag
-> SchemaP SwaggerDoc Object [Pair] CipherSuiteTag CipherSuiteTag
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"defaultCipherSuite" ValueSchema NamedSwaggerDoc CipherSuiteTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] MLSConfig ([ProtocolTag] -> MLSConfig)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig [ProtocolTag]
-> SchemaP SwaggerDoc Object [Pair] MLSConfig MLSConfig
forall a b.
SchemaP SwaggerDoc Object [Pair] MLSConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MLSConfig a
-> SchemaP SwaggerDoc Object [Pair] MLSConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MLSConfig -> [ProtocolTag]
mlsSupportedProtocols (MLSConfig -> [ProtocolTag])
-> SchemaP SwaggerDoc Object [Pair] [ProtocolTag] [ProtocolTag]
-> SchemaP SwaggerDoc Object [Pair] MLSConfig [ProtocolTag]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [ProtocolTag] [ProtocolTag]
-> SchemaP SwaggerDoc Object [Pair] [ProtocolTag] [ProtocolTag]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"supportedProtocols" (SchemaP NamedSwaggerDoc Value Value ProtocolTag ProtocolTag
-> SchemaP SwaggerDoc Value Value [ProtocolTag] [ProtocolTag]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP NamedSwaggerDoc Value Value ProtocolTag ProtocolTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance Default (LockableFeature MLSConfig) where
  def :: LockableFeature MLSConfig
def = LockableFeature MLSConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature {status = FeatureStatusDisabled}

instance IsFeatureConfig MLSConfig where
  type FeatureSymbol MLSConfig = "mls"
  featureSingleton :: FeatureSingleton MLSConfig
featureSingleton = FeatureSingleton MLSConfig
FeatureSingletonMLSConfig
  objectSchema :: SchemaP SwaggerDoc Object [Pair] MLSConfig MLSConfig
objectSchema = Text
-> ValueSchema NamedSwaggerDoc MLSConfig
-> SchemaP SwaggerDoc Object [Pair] MLSConfig MLSConfig
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"config" ValueSchema NamedSwaggerDoc MLSConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

----------------------------------------------------------------------
-- ExposeInvitationURLsToTeamAdminConfig

data ExposeInvitationURLsToTeamAdminConfig = ExposeInvitationURLsToTeamAdminConfig
  deriving stock (Int -> ExposeInvitationURLsToTeamAdminConfig -> ShowS
[ExposeInvitationURLsToTeamAdminConfig] -> ShowS
ExposeInvitationURLsToTeamAdminConfig -> String
(Int -> ExposeInvitationURLsToTeamAdminConfig -> ShowS)
-> (ExposeInvitationURLsToTeamAdminConfig -> String)
-> ([ExposeInvitationURLsToTeamAdminConfig] -> ShowS)
-> Show ExposeInvitationURLsToTeamAdminConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExposeInvitationURLsToTeamAdminConfig -> ShowS
showsPrec :: Int -> ExposeInvitationURLsToTeamAdminConfig -> ShowS
$cshow :: ExposeInvitationURLsToTeamAdminConfig -> String
show :: ExposeInvitationURLsToTeamAdminConfig -> String
$cshowList :: [ExposeInvitationURLsToTeamAdminConfig] -> ShowS
showList :: [ExposeInvitationURLsToTeamAdminConfig] -> ShowS
Show, ExposeInvitationURLsToTeamAdminConfig
-> ExposeInvitationURLsToTeamAdminConfig -> Bool
(ExposeInvitationURLsToTeamAdminConfig
 -> ExposeInvitationURLsToTeamAdminConfig -> Bool)
-> (ExposeInvitationURLsToTeamAdminConfig
    -> ExposeInvitationURLsToTeamAdminConfig -> Bool)
-> Eq ExposeInvitationURLsToTeamAdminConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExposeInvitationURLsToTeamAdminConfig
-> ExposeInvitationURLsToTeamAdminConfig -> Bool
== :: ExposeInvitationURLsToTeamAdminConfig
-> ExposeInvitationURLsToTeamAdminConfig -> Bool
$c/= :: ExposeInvitationURLsToTeamAdminConfig
-> ExposeInvitationURLsToTeamAdminConfig -> Bool
/= :: ExposeInvitationURLsToTeamAdminConfig
-> ExposeInvitationURLsToTeamAdminConfig -> Bool
Eq, (forall x.
 ExposeInvitationURLsToTeamAdminConfig
 -> Rep ExposeInvitationURLsToTeamAdminConfig x)
-> (forall x.
    Rep ExposeInvitationURLsToTeamAdminConfig x
    -> ExposeInvitationURLsToTeamAdminConfig)
-> Generic ExposeInvitationURLsToTeamAdminConfig
forall x.
Rep ExposeInvitationURLsToTeamAdminConfig x
-> ExposeInvitationURLsToTeamAdminConfig
forall x.
ExposeInvitationURLsToTeamAdminConfig
-> Rep ExposeInvitationURLsToTeamAdminConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ExposeInvitationURLsToTeamAdminConfig
-> Rep ExposeInvitationURLsToTeamAdminConfig x
from :: forall x.
ExposeInvitationURLsToTeamAdminConfig
-> Rep ExposeInvitationURLsToTeamAdminConfig x
$cto :: forall x.
Rep ExposeInvitationURLsToTeamAdminConfig x
-> ExposeInvitationURLsToTeamAdminConfig
to :: forall x.
Rep ExposeInvitationURLsToTeamAdminConfig x
-> ExposeInvitationURLsToTeamAdminConfig
Generic)
  deriving (Gen ExposeInvitationURLsToTeamAdminConfig
Gen ExposeInvitationURLsToTeamAdminConfig
-> (ExposeInvitationURLsToTeamAdminConfig
    -> [ExposeInvitationURLsToTeamAdminConfig])
-> Arbitrary ExposeInvitationURLsToTeamAdminConfig
ExposeInvitationURLsToTeamAdminConfig
-> [ExposeInvitationURLsToTeamAdminConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ExposeInvitationURLsToTeamAdminConfig
arbitrary :: Gen ExposeInvitationURLsToTeamAdminConfig
$cshrink :: ExposeInvitationURLsToTeamAdminConfig
-> [ExposeInvitationURLsToTeamAdminConfig]
shrink :: ExposeInvitationURLsToTeamAdminConfig
-> [ExposeInvitationURLsToTeamAdminConfig]
Arbitrary) via (GenericUniform ExposeInvitationURLsToTeamAdminConfig)
  deriving (Text
Text -> RenderableSymbol ExposeInvitationURLsToTeamAdminConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName ExposeInvitationURLsToTeamAdminConfig)

instance Default ExposeInvitationURLsToTeamAdminConfig where
  def :: ExposeInvitationURLsToTeamAdminConfig
def = ExposeInvitationURLsToTeamAdminConfig
ExposeInvitationURLsToTeamAdminConfig

instance Default (LockableFeature ExposeInvitationURLsToTeamAdminConfig) where
  def :: LockableFeature ExposeInvitationURLsToTeamAdminConfig
def = LockableFeature ExposeInvitationURLsToTeamAdminConfig
forall cfg. Default cfg => LockableFeature cfg
defLockedFeature

instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where
  type FeatureSymbol ExposeInvitationURLsToTeamAdminConfig = "exposeInvitationURLsToTeamAdmin"
  featureSingleton :: FeatureSingleton ExposeInvitationURLsToTeamAdminConfig
featureSingleton = FeatureSingleton ExposeInvitationURLsToTeamAdminConfig
FeatureSingletonExposeInvitationURLsToTeamAdminConfig
  objectSchema :: ObjectSchema SwaggerDoc ExposeInvitationURLsToTeamAdminConfig
objectSchema = ExposeInvitationURLsToTeamAdminConfig
-> ObjectSchema SwaggerDoc ExposeInvitationURLsToTeamAdminConfig
forall a.
a
-> SchemaP
     SwaggerDoc Object [Pair] ExposeInvitationURLsToTeamAdminConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExposeInvitationURLsToTeamAdminConfig
ExposeInvitationURLsToTeamAdminConfig

instance ToSchema ExposeInvitationURLsToTeamAdminConfig where
  schema :: ValueSchema NamedSwaggerDoc ExposeInvitationURLsToTeamAdminConfig
schema = Text
-> ObjectSchema SwaggerDoc ExposeInvitationURLsToTeamAdminConfig
-> ValueSchema
     NamedSwaggerDoc ExposeInvitationURLsToTeamAdminConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ExposeInvitationURLsToTeamAdminConfig" ObjectSchema SwaggerDoc ExposeInvitationURLsToTeamAdminConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

----------------------------------------------------------------------
-- OutlookCalIntegrationConfig

-- | This feature setting only applies to the Outlook Calendar extension for Wire.
-- As it is an external service, it should only be configured through this feature flag and otherwise ignored by the backend.
data OutlookCalIntegrationConfig = OutlookCalIntegrationConfig
  deriving stock (OutlookCalIntegrationConfig -> OutlookCalIntegrationConfig -> Bool
(OutlookCalIntegrationConfig
 -> OutlookCalIntegrationConfig -> Bool)
-> (OutlookCalIntegrationConfig
    -> OutlookCalIntegrationConfig -> Bool)
-> Eq OutlookCalIntegrationConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutlookCalIntegrationConfig -> OutlookCalIntegrationConfig -> Bool
== :: OutlookCalIntegrationConfig -> OutlookCalIntegrationConfig -> Bool
$c/= :: OutlookCalIntegrationConfig -> OutlookCalIntegrationConfig -> Bool
/= :: OutlookCalIntegrationConfig -> OutlookCalIntegrationConfig -> Bool
Eq, Int -> OutlookCalIntegrationConfig -> ShowS
[OutlookCalIntegrationConfig] -> ShowS
OutlookCalIntegrationConfig -> String
(Int -> OutlookCalIntegrationConfig -> ShowS)
-> (OutlookCalIntegrationConfig -> String)
-> ([OutlookCalIntegrationConfig] -> ShowS)
-> Show OutlookCalIntegrationConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutlookCalIntegrationConfig -> ShowS
showsPrec :: Int -> OutlookCalIntegrationConfig -> ShowS
$cshow :: OutlookCalIntegrationConfig -> String
show :: OutlookCalIntegrationConfig -> String
$cshowList :: [OutlookCalIntegrationConfig] -> ShowS
showList :: [OutlookCalIntegrationConfig] -> ShowS
Show, (forall x.
 OutlookCalIntegrationConfig -> Rep OutlookCalIntegrationConfig x)
-> (forall x.
    Rep OutlookCalIntegrationConfig x -> OutlookCalIntegrationConfig)
-> Generic OutlookCalIntegrationConfig
forall x.
Rep OutlookCalIntegrationConfig x -> OutlookCalIntegrationConfig
forall x.
OutlookCalIntegrationConfig -> Rep OutlookCalIntegrationConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OutlookCalIntegrationConfig -> Rep OutlookCalIntegrationConfig x
from :: forall x.
OutlookCalIntegrationConfig -> Rep OutlookCalIntegrationConfig x
$cto :: forall x.
Rep OutlookCalIntegrationConfig x -> OutlookCalIntegrationConfig
to :: forall x.
Rep OutlookCalIntegrationConfig x -> OutlookCalIntegrationConfig
Generic)
  deriving (Gen OutlookCalIntegrationConfig
Gen OutlookCalIntegrationConfig
-> (OutlookCalIntegrationConfig -> [OutlookCalIntegrationConfig])
-> Arbitrary OutlookCalIntegrationConfig
OutlookCalIntegrationConfig -> [OutlookCalIntegrationConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OutlookCalIntegrationConfig
arbitrary :: Gen OutlookCalIntegrationConfig
$cshrink :: OutlookCalIntegrationConfig -> [OutlookCalIntegrationConfig]
shrink :: OutlookCalIntegrationConfig -> [OutlookCalIntegrationConfig]
Arbitrary) via (GenericUniform OutlookCalIntegrationConfig)
  deriving (Text
Text -> RenderableSymbol OutlookCalIntegrationConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName OutlookCalIntegrationConfig)

instance Default OutlookCalIntegrationConfig where
  def :: OutlookCalIntegrationConfig
def = OutlookCalIntegrationConfig
OutlookCalIntegrationConfig

instance Default (LockableFeature OutlookCalIntegrationConfig) where
  def :: LockableFeature OutlookCalIntegrationConfig
def = LockableFeature OutlookCalIntegrationConfig
forall cfg. Default cfg => LockableFeature cfg
defLockedFeature

instance IsFeatureConfig OutlookCalIntegrationConfig where
  type FeatureSymbol OutlookCalIntegrationConfig = "outlookCalIntegration"
  featureSingleton :: FeatureSingleton OutlookCalIntegrationConfig
featureSingleton = FeatureSingleton OutlookCalIntegrationConfig
FeatureSingletonOutlookCalIntegrationConfig
  objectSchema :: ObjectSchema SwaggerDoc OutlookCalIntegrationConfig
objectSchema = OutlookCalIntegrationConfig
-> ObjectSchema SwaggerDoc OutlookCalIntegrationConfig
forall a.
a -> SchemaP SwaggerDoc Object [Pair] OutlookCalIntegrationConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutlookCalIntegrationConfig
OutlookCalIntegrationConfig

instance ToSchema OutlookCalIntegrationConfig where
  schema :: ValueSchema NamedSwaggerDoc OutlookCalIntegrationConfig
schema = Text
-> ObjectSchema SwaggerDoc OutlookCalIntegrationConfig
-> ValueSchema NamedSwaggerDoc OutlookCalIntegrationConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"OutlookCalIntegrationConfig" ObjectSchema SwaggerDoc OutlookCalIntegrationConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

----------------------------------------------------------------------
-- MlsE2EId

data MlsE2EIdConfig = MlsE2EIdConfig
  { MlsE2EIdConfig -> NominalDiffTime
verificationExpiration :: NominalDiffTime,
    MlsE2EIdConfig -> Maybe HttpsUrl
acmeDiscoveryUrl :: Maybe HttpsUrl,
    MlsE2EIdConfig -> Maybe HttpsUrl
crlProxy :: Maybe HttpsUrl,
    MlsE2EIdConfig -> Bool
useProxyOnMobile :: Bool
  }
  deriving stock (MlsE2EIdConfig -> MlsE2EIdConfig -> Bool
(MlsE2EIdConfig -> MlsE2EIdConfig -> Bool)
-> (MlsE2EIdConfig -> MlsE2EIdConfig -> Bool) -> Eq MlsE2EIdConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MlsE2EIdConfig -> MlsE2EIdConfig -> Bool
== :: MlsE2EIdConfig -> MlsE2EIdConfig -> Bool
$c/= :: MlsE2EIdConfig -> MlsE2EIdConfig -> Bool
/= :: MlsE2EIdConfig -> MlsE2EIdConfig -> Bool
Eq, Int -> MlsE2EIdConfig -> ShowS
[MlsE2EIdConfig] -> ShowS
MlsE2EIdConfig -> String
(Int -> MlsE2EIdConfig -> ShowS)
-> (MlsE2EIdConfig -> String)
-> ([MlsE2EIdConfig] -> ShowS)
-> Show MlsE2EIdConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MlsE2EIdConfig -> ShowS
showsPrec :: Int -> MlsE2EIdConfig -> ShowS
$cshow :: MlsE2EIdConfig -> String
show :: MlsE2EIdConfig -> String
$cshowList :: [MlsE2EIdConfig] -> ShowS
showList :: [MlsE2EIdConfig] -> ShowS
Show, (forall x. MlsE2EIdConfig -> Rep MlsE2EIdConfig x)
-> (forall x. Rep MlsE2EIdConfig x -> MlsE2EIdConfig)
-> Generic MlsE2EIdConfig
forall x. Rep MlsE2EIdConfig x -> MlsE2EIdConfig
forall x. MlsE2EIdConfig -> Rep MlsE2EIdConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MlsE2EIdConfig -> Rep MlsE2EIdConfig x
from :: forall x. MlsE2EIdConfig -> Rep MlsE2EIdConfig x
$cto :: forall x. Rep MlsE2EIdConfig x -> MlsE2EIdConfig
to :: forall x. Rep MlsE2EIdConfig x -> MlsE2EIdConfig
Generic)
  deriving (Text
Text -> RenderableSymbol MlsE2EIdConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName MlsE2EIdConfig)

instance Default MlsE2EIdConfig where
  def :: MlsE2EIdConfig
def = NominalDiffTime
-> Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig
MlsE2EIdConfig (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24)) Maybe HttpsUrl
forall a. Maybe a
Nothing Maybe HttpsUrl
forall a. Maybe a
Nothing Bool
False

instance Arbitrary MlsE2EIdConfig where
  arbitrary :: Gen MlsE2EIdConfig
arbitrary =
    NominalDiffTime
-> Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig
MlsE2EIdConfig
      (NominalDiffTime
 -> Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
-> Gen NominalDiffTime
-> Gen (Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> NominalDiffTime) -> Gen Word32 -> Gen NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => Gen a
arbitrary @Word32))
      Gen (Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
-> Gen (Maybe HttpsUrl)
-> Gen (Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe HttpsUrl)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
-> Gen (Maybe HttpsUrl) -> Gen (Bool -> MlsE2EIdConfig)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HttpsUrl -> Maybe HttpsUrl)
-> Gen HttpsUrl -> Gen (Maybe HttpsUrl)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HttpsUrl -> Maybe HttpsUrl
forall a. a -> Maybe a
Just Gen HttpsUrl
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Bool -> MlsE2EIdConfig) -> Gen Bool -> Gen MlsE2EIdConfig
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary

instance ToSchema MlsE2EIdConfig where
  schema :: ValueSchema NamedSwaggerDoc MlsE2EIdConfig
  schema :: ValueSchema NamedSwaggerDoc MlsE2EIdConfig
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig MlsE2EIdConfig
-> ValueSchema NamedSwaggerDoc MlsE2EIdConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"MlsE2EIdConfig" (SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig MlsE2EIdConfig
 -> ValueSchema NamedSwaggerDoc MlsE2EIdConfig)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig MlsE2EIdConfig
-> ValueSchema NamedSwaggerDoc MlsE2EIdConfig
forall a b. (a -> b) -> a -> b
$
      NominalDiffTime
-> Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig
MlsE2EIdConfig
        (NominalDiffTime
 -> Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig NominalDiffTime
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MlsE2EIdConfig
     (Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NominalDiffTime -> Int
toSeconds (NominalDiffTime -> Int)
-> (MlsE2EIdConfig -> NominalDiffTime) -> MlsE2EIdConfig -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MlsE2EIdConfig -> NominalDiffTime
verificationExpiration) (MlsE2EIdConfig -> Int)
-> SchemaP SwaggerDoc Object [Pair] Int NominalDiffTime
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig NominalDiffTime
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Int NominalDiffTime
-> SchemaP SwaggerDoc Object [Pair] Int NominalDiffTime
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"verificationExpiration" NamedSwaggerDoc -> NamedSwaggerDoc
veDesc (Int -> NominalDiffTime
fromSeconds (Int -> NominalDiffTime)
-> SchemaP NamedSwaggerDoc Value Value Int Int
-> SchemaP NamedSwaggerDoc Value Value Int NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaP NamedSwaggerDoc Value Value Int Int
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MlsE2EIdConfig
  (Maybe HttpsUrl -> Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MlsE2EIdConfig
     (Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
forall a b.
SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig a
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MlsE2EIdConfig -> Maybe HttpsUrl
acmeDiscoveryUrl (MlsE2EIdConfig -> Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig (Maybe HttpsUrl)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
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 HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
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
"acmeDiscoveryUrl" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MlsE2EIdConfig
  (Maybe HttpsUrl -> Bool -> MlsE2EIdConfig)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] MlsE2EIdConfig (Bool -> MlsE2EIdConfig)
forall a b.
SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig a
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MlsE2EIdConfig -> Maybe HttpsUrl
crlProxy (MlsE2EIdConfig -> Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig (Maybe HttpsUrl)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
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 HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
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
"crlProxy" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc Object [Pair] MlsE2EIdConfig (Bool -> MlsE2EIdConfig)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig Bool
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig MlsE2EIdConfig
forall a b.
SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig a
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MlsE2EIdConfig -> Bool
useProxyOnMobile (MlsE2EIdConfig -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
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
"useProxyOnMobile" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    where
      fromSeconds :: Int -> NominalDiffTime
      fromSeconds :: Int -> NominalDiffTime
fromSeconds = Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral

      toSeconds :: NominalDiffTime -> Int
      toSeconds :: NominalDiffTime -> Int
toSeconds = NominalDiffTime -> Int
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate

      veDesc :: NamedSwaggerDoc -> NamedSwaggerDoc
      veDesc :: NamedSwaggerDoc -> NamedSwaggerDoc
veDesc =
        (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description
          ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"When a client first tries to fetch or renew a certificate, \
             \they may need to login to an identity provider (IdP) depending on their IdP domain authentication policy. \
             \The user may have a grace period during which they can \"snooze\" this login. \
             \The duration of this grace period (in seconds) is set in the `verificationDuration` parameter, \
             \which is enforced separately by each client. \
             \After the grace period has expired, the client will not allow the user to use the application \
             \until they have logged to refresh the certificate. The default value is 1 day (86400s). \
             \The client enrolls using the Automatic Certificate Management Environment (ACME) protocol. \
             \The `acmeDiscoveryUrl` parameter must be set to the HTTPS URL of the ACME server discovery endpoint for \
             \this team. It is of the form \"https://acme.{backendDomain}/acme/{provisionerName}/discovery\". For example: \
             \`https://acme.example.com/acme/provisioner1/discovery`."

instance Default (LockableFeature MlsE2EIdConfig) where
  def :: LockableFeature MlsE2EIdConfig
def = LockableFeature MlsE2EIdConfig
forall cfg. Default cfg => LockableFeature cfg
defLockedFeature

instance IsFeatureConfig MlsE2EIdConfig where
  type FeatureSymbol MlsE2EIdConfig = "mlsE2EId"
  featureSingleton :: FeatureSingleton MlsE2EIdConfig
featureSingleton = FeatureSingleton MlsE2EIdConfig
FeatureSingletonMlsE2EIdConfig
  objectSchema :: SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig MlsE2EIdConfig
objectSchema = Text
-> ValueSchema NamedSwaggerDoc MlsE2EIdConfig
-> SchemaP SwaggerDoc Object [Pair] MlsE2EIdConfig MlsE2EIdConfig
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"config" ValueSchema NamedSwaggerDoc MlsE2EIdConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

----------------------------------------------------------------------
-- MlsMigration

data MlsMigrationConfig = MlsMigrationConfig
  { MlsMigrationConfig -> Maybe UTCTime
startTime :: Maybe UTCTime,
    MlsMigrationConfig -> Maybe UTCTime
finaliseRegardlessAfter :: Maybe UTCTime
  }
  deriving stock (MlsMigrationConfig -> MlsMigrationConfig -> Bool
(MlsMigrationConfig -> MlsMigrationConfig -> Bool)
-> (MlsMigrationConfig -> MlsMigrationConfig -> Bool)
-> Eq MlsMigrationConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MlsMigrationConfig -> MlsMigrationConfig -> Bool
== :: MlsMigrationConfig -> MlsMigrationConfig -> Bool
$c/= :: MlsMigrationConfig -> MlsMigrationConfig -> Bool
/= :: MlsMigrationConfig -> MlsMigrationConfig -> Bool
Eq, Int -> MlsMigrationConfig -> ShowS
[MlsMigrationConfig] -> ShowS
MlsMigrationConfig -> String
(Int -> MlsMigrationConfig -> ShowS)
-> (MlsMigrationConfig -> String)
-> ([MlsMigrationConfig] -> ShowS)
-> Show MlsMigrationConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MlsMigrationConfig -> ShowS
showsPrec :: Int -> MlsMigrationConfig -> ShowS
$cshow :: MlsMigrationConfig -> String
show :: MlsMigrationConfig -> String
$cshowList :: [MlsMigrationConfig] -> ShowS
showList :: [MlsMigrationConfig] -> ShowS
Show, (forall x. MlsMigrationConfig -> Rep MlsMigrationConfig x)
-> (forall x. Rep MlsMigrationConfig x -> MlsMigrationConfig)
-> Generic MlsMigrationConfig
forall x. Rep MlsMigrationConfig x -> MlsMigrationConfig
forall x. MlsMigrationConfig -> Rep MlsMigrationConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MlsMigrationConfig -> Rep MlsMigrationConfig x
from :: forall x. MlsMigrationConfig -> Rep MlsMigrationConfig x
$cto :: forall x. Rep MlsMigrationConfig x -> MlsMigrationConfig
to :: forall x. Rep MlsMigrationConfig x -> MlsMigrationConfig
Generic)
  deriving (Text
Text -> RenderableSymbol MlsMigrationConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName MlsMigrationConfig)

instance Default MlsMigrationConfig where
  def :: MlsMigrationConfig
def = Maybe UTCTime -> Maybe UTCTime -> MlsMigrationConfig
MlsMigrationConfig Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing

instance Arbitrary MlsMigrationConfig where
  arbitrary :: Gen MlsMigrationConfig
arbitrary = do
    Maybe UTCTime
startTime <- (UTCTimeMillis -> UTCTime) -> Maybe UTCTimeMillis -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTimeMillis -> UTCTime
fromUTCTimeMillis (Maybe UTCTimeMillis -> Maybe UTCTime)
-> Gen (Maybe UTCTimeMillis) -> Gen (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe UTCTimeMillis)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe UTCTime
finaliseRegardlessAfter <- (UTCTimeMillis -> UTCTime) -> Maybe UTCTimeMillis -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTimeMillis -> UTCTime
fromUTCTimeMillis (Maybe UTCTimeMillis -> Maybe UTCTime)
-> Gen (Maybe UTCTimeMillis) -> Gen (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe UTCTimeMillis)
forall a. Arbitrary a => Gen a
arbitrary
    pure
      MlsMigrationConfig
        { $sel:startTime:MlsMigrationConfig :: Maybe UTCTime
startTime = Maybe UTCTime
startTime,
          $sel:finaliseRegardlessAfter:MlsMigrationConfig :: Maybe UTCTime
finaliseRegardlessAfter = Maybe UTCTime
finaliseRegardlessAfter
        }

instance ToSchema MlsMigrationConfig where
  schema :: ValueSchema NamedSwaggerDoc MlsMigrationConfig
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig MlsMigrationConfig
-> ValueSchema NamedSwaggerDoc MlsMigrationConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"MlsMigration" (SchemaP
   SwaggerDoc Object [Pair] MlsMigrationConfig MlsMigrationConfig
 -> ValueSchema NamedSwaggerDoc MlsMigrationConfig)
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig MlsMigrationConfig
-> ValueSchema NamedSwaggerDoc MlsMigrationConfig
forall a b. (a -> b) -> a -> b
$
      Maybe UTCTime -> Maybe UTCTime -> MlsMigrationConfig
MlsMigrationConfig
        (Maybe UTCTime -> Maybe UTCTime -> MlsMigrationConfig)
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig (Maybe UTCTime)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MlsMigrationConfig
     (Maybe UTCTime -> MlsMigrationConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MlsMigrationConfig -> Maybe UTCTime
startTime (MlsMigrationConfig -> Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig (Maybe UTCTime)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UTCTime (Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
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 UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTime (Maybe UTCTime)
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
"startTime" SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
utcTimeSchema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MlsMigrationConfig
  (Maybe UTCTime -> MlsMigrationConfig)
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig (Maybe UTCTime)
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig MlsMigrationConfig
forall a b.
SchemaP SwaggerDoc Object [Pair] MlsMigrationConfig (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MlsMigrationConfig a
-> SchemaP SwaggerDoc Object [Pair] MlsMigrationConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MlsMigrationConfig -> Maybe UTCTime
finaliseRegardlessAfter (MlsMigrationConfig -> Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig (Maybe UTCTime)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UTCTime (Maybe UTCTime)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UTCTime) (Maybe UTCTime)
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 UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTime (Maybe UTCTime)
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
"finaliseRegardlessAfter" SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
utcTimeSchema)

instance Default (LockableFeature MlsMigrationConfig) where
  def :: LockableFeature MlsMigrationConfig
def = LockableFeature MlsMigrationConfig
forall cfg. Default cfg => LockableFeature cfg
defLockedFeature

instance IsFeatureConfig MlsMigrationConfig where
  type FeatureSymbol MlsMigrationConfig = "mlsMigration"
  featureSingleton :: FeatureSingleton MlsMigrationConfig
featureSingleton = FeatureSingleton MlsMigrationConfig
FeatureSingletonMlsMigrationConfig
  objectSchema :: SchemaP
  SwaggerDoc Object [Pair] MlsMigrationConfig MlsMigrationConfig
objectSchema = Text
-> ValueSchema NamedSwaggerDoc MlsMigrationConfig
-> SchemaP
     SwaggerDoc Object [Pair] MlsMigrationConfig MlsMigrationConfig
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"config" ValueSchema NamedSwaggerDoc MlsMigrationConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

----------------------------------------------------------------------
-- EnforceFileDownloadLocationConfig

data EnforceFileDownloadLocationConfig = EnforceFileDownloadLocationConfig
  { EnforceFileDownloadLocationConfig -> Maybe Text
enforcedDownloadLocation :: Maybe Text
  }
  deriving stock (EnforceFileDownloadLocationConfig
-> EnforceFileDownloadLocationConfig -> Bool
(EnforceFileDownloadLocationConfig
 -> EnforceFileDownloadLocationConfig -> Bool)
-> (EnforceFileDownloadLocationConfig
    -> EnforceFileDownloadLocationConfig -> Bool)
-> Eq EnforceFileDownloadLocationConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnforceFileDownloadLocationConfig
-> EnforceFileDownloadLocationConfig -> Bool
== :: EnforceFileDownloadLocationConfig
-> EnforceFileDownloadLocationConfig -> Bool
$c/= :: EnforceFileDownloadLocationConfig
-> EnforceFileDownloadLocationConfig -> Bool
/= :: EnforceFileDownloadLocationConfig
-> EnforceFileDownloadLocationConfig -> Bool
Eq, Int -> EnforceFileDownloadLocationConfig -> ShowS
[EnforceFileDownloadLocationConfig] -> ShowS
EnforceFileDownloadLocationConfig -> String
(Int -> EnforceFileDownloadLocationConfig -> ShowS)
-> (EnforceFileDownloadLocationConfig -> String)
-> ([EnforceFileDownloadLocationConfig] -> ShowS)
-> Show EnforceFileDownloadLocationConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnforceFileDownloadLocationConfig -> ShowS
showsPrec :: Int -> EnforceFileDownloadLocationConfig -> ShowS
$cshow :: EnforceFileDownloadLocationConfig -> String
show :: EnforceFileDownloadLocationConfig -> String
$cshowList :: [EnforceFileDownloadLocationConfig] -> ShowS
showList :: [EnforceFileDownloadLocationConfig] -> ShowS
Show, (forall x.
 EnforceFileDownloadLocationConfig
 -> Rep EnforceFileDownloadLocationConfig x)
-> (forall x.
    Rep EnforceFileDownloadLocationConfig x
    -> EnforceFileDownloadLocationConfig)
-> Generic EnforceFileDownloadLocationConfig
forall x.
Rep EnforceFileDownloadLocationConfig x
-> EnforceFileDownloadLocationConfig
forall x.
EnforceFileDownloadLocationConfig
-> Rep EnforceFileDownloadLocationConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
EnforceFileDownloadLocationConfig
-> Rep EnforceFileDownloadLocationConfig x
from :: forall x.
EnforceFileDownloadLocationConfig
-> Rep EnforceFileDownloadLocationConfig x
$cto :: forall x.
Rep EnforceFileDownloadLocationConfig x
-> EnforceFileDownloadLocationConfig
to :: forall x.
Rep EnforceFileDownloadLocationConfig x
-> EnforceFileDownloadLocationConfig
Generic)
  deriving (Text
Text -> RenderableSymbol EnforceFileDownloadLocationConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName EnforceFileDownloadLocationConfig)

instance Default EnforceFileDownloadLocationConfig where
  def :: EnforceFileDownloadLocationConfig
def = Maybe Text -> EnforceFileDownloadLocationConfig
EnforceFileDownloadLocationConfig Maybe Text
forall a. Maybe a
Nothing

instance Arbitrary EnforceFileDownloadLocationConfig where
  arbitrary :: Gen EnforceFileDownloadLocationConfig
arbitrary = Maybe Text -> EnforceFileDownloadLocationConfig
EnforceFileDownloadLocationConfig (Maybe Text -> EnforceFileDownloadLocationConfig)
-> (Maybe PrintableString -> Maybe Text)
-> Maybe PrintableString
-> EnforceFileDownloadLocationConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrintableString -> Text) -> Maybe PrintableString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
getPrintableString) (Maybe PrintableString -> EnforceFileDownloadLocationConfig)
-> Gen (Maybe PrintableString)
-> Gen EnforceFileDownloadLocationConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe PrintableString)
forall a. Arbitrary a => Gen a
arbitrary

instance ToSchema EnforceFileDownloadLocationConfig where
  schema :: ValueSchema NamedSwaggerDoc EnforceFileDownloadLocationConfig
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     EnforceFileDownloadLocationConfig
     EnforceFileDownloadLocationConfig
-> ValueSchema NamedSwaggerDoc EnforceFileDownloadLocationConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"EnforceFileDownloadLocation" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   EnforceFileDownloadLocationConfig
   EnforceFileDownloadLocationConfig
 -> ValueSchema NamedSwaggerDoc EnforceFileDownloadLocationConfig)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     EnforceFileDownloadLocationConfig
     EnforceFileDownloadLocationConfig
-> ValueSchema NamedSwaggerDoc EnforceFileDownloadLocationConfig
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> EnforceFileDownloadLocationConfig
EnforceFileDownloadLocationConfig
        (Maybe Text -> EnforceFileDownloadLocationConfig)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     EnforceFileDownloadLocationConfig
     (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     EnforceFileDownloadLocationConfig
     EnforceFileDownloadLocationConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnforceFileDownloadLocationConfig -> Maybe Text
enforcedDownloadLocation (EnforceFileDownloadLocationConfig -> Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     EnforceFileDownloadLocationConfig
     (Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
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 Text Text
-> SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
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
"enforcedDownloadLocation" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance Default (LockableFeature EnforceFileDownloadLocationConfig) where
  def :: LockableFeature EnforceFileDownloadLocationConfig
def = LockableFeature EnforceFileDownloadLocationConfig
forall cfg. Default cfg => LockableFeature cfg
defLockedFeature

instance IsFeatureConfig EnforceFileDownloadLocationConfig where
  type FeatureSymbol EnforceFileDownloadLocationConfig = "enforceFileDownloadLocation"
  featureSingleton :: FeatureSingleton EnforceFileDownloadLocationConfig
featureSingleton = FeatureSingleton EnforceFileDownloadLocationConfig
FeatureSingletonEnforceFileDownloadLocationConfig
  objectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  EnforceFileDownloadLocationConfig
  EnforceFileDownloadLocationConfig
objectSchema = Text
-> ValueSchema NamedSwaggerDoc EnforceFileDownloadLocationConfig
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     EnforceFileDownloadLocationConfig
     EnforceFileDownloadLocationConfig
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"config" ValueSchema NamedSwaggerDoc EnforceFileDownloadLocationConfig
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

----------------------------------------------------------------------
-- Guarding the fanout of events when a team member is deleted.
--
-- FUTUREWORK: This is a transient flag that is to be removed after about 6
-- months of its introduction, namely once all clients get a chance to adapt to
-- a limited event fanout.

-- | This feature does not have a PUT endpoint. See [Note: unsettable features].
data LimitedEventFanoutConfig = LimitedEventFanoutConfig
  deriving stock (LimitedEventFanoutConfig -> LimitedEventFanoutConfig -> Bool
(LimitedEventFanoutConfig -> LimitedEventFanoutConfig -> Bool)
-> (LimitedEventFanoutConfig -> LimitedEventFanoutConfig -> Bool)
-> Eq LimitedEventFanoutConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LimitedEventFanoutConfig -> LimitedEventFanoutConfig -> Bool
== :: LimitedEventFanoutConfig -> LimitedEventFanoutConfig -> Bool
$c/= :: LimitedEventFanoutConfig -> LimitedEventFanoutConfig -> Bool
/= :: LimitedEventFanoutConfig -> LimitedEventFanoutConfig -> Bool
Eq, Int -> LimitedEventFanoutConfig -> ShowS
[LimitedEventFanoutConfig] -> ShowS
LimitedEventFanoutConfig -> String
(Int -> LimitedEventFanoutConfig -> ShowS)
-> (LimitedEventFanoutConfig -> String)
-> ([LimitedEventFanoutConfig] -> ShowS)
-> Show LimitedEventFanoutConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LimitedEventFanoutConfig -> ShowS
showsPrec :: Int -> LimitedEventFanoutConfig -> ShowS
$cshow :: LimitedEventFanoutConfig -> String
show :: LimitedEventFanoutConfig -> String
$cshowList :: [LimitedEventFanoutConfig] -> ShowS
showList :: [LimitedEventFanoutConfig] -> ShowS
Show, (forall x.
 LimitedEventFanoutConfig -> Rep LimitedEventFanoutConfig x)
-> (forall x.
    Rep LimitedEventFanoutConfig x -> LimitedEventFanoutConfig)
-> Generic LimitedEventFanoutConfig
forall x.
Rep LimitedEventFanoutConfig x -> LimitedEventFanoutConfig
forall x.
LimitedEventFanoutConfig -> Rep LimitedEventFanoutConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LimitedEventFanoutConfig -> Rep LimitedEventFanoutConfig x
from :: forall x.
LimitedEventFanoutConfig -> Rep LimitedEventFanoutConfig x
$cto :: forall x.
Rep LimitedEventFanoutConfig x -> LimitedEventFanoutConfig
to :: forall x.
Rep LimitedEventFanoutConfig x -> LimitedEventFanoutConfig
Generic)
  deriving (Gen LimitedEventFanoutConfig
Gen LimitedEventFanoutConfig
-> (LimitedEventFanoutConfig -> [LimitedEventFanoutConfig])
-> Arbitrary LimitedEventFanoutConfig
LimitedEventFanoutConfig -> [LimitedEventFanoutConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LimitedEventFanoutConfig
arbitrary :: Gen LimitedEventFanoutConfig
$cshrink :: LimitedEventFanoutConfig -> [LimitedEventFanoutConfig]
shrink :: LimitedEventFanoutConfig -> [LimitedEventFanoutConfig]
Arbitrary) via (GenericUniform LimitedEventFanoutConfig)
  deriving (Text
Text -> RenderableSymbol LimitedEventFanoutConfig
forall {k} (a :: k). Text -> RenderableSymbol a
$crenderSymbol :: Text
renderSymbol :: Text
RenderableSymbol) via (RenderableTypeName LimitedEventFanoutConfig)

instance Default LimitedEventFanoutConfig where
  def :: LimitedEventFanoutConfig
def = LimitedEventFanoutConfig
LimitedEventFanoutConfig

instance Default (LockableFeature LimitedEventFanoutConfig) where
  def :: LockableFeature LimitedEventFanoutConfig
def = LockableFeature LimitedEventFanoutConfig
forall cfg. Default cfg => LockableFeature cfg
defUnlockedFeature

instance IsFeatureConfig LimitedEventFanoutConfig where
  type FeatureSymbol LimitedEventFanoutConfig = "limitedEventFanout"
  featureSingleton :: FeatureSingleton LimitedEventFanoutConfig
featureSingleton = FeatureSingleton LimitedEventFanoutConfig
FeatureSingletonLimitedEventFanoutConfig
  objectSchema :: ObjectSchema SwaggerDoc LimitedEventFanoutConfig
objectSchema = LimitedEventFanoutConfig
-> ObjectSchema SwaggerDoc LimitedEventFanoutConfig
forall a.
a -> SchemaP SwaggerDoc Object [Pair] LimitedEventFanoutConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LimitedEventFanoutConfig
LimitedEventFanoutConfig

instance ToSchema LimitedEventFanoutConfig where
  schema :: ValueSchema NamedSwaggerDoc LimitedEventFanoutConfig
schema = Text
-> ObjectSchema SwaggerDoc LimitedEventFanoutConfig
-> ValueSchema NamedSwaggerDoc LimitedEventFanoutConfig
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"LimitedEventFanoutConfig" ObjectSchema SwaggerDoc LimitedEventFanoutConfig
forall cfg. IsFeatureConfig cfg => ObjectSchema SwaggerDoc cfg
objectSchema

----------------------------------------------------------------------
-- FeatureStatus

data FeatureStatus
  = FeatureStatusEnabled
  | FeatureStatusDisabled
  deriving stock (FeatureStatus -> FeatureStatus -> Bool
(FeatureStatus -> FeatureStatus -> Bool)
-> (FeatureStatus -> FeatureStatus -> Bool) -> Eq FeatureStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeatureStatus -> FeatureStatus -> Bool
== :: FeatureStatus -> FeatureStatus -> Bool
$c/= :: FeatureStatus -> FeatureStatus -> Bool
/= :: FeatureStatus -> FeatureStatus -> Bool
Eq, Eq FeatureStatus
Eq FeatureStatus =>
(FeatureStatus -> FeatureStatus -> Ordering)
-> (FeatureStatus -> FeatureStatus -> Bool)
-> (FeatureStatus -> FeatureStatus -> Bool)
-> (FeatureStatus -> FeatureStatus -> Bool)
-> (FeatureStatus -> FeatureStatus -> Bool)
-> (FeatureStatus -> FeatureStatus -> FeatureStatus)
-> (FeatureStatus -> FeatureStatus -> FeatureStatus)
-> Ord FeatureStatus
FeatureStatus -> FeatureStatus -> Bool
FeatureStatus -> FeatureStatus -> Ordering
FeatureStatus -> FeatureStatus -> FeatureStatus
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 :: FeatureStatus -> FeatureStatus -> Ordering
compare :: FeatureStatus -> FeatureStatus -> Ordering
$c< :: FeatureStatus -> FeatureStatus -> Bool
< :: FeatureStatus -> FeatureStatus -> Bool
$c<= :: FeatureStatus -> FeatureStatus -> Bool
<= :: FeatureStatus -> FeatureStatus -> Bool
$c> :: FeatureStatus -> FeatureStatus -> Bool
> :: FeatureStatus -> FeatureStatus -> Bool
$c>= :: FeatureStatus -> FeatureStatus -> Bool
>= :: FeatureStatus -> FeatureStatus -> Bool
$cmax :: FeatureStatus -> FeatureStatus -> FeatureStatus
max :: FeatureStatus -> FeatureStatus -> FeatureStatus
$cmin :: FeatureStatus -> FeatureStatus -> FeatureStatus
min :: FeatureStatus -> FeatureStatus -> FeatureStatus
Ord, Int -> FeatureStatus
FeatureStatus -> Int
FeatureStatus -> [FeatureStatus]
FeatureStatus -> FeatureStatus
FeatureStatus -> FeatureStatus -> [FeatureStatus]
FeatureStatus -> FeatureStatus -> FeatureStatus -> [FeatureStatus]
(FeatureStatus -> FeatureStatus)
-> (FeatureStatus -> FeatureStatus)
-> (Int -> FeatureStatus)
-> (FeatureStatus -> Int)
-> (FeatureStatus -> [FeatureStatus])
-> (FeatureStatus -> FeatureStatus -> [FeatureStatus])
-> (FeatureStatus -> FeatureStatus -> [FeatureStatus])
-> (FeatureStatus
    -> FeatureStatus -> FeatureStatus -> [FeatureStatus])
-> Enum FeatureStatus
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 :: FeatureStatus -> FeatureStatus
succ :: FeatureStatus -> FeatureStatus
$cpred :: FeatureStatus -> FeatureStatus
pred :: FeatureStatus -> FeatureStatus
$ctoEnum :: Int -> FeatureStatus
toEnum :: Int -> FeatureStatus
$cfromEnum :: FeatureStatus -> Int
fromEnum :: FeatureStatus -> Int
$cenumFrom :: FeatureStatus -> [FeatureStatus]
enumFrom :: FeatureStatus -> [FeatureStatus]
$cenumFromThen :: FeatureStatus -> FeatureStatus -> [FeatureStatus]
enumFromThen :: FeatureStatus -> FeatureStatus -> [FeatureStatus]
$cenumFromTo :: FeatureStatus -> FeatureStatus -> [FeatureStatus]
enumFromTo :: FeatureStatus -> FeatureStatus -> [FeatureStatus]
$cenumFromThenTo :: FeatureStatus -> FeatureStatus -> FeatureStatus -> [FeatureStatus]
enumFromThenTo :: FeatureStatus -> FeatureStatus -> FeatureStatus -> [FeatureStatus]
Enum, FeatureStatus
FeatureStatus -> FeatureStatus -> Bounded FeatureStatus
forall a. a -> a -> Bounded a
$cminBound :: FeatureStatus
minBound :: FeatureStatus
$cmaxBound :: FeatureStatus
maxBound :: FeatureStatus
Bounded, Int -> FeatureStatus -> ShowS
[FeatureStatus] -> ShowS
FeatureStatus -> String
(Int -> FeatureStatus -> ShowS)
-> (FeatureStatus -> String)
-> ([FeatureStatus] -> ShowS)
-> Show FeatureStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeatureStatus -> ShowS
showsPrec :: Int -> FeatureStatus -> ShowS
$cshow :: FeatureStatus -> String
show :: FeatureStatus -> String
$cshowList :: [FeatureStatus] -> ShowS
showList :: [FeatureStatus] -> ShowS
Show, (forall x. FeatureStatus -> Rep FeatureStatus x)
-> (forall x. Rep FeatureStatus x -> FeatureStatus)
-> Generic FeatureStatus
forall x. Rep FeatureStatus x -> FeatureStatus
forall x. FeatureStatus -> Rep FeatureStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FeatureStatus -> Rep FeatureStatus x
from :: forall x. FeatureStatus -> Rep FeatureStatus x
$cto :: forall x. Rep FeatureStatus x -> FeatureStatus
to :: forall x. Rep FeatureStatus x -> FeatureStatus
Generic)
  deriving (Gen FeatureStatus
Gen FeatureStatus
-> (FeatureStatus -> [FeatureStatus]) -> Arbitrary FeatureStatus
FeatureStatus -> [FeatureStatus]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen FeatureStatus
arbitrary :: Gen FeatureStatus
$cshrink :: FeatureStatus -> [FeatureStatus]
shrink :: FeatureStatus -> [FeatureStatus]
Arbitrary) via (GenericUniform FeatureStatus)
  deriving ([FeatureStatus] -> Value
[FeatureStatus] -> Encoding
FeatureStatus -> Value
FeatureStatus -> Encoding
(FeatureStatus -> Value)
-> (FeatureStatus -> Encoding)
-> ([FeatureStatus] -> Value)
-> ([FeatureStatus] -> Encoding)
-> ToJSON FeatureStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FeatureStatus -> Value
toJSON :: FeatureStatus -> Value
$ctoEncoding :: FeatureStatus -> Encoding
toEncoding :: FeatureStatus -> Encoding
$ctoJSONList :: [FeatureStatus] -> Value
toJSONList :: [FeatureStatus] -> Value
$ctoEncodingList :: [FeatureStatus] -> Encoding
toEncodingList :: [FeatureStatus] -> Encoding
ToJSON, Value -> Parser [FeatureStatus]
Value -> Parser FeatureStatus
(Value -> Parser FeatureStatus)
-> (Value -> Parser [FeatureStatus]) -> FromJSON FeatureStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FeatureStatus
parseJSON :: Value -> Parser FeatureStatus
$cparseJSONList :: Value -> Parser [FeatureStatus]
parseJSONList :: Value -> Parser [FeatureStatus]
FromJSON, Typeable FeatureStatus
Typeable FeatureStatus =>
(Proxy FeatureStatus -> Declare (Definitions Schema) NamedSchema)
-> ToSchema FeatureStatus
Proxy FeatureStatus -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy FeatureStatus -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy FeatureStatus -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema FeatureStatus)

instance S.ToParamSchema FeatureStatus where
  toParamSchema :: Proxy FeatureStatus -> Schema
toParamSchema Proxy FeatureStatus
_ =
    Schema
forall a. Monoid a => a
mempty
      { S._schemaType = Just S.OpenApiString,
        S._schemaEnum = Just (A.String . toQueryParam <$> [(minBound :: FeatureStatus) ..])
      }

instance FromHttpApiData FeatureStatus where
  parseUrlPiece :: Text -> Either Text FeatureStatus
parseUrlPiece =
    Either Text FeatureStatus
-> (FeatureStatus -> Either Text FeatureStatus)
-> Maybe FeatureStatus
-> Either Text FeatureStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text FeatureStatus
forall a b. a -> Either a b
Left Text
"must be 'enabled' or 'disabled'") FeatureStatus -> Either Text FeatureStatus
forall a b. b -> Either a b
Right
      (Maybe FeatureStatus -> Either Text FeatureStatus)
-> (Text -> Maybe FeatureStatus)
-> Text
-> Either Text FeatureStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe FeatureStatus
forall a. FromByteString a => ByteString -> Maybe a
fromByteString'
      (ByteString -> Maybe FeatureStatus)
-> (Text -> ByteString) -> Text -> Maybe FeatureStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
      (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance ToHttpApiData FeatureStatus where
  toUrlPiece :: FeatureStatus -> Text
toUrlPiece = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (FeatureStatus -> ByteString) -> FeatureStatus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeatureStatus -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance ToSchema FeatureStatus where
  schema :: SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
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
"FeatureStatus" (SchemaP [Value] Text (Alt Maybe Text) FeatureStatus FeatureStatus
 -> SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus)
-> SchemaP
     [Value] Text (Alt Maybe Text) FeatureStatus FeatureStatus
-> SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) FeatureStatus FeatureStatus]
-> SchemaP
     [Value] Text (Alt Maybe Text) FeatureStatus FeatureStatus
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> FeatureStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) FeatureStatus FeatureStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"enabled" FeatureStatus
FeatureStatusEnabled,
          Text
-> FeatureStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) FeatureStatus FeatureStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"disabled" FeatureStatus
FeatureStatusDisabled
        ]

instance ToByteString FeatureStatus where
  builder :: FeatureStatus -> Builder
builder FeatureStatus
FeatureStatusEnabled = Builder
"enabled"
  builder FeatureStatus
FeatureStatusDisabled = Builder
"disabled"

instance FromByteString FeatureStatus where
  parser :: Parser FeatureStatus
parser =
    Parser ByteString
Parser.takeByteString Parser ByteString
-> (ByteString -> Parser FeatureStatus) -> Parser FeatureStatus
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
>>= \ByteString
b ->
      case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
b of
        Right Text
"enabled" -> FeatureStatus -> Parser FeatureStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureStatus
FeatureStatusEnabled
        Right Text
"disabled" -> FeatureStatus -> Parser FeatureStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureStatus
FeatureStatusDisabled
        Right Text
t -> String -> Parser FeatureStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FeatureStatus) -> String -> Parser FeatureStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid FeatureStatus: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t
        Left UnicodeException
e -> String -> Parser FeatureStatus
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FeatureStatus) -> String -> Parser FeatureStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid FeatureStatus: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e

instance Cass.Cql FeatureStatus where
  ctype :: Tagged FeatureStatus ColumnType
ctype = ColumnType -> Tagged FeatureStatus ColumnType
forall a b. b -> Tagged a b
Cass.Tagged ColumnType
Cass.IntColumn

  fromCql :: Value -> Either String FeatureStatus
fromCql (Cass.CqlInt Int32
n) = case Int32
n of
    Int32
0 -> FeatureStatus -> Either String FeatureStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureStatus
FeatureStatusDisabled
    Int32
1 -> FeatureStatus -> Either String FeatureStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureStatus
FeatureStatusEnabled
    Int32
_ -> String -> Either String FeatureStatus
forall a b. a -> Either a b
Left String
"fromCql: Invalid FeatureStatus"
  fromCql Value
_ = String -> Either String FeatureStatus
forall a b. a -> Either a b
Left String
"fromCql: FeatureStatus: CqlInt expected"

  toCql :: FeatureStatus -> Value
toCql FeatureStatus
FeatureStatusDisabled = Int32 -> Value
Cass.CqlInt Int32
0
  toCql FeatureStatus
FeatureStatusEnabled = Int32 -> Value
Cass.CqlInt Int32
1

-- | list of available features config types
type Features :: [Type]
type Features =
  [ LegalholdConfig,
    SSOConfig,
    SearchVisibilityAvailableConfig,
    SearchVisibilityInboundConfig,
    ValidateSAMLEmailsConfig,
    DigitalSignaturesConfig,
    AppLockConfig,
    FileSharingConfig,
    ClassifiedDomainsConfig,
    ConferenceCallingConfig,
    SelfDeletingMessagesConfig,
    GuestLinksConfig,
    SndFactorPasswordChallengeConfig,
    MLSConfig,
    ExposeInvitationURLsToTeamAdminConfig,
    OutlookCalIntegrationConfig,
    MlsE2EIdConfig,
    MlsMigrationConfig,
    EnforceFileDownloadLocationConfig,
    LimitedEventFanoutConfig
  ]

-- | list of available features as a record
type AllFeatures f = NP f Features

-- | 'AllFeatures' specialised to the 'LockableFeature' functor
type AllTeamFeatures = AllFeatures LockableFeature

class (Default (LockableFeature cfg)) => LockableFeatureDefault cfg

instance (Default (LockableFeature cfg)) => LockableFeatureDefault cfg

instance Default AllTeamFeatures where
  def :: AllTeamFeatures
def = Proxy LockableFeatureDefault
-> (forall a. LockableFeatureDefault a => LockableFeature a)
-> AllTeamFeatures
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @LockableFeatureDefault) LockableFeature a
forall a. Default a => a
forall a. LockableFeatureDefault a => LockableFeature a
def

-- | object schema for nary products
class HObjectSchema c xs where
  hobjectSchema :: (forall cfg. (c cfg) => ObjectSchema SwaggerDoc (f cfg)) -> ObjectSchema SwaggerDoc (NP f xs)

instance HObjectSchema c '[] where
  hobjectSchema :: forall (f :: k -> *).
(forall (cfg :: k). c cfg => ObjectSchema SwaggerDoc (f cfg))
-> ObjectSchema SwaggerDoc (NP f '[])
hobjectSchema forall (cfg :: k). c cfg => ObjectSchema SwaggerDoc (f cfg)
_ = NP f '[] -> SchemaP SwaggerDoc Object [Pair] (NP f '[]) (NP f '[])
forall a. a -> SchemaP SwaggerDoc Object [Pair] (NP f '[]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP f '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance (HObjectSchema c xs, c x) => HObjectSchema c ((x :: Type) : xs) where
  hobjectSchema :: forall (f :: * -> *).
(forall cfg. c cfg => ObjectSchema SwaggerDoc (f cfg))
-> ObjectSchema SwaggerDoc (NP f (x : xs))
hobjectSchema forall cfg. c cfg => ObjectSchema SwaggerDoc (f cfg)
f = f x -> NP f xs -> NP f (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (f x -> NP f xs -> NP f (x : xs))
-> SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) (f x)
-> SchemaP
     SwaggerDoc Object [Pair] (NP f (x : xs)) (NP f xs -> NP f (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP f (x : xs) -> f x
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd (NP f (x : xs) -> f x)
-> SchemaP SwaggerDoc Object [Pair] (f x) (f x)
-> SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) (f x)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] (f x) (f x)
forall cfg. c cfg => ObjectSchema SwaggerDoc (f cfg)
f SchemaP
  SwaggerDoc Object [Pair] (NP f (x : xs)) (NP f xs -> NP f (x : xs))
-> SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) (NP f xs)
-> SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) (NP f (x : xs))
forall a b.
SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) a
-> SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NP f (x : xs) -> NP f xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
NP f (x : xs) -> NP f xs
tl (NP f (x : xs) -> NP f xs)
-> SchemaP SwaggerDoc Object [Pair] (NP f xs) (NP f xs)
-> SchemaP SwaggerDoc Object [Pair] (NP f (x : xs)) (NP f xs)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= forall {k} (c :: k -> Constraint) (xs :: [k]) (f :: k -> *).
HObjectSchema c xs =>
(forall (cfg :: k). c cfg => ObjectSchema SwaggerDoc (f cfg))
-> ObjectSchema SwaggerDoc (NP f xs)
forall (c :: * -> Constraint) (xs :: [*]) (f :: * -> *).
HObjectSchema c xs =>
(forall cfg. c cfg => ObjectSchema SwaggerDoc (f cfg))
-> ObjectSchema SwaggerDoc (NP f xs)
hobjectSchema @c @xs ObjectSchema SwaggerDoc (f cfg)
forall cfg. c cfg => ObjectSchema SwaggerDoc (f cfg)
f

-- | constraint synonym  for 'ToSchema' 'AllTeamFeatures'
class (IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg

instance (IsFeatureConfig cfg, ToSchema cfg) => FeatureFieldConstraints cfg

instance ToSchema AllTeamFeatures where
  schema :: ValueSchema NamedSwaggerDoc AllTeamFeatures
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] AllTeamFeatures AllTeamFeatures
-> ValueSchema NamedSwaggerDoc AllTeamFeatures
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AllTeamFeatures" (SchemaP SwaggerDoc Object [Pair] AllTeamFeatures AllTeamFeatures
 -> ValueSchema NamedSwaggerDoc AllTeamFeatures)
-> SchemaP SwaggerDoc Object [Pair] AllTeamFeatures AllTeamFeatures
-> ValueSchema NamedSwaggerDoc AllTeamFeatures
forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k -> Constraint) (xs :: [k]) (f :: k -> *).
HObjectSchema c xs =>
(forall (cfg :: k). c cfg => ObjectSchema SwaggerDoc (f cfg))
-> ObjectSchema SwaggerDoc (NP f xs)
forall (c :: * -> Constraint) (xs :: [*]) (f :: * -> *).
HObjectSchema c xs =>
(forall cfg. c cfg => ObjectSchema SwaggerDoc (f cfg))
-> ObjectSchema SwaggerDoc (NP f xs)
hobjectSchema @FeatureFieldConstraints ObjectSchema SwaggerDoc (LockableFeature cfg)
forall cfg.
FeatureFieldConstraints cfg =>
ObjectSchema SwaggerDoc (LockableFeature cfg)
featureField
    where
      featureField :: forall cfg. (FeatureFieldConstraints cfg) => ObjectSchema SwaggerDoc (LockableFeature cfg)
      featureField :: forall cfg.
FeatureFieldConstraints cfg =>
ObjectSchema SwaggerDoc (LockableFeature cfg)
featureField = Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (LockableFeature cfg)
     (LockableFeature cfg)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LockableFeature cfg)
     (LockableFeature cfg)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field (String -> Text
T.pack (Proxy (FeatureSymbol cfg) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(FeatureSymbol cfg)))) SchemaP
  NamedSwaggerDoc
  Value
  Value
  (LockableFeature cfg)
  (LockableFeature cfg)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

class (Arbitrary cfg, IsFeatureConfig cfg) => ArbitraryFeatureConfig cfg

instance (Arbitrary cfg, IsFeatureConfig cfg) => ArbitraryFeatureConfig cfg

instance Arbitrary AllTeamFeatures where
  arbitrary :: Gen AllTeamFeatures
arbitrary = NP (Gen :.: LockableFeature) Features -> Gen AllTeamFeatures
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NP xs, Applicative f) =>
NP (f :.: g) xs -> f (NP g xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' (NP (Gen :.: LockableFeature) Features -> Gen AllTeamFeatures)
-> NP (Gen :.: LockableFeature) Features -> Gen AllTeamFeatures
forall a b. (a -> b) -> a -> b
$ Proxy ArbitraryFeatureConfig
-> (forall a.
    ArbitraryFeatureConfig a =>
    (:.:) Gen LockableFeature a)
-> NP (Gen :.: LockableFeature) Features
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @ArbitraryFeatureConfig) (Gen (LockableFeature a) -> (:.:) Gen LockableFeature a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp Gen (LockableFeature a)
forall a. Arbitrary a => Gen a
arbitrary)

-- | FUTUREWORK: 'NpProject' and 'NpUpdate' can be useful for more than
-- features. Maybe they should be moved somewhere else.
class NpProject x xs where
  npProject' :: Proxy x -> NP f xs -> f x

instance {-# OVERLAPPING #-} NpProject x (x : xs) where
  npProject' :: forall (f :: a -> *). Proxy x -> NP f (x : xs) -> f x
npProject' Proxy x
_ (f x
x :* NP f xs
_) = f x
f x
x

instance (NpProject x xs) => NpProject x (y : xs) where
  npProject' :: forall (f :: a -> *). Proxy x -> NP f (y : xs) -> f x
npProject' Proxy x
p (f x
_ :* NP f xs
xs) = Proxy x -> NP f xs -> f x
forall {k} (x :: k) (xs :: [k]) (f :: k -> *).
NpProject x xs =>
Proxy x -> NP f xs -> f x
forall (f :: a -> *). Proxy x -> NP f xs -> f x
npProject' Proxy x
p NP f xs
xs

instance (TypeError ('ShowType x :<>: 'Text " not found")) => NpProject x '[] where
  npProject' :: forall (f :: k -> *). Proxy x -> NP f '[] -> f x
npProject' = String -> Proxy x -> NP f '[] -> f x
forall a. HasCallStack => String -> a
error String
"npProject': someone naughty removed the type error constraint"

-- | Get the first field of a given type out of an @'NP' f xs@.
npProject :: forall x f xs. (NpProject x xs) => NP f xs -> f x
npProject :: forall {k} (x :: k) (f :: k -> *) (xs :: [k]).
NpProject x xs =>
NP f xs -> f x
npProject = Proxy x -> NP f xs -> f x
forall {k} (x :: k) (xs :: [k]) (f :: k -> *).
NpProject x xs =>
Proxy x -> NP f xs -> f x
forall (f :: k -> *). Proxy x -> NP f xs -> f x
npProject' (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @x)

class NpUpdate x xs where
  npUpdate' :: Proxy x -> f x -> NP f xs -> NP f xs

instance {-# OVERLAPPING #-} NpUpdate x (x : xs) where
  npUpdate' :: forall (f :: a -> *).
Proxy x -> f x -> NP f (x : xs) -> NP f (x : xs)
npUpdate' Proxy x
_ f x
x (f x
_ :* NP f xs
xs) = f x
x f x -> NP f xs -> NP f (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP f xs
NP f xs
xs

instance (NpUpdate x xs) => NpUpdate x (y : xs) where
  npUpdate' :: forall (f :: a -> *).
Proxy x -> f x -> NP f (y : xs) -> NP f (y : xs)
npUpdate' Proxy x
p f x
x (f x
y :* NP f xs
xs) = f y
f x
y f y -> NP f xs -> NP f (y : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Proxy x -> f x -> NP f xs -> NP f xs
forall {k} (x :: k) (xs :: [k]) (f :: k -> *).
NpUpdate x xs =>
Proxy x -> f x -> NP f xs -> NP f xs
forall (f :: a -> *). Proxy x -> f x -> NP f xs -> NP f xs
npUpdate' Proxy x
p f x
x NP f xs
NP f xs
xs

instance (TypeError ('ShowType x :<>: 'Text " not found")) => NpUpdate x '[] where
  npUpdate' :: forall (f :: k -> *). Proxy x -> f x -> NP f '[] -> NP f '[]
npUpdate' = String -> Proxy x -> f x -> NP f '[] -> NP f '[]
forall a. HasCallStack => String -> a
error String
"npUpdate': someone naughty removed the type error constraint"

-- | Update the first field of a given type in an @'NP' f xs@.
npUpdate :: forall x f xs. (NpUpdate x xs) => f x -> NP f xs -> NP f xs
npUpdate :: forall {k} (x :: k) (f :: k -> *) (xs :: [k]).
NpUpdate x xs =>
f x -> NP f xs -> NP f xs
npUpdate = Proxy x -> f x -> NP f xs -> NP f xs
forall {k} (x :: k) (xs :: [k]) (f :: k -> *).
NpUpdate x xs =>
Proxy x -> f x -> NP f xs -> NP f xs
forall (f :: k -> *). Proxy x -> f x -> NP f xs -> NP f xs
npUpdate' (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @x)

deriving via (Schema AllTeamFeatures) instance (FromJSON AllTeamFeatures)

deriving via (Schema AllTeamFeatures) instance (ToJSON AllTeamFeatures)

deriving via (Schema AllTeamFeatures) instance (S.ToSchema AllTeamFeatures)