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

module Wire.API.SystemSettings where

import Control.Lens hiding ((.=))
import Data.Aeson qualified as A
import Data.OpenApi qualified as S
import Data.Schema as Schema
import Imports
import Servant.OpenApi.Internal.Orphans ()
import Test.QuickCheck
import Wire.Arbitrary

-- | Subset of `Brig.Options.Settings` that is safe to be shown in public.
--
-- Used to expose settings via the @/system/settings/unauthorized@ endpoint.
-- ALWAYS CHECK WITH SECURITY IF YOU WANT TO ADD SETTINGS HERE.
data SystemSettingsPublic = SystemSettingsPublic
  { SystemSettingsPublic -> Bool
sspSetRestrictUserCreation :: !Bool
  }
  deriving (SystemSettingsPublic -> SystemSettingsPublic -> Bool
(SystemSettingsPublic -> SystemSettingsPublic -> Bool)
-> (SystemSettingsPublic -> SystemSettingsPublic -> Bool)
-> Eq SystemSettingsPublic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SystemSettingsPublic -> SystemSettingsPublic -> Bool
== :: SystemSettingsPublic -> SystemSettingsPublic -> Bool
$c/= :: SystemSettingsPublic -> SystemSettingsPublic -> Bool
/= :: SystemSettingsPublic -> SystemSettingsPublic -> Bool
Eq, Int -> SystemSettingsPublic -> ShowS
[SystemSettingsPublic] -> ShowS
SystemSettingsPublic -> String
(Int -> SystemSettingsPublic -> ShowS)
-> (SystemSettingsPublic -> String)
-> ([SystemSettingsPublic] -> ShowS)
-> Show SystemSettingsPublic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SystemSettingsPublic -> ShowS
showsPrec :: Int -> SystemSettingsPublic -> ShowS
$cshow :: SystemSettingsPublic -> String
show :: SystemSettingsPublic -> String
$cshowList :: [SystemSettingsPublic] -> ShowS
showList :: [SystemSettingsPublic] -> ShowS
Show, (forall x. SystemSettingsPublic -> Rep SystemSettingsPublic x)
-> (forall x. Rep SystemSettingsPublic x -> SystemSettingsPublic)
-> Generic SystemSettingsPublic
forall x. Rep SystemSettingsPublic x -> SystemSettingsPublic
forall x. SystemSettingsPublic -> Rep SystemSettingsPublic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SystemSettingsPublic -> Rep SystemSettingsPublic x
from :: forall x. SystemSettingsPublic -> Rep SystemSettingsPublic x
$cto :: forall x. Rep SystemSettingsPublic x -> SystemSettingsPublic
to :: forall x. Rep SystemSettingsPublic x -> SystemSettingsPublic
Generic)
  deriving ([SystemSettingsPublic] -> Value
[SystemSettingsPublic] -> Encoding
SystemSettingsPublic -> Value
SystemSettingsPublic -> Encoding
(SystemSettingsPublic -> Value)
-> (SystemSettingsPublic -> Encoding)
-> ([SystemSettingsPublic] -> Value)
-> ([SystemSettingsPublic] -> Encoding)
-> ToJSON SystemSettingsPublic
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SystemSettingsPublic -> Value
toJSON :: SystemSettingsPublic -> Value
$ctoEncoding :: SystemSettingsPublic -> Encoding
toEncoding :: SystemSettingsPublic -> Encoding
$ctoJSONList :: [SystemSettingsPublic] -> Value
toJSONList :: [SystemSettingsPublic] -> Value
$ctoEncodingList :: [SystemSettingsPublic] -> Encoding
toEncodingList :: [SystemSettingsPublic] -> Encoding
A.ToJSON, Value -> Parser [SystemSettingsPublic]
Value -> Parser SystemSettingsPublic
(Value -> Parser SystemSettingsPublic)
-> (Value -> Parser [SystemSettingsPublic])
-> FromJSON SystemSettingsPublic
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SystemSettingsPublic
parseJSON :: Value -> Parser SystemSettingsPublic
$cparseJSONList :: Value -> Parser [SystemSettingsPublic]
parseJSONList :: Value -> Parser [SystemSettingsPublic]
A.FromJSON, Typeable SystemSettingsPublic
Typeable SystemSettingsPublic =>
(Proxy SystemSettingsPublic
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SystemSettingsPublic
Proxy SystemSettingsPublic
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SystemSettingsPublic
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SystemSettingsPublic
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema SystemSettingsPublic
  deriving (Gen SystemSettingsPublic
Gen SystemSettingsPublic
-> (SystemSettingsPublic -> [SystemSettingsPublic])
-> Arbitrary SystemSettingsPublic
SystemSettingsPublic -> [SystemSettingsPublic]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SystemSettingsPublic
arbitrary :: Gen SystemSettingsPublic
$cshrink :: SystemSettingsPublic -> [SystemSettingsPublic]
shrink :: SystemSettingsPublic -> [SystemSettingsPublic]
Arbitrary) via (GenericUniform SystemSettingsPublic)

instance ToSchema SystemSettingsPublic where
  schema :: ValueSchema NamedSwaggerDoc SystemSettingsPublic
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
-> ValueSchema NamedSwaggerDoc SystemSettingsPublic
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SystemSettingsPublic" (SchemaP
   SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
 -> ValueSchema NamedSwaggerDoc SystemSettingsPublic)
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
-> ValueSchema NamedSwaggerDoc SystemSettingsPublic
forall a b. (a -> b) -> a -> b
$ SchemaP
  SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
settingsPublicObjectSchema

settingsPublicObjectSchema :: ObjectSchema SwaggerDoc SystemSettingsPublic
settingsPublicObjectSchema :: SchemaP
  SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
settingsPublicObjectSchema =
  Bool -> SystemSettingsPublic
SystemSettingsPublic
    (Bool -> SystemSettingsPublic)
-> SchemaP SwaggerDoc Object [Pair] SystemSettingsPublic Bool
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemSettingsPublic -> Bool
sspSetRestrictUserCreation (SystemSettingsPublic -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] SystemSettingsPublic Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"setRestrictUserCreation" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Do not allow certain user creation flows") SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

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

instance ToSchema SystemSettingsInternal where
  schema :: ValueSchema NamedSwaggerDoc SystemSettingsInternal
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SystemSettingsInternal
     SystemSettingsInternal
-> ValueSchema NamedSwaggerDoc SystemSettingsInternal
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SystemSettingsInternal" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   SystemSettingsInternal
   SystemSettingsInternal
 -> ValueSchema NamedSwaggerDoc SystemSettingsInternal)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SystemSettingsInternal
     SystemSettingsInternal
-> ValueSchema NamedSwaggerDoc SystemSettingsInternal
forall a b. (a -> b) -> a -> b
$ SchemaP
  SwaggerDoc
  Object
  [Pair]
  SystemSettingsInternal
  SystemSettingsInternal
settingsInternalObjectSchema

settingsInternalObjectSchema :: ObjectSchema SwaggerDoc SystemSettingsInternal
settingsInternalObjectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  SystemSettingsInternal
  SystemSettingsInternal
settingsInternalObjectSchema =
  Bool -> SystemSettingsInternal
SystemSettingsInternal
    (Bool -> SystemSettingsInternal)
-> SchemaP SwaggerDoc Object [Pair] SystemSettingsInternal Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SystemSettingsInternal
     SystemSettingsInternal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemSettingsInternal -> Bool
ssiSetEnableMls (SystemSettingsInternal -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] SystemSettingsInternal Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"setEnableMls" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Whether MLS is enabled or not") SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

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

instance ToSchema SystemSettings where
  schema :: ValueSchema NamedSwaggerDoc SystemSettings
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] SystemSettings SystemSettings
-> ValueSchema NamedSwaggerDoc SystemSettings
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SystemSettings" (SchemaP SwaggerDoc Object [Pair] SystemSettings SystemSettings
 -> ValueSchema NamedSwaggerDoc SystemSettings)
-> SchemaP SwaggerDoc Object [Pair] SystemSettings SystemSettings
-> ValueSchema NamedSwaggerDoc SystemSettings
forall a b. (a -> b) -> a -> b
$
      SystemSettingsPublic -> SystemSettingsInternal -> SystemSettings
SystemSettings
        (SystemSettingsPublic -> SystemSettingsInternal -> SystemSettings)
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettings SystemSettingsPublic
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SystemSettings
     (SystemSettingsInternal -> SystemSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemSettings -> SystemSettingsPublic
ssPublic (SystemSettings -> SystemSettingsPublic)
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettings SystemSettingsPublic
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] SystemSettingsPublic SystemSettingsPublic
settingsPublicObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  SystemSettings
  (SystemSettingsInternal -> SystemSettings)
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettings SystemSettingsInternal
-> SchemaP SwaggerDoc Object [Pair] SystemSettings SystemSettings
forall a b.
SchemaP SwaggerDoc Object [Pair] SystemSettings (a -> b)
-> SchemaP SwaggerDoc Object [Pair] SystemSettings a
-> SchemaP SwaggerDoc Object [Pair] SystemSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SystemSettings -> SystemSettingsInternal
ssInternal (SystemSettings -> SystemSettingsInternal)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SystemSettingsInternal
     SystemSettingsInternal
-> SchemaP
     SwaggerDoc Object [Pair] SystemSettings SystemSettingsInternal
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  SystemSettingsInternal
  SystemSettingsInternal
settingsInternalObjectSchema