{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.Mattermost.Types.Config where

import qualified Data.Aeson as A
import           Data.Text (Text)
import qualified Data.Text as T

data ServerConfig = ServerConfig
  {
  -- { configSqlsettings :: UnknownObject
  -- , configPrivacysettings :: PrivacySettings
    ServerConfig -> LogSettings
configLogsettings :: LogSettings
  , ServerConfig -> ComplianceSettings
configCompliancesettings :: ComplianceSettings
  , ServerConfig -> EmailSettings
configEmailsettings :: EmailSettings
  -- , configFilesettings :: FileSettings
  -- , configGitlabsettings :: GitLabSettings
  , ServerConfig -> NativeAppSettings
configNativeappsettings :: NativeAppSettings
  -- , configLdapsettings :: LdapSettings
  -- , configServicesettings :: ServiceSettings
  -- , configOffice365settings :: Office365Settings
  -- , configGooglesettings :: GoogleSettings
  , ServerConfig -> PasswordSettings
configPasswordsettings :: PasswordSettings
  , ServerConfig -> TeamSettings
configTeamsettings :: TeamSettings
  -- , configSamlsettings :: SamlSettings
  -- , configClustersettings :: ClusterSettings
  -- , configRatelimitsettings :: RateLimitSettings
  -- , configLocalizationsettings :: LocalizationSettings
  , ServerConfig -> SupportSettings
configSupportsettings :: SupportSettings
  -- , configAnalyticssettings :: Integer
  , ServerConfig -> MetricsSettings
configMetricssettings :: MetricsSettings
  , ServerConfig -> WebrtcSettings
configWebrtcsettings :: WebrtcSettings
  } deriving (ReadPrec [ServerConfig]
ReadPrec ServerConfig
Int -> ReadS ServerConfig
ReadS [ServerConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServerConfig]
$creadListPrec :: ReadPrec [ServerConfig]
readPrec :: ReadPrec ServerConfig
$creadPrec :: ReadPrec ServerConfig
readList :: ReadS [ServerConfig]
$creadList :: ReadS [ServerConfig]
readsPrec :: Int -> ReadS ServerConfig
$creadsPrec :: Int -> ReadS ServerConfig
Read, Int -> ServerConfig -> ShowS
[ServerConfig] -> ShowS
ServerConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerConfig] -> ShowS
$cshowList :: [ServerConfig] -> ShowS
show :: ServerConfig -> String
$cshow :: ServerConfig -> String
showsPrec :: Int -> ServerConfig -> ShowS
$cshowsPrec :: Int -> ServerConfig -> ShowS
Show, ServerConfig -> ServerConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerConfig -> ServerConfig -> Bool
$c/= :: ServerConfig -> ServerConfig -> Bool
== :: ServerConfig -> ServerConfig -> Bool
$c== :: ServerConfig -> ServerConfig -> Bool
Eq)

instance A.FromJSON ServerConfig where
  parseJSON :: Value -> Parser ServerConfig
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"config" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    -- configSqlsettings <- v A..: "SqlSettings"
    -- configPrivacysettings <- v A..: "PrivacySettings"
    LogSettings
configLogsettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"LogSettings"
    ComplianceSettings
configCompliancesettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ComplianceSettings"
    EmailSettings
configEmailsettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EmailSettings"
    -- configFilesettings <- v A..: "FileSettings"
    -- configGitlabsettings <- v A..: "GitLabSettings"
    NativeAppSettings
configNativeappsettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"NativeAppSettings"
    -- configLdapsettings <- v A..: "LdapSettings"
    -- configServicesettings <- v A..: "ServiceSettings"
    -- configOffice365settings <- v A..: "Office365Settings"
    -- configGooglesettings <- v A..: "GoogleSettings"
    PasswordSettings
configPasswordsettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"PasswordSettings"
    TeamSettings
configTeamsettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TeamSettings"
    -- configSamlsettings <- v A..: "SamlSettings"
    -- configClustersettings <- v A..: "ClusterSettings"
    -- configRatelimitsettings <- v A..: "RateLimitSettings"
    -- configLocalizationsettings <- v A..: "LocalizationSettings"
    SupportSettings
configSupportsettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SupportSettings"
    -- configAnalyticssettings <- v A..: "AnalyticsSettings"
    MetricsSettings
configMetricssettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MetricsSettings"
    WebrtcSettings
configWebrtcsettings <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"WebrtcSettings"
    forall (m :: * -> *) a. Monad m => a -> m a
return ServerConfig { SupportSettings
ComplianceSettings
NativeAppSettings
MetricsSettings
LogSettings
PasswordSettings
WebrtcSettings
TeamSettings
EmailSettings
configWebrtcsettings :: WebrtcSettings
configMetricssettings :: MetricsSettings
configSupportsettings :: SupportSettings
configTeamsettings :: TeamSettings
configPasswordsettings :: PasswordSettings
configNativeappsettings :: NativeAppSettings
configEmailsettings :: EmailSettings
configCompliancesettings :: ComplianceSettings
configLogsettings :: LogSettings
configWebrtcsettings :: WebrtcSettings
configMetricssettings :: MetricsSettings
configSupportsettings :: SupportSettings
configTeamsettings :: TeamSettings
configPasswordsettings :: PasswordSettings
configNativeappsettings :: NativeAppSettings
configEmailsettings :: EmailSettings
configCompliancesettings :: ComplianceSettings
configLogsettings :: LogSettings
.. }

instance A.ToJSON ServerConfig where
  toJSON :: ServerConfig -> Value
toJSON ServerConfig { SupportSettings
ComplianceSettings
NativeAppSettings
MetricsSettings
LogSettings
PasswordSettings
WebrtcSettings
TeamSettings
EmailSettings
configWebrtcsettings :: WebrtcSettings
configMetricssettings :: MetricsSettings
configSupportsettings :: SupportSettings
configTeamsettings :: TeamSettings
configPasswordsettings :: PasswordSettings
configNativeappsettings :: NativeAppSettings
configEmailsettings :: EmailSettings
configCompliancesettings :: ComplianceSettings
configLogsettings :: LogSettings
configWebrtcsettings :: ServerConfig -> WebrtcSettings
configMetricssettings :: ServerConfig -> MetricsSettings
configSupportsettings :: ServerConfig -> SupportSettings
configTeamsettings :: ServerConfig -> TeamSettings
configPasswordsettings :: ServerConfig -> PasswordSettings
configNativeappsettings :: ServerConfig -> NativeAppSettings
configEmailsettings :: ServerConfig -> EmailSettings
configCompliancesettings :: ServerConfig -> ComplianceSettings
configLogsettings :: ServerConfig -> LogSettings
.. } = [Pair] -> Value
A.object
    [ Key
"EmailSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= EmailSettings
configEmailsettings
    , Key
"WebrtcSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= WebrtcSettings
configWebrtcsettings
    , Key
"PasswordSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= PasswordSettings
configPasswordsettings
    , Key
"LogSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= LogSettings
configLogsettings
    , Key
"NativeAppSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= NativeAppSettings
configNativeappsettings
    , Key
"MetricsSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= MetricsSettings
configMetricssettings
    , Key
"ComplianceSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= ComplianceSettings
configCompliancesettings
    -- , "SqlSettings" A..= configSqlsettings
    -- , "PrivacySettings" A..= configPrivacysettings
    -- , "EmailSettings" A..= configEmailsettings
    -- , "FileSettings" A..= configFilesettings
    -- , "GitLabSettings" A..= configGitlabsettings
    -- , "LdapSettings" A..= configLdapsettings
    -- , "ServiceSettings" A..= configServicesettings
    -- , "Office365Settings" A..= configOffice365settings
    -- , "GoogleSettings" A..= configGooglesettings
    -- , "TeamSettings" A..= configTeamsettings
    -- , "SamlSettings" A..= configSamlsettings
    -- , "ClusterSettings" A..= configClustersettings
    -- , "RateLimitSettings" A..= configRatelimitsettings
    -- , "LocalizationSettings" A..= configLocalizationsettings
    , Key
"SupportSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= SupportSettings
configSupportsettings
    -- , "AnalyticsSettings" A..= configAnalyticssettings
    , Key
"WebrtcSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= WebrtcSettings
configWebrtcsettings
    ]

-- --

data EmailSettings = EmailSettings
  { EmailSettings -> Bool
emailSettingsSendemailnotifications :: Bool
  , EmailSettings -> Maybe Text
emailSettingsPasswordresetsalt :: Maybe T.Text
  , EmailSettings -> Bool
emailSettingsEnablesignupwithemail :: Bool
  , EmailSettings -> Text
emailSettingsSmtpusername ::T.Text
  , EmailSettings -> Int
emailSettingsEmailbatchinginterval :: Int
  , EmailSettings -> Text
emailSettingsFeedbackname ::T.Text
  , EmailSettings -> Bool
emailSettingsRequireemailverification :: Bool
  , EmailSettings -> Text
emailSettingsSmtpserver ::T.Text
  , EmailSettings -> Text
emailSettingsSmtppassword ::T.Text
  , EmailSettings -> Bool
emailSettingsEnablesigninwithemail :: Bool
  , EmailSettings -> Text
emailSettingsPushnotificationcontents ::T.Text
  , EmailSettings -> Text
emailSettingsPushnotificationserver ::T.Text
  , EmailSettings -> Bool
emailSettingsEnableemailbatching :: Bool
  , EmailSettings -> Int
emailSettingsEmailbatchingbuffersize :: Int
  , EmailSettings -> Text
emailSettingsConnectionsecurity ::T.Text
  , EmailSettings -> Text
emailSettingsSmtpport ::T.Text
  , EmailSettings -> Text
emailSettingsFeedbackemail ::T.Text
  , EmailSettings -> Bool
emailSettingsSendpushnotifications :: Bool
  , EmailSettings -> Text
emailSettingsFeedbackorganization ::T.Text
  , EmailSettings -> Text
emailSettingsInvitesalt ::T.Text
  , EmailSettings -> Bool
emailSettingsEnablesigninwithusername :: Bool
  } deriving (ReadPrec [EmailSettings]
ReadPrec EmailSettings
Int -> ReadS EmailSettings
ReadS [EmailSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmailSettings]
$creadListPrec :: ReadPrec [EmailSettings]
readPrec :: ReadPrec EmailSettings
$creadPrec :: ReadPrec EmailSettings
readList :: ReadS [EmailSettings]
$creadList :: ReadS [EmailSettings]
readsPrec :: Int -> ReadS EmailSettings
$creadsPrec :: Int -> ReadS EmailSettings
Read, Int -> EmailSettings -> ShowS
[EmailSettings] -> ShowS
EmailSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmailSettings] -> ShowS
$cshowList :: [EmailSettings] -> ShowS
show :: EmailSettings -> String
$cshow :: EmailSettings -> String
showsPrec :: Int -> EmailSettings -> ShowS
$cshowsPrec :: Int -> EmailSettings -> ShowS
Show, EmailSettings -> EmailSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmailSettings -> EmailSettings -> Bool
$c/= :: EmailSettings -> EmailSettings -> Bool
== :: EmailSettings -> EmailSettings -> Bool
$c== :: EmailSettings -> EmailSettings -> Bool
Eq)

instance A.FromJSON EmailSettings where
  parseJSON :: Value -> Parser EmailSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"emailSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Bool
emailSettingsSendemailnotifications <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SendEmailNotifications"
    Maybe Text
emailSettingsPasswordresetsalt <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"PasswordResetSalt"
    Bool
emailSettingsEnablesignupwithemail <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableSignUpWithEmail"
    Text
emailSettingsSmtpusername <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SMTPUsername"
    Int
emailSettingsEmailbatchinginterval <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EmailBatchingInterval"
    Text
emailSettingsFeedbackname <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"FeedbackName"
    Bool
emailSettingsRequireemailverification <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RequireEmailVerification"
    Text
emailSettingsSmtpserver <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SMTPServer"
    Text
emailSettingsSmtppassword <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SMTPPassword"
    Bool
emailSettingsEnablesigninwithemail <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableSignInWithEmail"
    Text
emailSettingsPushnotificationcontents <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"PushNotificationContents"
    Text
emailSettingsPushnotificationserver <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"PushNotificationServer"
    Bool
emailSettingsEnableemailbatching <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableEmailBatching"
    Int
emailSettingsEmailbatchingbuffersize <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EmailBatchingBufferSize"
    Text
emailSettingsConnectionsecurity <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ConnectionSecurity"
    Text
emailSettingsSmtpport <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SMTPPort"
    Text
emailSettingsFeedbackemail <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"FeedbackEmail"
    Bool
emailSettingsSendpushnotifications <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SendPushNotifications"
    Text
emailSettingsFeedbackorganization <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"FeedbackOrganization"
    Text
emailSettingsInvitesalt <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"InviteSalt"
    Bool
emailSettingsEnablesigninwithusername <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableSignInWithUsername"
    forall (m :: * -> *) a. Monad m => a -> m a
return EmailSettings { Bool
Int
Maybe Text
Text
emailSettingsEnablesigninwithusername :: Bool
emailSettingsInvitesalt :: Text
emailSettingsFeedbackorganization :: Text
emailSettingsSendpushnotifications :: Bool
emailSettingsFeedbackemail :: Text
emailSettingsSmtpport :: Text
emailSettingsConnectionsecurity :: Text
emailSettingsEmailbatchingbuffersize :: Int
emailSettingsEnableemailbatching :: Bool
emailSettingsPushnotificationserver :: Text
emailSettingsPushnotificationcontents :: Text
emailSettingsEnablesigninwithemail :: Bool
emailSettingsSmtppassword :: Text
emailSettingsSmtpserver :: Text
emailSettingsRequireemailverification :: Bool
emailSettingsFeedbackname :: Text
emailSettingsEmailbatchinginterval :: Int
emailSettingsSmtpusername :: Text
emailSettingsEnablesignupwithemail :: Bool
emailSettingsPasswordresetsalt :: Maybe Text
emailSettingsSendemailnotifications :: Bool
emailSettingsEnablesigninwithusername :: Bool
emailSettingsInvitesalt :: Text
emailSettingsFeedbackorganization :: Text
emailSettingsSendpushnotifications :: Bool
emailSettingsFeedbackemail :: Text
emailSettingsSmtpport :: Text
emailSettingsConnectionsecurity :: Text
emailSettingsEmailbatchingbuffersize :: Int
emailSettingsEnableemailbatching :: Bool
emailSettingsPushnotificationserver :: Text
emailSettingsPushnotificationcontents :: Text
emailSettingsEnablesigninwithemail :: Bool
emailSettingsSmtppassword :: Text
emailSettingsSmtpserver :: Text
emailSettingsRequireemailverification :: Bool
emailSettingsFeedbackname :: Text
emailSettingsEmailbatchinginterval :: Int
emailSettingsSmtpusername :: Text
emailSettingsEnablesignupwithemail :: Bool
emailSettingsPasswordresetsalt :: Maybe Text
emailSettingsSendemailnotifications :: Bool
.. }

instance A.ToJSON EmailSettings where
  toJSON :: EmailSettings -> Value
toJSON EmailSettings { Bool
Int
Maybe Text
Text
emailSettingsEnablesigninwithusername :: Bool
emailSettingsInvitesalt :: Text
emailSettingsFeedbackorganization :: Text
emailSettingsSendpushnotifications :: Bool
emailSettingsFeedbackemail :: Text
emailSettingsSmtpport :: Text
emailSettingsConnectionsecurity :: Text
emailSettingsEmailbatchingbuffersize :: Int
emailSettingsEnableemailbatching :: Bool
emailSettingsPushnotificationserver :: Text
emailSettingsPushnotificationcontents :: Text
emailSettingsEnablesigninwithemail :: Bool
emailSettingsSmtppassword :: Text
emailSettingsSmtpserver :: Text
emailSettingsRequireemailverification :: Bool
emailSettingsFeedbackname :: Text
emailSettingsEmailbatchinginterval :: Int
emailSettingsSmtpusername :: Text
emailSettingsEnablesignupwithemail :: Bool
emailSettingsPasswordresetsalt :: Maybe Text
emailSettingsSendemailnotifications :: Bool
emailSettingsEnablesigninwithusername :: EmailSettings -> Bool
emailSettingsInvitesalt :: EmailSettings -> Text
emailSettingsFeedbackorganization :: EmailSettings -> Text
emailSettingsSendpushnotifications :: EmailSettings -> Bool
emailSettingsFeedbackemail :: EmailSettings -> Text
emailSettingsSmtpport :: EmailSettings -> Text
emailSettingsConnectionsecurity :: EmailSettings -> Text
emailSettingsEmailbatchingbuffersize :: EmailSettings -> Int
emailSettingsEnableemailbatching :: EmailSettings -> Bool
emailSettingsPushnotificationserver :: EmailSettings -> Text
emailSettingsPushnotificationcontents :: EmailSettings -> Text
emailSettingsEnablesigninwithemail :: EmailSettings -> Bool
emailSettingsSmtppassword :: EmailSettings -> Text
emailSettingsSmtpserver :: EmailSettings -> Text
emailSettingsRequireemailverification :: EmailSettings -> Bool
emailSettingsFeedbackname :: EmailSettings -> Text
emailSettingsEmailbatchinginterval :: EmailSettings -> Int
emailSettingsSmtpusername :: EmailSettings -> Text
emailSettingsEnablesignupwithemail :: EmailSettings -> Bool
emailSettingsPasswordresetsalt :: EmailSettings -> Maybe Text
emailSettingsSendemailnotifications :: EmailSettings -> Bool
.. } = [Pair] -> Value
A.object forall a b. (a -> b) -> a -> b
$
    [ Key
"SendEmailNotifications" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
emailSettingsSendemailnotifications
    , Key
"EnableSignUpWithEmail" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
emailSettingsEnablesignupwithemail
    , Key
"SMTPUsername" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsSmtpusername
    , Key
"EmailBatchingInterval" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
emailSettingsEmailbatchinginterval
    , Key
"FeedbackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsFeedbackname
    , Key
"RequireEmailVerification" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
emailSettingsRequireemailverification
    , Key
"SMTPServer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsSmtpserver
    , Key
"SMTPPassword" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsSmtppassword
    , Key
"EnableSignInWithEmail" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
emailSettingsEnablesigninwithemail
    , Key
"PushNotificationContents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsPushnotificationcontents
    , Key
"PushNotificationServer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsPushnotificationserver
    , Key
"EnableEmailBatching" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
emailSettingsEnableemailbatching
    , Key
"EmailBatchingBufferSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
emailSettingsEmailbatchingbuffersize
    , Key
"ConnectionSecurity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsConnectionsecurity
    , Key
"SMTPPort" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsSmtpport
    , Key
"FeedbackEmail" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsFeedbackemail
    , Key
"SendPushNotifications" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
emailSettingsSendpushnotifications
    , Key
"FeedbackOrganization" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsFeedbackorganization
    , Key
"InviteSalt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
emailSettingsInvitesalt
    , Key
"EnableSignInWithUsername" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
emailSettingsEnablesigninwithusername
    ] forall a. [a] -> [a] -> [a]
++
    [ Key
"PasswordResetSalt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
x | Just Text
x <- [Maybe Text
emailSettingsPasswordresetsalt] ]

data TeammateNameDisplayMode =
    TMUsername
    | TMNicknameOrFullname
    | TMFullname
    | TMUnknown T.Text
    deriving (TeammateNameDisplayMode -> TeammateNameDisplayMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeammateNameDisplayMode -> TeammateNameDisplayMode -> Bool
$c/= :: TeammateNameDisplayMode -> TeammateNameDisplayMode -> Bool
== :: TeammateNameDisplayMode -> TeammateNameDisplayMode -> Bool
$c== :: TeammateNameDisplayMode -> TeammateNameDisplayMode -> Bool
Eq, Int -> TeammateNameDisplayMode -> ShowS
[TeammateNameDisplayMode] -> ShowS
TeammateNameDisplayMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeammateNameDisplayMode] -> ShowS
$cshowList :: [TeammateNameDisplayMode] -> ShowS
show :: TeammateNameDisplayMode -> String
$cshow :: TeammateNameDisplayMode -> String
showsPrec :: Int -> TeammateNameDisplayMode -> ShowS
$cshowsPrec :: Int -> TeammateNameDisplayMode -> ShowS
Show, ReadPrec [TeammateNameDisplayMode]
ReadPrec TeammateNameDisplayMode
Int -> ReadS TeammateNameDisplayMode
ReadS [TeammateNameDisplayMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TeammateNameDisplayMode]
$creadListPrec :: ReadPrec [TeammateNameDisplayMode]
readPrec :: ReadPrec TeammateNameDisplayMode
$creadPrec :: ReadPrec TeammateNameDisplayMode
readList :: ReadS [TeammateNameDisplayMode]
$creadList :: ReadS [TeammateNameDisplayMode]
readsPrec :: Int -> ReadS TeammateNameDisplayMode
$creadsPrec :: Int -> ReadS TeammateNameDisplayMode
Read)

teammateDisplayModeFromText :: Text -> TeammateNameDisplayMode
teammateDisplayModeFromText :: Text -> TeammateNameDisplayMode
teammateDisplayModeFromText Text
t =
    case Text
t of
        Text
"username"           -> TeammateNameDisplayMode
TMUsername
        Text
"nickname_full_name" -> TeammateNameDisplayMode
TMNicknameOrFullname
        Text
"full_name"          -> TeammateNameDisplayMode
TMFullname
        Text
_                    -> Text -> TeammateNameDisplayMode
TMUnknown Text
t

instance A.FromJSON TeammateNameDisplayMode where
    parseJSON :: Value -> Parser TeammateNameDisplayMode
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"TeammateNameDisplayMode"
        (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TeammateNameDisplayMode
teammateDisplayModeFromText)

instance A.ToJSON TeammateNameDisplayMode where
    toJSON :: TeammateNameDisplayMode -> Value
toJSON TeammateNameDisplayMode
TMUsername           = Value
"username"
    toJSON TeammateNameDisplayMode
TMNicknameOrFullname = Value
"nickname_full_name"
    toJSON TeammateNameDisplayMode
TMFullname           = Value
"full_name"
    toJSON (TMUnknown Text
t)        = forall a. ToJSON a => a -> Value
A.toJSON Text
t

data RestrictDirectMessageSetting =
    RestrictAny
    | RestrictTeam
    | RestrictUnknown T.Text
    deriving (Int -> RestrictDirectMessageSetting -> ShowS
[RestrictDirectMessageSetting] -> ShowS
RestrictDirectMessageSetting -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestrictDirectMessageSetting] -> ShowS
$cshowList :: [RestrictDirectMessageSetting] -> ShowS
show :: RestrictDirectMessageSetting -> String
$cshow :: RestrictDirectMessageSetting -> String
showsPrec :: Int -> RestrictDirectMessageSetting -> ShowS
$cshowsPrec :: Int -> RestrictDirectMessageSetting -> ShowS
Show, RestrictDirectMessageSetting
-> RestrictDirectMessageSetting -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestrictDirectMessageSetting
-> RestrictDirectMessageSetting -> Bool
$c/= :: RestrictDirectMessageSetting
-> RestrictDirectMessageSetting -> Bool
== :: RestrictDirectMessageSetting
-> RestrictDirectMessageSetting -> Bool
$c== :: RestrictDirectMessageSetting
-> RestrictDirectMessageSetting -> Bool
Eq, ReadPrec [RestrictDirectMessageSetting]
ReadPrec RestrictDirectMessageSetting
Int -> ReadS RestrictDirectMessageSetting
ReadS [RestrictDirectMessageSetting]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestrictDirectMessageSetting]
$creadListPrec :: ReadPrec [RestrictDirectMessageSetting]
readPrec :: ReadPrec RestrictDirectMessageSetting
$creadPrec :: ReadPrec RestrictDirectMessageSetting
readList :: ReadS [RestrictDirectMessageSetting]
$creadList :: ReadS [RestrictDirectMessageSetting]
readsPrec :: Int -> ReadS RestrictDirectMessageSetting
$creadsPrec :: Int -> ReadS RestrictDirectMessageSetting
Read)

instance A.FromJSON RestrictDirectMessageSetting where
    parseJSON :: Value -> Parser RestrictDirectMessageSetting
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RestrictDirectMessageSetting" forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Text
t of
            Text
"any" -> forall (m :: * -> *) a. Monad m => a -> m a
return RestrictDirectMessageSetting
RestrictAny
            Text
"team" -> forall (m :: * -> *) a. Monad m => a -> m a
return RestrictDirectMessageSetting
RestrictTeam
            Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> RestrictDirectMessageSetting
RestrictUnknown Text
t

instance A.ToJSON RestrictDirectMessageSetting where
    toJSON :: RestrictDirectMessageSetting -> Value
toJSON RestrictDirectMessageSetting
RestrictAny = forall a. ToJSON a => a -> Value
A.toJSON (Text
"any" :: T.Text)
    toJSON RestrictDirectMessageSetting
RestrictTeam = forall a. ToJSON a => a -> Value
A.toJSON (Text
"team" :: T.Text)
    toJSON (RestrictUnknown Text
t) = forall a. ToJSON a => a -> Value
A.toJSON Text
t

data ClientConfig = ClientConfig
  { ClientConfig -> Text
clientConfigVersion :: T.Text
  , ClientConfig -> Text
clientConfigBuildNumber :: T.Text
  , ClientConfig -> Text
clientConfigBuildDate :: T.Text
  , ClientConfig -> Text
clientConfigBuildHash :: T.Text
  , ClientConfig -> Text
clientConfigBuildHashEnterprise :: T.Text
  , ClientConfig -> Text
clientConfigBuildEnterpriseReady :: T.Text

  , ClientConfig -> Text
clientConfigSiteURL :: T.Text
  , ClientConfig -> Text
clientConfigSiteName :: T.Text
  , ClientConfig -> Text
clientConfigEnableOpenServer :: T.Text
  , ClientConfig -> RestrictDirectMessageSetting
clientConfigRestrictDirectMessage :: RestrictDirectMessageSetting
  , ClientConfig -> TeammateNameDisplayMode
clientConfigTeammateNameDisplay :: TeammateNameDisplayMode

  , ClientConfig -> Text
clientConfigEnableOAuthServiceProvider :: T.Text
  , ClientConfig -> Text
clientConfigGoogleDeveloperKey :: T.Text
  , ClientConfig -> Text
clientConfigEnableIncomingWebhooks :: T.Text
  , ClientConfig -> Text
clientConfigEnableOutgoingWebhooks :: T.Text
  , ClientConfig -> Text
clientConfigEnableCommands :: T.Text
  , ClientConfig -> Text
clientConfigEnablePostUsernameOverride :: T.Text
  , ClientConfig -> Text
clientConfigEnablePostIconOverride :: T.Text
  , ClientConfig -> Text
clientConfigEnableLinkPreviews :: T.Text
  , ClientConfig -> Text
clientConfigEnableTesting :: T.Text
  , ClientConfig -> Text
clientConfigEnableDeveloper :: T.Text
  , ClientConfig -> Text
clientConfigEnableDiagnostics :: T.Text
  , ClientConfig -> Text
clientConfigPostEditTimeLimit :: T.Text

  , ClientConfig -> Text
clientConfigSendEmailNotifications :: T.Text
  , ClientConfig -> Text
clientConfigSendPushNotifications :: T.Text
  , ClientConfig -> Text
clientConfigEnableSignUpWithEmail :: T.Text
  , ClientConfig -> Text
clientConfigEnableSignInWithEmail :: T.Text
  , ClientConfig -> Text
clientConfigEnableSignInWithUsername :: T.Text
  , ClientConfig -> Text
clientConfigRequireEmailVerification :: T.Text
  , ClientConfig -> Text
clientConfigEnableEmailBatching :: T.Text

  , ClientConfig -> Text
clientConfigEnableSignUpWithGitLab :: T.Text

  , ClientConfig -> Text
clientConfigShowEmailAddress :: T.Text

  , ClientConfig -> Text
clientConfigTermsOfServiceLink :: T.Text
  , ClientConfig -> Text
clientConfigPrivacyPolicyLink :: T.Text
  , ClientConfig -> Text
clientConfigAboutLink :: T.Text
  , ClientConfig -> Text
clientConfigHelpLink :: T.Text
  , ClientConfig -> Text
clientConfigReportAProblemLink :: T.Text
  , ClientConfig -> Maybe Text
clientConfigAdministratorsGuideLink :: Maybe T.Text
  , ClientConfig -> Maybe Text
clientConfigTroubleshootingForumLink :: Maybe T.Text
  , ClientConfig -> Maybe Text
clientConfigCommercialSupportLink :: Maybe T.Text
  , ClientConfig -> Text
clientConfigSupportEmail :: T.Text

  , ClientConfig -> Text
clientConfigEnableFileAttachments :: T.Text
  , ClientConfig -> Text
clientConfigEnablePublicLink :: T.Text

  , ClientConfig -> Text
clientConfigWebsocketPort :: T.Text
  , ClientConfig -> Text
clientConfigWebsocketSecurePort :: T.Text

  , ClientConfig -> Text
clientConfigDefaultClientLocale :: T.Text
  , ClientConfig -> Text
clientConfigAvailableLocales :: T.Text
  , ClientConfig -> Text
clientConfigSQLDriverName :: T.Text

  , ClientConfig -> Text
clientConfigEnableCustomEmoji :: T.Text
  , ClientConfig -> Text
clientConfigEnableEmojiPicker :: T.Text
  , ClientConfig -> Text
clientConfigMaxFileSize :: T.Text

  , ClientConfig -> Text
clientConfigAppDownloadLink :: T.Text
  , ClientConfig -> Text
clientConfigAndroidAppDownloadLink :: T.Text
  , ClientConfig -> Text
clientConfigIosAppDownloadLink :: T.Text

  , ClientConfig -> Text
clientConfigMaxNotificationsPerChannel :: T.Text
  , ClientConfig -> Text
clientConfigTimeBetweenUserTypingUpdatesMilliseconds :: T.Text
  , ClientConfig -> Text
clientConfigEnableUserTypingMessages :: T.Text
  , ClientConfig -> Text
clientConfigEnableChannelViewedMessages :: T.Text

  , ClientConfig -> Text
clientConfigDiagnosticId :: T.Text
  , ClientConfig -> Text
clientConfigDiagnosticsEnabled :: T.Text
  } deriving (ReadPrec [ClientConfig]
ReadPrec ClientConfig
Int -> ReadS ClientConfig
ReadS [ClientConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClientConfig]
$creadListPrec :: ReadPrec [ClientConfig]
readPrec :: ReadPrec ClientConfig
$creadPrec :: ReadPrec ClientConfig
readList :: ReadS [ClientConfig]
$creadList :: ReadS [ClientConfig]
readsPrec :: Int -> ReadS ClientConfig
$creadsPrec :: Int -> ReadS ClientConfig
Read, Int -> ClientConfig -> ShowS
[ClientConfig] -> ShowS
ClientConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientConfig] -> ShowS
$cshowList :: [ClientConfig] -> ShowS
show :: ClientConfig -> String
$cshow :: ClientConfig -> String
showsPrec :: Int -> ClientConfig -> ShowS
$cshowsPrec :: Int -> ClientConfig -> ShowS
Show, ClientConfig -> ClientConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientConfig -> ClientConfig -> Bool
$c/= :: ClientConfig -> ClientConfig -> Bool
== :: ClientConfig -> ClientConfig -> Bool
$c== :: ClientConfig -> ClientConfig -> Bool
Eq)

data LimitedClientConfig = LimitedClientConfig
  { LimitedClientConfig -> Text
limitedClientConfigVersion :: T.Text
  , LimitedClientConfig -> Text
limitedClientConfigBuildNumber :: T.Text
  , LimitedClientConfig -> Text
limitedClientConfigBuildDate :: T.Text
  , LimitedClientConfig -> Text
limitedClientConfigBuildHash :: T.Text
  , LimitedClientConfig -> Text
limitedClientConfigBuildHashEnterprise :: T.Text
  , LimitedClientConfig -> Text
limitedClientConfigBuildEnterpriseReady :: T.Text
  } deriving (ReadPrec [LimitedClientConfig]
ReadPrec LimitedClientConfig
Int -> ReadS LimitedClientConfig
ReadS [LimitedClientConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LimitedClientConfig]
$creadListPrec :: ReadPrec [LimitedClientConfig]
readPrec :: ReadPrec LimitedClientConfig
$creadPrec :: ReadPrec LimitedClientConfig
readList :: ReadS [LimitedClientConfig]
$creadList :: ReadS [LimitedClientConfig]
readsPrec :: Int -> ReadS LimitedClientConfig
$creadsPrec :: Int -> ReadS LimitedClientConfig
Read, Int -> LimitedClientConfig -> ShowS
[LimitedClientConfig] -> ShowS
LimitedClientConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LimitedClientConfig] -> ShowS
$cshowList :: [LimitedClientConfig] -> ShowS
show :: LimitedClientConfig -> String
$cshow :: LimitedClientConfig -> String
showsPrec :: Int -> LimitedClientConfig -> ShowS
$cshowsPrec :: Int -> LimitedClientConfig -> ShowS
Show, LimitedClientConfig -> LimitedClientConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LimitedClientConfig -> LimitedClientConfig -> Bool
$c/= :: LimitedClientConfig -> LimitedClientConfig -> Bool
== :: LimitedClientConfig -> LimitedClientConfig -> Bool
$c== :: LimitedClientConfig -> LimitedClientConfig -> Bool
Eq)

instance A.FromJSON LimitedClientConfig where
  parseJSON :: Value -> Parser LimitedClientConfig
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LimitedClientConfig" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
limitedClientConfigVersion              <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Version"
    Text
limitedClientConfigBuildNumber          <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildNumber"
    Text
limitedClientConfigBuildDate            <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildDate"
    Text
limitedClientConfigBuildHash            <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildHash"
    Text
limitedClientConfigBuildHashEnterprise  <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildHashEnterprise"
    Text
limitedClientConfigBuildEnterpriseReady <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildEnterpriseReady"
    forall (m :: * -> *) a. Monad m => a -> m a
return LimitedClientConfig { Text
limitedClientConfigBuildEnterpriseReady :: Text
limitedClientConfigBuildHashEnterprise :: Text
limitedClientConfigBuildHash :: Text
limitedClientConfigBuildDate :: Text
limitedClientConfigBuildNumber :: Text
limitedClientConfigVersion :: Text
limitedClientConfigBuildEnterpriseReady :: Text
limitedClientConfigBuildHashEnterprise :: Text
limitedClientConfigBuildHash :: Text
limitedClientConfigBuildDate :: Text
limitedClientConfigBuildNumber :: Text
limitedClientConfigVersion :: Text
.. }

instance A.FromJSON ClientConfig where
  parseJSON :: Value -> Parser ClientConfig
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ClientConfig" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
clientConfigVersion <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Version"
    Text
clientConfigBuildNumber <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildNumber"
    Text
clientConfigBuildDate <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildDate"
    Text
clientConfigBuildHash <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildHash"
    Text
clientConfigBuildHashEnterprise <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildHashEnterprise"
    Text
clientConfigBuildEnterpriseReady <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BuildEnterpriseReady"

    Text
clientConfigSiteURL <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SiteURL"
    Text
clientConfigSiteName <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SiteName"
    Text
clientConfigEnableOpenServer <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableOpenServer"
    RestrictDirectMessageSetting
clientConfigRestrictDirectMessage <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictDirectMessage"
    TeammateNameDisplayMode
clientConfigTeammateNameDisplay <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TeammateNameDisplay"

    Text
clientConfigEnableOAuthServiceProvider <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableOAuthServiceProvider"
    Text
clientConfigGoogleDeveloperKey <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"GoogleDeveloperKey"
    Text
clientConfigEnableIncomingWebhooks <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableIncomingWebhooks"
    Text
clientConfigEnableOutgoingWebhooks <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableOutgoingWebhooks"
    Text
clientConfigEnableCommands <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableCommands"
    Text
clientConfigEnablePostUsernameOverride <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnablePostUsernameOverride"
    Text
clientConfigEnablePostIconOverride <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnablePostIconOverride"
    Text
clientConfigEnableLinkPreviews <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableLinkPreviews"
    Text
clientConfigEnableTesting <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableTesting"
    Text
clientConfigEnableDeveloper <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableDeveloper"
    Text
clientConfigEnableDiagnostics <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableDiagnostics"
    Text
clientConfigPostEditTimeLimit <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"PostEditTimeLimit"

    Text
clientConfigSendEmailNotifications <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SendEmailNotifications"
    Text
clientConfigSendPushNotifications <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SendPushNotifications"
    Text
clientConfigEnableSignUpWithEmail <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableSignUpWithEmail"
    Text
clientConfigEnableSignInWithEmail <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableSignInWithEmail"
    Text
clientConfigEnableSignInWithUsername <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableSignInWithUsername"
    Text
clientConfigRequireEmailVerification <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RequireEmailVerification"
    Text
clientConfigEnableEmailBatching <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableEmailBatching"

    Text
clientConfigEnableSignUpWithGitLab <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableSignUpWithGitLab"

    Text
clientConfigShowEmailAddress <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ShowEmailAddress"

    Text
clientConfigTermsOfServiceLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TermsOfServiceLink"
    Text
clientConfigPrivacyPolicyLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"PrivacyPolicyLink"
    Text
clientConfigAboutLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"AboutLink"
    Text
clientConfigHelpLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"HelpLink"
    Text
clientConfigReportAProblemLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ReportAProblemLink"
    Maybe Text
clientConfigAdministratorsGuideLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"AdministratorsGuideLink"
    Maybe Text
clientConfigTroubleshootingForumLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"TroubleshootingForumLink"
    Maybe Text
clientConfigCommercialSupportLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"CommercialSupportLink"
    Text
clientConfigSupportEmail <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SupportEmail"

    Text
clientConfigEnableFileAttachments <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableFileAttachments"
    Text
clientConfigEnablePublicLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnablePublicLink"

    Text
clientConfigWebsocketPort <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"WebsocketPort"
    Text
clientConfigWebsocketSecurePort <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"WebsocketSecurePort"

    Text
clientConfigDefaultClientLocale <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"DefaultClientLocale"
    Text
clientConfigAvailableLocales <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"AvailableLocales"
    Text
clientConfigSQLDriverName <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SQLDriverName"

    Text
clientConfigEnableCustomEmoji <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableCustomEmoji"
    Text
clientConfigEnableEmojiPicker <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableEmojiPicker"
    Text
clientConfigMaxFileSize <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MaxFileSize"

    Text
clientConfigAppDownloadLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"AppDownloadLink"
    Text
clientConfigAndroidAppDownloadLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"AndroidAppDownloadLink"
    Text
clientConfigIosAppDownloadLink <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"IosAppDownloadLink"

    Text
clientConfigMaxNotificationsPerChannel <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MaxNotificationsPerChannel"
    Text
clientConfigTimeBetweenUserTypingUpdatesMilliseconds <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TimeBetweenUserTypingUpdatesMilliseconds"
    Text
clientConfigEnableUserTypingMessages <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableUserTypingMessages"
    Text
clientConfigEnableChannelViewedMessages <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableChannelViewedMessages"

    Text
clientConfigDiagnosticId <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"DiagnosticId"
    Text
clientConfigDiagnosticsEnabled <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"DiagnosticsEnabled"
    forall (m :: * -> *) a. Monad m => a -> m a
return ClientConfig { Maybe Text
Text
RestrictDirectMessageSetting
TeammateNameDisplayMode
clientConfigDiagnosticsEnabled :: Text
clientConfigDiagnosticId :: Text
clientConfigEnableChannelViewedMessages :: Text
clientConfigEnableUserTypingMessages :: Text
clientConfigTimeBetweenUserTypingUpdatesMilliseconds :: Text
clientConfigMaxNotificationsPerChannel :: Text
clientConfigIosAppDownloadLink :: Text
clientConfigAndroidAppDownloadLink :: Text
clientConfigAppDownloadLink :: Text
clientConfigMaxFileSize :: Text
clientConfigEnableEmojiPicker :: Text
clientConfigEnableCustomEmoji :: Text
clientConfigSQLDriverName :: Text
clientConfigAvailableLocales :: Text
clientConfigDefaultClientLocale :: Text
clientConfigWebsocketSecurePort :: Text
clientConfigWebsocketPort :: Text
clientConfigEnablePublicLink :: Text
clientConfigEnableFileAttachments :: Text
clientConfigSupportEmail :: Text
clientConfigCommercialSupportLink :: Maybe Text
clientConfigTroubleshootingForumLink :: Maybe Text
clientConfigAdministratorsGuideLink :: Maybe Text
clientConfigReportAProblemLink :: Text
clientConfigHelpLink :: Text
clientConfigAboutLink :: Text
clientConfigPrivacyPolicyLink :: Text
clientConfigTermsOfServiceLink :: Text
clientConfigShowEmailAddress :: Text
clientConfigEnableSignUpWithGitLab :: Text
clientConfigEnableEmailBatching :: Text
clientConfigRequireEmailVerification :: Text
clientConfigEnableSignInWithUsername :: Text
clientConfigEnableSignInWithEmail :: Text
clientConfigEnableSignUpWithEmail :: Text
clientConfigSendPushNotifications :: Text
clientConfigSendEmailNotifications :: Text
clientConfigPostEditTimeLimit :: Text
clientConfigEnableDiagnostics :: Text
clientConfigEnableDeveloper :: Text
clientConfigEnableTesting :: Text
clientConfigEnableLinkPreviews :: Text
clientConfigEnablePostIconOverride :: Text
clientConfigEnablePostUsernameOverride :: Text
clientConfigEnableCommands :: Text
clientConfigEnableOutgoingWebhooks :: Text
clientConfigEnableIncomingWebhooks :: Text
clientConfigGoogleDeveloperKey :: Text
clientConfigEnableOAuthServiceProvider :: Text
clientConfigTeammateNameDisplay :: TeammateNameDisplayMode
clientConfigRestrictDirectMessage :: RestrictDirectMessageSetting
clientConfigEnableOpenServer :: Text
clientConfigSiteName :: Text
clientConfigSiteURL :: Text
clientConfigBuildEnterpriseReady :: Text
clientConfigBuildHashEnterprise :: Text
clientConfigBuildHash :: Text
clientConfigBuildDate :: Text
clientConfigBuildNumber :: Text
clientConfigVersion :: Text
clientConfigDiagnosticsEnabled :: Text
clientConfigDiagnosticId :: Text
clientConfigEnableChannelViewedMessages :: Text
clientConfigEnableUserTypingMessages :: Text
clientConfigTimeBetweenUserTypingUpdatesMilliseconds :: Text
clientConfigMaxNotificationsPerChannel :: Text
clientConfigIosAppDownloadLink :: Text
clientConfigAndroidAppDownloadLink :: Text
clientConfigAppDownloadLink :: Text
clientConfigMaxFileSize :: Text
clientConfigEnableEmojiPicker :: Text
clientConfigEnableCustomEmoji :: Text
clientConfigSQLDriverName :: Text
clientConfigAvailableLocales :: Text
clientConfigDefaultClientLocale :: Text
clientConfigWebsocketSecurePort :: Text
clientConfigWebsocketPort :: Text
clientConfigEnablePublicLink :: Text
clientConfigEnableFileAttachments :: Text
clientConfigSupportEmail :: Text
clientConfigCommercialSupportLink :: Maybe Text
clientConfigTroubleshootingForumLink :: Maybe Text
clientConfigAdministratorsGuideLink :: Maybe Text
clientConfigReportAProblemLink :: Text
clientConfigHelpLink :: Text
clientConfigAboutLink :: Text
clientConfigPrivacyPolicyLink :: Text
clientConfigTermsOfServiceLink :: Text
clientConfigShowEmailAddress :: Text
clientConfigEnableSignUpWithGitLab :: Text
clientConfigEnableEmailBatching :: Text
clientConfigRequireEmailVerification :: Text
clientConfigEnableSignInWithUsername :: Text
clientConfigEnableSignInWithEmail :: Text
clientConfigEnableSignUpWithEmail :: Text
clientConfigSendPushNotifications :: Text
clientConfigSendEmailNotifications :: Text
clientConfigPostEditTimeLimit :: Text
clientConfigEnableDiagnostics :: Text
clientConfigEnableDeveloper :: Text
clientConfigEnableTesting :: Text
clientConfigEnableLinkPreviews :: Text
clientConfigEnablePostIconOverride :: Text
clientConfigEnablePostUsernameOverride :: Text
clientConfigEnableCommands :: Text
clientConfigEnableOutgoingWebhooks :: Text
clientConfigEnableIncomingWebhooks :: Text
clientConfigGoogleDeveloperKey :: Text
clientConfigEnableOAuthServiceProvider :: Text
clientConfigTeammateNameDisplay :: TeammateNameDisplayMode
clientConfigRestrictDirectMessage :: RestrictDirectMessageSetting
clientConfigEnableOpenServer :: Text
clientConfigSiteName :: Text
clientConfigSiteURL :: Text
clientConfigBuildEnterpriseReady :: Text
clientConfigBuildHashEnterprise :: Text
clientConfigBuildHash :: Text
clientConfigBuildDate :: Text
clientConfigBuildNumber :: Text
clientConfigVersion :: Text
.. }


data TeamSettings = TeamSettings
  { TeamSettings -> Text
teamSettingsRestrictpublicchanneldeletion :: Text
  , TeamSettings -> Text
teamSettingsRestrictcreationtodomains :: Text
  , TeamSettings -> Int
teamSettingsMaxusersperteam :: Int
  , TeamSettings -> Text
teamSettingsCustomdescriptiontext :: Text
  , TeamSettings -> Bool
teamSettingsEnableopenserver :: Bool
  , TeamSettings -> Bool
teamSettingsEnableusercreation :: Bool
  , TeamSettings -> Text
teamSettingsCustombrandtext :: Text
  , TeamSettings -> Text
teamSettingsRestrictprivatechanneldeletion :: Text
  , TeamSettings -> Int
teamSettingsMaxchannelsperteam :: Int
  , TeamSettings -> Text
teamSettingsRestrictteaminvite :: Text
  , TeamSettings -> Text
teamSettingsSitename :: Text
  , TeamSettings -> Text
teamSettingsRestrictpublicchannelmanagement :: Text
  , TeamSettings -> Int
teamSettingsMaxnotificationsperchannel :: Int
  , TeamSettings -> Text
teamSettingsRestrictdirectmessage :: Text
  , TeamSettings -> Int
teamSettingsUserstatusawaytimeout :: Int
  , TeamSettings -> Bool
teamSettingsEnablecustombrand :: Bool
  , TeamSettings -> Text
teamSettingsRestrictprivatechannelmanagement :: Text
  , TeamSettings -> Text
teamSettingsRestrictprivatechannelcreation :: Text
  , TeamSettings -> Text
teamSettingsRestrictpublicchannelcreation :: Text
  } deriving (ReadPrec [TeamSettings]
ReadPrec TeamSettings
Int -> ReadS TeamSettings
ReadS [TeamSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TeamSettings]
$creadListPrec :: ReadPrec [TeamSettings]
readPrec :: ReadPrec TeamSettings
$creadPrec :: ReadPrec TeamSettings
readList :: ReadS [TeamSettings]
$creadList :: ReadS [TeamSettings]
readsPrec :: Int -> ReadS TeamSettings
$creadsPrec :: Int -> ReadS TeamSettings
Read, Int -> TeamSettings -> ShowS
[TeamSettings] -> ShowS
TeamSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamSettings] -> ShowS
$cshowList :: [TeamSettings] -> ShowS
show :: TeamSettings -> String
$cshow :: TeamSettings -> String
showsPrec :: Int -> TeamSettings -> ShowS
$cshowsPrec :: Int -> TeamSettings -> ShowS
Show, TeamSettings -> TeamSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamSettings -> TeamSettings -> Bool
$c/= :: TeamSettings -> TeamSettings -> Bool
== :: TeamSettings -> TeamSettings -> Bool
$c== :: TeamSettings -> TeamSettings -> Bool
Eq)

instance A.FromJSON TeamSettings where
  parseJSON :: Value -> Parser TeamSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"teamSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
teamSettingsRestrictpublicchanneldeletion <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictPublicChannelDeletion"
    Text
teamSettingsRestrictcreationtodomains <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictCreationToDomains"
    Int
teamSettingsMaxusersperteam <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MaxUsersPerTeam"
    Text
teamSettingsCustomdescriptiontext <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"CustomDescriptionText"
    Bool
teamSettingsEnableopenserver <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableOpenServer"
    Bool
teamSettingsEnableusercreation <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableUserCreation"
    Text
teamSettingsCustombrandtext <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"CustomBrandText"
    Text
teamSettingsRestrictprivatechanneldeletion <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictPrivateChannelDeletion"
    Int
teamSettingsMaxchannelsperteam <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MaxChannelsPerTeam"
    Text
teamSettingsRestrictteaminvite <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictTeamInvite"
    Text
teamSettingsSitename <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SiteName"
    Text
teamSettingsRestrictpublicchannelmanagement <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictPublicChannelManagement"
    Int
teamSettingsMaxnotificationsperchannel <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MaxNotificationsPerChannel"
    Text
teamSettingsRestrictdirectmessage <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictDirectMessage"
    Int
teamSettingsUserstatusawaytimeout <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"UserStatusAwayTimeout"
    Bool
teamSettingsEnablecustombrand <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableCustomBrand"
    Text
teamSettingsRestrictprivatechannelmanagement <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictPrivateChannelManagement"
    Text
teamSettingsRestrictprivatechannelcreation <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictPrivateChannelCreation"
    Text
teamSettingsRestrictpublicchannelcreation <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"RestrictPublicChannelCreation"
    forall (m :: * -> *) a. Monad m => a -> m a
return TeamSettings { Bool
Int
Text
teamSettingsRestrictpublicchannelcreation :: Text
teamSettingsRestrictprivatechannelcreation :: Text
teamSettingsRestrictprivatechannelmanagement :: Text
teamSettingsEnablecustombrand :: Bool
teamSettingsUserstatusawaytimeout :: Int
teamSettingsRestrictdirectmessage :: Text
teamSettingsMaxnotificationsperchannel :: Int
teamSettingsRestrictpublicchannelmanagement :: Text
teamSettingsSitename :: Text
teamSettingsRestrictteaminvite :: Text
teamSettingsMaxchannelsperteam :: Int
teamSettingsRestrictprivatechanneldeletion :: Text
teamSettingsCustombrandtext :: Text
teamSettingsEnableusercreation :: Bool
teamSettingsEnableopenserver :: Bool
teamSettingsCustomdescriptiontext :: Text
teamSettingsMaxusersperteam :: Int
teamSettingsRestrictcreationtodomains :: Text
teamSettingsRestrictpublicchanneldeletion :: Text
teamSettingsRestrictpublicchannelcreation :: Text
teamSettingsRestrictprivatechannelcreation :: Text
teamSettingsRestrictprivatechannelmanagement :: Text
teamSettingsEnablecustombrand :: Bool
teamSettingsUserstatusawaytimeout :: Int
teamSettingsRestrictdirectmessage :: Text
teamSettingsMaxnotificationsperchannel :: Int
teamSettingsRestrictpublicchannelmanagement :: Text
teamSettingsSitename :: Text
teamSettingsRestrictteaminvite :: Text
teamSettingsMaxchannelsperteam :: Int
teamSettingsRestrictprivatechanneldeletion :: Text
teamSettingsCustombrandtext :: Text
teamSettingsEnableusercreation :: Bool
teamSettingsEnableopenserver :: Bool
teamSettingsCustomdescriptiontext :: Text
teamSettingsMaxusersperteam :: Int
teamSettingsRestrictcreationtodomains :: Text
teamSettingsRestrictpublicchanneldeletion :: Text
.. }

instance A.ToJSON TeamSettings where
  toJSON :: TeamSettings -> Value
toJSON TeamSettings { Bool
Int
Text
teamSettingsRestrictpublicchannelcreation :: Text
teamSettingsRestrictprivatechannelcreation :: Text
teamSettingsRestrictprivatechannelmanagement :: Text
teamSettingsEnablecustombrand :: Bool
teamSettingsUserstatusawaytimeout :: Int
teamSettingsRestrictdirectmessage :: Text
teamSettingsMaxnotificationsperchannel :: Int
teamSettingsRestrictpublicchannelmanagement :: Text
teamSettingsSitename :: Text
teamSettingsRestrictteaminvite :: Text
teamSettingsMaxchannelsperteam :: Int
teamSettingsRestrictprivatechanneldeletion :: Text
teamSettingsCustombrandtext :: Text
teamSettingsEnableusercreation :: Bool
teamSettingsEnableopenserver :: Bool
teamSettingsCustomdescriptiontext :: Text
teamSettingsMaxusersperteam :: Int
teamSettingsRestrictcreationtodomains :: Text
teamSettingsRestrictpublicchanneldeletion :: Text
teamSettingsRestrictpublicchannelcreation :: TeamSettings -> Text
teamSettingsRestrictprivatechannelcreation :: TeamSettings -> Text
teamSettingsRestrictprivatechannelmanagement :: TeamSettings -> Text
teamSettingsEnablecustombrand :: TeamSettings -> Bool
teamSettingsUserstatusawaytimeout :: TeamSettings -> Int
teamSettingsRestrictdirectmessage :: TeamSettings -> Text
teamSettingsMaxnotificationsperchannel :: TeamSettings -> Int
teamSettingsRestrictpublicchannelmanagement :: TeamSettings -> Text
teamSettingsSitename :: TeamSettings -> Text
teamSettingsRestrictteaminvite :: TeamSettings -> Text
teamSettingsMaxchannelsperteam :: TeamSettings -> Int
teamSettingsRestrictprivatechanneldeletion :: TeamSettings -> Text
teamSettingsCustombrandtext :: TeamSettings -> Text
teamSettingsEnableusercreation :: TeamSettings -> Bool
teamSettingsEnableopenserver :: TeamSettings -> Bool
teamSettingsCustomdescriptiontext :: TeamSettings -> Text
teamSettingsMaxusersperteam :: TeamSettings -> Int
teamSettingsRestrictcreationtodomains :: TeamSettings -> Text
teamSettingsRestrictpublicchanneldeletion :: TeamSettings -> Text
.. } = [Pair] -> Value
A.object
    [ Key
"RestrictPublicChannelDeletion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictpublicchanneldeletion
    , Key
"RestrictCreationToDomains" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictcreationtodomains
    , Key
"MaxUsersPerTeam" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
teamSettingsMaxusersperteam
    , Key
"CustomDescriptionText" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsCustomdescriptiontext
    , Key
"EnableOpenServer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
teamSettingsEnableopenserver
    , Key
"EnableUserCreation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
teamSettingsEnableusercreation
    , Key
"CustomBrandText" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsCustombrandtext
    , Key
"RestrictPrivateChannelDeletion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictprivatechanneldeletion
    , Key
"MaxChannelsPerTeam" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
teamSettingsMaxchannelsperteam
    , Key
"RestrictTeamInvite" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictteaminvite
    , Key
"SiteName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsSitename
    , Key
"RestrictPublicChannelManagement" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictpublicchannelmanagement
    , Key
"MaxNotificationsPerChannel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
teamSettingsMaxnotificationsperchannel
    , Key
"RestrictDirectMessage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictdirectmessage
    , Key
"UserStatusAwayTimeout" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
teamSettingsUserstatusawaytimeout
    , Key
"EnableCustomBrand" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
teamSettingsEnablecustombrand
    , Key
"RestrictPrivateChannelManagement" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictprivatechannelmanagement
    , Key
"RestrictPrivateChannelCreation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictprivatechannelcreation
    , Key
"RestrictPublicChannelCreation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
teamSettingsRestrictpublicchannelcreation
    ]


data WebrtcSettings = WebrtcSettings
  { WebrtcSettings -> Text
webrtcSettingsStunuri :: Text
  , WebrtcSettings -> Text
webrtcSettingsTurnsharedkey :: Text
  , WebrtcSettings -> Bool
webrtcSettingsEnable :: Bool
  , WebrtcSettings -> Text
webrtcSettingsGatewayadminsecret :: Text
  , WebrtcSettings -> Text
webrtcSettingsTurnuri :: Text
  , WebrtcSettings -> Text
webrtcSettingsGatewayadminurl :: Text
  , WebrtcSettings -> Text
webrtcSettingsTurnusername :: Text
  , WebrtcSettings -> Text
webrtcSettingsGatewaywebsocketurl :: Text
  } deriving (ReadPrec [WebrtcSettings]
ReadPrec WebrtcSettings
Int -> ReadS WebrtcSettings
ReadS [WebrtcSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebrtcSettings]
$creadListPrec :: ReadPrec [WebrtcSettings]
readPrec :: ReadPrec WebrtcSettings
$creadPrec :: ReadPrec WebrtcSettings
readList :: ReadS [WebrtcSettings]
$creadList :: ReadS [WebrtcSettings]
readsPrec :: Int -> ReadS WebrtcSettings
$creadsPrec :: Int -> ReadS WebrtcSettings
Read, Int -> WebrtcSettings -> ShowS
[WebrtcSettings] -> ShowS
WebrtcSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebrtcSettings] -> ShowS
$cshowList :: [WebrtcSettings] -> ShowS
show :: WebrtcSettings -> String
$cshow :: WebrtcSettings -> String
showsPrec :: Int -> WebrtcSettings -> ShowS
$cshowsPrec :: Int -> WebrtcSettings -> ShowS
Show, WebrtcSettings -> WebrtcSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebrtcSettings -> WebrtcSettings -> Bool
$c/= :: WebrtcSettings -> WebrtcSettings -> Bool
== :: WebrtcSettings -> WebrtcSettings -> Bool
$c== :: WebrtcSettings -> WebrtcSettings -> Bool
Eq)

instance A.FromJSON WebrtcSettings where
  parseJSON :: Value -> Parser WebrtcSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"webrtcSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
webrtcSettingsStunuri <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"StunURI"
    Text
webrtcSettingsTurnsharedkey <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TurnSharedKey"
    Bool
webrtcSettingsEnable <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Enable"
    Text
webrtcSettingsGatewayadminsecret <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"GatewayAdminSecret"
    Text
webrtcSettingsTurnuri <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TurnURI"
    Text
webrtcSettingsGatewayadminurl <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"GatewayAdminUrl"
    Text
webrtcSettingsTurnusername <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TurnUsername"
    Text
webrtcSettingsGatewaywebsocketurl <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"GatewayWebsocketUrl"
    forall (m :: * -> *) a. Monad m => a -> m a
return WebrtcSettings { Bool
Text
webrtcSettingsGatewaywebsocketurl :: Text
webrtcSettingsTurnusername :: Text
webrtcSettingsGatewayadminurl :: Text
webrtcSettingsTurnuri :: Text
webrtcSettingsGatewayadminsecret :: Text
webrtcSettingsEnable :: Bool
webrtcSettingsTurnsharedkey :: Text
webrtcSettingsStunuri :: Text
webrtcSettingsGatewaywebsocketurl :: Text
webrtcSettingsTurnusername :: Text
webrtcSettingsGatewayadminurl :: Text
webrtcSettingsTurnuri :: Text
webrtcSettingsGatewayadminsecret :: Text
webrtcSettingsEnable :: Bool
webrtcSettingsTurnsharedkey :: Text
webrtcSettingsStunuri :: Text
.. }

instance A.ToJSON WebrtcSettings where
  toJSON :: WebrtcSettings -> Value
toJSON WebrtcSettings { Bool
Text
webrtcSettingsGatewaywebsocketurl :: Text
webrtcSettingsTurnusername :: Text
webrtcSettingsGatewayadminurl :: Text
webrtcSettingsTurnuri :: Text
webrtcSettingsGatewayadminsecret :: Text
webrtcSettingsEnable :: Bool
webrtcSettingsTurnsharedkey :: Text
webrtcSettingsStunuri :: Text
webrtcSettingsGatewaywebsocketurl :: WebrtcSettings -> Text
webrtcSettingsTurnusername :: WebrtcSettings -> Text
webrtcSettingsGatewayadminurl :: WebrtcSettings -> Text
webrtcSettingsTurnuri :: WebrtcSettings -> Text
webrtcSettingsGatewayadminsecret :: WebrtcSettings -> Text
webrtcSettingsEnable :: WebrtcSettings -> Bool
webrtcSettingsTurnsharedkey :: WebrtcSettings -> Text
webrtcSettingsStunuri :: WebrtcSettings -> Text
.. } = [Pair] -> Value
A.object
    [ Key
"StunURI" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
webrtcSettingsStunuri
    , Key
"TurnSharedKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
webrtcSettingsTurnsharedkey
    , Key
"Enable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
webrtcSettingsEnable
    , Key
"GatewayAdminSecret" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
webrtcSettingsGatewayadminsecret
    , Key
"TurnURI" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
webrtcSettingsTurnuri
    , Key
"GatewayAdminUrl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
webrtcSettingsGatewayadminurl
    , Key
"TurnUsername" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
webrtcSettingsTurnusername
    , Key
"GatewayWebsocketUrl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
webrtcSettingsGatewaywebsocketurl
    ]


data PasswordSettings = PasswordSettings
  { PasswordSettings -> Bool
passwordSettingsUppercase :: Bool
  , PasswordSettings -> Bool
passwordSettingsLowercase :: Bool
  , PasswordSettings -> Bool
passwordSettingsNumber :: Bool
  , PasswordSettings -> Bool
passwordSettingsSymbol :: Bool
  , PasswordSettings -> Int
passwordSettingsMinimumlength :: Int
  } deriving (ReadPrec [PasswordSettings]
ReadPrec PasswordSettings
Int -> ReadS PasswordSettings
ReadS [PasswordSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PasswordSettings]
$creadListPrec :: ReadPrec [PasswordSettings]
readPrec :: ReadPrec PasswordSettings
$creadPrec :: ReadPrec PasswordSettings
readList :: ReadS [PasswordSettings]
$creadList :: ReadS [PasswordSettings]
readsPrec :: Int -> ReadS PasswordSettings
$creadsPrec :: Int -> ReadS PasswordSettings
Read, Int -> PasswordSettings -> ShowS
[PasswordSettings] -> ShowS
PasswordSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordSettings] -> ShowS
$cshowList :: [PasswordSettings] -> ShowS
show :: PasswordSettings -> String
$cshow :: PasswordSettings -> String
showsPrec :: Int -> PasswordSettings -> ShowS
$cshowsPrec :: Int -> PasswordSettings -> ShowS
Show, PasswordSettings -> PasswordSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordSettings -> PasswordSettings -> Bool
$c/= :: PasswordSettings -> PasswordSettings -> Bool
== :: PasswordSettings -> PasswordSettings -> Bool
$c== :: PasswordSettings -> PasswordSettings -> Bool
Eq)

instance A.FromJSON PasswordSettings where
  parseJSON :: Value -> Parser PasswordSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"passwordSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Bool
passwordSettingsUppercase <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Uppercase"
    Bool
passwordSettingsLowercase <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Lowercase"
    Bool
passwordSettingsNumber <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Number"
    Bool
passwordSettingsSymbol <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Symbol"
    Int
passwordSettingsMinimumlength <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MinimumLength"
    forall (m :: * -> *) a. Monad m => a -> m a
return PasswordSettings { Bool
Int
passwordSettingsMinimumlength :: Int
passwordSettingsSymbol :: Bool
passwordSettingsNumber :: Bool
passwordSettingsLowercase :: Bool
passwordSettingsUppercase :: Bool
passwordSettingsMinimumlength :: Int
passwordSettingsSymbol :: Bool
passwordSettingsNumber :: Bool
passwordSettingsLowercase :: Bool
passwordSettingsUppercase :: Bool
.. }

instance A.ToJSON PasswordSettings where
  toJSON :: PasswordSettings -> Value
toJSON PasswordSettings { Bool
Int
passwordSettingsMinimumlength :: Int
passwordSettingsSymbol :: Bool
passwordSettingsNumber :: Bool
passwordSettingsLowercase :: Bool
passwordSettingsUppercase :: Bool
passwordSettingsMinimumlength :: PasswordSettings -> Int
passwordSettingsSymbol :: PasswordSettings -> Bool
passwordSettingsNumber :: PasswordSettings -> Bool
passwordSettingsLowercase :: PasswordSettings -> Bool
passwordSettingsUppercase :: PasswordSettings -> Bool
.. } = [Pair] -> Value
A.object
    [ Key
"Uppercase" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
passwordSettingsUppercase
    , Key
"Lowercase" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
passwordSettingsLowercase
    , Key
"Number" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
passwordSettingsNumber
    , Key
"Symbol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
passwordSettingsSymbol
    , Key
"MinimumLength" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
passwordSettingsMinimumlength
    ]

--

data PrivacySettings = PrivacySettings
  { PrivacySettings -> Bool
privacySettingsShowemailaddress :: Bool
  , PrivacySettings -> Bool
privacySettingsShowfullname :: Bool
  } deriving (ReadPrec [PrivacySettings]
ReadPrec PrivacySettings
Int -> ReadS PrivacySettings
ReadS [PrivacySettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrivacySettings]
$creadListPrec :: ReadPrec [PrivacySettings]
readPrec :: ReadPrec PrivacySettings
$creadPrec :: ReadPrec PrivacySettings
readList :: ReadS [PrivacySettings]
$creadList :: ReadS [PrivacySettings]
readsPrec :: Int -> ReadS PrivacySettings
$creadsPrec :: Int -> ReadS PrivacySettings
Read, Int -> PrivacySettings -> ShowS
[PrivacySettings] -> ShowS
PrivacySettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivacySettings] -> ShowS
$cshowList :: [PrivacySettings] -> ShowS
show :: PrivacySettings -> String
$cshow :: PrivacySettings -> String
showsPrec :: Int -> PrivacySettings -> ShowS
$cshowsPrec :: Int -> PrivacySettings -> ShowS
Show, PrivacySettings -> PrivacySettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivacySettings -> PrivacySettings -> Bool
$c/= :: PrivacySettings -> PrivacySettings -> Bool
== :: PrivacySettings -> PrivacySettings -> Bool
$c== :: PrivacySettings -> PrivacySettings -> Bool
Eq)

instance A.FromJSON PrivacySettings where
  parseJSON :: Value -> Parser PrivacySettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"privacySettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Bool
privacySettingsShowemailaddress <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ShowEmailAddress"
    Bool
privacySettingsShowfullname <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ShowFullName"
    forall (m :: * -> *) a. Monad m => a -> m a
return PrivacySettings { Bool
privacySettingsShowfullname :: Bool
privacySettingsShowemailaddress :: Bool
privacySettingsShowfullname :: Bool
privacySettingsShowemailaddress :: Bool
.. }

instance A.ToJSON PrivacySettings where
  toJSON :: PrivacySettings -> Value
toJSON PrivacySettings { Bool
privacySettingsShowfullname :: Bool
privacySettingsShowemailaddress :: Bool
privacySettingsShowfullname :: PrivacySettings -> Bool
privacySettingsShowemailaddress :: PrivacySettings -> Bool
.. } = [Pair] -> Value
A.object
    [ Key
"ShowEmailAddress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
privacySettingsShowemailaddress
    , Key
"ShowFullName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
privacySettingsShowfullname
    ]

--

data RateLimitSettings = RateLimitSettings
  { RateLimitSettings -> Bool
rateLimitSettingsEnable :: Bool
  , RateLimitSettings -> Bool
rateLimitSettingsVarybyremoteaddr :: Bool
  , RateLimitSettings -> Int
rateLimitSettingsMemorystoresize :: Int
  , RateLimitSettings -> Int
rateLimitSettingsMaxburst :: Int
  , RateLimitSettings -> Text
rateLimitSettingsVarybyheader :: Text
  , RateLimitSettings -> Int
rateLimitSettingsPersec :: Int
  } deriving (ReadPrec [RateLimitSettings]
ReadPrec RateLimitSettings
Int -> ReadS RateLimitSettings
ReadS [RateLimitSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RateLimitSettings]
$creadListPrec :: ReadPrec [RateLimitSettings]
readPrec :: ReadPrec RateLimitSettings
$creadPrec :: ReadPrec RateLimitSettings
readList :: ReadS [RateLimitSettings]
$creadList :: ReadS [RateLimitSettings]
readsPrec :: Int -> ReadS RateLimitSettings
$creadsPrec :: Int -> ReadS RateLimitSettings
Read, Int -> RateLimitSettings -> ShowS
[RateLimitSettings] -> ShowS
RateLimitSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RateLimitSettings] -> ShowS
$cshowList :: [RateLimitSettings] -> ShowS
show :: RateLimitSettings -> String
$cshow :: RateLimitSettings -> String
showsPrec :: Int -> RateLimitSettings -> ShowS
$cshowsPrec :: Int -> RateLimitSettings -> ShowS
Show, RateLimitSettings -> RateLimitSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RateLimitSettings -> RateLimitSettings -> Bool
$c/= :: RateLimitSettings -> RateLimitSettings -> Bool
== :: RateLimitSettings -> RateLimitSettings -> Bool
$c== :: RateLimitSettings -> RateLimitSettings -> Bool
Eq)

instance A.FromJSON RateLimitSettings where
  parseJSON :: Value -> Parser RateLimitSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"rateLimitSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Bool
rateLimitSettingsEnable <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Enable"
    Bool
rateLimitSettingsVarybyremoteaddr <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"VaryByRemoteAddr"
    Int
rateLimitSettingsMemorystoresize <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MemoryStoreSize"
    Int
rateLimitSettingsMaxburst <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"MaxBurst"
    Text
rateLimitSettingsVarybyheader <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"VaryByHeader"
    Int
rateLimitSettingsPersec <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"PerSec"
    forall (m :: * -> *) a. Monad m => a -> m a
return RateLimitSettings { Bool
Int
Text
rateLimitSettingsPersec :: Int
rateLimitSettingsVarybyheader :: Text
rateLimitSettingsMaxburst :: Int
rateLimitSettingsMemorystoresize :: Int
rateLimitSettingsVarybyremoteaddr :: Bool
rateLimitSettingsEnable :: Bool
rateLimitSettingsPersec :: Int
rateLimitSettingsVarybyheader :: Text
rateLimitSettingsMaxburst :: Int
rateLimitSettingsMemorystoresize :: Int
rateLimitSettingsVarybyremoteaddr :: Bool
rateLimitSettingsEnable :: Bool
.. }

instance A.ToJSON RateLimitSettings where
  toJSON :: RateLimitSettings -> Value
toJSON RateLimitSettings { Bool
Int
Text
rateLimitSettingsPersec :: Int
rateLimitSettingsVarybyheader :: Text
rateLimitSettingsMaxburst :: Int
rateLimitSettingsMemorystoresize :: Int
rateLimitSettingsVarybyremoteaddr :: Bool
rateLimitSettingsEnable :: Bool
rateLimitSettingsPersec :: RateLimitSettings -> Int
rateLimitSettingsVarybyheader :: RateLimitSettings -> Text
rateLimitSettingsMaxburst :: RateLimitSettings -> Int
rateLimitSettingsMemorystoresize :: RateLimitSettings -> Int
rateLimitSettingsVarybyremoteaddr :: RateLimitSettings -> Bool
rateLimitSettingsEnable :: RateLimitSettings -> Bool
.. } = [Pair] -> Value
A.object
    [ Key
"Enable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
rateLimitSettingsEnable
    , Key
"VaryByRemoteAddr" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
rateLimitSettingsVarybyremoteaddr
    , Key
"MemoryStoreSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
rateLimitSettingsMemorystoresize
    , Key
"MaxBurst" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
rateLimitSettingsMaxburst
    , Key
"VaryByHeader" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
rateLimitSettingsVarybyheader
    , Key
"PerSec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
rateLimitSettingsPersec
    ]


data LogSettings = LogSettings
  { LogSettings -> Bool
logSettingsEnablefile :: Bool
  , LogSettings -> Text
logSettingsFilelocation :: Text
  , LogSettings -> Text
logSettingsFilelevel :: Text
  , LogSettings -> Bool
logSettingsEnableconsole :: Bool
  , LogSettings -> Bool
logSettingsEnablewebhookdebugging :: Bool
  , LogSettings -> Text
logSettingsConsolelevel :: Text
  , LogSettings -> Text
logSettingsFileformat :: Text
  , LogSettings -> Bool
logSettingsEnablediagnostics :: Bool
  } deriving (ReadPrec [LogSettings]
ReadPrec LogSettings
Int -> ReadS LogSettings
ReadS [LogSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogSettings]
$creadListPrec :: ReadPrec [LogSettings]
readPrec :: ReadPrec LogSettings
$creadPrec :: ReadPrec LogSettings
readList :: ReadS [LogSettings]
$creadList :: ReadS [LogSettings]
readsPrec :: Int -> ReadS LogSettings
$creadsPrec :: Int -> ReadS LogSettings
Read, Int -> LogSettings -> ShowS
[LogSettings] -> ShowS
LogSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogSettings] -> ShowS
$cshowList :: [LogSettings] -> ShowS
show :: LogSettings -> String
$cshow :: LogSettings -> String
showsPrec :: Int -> LogSettings -> ShowS
$cshowsPrec :: Int -> LogSettings -> ShowS
Show, LogSettings -> LogSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogSettings -> LogSettings -> Bool
$c/= :: LogSettings -> LogSettings -> Bool
== :: LogSettings -> LogSettings -> Bool
$c== :: LogSettings -> LogSettings -> Bool
Eq)

instance A.FromJSON LogSettings where
  parseJSON :: Value -> Parser LogSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"logSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Bool
logSettingsEnablefile <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableFile"
    Text
logSettingsFilelocation <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"FileLocation"
    Text
logSettingsFilelevel <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"FileLevel"
    Bool
logSettingsEnableconsole <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableConsole"
    Bool
logSettingsEnablewebhookdebugging <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableWebhookDebugging"
    Text
logSettingsConsolelevel <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ConsoleLevel"
    Text
logSettingsFileformat <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"FileFormat"
    Bool
logSettingsEnablediagnostics <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableDiagnostics"
    forall (m :: * -> *) a. Monad m => a -> m a
return LogSettings { Bool
Text
logSettingsEnablediagnostics :: Bool
logSettingsFileformat :: Text
logSettingsConsolelevel :: Text
logSettingsEnablewebhookdebugging :: Bool
logSettingsEnableconsole :: Bool
logSettingsFilelevel :: Text
logSettingsFilelocation :: Text
logSettingsEnablefile :: Bool
logSettingsEnablediagnostics :: Bool
logSettingsFileformat :: Text
logSettingsConsolelevel :: Text
logSettingsEnablewebhookdebugging :: Bool
logSettingsEnableconsole :: Bool
logSettingsFilelevel :: Text
logSettingsFilelocation :: Text
logSettingsEnablefile :: Bool
.. }

instance A.ToJSON LogSettings where
  toJSON :: LogSettings -> Value
toJSON LogSettings { Bool
Text
logSettingsEnablediagnostics :: Bool
logSettingsFileformat :: Text
logSettingsConsolelevel :: Text
logSettingsEnablewebhookdebugging :: Bool
logSettingsEnableconsole :: Bool
logSettingsFilelevel :: Text
logSettingsFilelocation :: Text
logSettingsEnablefile :: Bool
logSettingsEnablediagnostics :: LogSettings -> Bool
logSettingsFileformat :: LogSettings -> Text
logSettingsConsolelevel :: LogSettings -> Text
logSettingsEnablewebhookdebugging :: LogSettings -> Bool
logSettingsEnableconsole :: LogSettings -> Bool
logSettingsFilelevel :: LogSettings -> Text
logSettingsFilelocation :: LogSettings -> Text
logSettingsEnablefile :: LogSettings -> Bool
.. } = [Pair] -> Value
A.object
    [ Key
"EnableFile" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
logSettingsEnablefile
    , Key
"FileLocation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
logSettingsFilelocation
    , Key
"FileLevel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
logSettingsFilelevel
    , Key
"EnableConsole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
logSettingsEnableconsole
    , Key
"EnableWebhookDebugging" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
logSettingsEnablewebhookdebugging
    , Key
"ConsoleLevel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
logSettingsConsolelevel
    , Key
"FileFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
logSettingsFileformat
    , Key
"EnableDiagnostics" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
logSettingsEnablediagnostics
    ]

--

data MetricsSettings = MetricsSettings
  { MetricsSettings -> Integer
metricsSettingsBlockprofilerate :: Integer
  , MetricsSettings -> Bool
metricsSettingsEnable :: Bool
  , MetricsSettings -> Text
metricsSettingsListenaddress :: Text
  } deriving (ReadPrec [MetricsSettings]
ReadPrec MetricsSettings
Int -> ReadS MetricsSettings
ReadS [MetricsSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MetricsSettings]
$creadListPrec :: ReadPrec [MetricsSettings]
readPrec :: ReadPrec MetricsSettings
$creadPrec :: ReadPrec MetricsSettings
readList :: ReadS [MetricsSettings]
$creadList :: ReadS [MetricsSettings]
readsPrec :: Int -> ReadS MetricsSettings
$creadsPrec :: Int -> ReadS MetricsSettings
Read, Int -> MetricsSettings -> ShowS
[MetricsSettings] -> ShowS
MetricsSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetricsSettings] -> ShowS
$cshowList :: [MetricsSettings] -> ShowS
show :: MetricsSettings -> String
$cshow :: MetricsSettings -> String
showsPrec :: Int -> MetricsSettings -> ShowS
$cshowsPrec :: Int -> MetricsSettings -> ShowS
Show, MetricsSettings -> MetricsSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricsSettings -> MetricsSettings -> Bool
$c/= :: MetricsSettings -> MetricsSettings -> Bool
== :: MetricsSettings -> MetricsSettings -> Bool
$c== :: MetricsSettings -> MetricsSettings -> Bool
Eq)

instance A.FromJSON MetricsSettings where
  parseJSON :: Value -> Parser MetricsSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"metricsSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Integer
metricsSettingsBlockprofilerate <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"BlockProfileRate"
    Bool
metricsSettingsEnable <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Enable"
    Text
metricsSettingsListenaddress <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ListenAddress"
    forall (m :: * -> *) a. Monad m => a -> m a
return MetricsSettings { Bool
Integer
Text
metricsSettingsListenaddress :: Text
metricsSettingsEnable :: Bool
metricsSettingsBlockprofilerate :: Integer
metricsSettingsListenaddress :: Text
metricsSettingsEnable :: Bool
metricsSettingsBlockprofilerate :: Integer
.. }

instance A.ToJSON MetricsSettings where
  toJSON :: MetricsSettings -> Value
toJSON MetricsSettings { Bool
Integer
Text
metricsSettingsListenaddress :: Text
metricsSettingsEnable :: Bool
metricsSettingsBlockprofilerate :: Integer
metricsSettingsListenaddress :: MetricsSettings -> Text
metricsSettingsEnable :: MetricsSettings -> Bool
metricsSettingsBlockprofilerate :: MetricsSettings -> Integer
.. } = [Pair] -> Value
A.object
    [ Key
"BlockProfileRate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Integer
metricsSettingsBlockprofilerate
    , Key
"Enable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
metricsSettingsEnable
    , Key
"ListenAddress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
metricsSettingsListenaddress
    ]

--

data NativeAppSettings = NativeAppSettings
  { NativeAppSettings -> Text
nativeAppSettingsAndroidappdownloadlink :: Text
  , NativeAppSettings -> Text
nativeAppSettingsAppdownloadlink :: Text
  , NativeAppSettings -> Text
nativeAppSettingsIosappdownloadlink :: Text
  } deriving (ReadPrec [NativeAppSettings]
ReadPrec NativeAppSettings
Int -> ReadS NativeAppSettings
ReadS [NativeAppSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NativeAppSettings]
$creadListPrec :: ReadPrec [NativeAppSettings]
readPrec :: ReadPrec NativeAppSettings
$creadPrec :: ReadPrec NativeAppSettings
readList :: ReadS [NativeAppSettings]
$creadList :: ReadS [NativeAppSettings]
readsPrec :: Int -> ReadS NativeAppSettings
$creadsPrec :: Int -> ReadS NativeAppSettings
Read, Int -> NativeAppSettings -> ShowS
[NativeAppSettings] -> ShowS
NativeAppSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NativeAppSettings] -> ShowS
$cshowList :: [NativeAppSettings] -> ShowS
show :: NativeAppSettings -> String
$cshow :: NativeAppSettings -> String
showsPrec :: Int -> NativeAppSettings -> ShowS
$cshowsPrec :: Int -> NativeAppSettings -> ShowS
Show, NativeAppSettings -> NativeAppSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NativeAppSettings -> NativeAppSettings -> Bool
$c/= :: NativeAppSettings -> NativeAppSettings -> Bool
== :: NativeAppSettings -> NativeAppSettings -> Bool
$c== :: NativeAppSettings -> NativeAppSettings -> Bool
Eq)

instance A.FromJSON NativeAppSettings where
  parseJSON :: Value -> Parser NativeAppSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"nativeAppSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
nativeAppSettingsAndroidappdownloadlink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"AndroidAppDownloadLink"
    Text
nativeAppSettingsAppdownloadlink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"AppDownloadLink"
    Text
nativeAppSettingsIosappdownloadlink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"IosAppDownloadLink"
    forall (m :: * -> *) a. Monad m => a -> m a
return NativeAppSettings { Text
nativeAppSettingsIosappdownloadlink :: Text
nativeAppSettingsAppdownloadlink :: Text
nativeAppSettingsAndroidappdownloadlink :: Text
nativeAppSettingsIosappdownloadlink :: Text
nativeAppSettingsAppdownloadlink :: Text
nativeAppSettingsAndroidappdownloadlink :: Text
.. }

instance A.ToJSON NativeAppSettings where
  toJSON :: NativeAppSettings -> Value
toJSON NativeAppSettings { Text
nativeAppSettingsIosappdownloadlink :: Text
nativeAppSettingsAppdownloadlink :: Text
nativeAppSettingsAndroidappdownloadlink :: Text
nativeAppSettingsIosappdownloadlink :: NativeAppSettings -> Text
nativeAppSettingsAppdownloadlink :: NativeAppSettings -> Text
nativeAppSettingsAndroidappdownloadlink :: NativeAppSettings -> Text
.. } = [Pair] -> Value
A.object
    [ Key
"AndroidAppDownloadLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
nativeAppSettingsAndroidappdownloadlink
    , Key
"AppDownloadLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
nativeAppSettingsAppdownloadlink
    , Key
"IosAppDownloadLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
nativeAppSettingsIosappdownloadlink
    ]


data ComplianceSettings = ComplianceSettings
  { ComplianceSettings -> Text
complianceSettingsDirectory :: Text
  , ComplianceSettings -> Bool
complianceSettingsEnable :: Bool
  , ComplianceSettings -> Bool
complianceSettingsEnabledaily :: Bool
  } deriving (ReadPrec [ComplianceSettings]
ReadPrec ComplianceSettings
Int -> ReadS ComplianceSettings
ReadS [ComplianceSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComplianceSettings]
$creadListPrec :: ReadPrec [ComplianceSettings]
readPrec :: ReadPrec ComplianceSettings
$creadPrec :: ReadPrec ComplianceSettings
readList :: ReadS [ComplianceSettings]
$creadList :: ReadS [ComplianceSettings]
readsPrec :: Int -> ReadS ComplianceSettings
$creadsPrec :: Int -> ReadS ComplianceSettings
Read, Int -> ComplianceSettings -> ShowS
[ComplianceSettings] -> ShowS
ComplianceSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComplianceSettings] -> ShowS
$cshowList :: [ComplianceSettings] -> ShowS
show :: ComplianceSettings -> String
$cshow :: ComplianceSettings -> String
showsPrec :: Int -> ComplianceSettings -> ShowS
$cshowsPrec :: Int -> ComplianceSettings -> ShowS
Show, ComplianceSettings -> ComplianceSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComplianceSettings -> ComplianceSettings -> Bool
$c/= :: ComplianceSettings -> ComplianceSettings -> Bool
== :: ComplianceSettings -> ComplianceSettings -> Bool
$c== :: ComplianceSettings -> ComplianceSettings -> Bool
Eq)

instance A.FromJSON ComplianceSettings where
  parseJSON :: Value -> Parser ComplianceSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"complianceSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
complianceSettingsDirectory <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Directory"
    Bool
complianceSettingsEnable <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"Enable"
    Bool
complianceSettingsEnabledaily <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"EnableDaily"
    forall (m :: * -> *) a. Monad m => a -> m a
return ComplianceSettings { Bool
Text
complianceSettingsEnabledaily :: Bool
complianceSettingsEnable :: Bool
complianceSettingsDirectory :: Text
complianceSettingsEnabledaily :: Bool
complianceSettingsEnable :: Bool
complianceSettingsDirectory :: Text
.. }

instance A.ToJSON ComplianceSettings where
  toJSON :: ComplianceSettings -> Value
toJSON ComplianceSettings { Bool
Text
complianceSettingsEnabledaily :: Bool
complianceSettingsEnable :: Bool
complianceSettingsDirectory :: Text
complianceSettingsEnabledaily :: ComplianceSettings -> Bool
complianceSettingsEnable :: ComplianceSettings -> Bool
complianceSettingsDirectory :: ComplianceSettings -> Text
.. } = [Pair] -> Value
A.object
    [ Key
"Directory" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
complianceSettingsDirectory
    , Key
"Enable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
complianceSettingsEnable
    , Key
"EnableDaily" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
complianceSettingsEnabledaily
    ]


data SupportSettings = SupportSettings
  { SupportSettings -> Text
supportSettingsReportaproblemlink :: Text
  , SupportSettings -> Text
supportSettingsHelplink :: Text
  , SupportSettings -> Text
supportSettingsPrivacypolicylink :: Text
  , SupportSettings -> Text
supportSettingsTermsofservicelink :: Text
  , SupportSettings -> Text
supportSettingsAboutlink :: Text
  , SupportSettings -> Text
supportSettingsSupportemail :: Text
  } deriving (ReadPrec [SupportSettings]
ReadPrec SupportSettings
Int -> ReadS SupportSettings
ReadS [SupportSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SupportSettings]
$creadListPrec :: ReadPrec [SupportSettings]
readPrec :: ReadPrec SupportSettings
$creadPrec :: ReadPrec SupportSettings
readList :: ReadS [SupportSettings]
$creadList :: ReadS [SupportSettings]
readsPrec :: Int -> ReadS SupportSettings
$creadsPrec :: Int -> ReadS SupportSettings
Read, Int -> SupportSettings -> ShowS
[SupportSettings] -> ShowS
SupportSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SupportSettings] -> ShowS
$cshowList :: [SupportSettings] -> ShowS
show :: SupportSettings -> String
$cshow :: SupportSettings -> String
showsPrec :: Int -> SupportSettings -> ShowS
$cshowsPrec :: Int -> SupportSettings -> ShowS
Show, SupportSettings -> SupportSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SupportSettings -> SupportSettings -> Bool
$c/= :: SupportSettings -> SupportSettings -> Bool
== :: SupportSettings -> SupportSettings -> Bool
$c== :: SupportSettings -> SupportSettings -> Bool
Eq)

instance A.FromJSON SupportSettings where
  parseJSON :: Value -> Parser SupportSettings
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"supportSettings" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
supportSettingsReportaproblemlink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"ReportAProblemLink"
    Text
supportSettingsHelplink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"HelpLink"
    Text
supportSettingsPrivacypolicylink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"PrivacyPolicyLink"
    Text
supportSettingsTermsofservicelink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"TermsOfServiceLink"
    Text
supportSettingsAboutlink <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"AboutLink"
    Text
supportSettingsSupportemail <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"SupportEmail"
    forall (m :: * -> *) a. Monad m => a -> m a
return SupportSettings { Text
supportSettingsSupportemail :: Text
supportSettingsAboutlink :: Text
supportSettingsTermsofservicelink :: Text
supportSettingsPrivacypolicylink :: Text
supportSettingsHelplink :: Text
supportSettingsReportaproblemlink :: Text
supportSettingsSupportemail :: Text
supportSettingsAboutlink :: Text
supportSettingsTermsofservicelink :: Text
supportSettingsPrivacypolicylink :: Text
supportSettingsHelplink :: Text
supportSettingsReportaproblemlink :: Text
.. }

instance A.ToJSON SupportSettings where
  toJSON :: SupportSettings -> Value
toJSON SupportSettings { Text
supportSettingsSupportemail :: Text
supportSettingsAboutlink :: Text
supportSettingsTermsofservicelink :: Text
supportSettingsPrivacypolicylink :: Text
supportSettingsHelplink :: Text
supportSettingsReportaproblemlink :: Text
supportSettingsSupportemail :: SupportSettings -> Text
supportSettingsAboutlink :: SupportSettings -> Text
supportSettingsTermsofservicelink :: SupportSettings -> Text
supportSettingsPrivacypolicylink :: SupportSettings -> Text
supportSettingsHelplink :: SupportSettings -> Text
supportSettingsReportaproblemlink :: SupportSettings -> Text
.. } = [Pair] -> Value
A.object
    [ Key
"ReportAProblemLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
supportSettingsReportaproblemlink
    , Key
"HelpLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
supportSettingsHelplink
    , Key
"PrivacyPolicyLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
supportSettingsPrivacypolicylink
    , Key
"TermsOfServiceLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
supportSettingsTermsofservicelink
    , Key
"AboutLink" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
supportSettingsAboutlink
    , Key
"SupportEmail" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
supportSettingsSupportemail
    ]