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

-- 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.Provider.Service
  ( -- * ServiceRef
    ServiceRef (..),
    newServiceRef,
    serviceRefId,
    serviceRefProvider,

    -- * ServiceKey
    ServiceKey (..),
    ServiceKeyType (..),
    ServiceKeyPEM (..),

    -- * Service
    Service (..),
    ServiceToken (..),
    ServiceProfile (..),
    ServiceProfilePage (..),

    -- * Create/Update/Delete Service
    NewService (..),
    NewServiceResponse (..),
    UpdateService (..),
    UpdateServiceConn (..),
    mkUpdateServiceConn,
    DeleteService (..),

    -- * UpdateServiceWhitelist
    UpdateServiceWhitelist (..),
    UpdateServiceWhitelistResp (..),
  )
where

import Cassandra.CQL qualified as Cql
import Control.Lens (makeLenses, (?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.ByteString.Builder qualified as BB
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Conversion
import Data.Id
import Data.List1 (List1)
import Data.Misc (HttpsUrl (..), PlainTextPassword6)
import Data.OpenApi qualified as S
import Data.PEM (PEM, pemParseBS, pemWriteLBS)
import Data.Proxy
import Data.Range (Range, fromRange, rangedSchema)
import Data.SOP
import Data.Schema
import Data.Text qualified as Text
import Data.Text.Ascii
import Data.Text.Encoding qualified as Text
import Imports
import Wire.API.Provider.Service.Tag (ServiceTag (..))
import Wire.API.Routes.MultiVerb
import Wire.API.User.Profile (Asset, Name)
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- ServiceRef

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

instance ToSchema ServiceRef where
  schema :: ValueSchema NamedSwaggerDoc ServiceRef
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceRef
-> ValueSchema NamedSwaggerDoc ServiceRef
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ServiceRef" (SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceRef
 -> ValueSchema NamedSwaggerDoc ServiceRef)
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceRef
-> ValueSchema NamedSwaggerDoc ServiceRef
forall a b. (a -> b) -> a -> b
$
      ServiceId -> ProviderId -> ServiceRef
ServiceRef
        (ServiceId -> ProviderId -> ServiceRef)
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceId
-> SchemaP
     SwaggerDoc Object [Pair] ServiceRef (ProviderId -> ServiceRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceRef -> ServiceId
_serviceRefId (ServiceRef -> ServiceId)
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] ServiceRef (ProviderId -> ServiceRef)
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ProviderId
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ServiceRef
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceRef (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceRef a
-> SchemaP SwaggerDoc Object [Pair] ServiceRef b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceRef -> ProviderId
_serviceRefProvider (ServiceRef -> ProviderId)
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
-> SchemaP SwaggerDoc Object [Pair] ServiceRef ProviderId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"provider" SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

makeLenses ''ServiceRef

newServiceRef :: ServiceId -> ProviderId -> ServiceRef
newServiceRef :: ServiceId -> ProviderId -> ServiceRef
newServiceRef = ServiceId -> ProviderId -> ServiceRef
ServiceRef

--------------------------------------------------------------------------------
-- ServiceKey

-- | A PEM-encoded public key of a service used to verify the
-- identity of the remote peer in every established TLS connection
-- towards the service (i.e. public key pinning to prevent MITM attacks
-- with forged certificates).
data ServiceKey = ServiceKey
  { ServiceKey -> ServiceKeyType
serviceKeyType :: ServiceKeyType,
    ServiceKey -> Int32
serviceKeySize :: Int32,
    ServiceKey -> ServiceKeyPEM
serviceKeyPEM :: ServiceKeyPEM
  }
  deriving stock (ServiceKey -> ServiceKey -> Bool
(ServiceKey -> ServiceKey -> Bool)
-> (ServiceKey -> ServiceKey -> Bool) -> Eq ServiceKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServiceKey -> ServiceKey -> Bool
== :: ServiceKey -> ServiceKey -> Bool
$c/= :: ServiceKey -> ServiceKey -> Bool
/= :: ServiceKey -> ServiceKey -> Bool
Eq, Int -> ServiceKey -> ShowS
[ServiceKey] -> ShowS
ServiceKey -> String
(Int -> ServiceKey -> ShowS)
-> (ServiceKey -> String)
-> ([ServiceKey] -> ShowS)
-> Show ServiceKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServiceKey -> ShowS
showsPrec :: Int -> ServiceKey -> ShowS
$cshow :: ServiceKey -> String
show :: ServiceKey -> String
$cshowList :: [ServiceKey] -> ShowS
showList :: [ServiceKey] -> ShowS
Show, (forall x. ServiceKey -> Rep ServiceKey x)
-> (forall x. Rep ServiceKey x -> ServiceKey) -> Generic ServiceKey
forall x. Rep ServiceKey x -> ServiceKey
forall x. ServiceKey -> Rep ServiceKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServiceKey -> Rep ServiceKey x
from :: forall x. ServiceKey -> Rep ServiceKey x
$cto :: forall x. Rep ServiceKey x -> ServiceKey
to :: forall x. Rep ServiceKey x -> ServiceKey
Generic)
  deriving (Gen ServiceKey
Gen ServiceKey
-> (ServiceKey -> [ServiceKey]) -> Arbitrary ServiceKey
ServiceKey -> [ServiceKey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ServiceKey
arbitrary :: Gen ServiceKey
$cshrink :: ServiceKey -> [ServiceKey]
shrink :: ServiceKey -> [ServiceKey]
Arbitrary) via (GenericUniform ServiceKey)
  deriving (Value -> Parser [ServiceKey]
Value -> Parser ServiceKey
(Value -> Parser ServiceKey)
-> (Value -> Parser [ServiceKey]) -> FromJSON ServiceKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ServiceKey
parseJSON :: Value -> Parser ServiceKey
$cparseJSONList :: Value -> Parser [ServiceKey]
parseJSONList :: Value -> Parser [ServiceKey]
FromJSON, [ServiceKey] -> Value
[ServiceKey] -> Encoding
ServiceKey -> Value
ServiceKey -> Encoding
(ServiceKey -> Value)
-> (ServiceKey -> Encoding)
-> ([ServiceKey] -> Value)
-> ([ServiceKey] -> Encoding)
-> ToJSON ServiceKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ServiceKey -> Value
toJSON :: ServiceKey -> Value
$ctoEncoding :: ServiceKey -> Encoding
toEncoding :: ServiceKey -> Encoding
$ctoJSONList :: [ServiceKey] -> Value
toJSONList :: [ServiceKey] -> Value
$ctoEncodingList :: [ServiceKey] -> Encoding
toEncodingList :: [ServiceKey] -> Encoding
ToJSON, Typeable ServiceKey
Typeable ServiceKey =>
(Proxy ServiceKey -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ServiceKey
Proxy ServiceKey -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ServiceKey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ServiceKey -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ServiceKey

instance ToSchema ServiceKey where
  schema :: ValueSchema NamedSwaggerDoc ServiceKey
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKey
-> ValueSchema NamedSwaggerDoc ServiceKey
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ServiceKey" (SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKey
 -> ValueSchema NamedSwaggerDoc ServiceKey)
-> SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKey
-> ValueSchema NamedSwaggerDoc ServiceKey
forall a b. (a -> b) -> a -> b
$
      ServiceKeyType -> Int32 -> ServiceKeyPEM -> ServiceKey
ServiceKey
        (ServiceKeyType -> Int32 -> ServiceKeyPEM -> ServiceKey)
-> SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKeyType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceKey
     (Int32 -> ServiceKeyPEM -> ServiceKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceKey -> ServiceKeyType
serviceKeyType (ServiceKey -> ServiceKeyType)
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyType ServiceKeyType
-> SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKeyType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value ServiceKeyType ServiceKeyType
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyType ServiceKeyType
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"type" SchemaP NamedSwaggerDoc Value Value ServiceKeyType ServiceKeyType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceKey
  (Int32 -> ServiceKeyPEM -> ServiceKey)
-> SchemaP SwaggerDoc Object [Pair] ServiceKey Int32
-> SchemaP
     SwaggerDoc Object [Pair] ServiceKey (ServiceKeyPEM -> ServiceKey)
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceKey (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceKey a
-> SchemaP SwaggerDoc Object [Pair] ServiceKey b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceKey -> Int32
serviceKeySize (ServiceKey -> Int32)
-> SchemaP SwaggerDoc Object [Pair] Int32 Int32
-> SchemaP SwaggerDoc Object [Pair] ServiceKey Int32
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Int32 Int32
-> SchemaP SwaggerDoc Object [Pair] Int32 Int32
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"size" SchemaP NamedSwaggerDoc Value Value Int32 Int32
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] ServiceKey (ServiceKeyPEM -> ServiceKey)
-> SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKeyPEM
-> SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKey
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceKey (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceKey a
-> SchemaP SwaggerDoc Object [Pair] ServiceKey b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceKey -> ServiceKeyPEM
serviceKeyPEM (ServiceKey -> ServiceKeyPEM)
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
-> SchemaP SwaggerDoc Object [Pair] ServiceKey ServiceKeyPEM
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"pem" SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | Other types may be supported in the future.
data ServiceKeyType
  = RsaServiceKey
  deriving stock (ServiceKeyType -> ServiceKeyType -> Bool
(ServiceKeyType -> ServiceKeyType -> Bool)
-> (ServiceKeyType -> ServiceKeyType -> Bool) -> Eq ServiceKeyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServiceKeyType -> ServiceKeyType -> Bool
== :: ServiceKeyType -> ServiceKeyType -> Bool
$c/= :: ServiceKeyType -> ServiceKeyType -> Bool
/= :: ServiceKeyType -> ServiceKeyType -> Bool
Eq, Int -> ServiceKeyType
ServiceKeyType -> Int
ServiceKeyType -> [ServiceKeyType]
ServiceKeyType -> ServiceKeyType
ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
ServiceKeyType
-> ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
(ServiceKeyType -> ServiceKeyType)
-> (ServiceKeyType -> ServiceKeyType)
-> (Int -> ServiceKeyType)
-> (ServiceKeyType -> Int)
-> (ServiceKeyType -> [ServiceKeyType])
-> (ServiceKeyType -> ServiceKeyType -> [ServiceKeyType])
-> (ServiceKeyType -> ServiceKeyType -> [ServiceKeyType])
-> (ServiceKeyType
    -> ServiceKeyType -> ServiceKeyType -> [ServiceKeyType])
-> Enum ServiceKeyType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ServiceKeyType -> ServiceKeyType
succ :: ServiceKeyType -> ServiceKeyType
$cpred :: ServiceKeyType -> ServiceKeyType
pred :: ServiceKeyType -> ServiceKeyType
$ctoEnum :: Int -> ServiceKeyType
toEnum :: Int -> ServiceKeyType
$cfromEnum :: ServiceKeyType -> Int
fromEnum :: ServiceKeyType -> Int
$cenumFrom :: ServiceKeyType -> [ServiceKeyType]
enumFrom :: ServiceKeyType -> [ServiceKeyType]
$cenumFromThen :: ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
enumFromThen :: ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
$cenumFromTo :: ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
enumFromTo :: ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
$cenumFromThenTo :: ServiceKeyType
-> ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
enumFromThenTo :: ServiceKeyType
-> ServiceKeyType -> ServiceKeyType -> [ServiceKeyType]
Enum, ServiceKeyType
ServiceKeyType -> ServiceKeyType -> Bounded ServiceKeyType
forall a. a -> a -> Bounded a
$cminBound :: ServiceKeyType
minBound :: ServiceKeyType
$cmaxBound :: ServiceKeyType
maxBound :: ServiceKeyType
Bounded, Int -> ServiceKeyType -> ShowS
[ServiceKeyType] -> ShowS
ServiceKeyType -> String
(Int -> ServiceKeyType -> ShowS)
-> (ServiceKeyType -> String)
-> ([ServiceKeyType] -> ShowS)
-> Show ServiceKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServiceKeyType -> ShowS
showsPrec :: Int -> ServiceKeyType -> ShowS
$cshow :: ServiceKeyType -> String
show :: ServiceKeyType -> String
$cshowList :: [ServiceKeyType] -> ShowS
showList :: [ServiceKeyType] -> ShowS
Show, (forall x. ServiceKeyType -> Rep ServiceKeyType x)
-> (forall x. Rep ServiceKeyType x -> ServiceKeyType)
-> Generic ServiceKeyType
forall x. Rep ServiceKeyType x -> ServiceKeyType
forall x. ServiceKeyType -> Rep ServiceKeyType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServiceKeyType -> Rep ServiceKeyType x
from :: forall x. ServiceKeyType -> Rep ServiceKeyType x
$cto :: forall x. Rep ServiceKeyType x -> ServiceKeyType
to :: forall x. Rep ServiceKeyType x -> ServiceKeyType
Generic)
  deriving (Gen ServiceKeyType
Gen ServiceKeyType
-> (ServiceKeyType -> [ServiceKeyType]) -> Arbitrary ServiceKeyType
ServiceKeyType -> [ServiceKeyType]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ServiceKeyType
arbitrary :: Gen ServiceKeyType
$cshrink :: ServiceKeyType -> [ServiceKeyType]
shrink :: ServiceKeyType -> [ServiceKeyType]
Arbitrary) via (GenericUniform ServiceKeyType)
  deriving (Value -> Parser [ServiceKeyType]
Value -> Parser ServiceKeyType
(Value -> Parser ServiceKeyType)
-> (Value -> Parser [ServiceKeyType]) -> FromJSON ServiceKeyType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ServiceKeyType
parseJSON :: Value -> Parser ServiceKeyType
$cparseJSONList :: Value -> Parser [ServiceKeyType]
parseJSONList :: Value -> Parser [ServiceKeyType]
FromJSON, [ServiceKeyType] -> Value
[ServiceKeyType] -> Encoding
ServiceKeyType -> Value
ServiceKeyType -> Encoding
(ServiceKeyType -> Value)
-> (ServiceKeyType -> Encoding)
-> ([ServiceKeyType] -> Value)
-> ([ServiceKeyType] -> Encoding)
-> ToJSON ServiceKeyType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ServiceKeyType -> Value
toJSON :: ServiceKeyType -> Value
$ctoEncoding :: ServiceKeyType -> Encoding
toEncoding :: ServiceKeyType -> Encoding
$ctoJSONList :: [ServiceKeyType] -> Value
toJSONList :: [ServiceKeyType] -> Value
$ctoEncodingList :: [ServiceKeyType] -> Encoding
toEncodingList :: [ServiceKeyType] -> Encoding
ToJSON, Typeable ServiceKeyType
Typeable ServiceKeyType =>
(Proxy ServiceKeyType -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ServiceKeyType
Proxy ServiceKeyType -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ServiceKeyType -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ServiceKeyType -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ServiceKeyType

instance ToSchema ServiceKeyType where
  schema :: SchemaP NamedSwaggerDoc Value Value ServiceKeyType ServiceKeyType
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"ServiceKeyType" (Text
-> ServiceKeyType
-> SchemaP
     [Value] Text (Alt Maybe Text) ServiceKeyType ServiceKeyType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"rsa" ServiceKeyType
RsaServiceKey)

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

instance ToByteString ServiceKeyPEM where
  builder :: ServiceKeyPEM -> Builder
builder = ByteString -> Builder
BB.lazyByteString (ByteString -> Builder)
-> (ServiceKeyPEM -> ByteString) -> ServiceKeyPEM -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PEM -> ByteString
pemWriteLBS (PEM -> ByteString)
-> (ServiceKeyPEM -> PEM) -> ServiceKeyPEM -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceKeyPEM -> PEM
unServiceKeyPEM

instance FromByteString ServiceKeyPEM where
  parser :: Parser ServiceKeyPEM
parser = do
    ByteString
bs <- Parser ByteString
forall a. FromByteString a => Parser a
parser
    case ByteString -> Either String [PEM]
pemParseBS ByteString
bs of
      Left String
e -> String -> Parser ServiceKeyPEM
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Right [PEM
k] -> ServiceKeyPEM -> Parser ServiceKeyPEM
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PEM -> ServiceKeyPEM
ServiceKeyPEM PEM
k)
      Right [PEM]
_ -> String -> Parser ServiceKeyPEM
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Too many sections in PEM format. Expected 1."

instance ToSchema ServiceKeyPEM where
  schema :: SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
schema =
    (Schema -> Identity Schema)
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> Identity
     (SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM)
forall s a. HasSchema s a => Lens' s a
Lens'
  (SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM)
  Schema
S.schema ((Schema -> Identity Schema)
 -> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM))
-> ((Maybe Value -> Identity (Maybe Value))
    -> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> Identity
     (SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
 -> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
 -> Identity
      (SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM))
-> Value
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
pem (SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
 -> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM)
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall a b. (a -> b) -> a -> b
$
      (ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ServiceKeyPEM -> ByteString) -> ServiceKeyPEM -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceKeyPEM -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString')
        (ServiceKeyPEM -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text ServiceKeyPEM
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String ServiceKeyPEM)
-> SchemaP NamedSwaggerDoc Value Value Text ServiceKeyPEM
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText
          Text
"ServiceKeyPEM"
          (Parser ServiceKeyPEM -> ByteString -> Either String ServiceKeyPEM
forall a. Parser a -> ByteString -> Either String a
runParser Parser ServiceKeyPEM
forall a. FromByteString a => Parser a
parser (ByteString -> Either String ServiceKeyPEM)
-> (Text -> ByteString) -> Text -> Either String ServiceKeyPEM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8)
    where
      pem :: Value
pem =
        Text -> Value
A.String (Text -> Value) -> ([Text] -> Text) -> [Text] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines ([Text] -> Value) -> [Text] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Text
"-----BEGIN PUBLIC KEY-----",
            Text
"MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0",
            Text
"G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH",
            Text
"WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV",
            Text
"VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS",
            Text
"bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8",
            Text
"7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la",
            Text
"nQIDAQAB",
            Text
"-----END PUBLIC KEY-----"
          ]

instance Arbitrary ServiceKeyPEM where
  arbitrary :: Gen ServiceKeyPEM
arbitrary =
    case ByteString -> Either String [PEM]
pemParseBS ([ByteString] -> ByteString
BS.unlines [ByteString]
key) of
      Right [PEM
k] -> ServiceKeyPEM -> Gen ServiceKeyPEM
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServiceKeyPEM -> Gen ServiceKeyPEM)
-> ServiceKeyPEM -> Gen ServiceKeyPEM
forall a b. (a -> b) -> a -> b
$ PEM -> ServiceKeyPEM
ServiceKeyPEM PEM
k
      Either String [PEM]
other -> String -> Gen ServiceKeyPEM
forall a. HasCallStack => String -> a
error (String -> Gen ServiceKeyPEM) -> String -> Gen ServiceKeyPEM
forall a b. (a -> b) -> a -> b
$ String
"arbitrary ServiceKeyPEM: unexpected error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Either String [PEM] -> String
forall a. Show a => a -> String
show Either String [PEM]
other
    where
      key :: [ByteString]
key =
        [ ByteString
"-----BEGIN PUBLIC KEY-----",
          ByteString
"MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0",
          ByteString
"G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH",
          ByteString
"WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV",
          ByteString
"VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS",
          ByteString
"bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8",
          ByteString
"7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la",
          ByteString
"nQIDAQAB",
          ByteString
"-----END PUBLIC KEY-----"
        ]

--------------------------------------------------------------------------------
-- Service

-- | Full service definition as seen by the provider.
data Service = Service
  { Service -> ServiceId
serviceId :: ServiceId,
    Service -> Name
serviceName :: Name,
    Service -> Text
serviceSummary :: Text,
    Service -> Text
serviceDescr :: Text,
    Service -> HttpsUrl
serviceUrl :: HttpsUrl,
    Service -> List1 ServiceToken
serviceTokens :: List1 ServiceToken,
    Service -> List1 ServiceKey
serviceKeys :: List1 ServiceKey,
    Service -> [Asset]
serviceAssets :: [Asset],
    Service -> Set ServiceTag
serviceTags :: Set ServiceTag,
    Service -> Bool
serviceEnabled :: Bool
  }
  deriving stock (Service -> Service -> Bool
(Service -> Service -> Bool)
-> (Service -> Service -> Bool) -> Eq Service
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
/= :: Service -> Service -> Bool
Eq, Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
(Int -> Service -> ShowS)
-> (Service -> String) -> ([Service] -> ShowS) -> Show Service
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Service -> ShowS
showsPrec :: Int -> Service -> ShowS
$cshow :: Service -> String
show :: Service -> String
$cshowList :: [Service] -> ShowS
showList :: [Service] -> ShowS
Show, (forall x. Service -> Rep Service x)
-> (forall x. Rep Service x -> Service) -> Generic Service
forall x. Rep Service x -> Service
forall x. Service -> Rep Service x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Service -> Rep Service x
from :: forall x. Service -> Rep Service x
$cto :: forall x. Rep Service x -> Service
to :: forall x. Rep Service x -> Service
Generic)
  deriving (Gen Service
Gen Service -> (Service -> [Service]) -> Arbitrary Service
Service -> [Service]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Service
arbitrary :: Gen Service
$cshrink :: Service -> [Service]
shrink :: Service -> [Service]
Arbitrary) via (GenericUniform Service)
  deriving (Typeable Service
Typeable Service =>
(Proxy Service -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Service
Proxy Service -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Service -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Service -> Declare (Definitions Schema) NamedSchema
S.ToSchema, [Service] -> Value
[Service] -> Encoding
Service -> Value
Service -> Encoding
(Service -> Value)
-> (Service -> Encoding)
-> ([Service] -> Value)
-> ([Service] -> Encoding)
-> ToJSON Service
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Service -> Value
toJSON :: Service -> Value
$ctoEncoding :: Service -> Encoding
toEncoding :: Service -> Encoding
$ctoJSONList :: [Service] -> Value
toJSONList :: [Service] -> Value
$ctoEncodingList :: [Service] -> Encoding
toEncodingList :: [Service] -> Encoding
ToJSON, Value -> Parser [Service]
Value -> Parser Service
(Value -> Parser Service)
-> (Value -> Parser [Service]) -> FromJSON Service
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Service
parseJSON :: Value -> Parser Service
$cparseJSONList :: Value -> Parser [Service]
parseJSONList :: Value -> Parser [Service]
FromJSON) via (Schema Service)

instance ToSchema Service where
  schema :: ValueSchema NamedSwaggerDoc Service
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Service Service
-> ValueSchema NamedSwaggerDoc Service
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Service" (SchemaP SwaggerDoc Object [Pair] Service Service
 -> ValueSchema NamedSwaggerDoc Service)
-> SchemaP SwaggerDoc Object [Pair] Service Service
-> ValueSchema NamedSwaggerDoc Service
forall a b. (a -> b) -> a -> b
$
      ServiceId
-> Name
-> Text
-> Text
-> HttpsUrl
-> List1 ServiceToken
-> List1 ServiceKey
-> [Asset]
-> Set ServiceTag
-> Bool
-> Service
Service
        (ServiceId
 -> Name
 -> Text
 -> Text
 -> HttpsUrl
 -> List1 ServiceToken
 -> List1 ServiceKey
 -> [Asset]
 -> Set ServiceTag
 -> Bool
 -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service ServiceId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (Name
      -> Text
      -> Text
      -> HttpsUrl
      -> List1 ServiceToken
      -> List1 ServiceKey
      -> [Asset]
      -> Set ServiceTag
      -> Bool
      -> Service)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Service -> ServiceId
serviceId (Service -> ServiceId)
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] Service ServiceId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (Name
   -> Text
   -> Text
   -> HttpsUrl
   -> List1 ServiceToken
   -> List1 ServiceKey
   -> [Asset]
   -> Set ServiceTag
   -> Bool
   -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (Text
      -> Text
      -> HttpsUrl
      -> List1 ServiceToken
      -> List1 ServiceKey
      -> [Asset]
      -> Set ServiceTag
      -> Bool
      -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> Name
serviceName (Service -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] Service Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (Text
   -> Text
   -> HttpsUrl
   -> List1 ServiceToken
   -> List1 ServiceKey
   -> [Asset]
   -> Set ServiceTag
   -> Bool
   -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (Text
      -> HttpsUrl
      -> List1 ServiceToken
      -> List1 ServiceKey
      -> [Asset]
      -> Set ServiceTag
      -> Bool
      -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> Text
serviceSummary (Service -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] Service Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"summary" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (Text
   -> HttpsUrl
   -> List1 ServiceToken
   -> List1 ServiceKey
   -> [Asset]
   -> Set ServiceTag
   -> Bool
   -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (HttpsUrl
      -> List1 ServiceToken
      -> List1 ServiceKey
      -> [Asset]
      -> Set ServiceTag
      -> Bool
      -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> Text
serviceDescr (Service -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] Service Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"description" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (HttpsUrl
   -> List1 ServiceToken
   -> List1 ServiceKey
   -> [Asset]
   -> Set ServiceTag
   -> Bool
   -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service HttpsUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (List1 ServiceToken
      -> List1 ServiceKey
      -> [Asset]
      -> Set ServiceTag
      -> Bool
      -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> HttpsUrl
serviceUrl (Service -> HttpsUrl)
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] Service HttpsUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"base_url" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (List1 ServiceToken
   -> List1 ServiceKey
   -> [Asset]
   -> Set ServiceTag
   -> Bool
   -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service (List1 ServiceToken)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (List1 ServiceKey -> [Asset] -> Set ServiceTag -> Bool -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> List1 ServiceToken
serviceTokens (Service -> List1 ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] (List1 ServiceToken) (List1 ServiceToken)
-> SchemaP SwaggerDoc Object [Pair] Service (List1 ServiceToken)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     (List1 ServiceToken)
     (List1 ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] (List1 ServiceToken) (List1 ServiceToken)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"auth_tokens" SchemaP
  NamedSwaggerDoc
  Value
  Value
  (List1 ServiceToken)
  (List1 ServiceToken)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (List1 ServiceKey -> [Asset] -> Set ServiceTag -> Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service (List1 ServiceKey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     ([Asset] -> Set ServiceTag -> Bool -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> List1 ServiceKey
serviceKeys (Service -> List1 ServiceKey)
-> SchemaP
     SwaggerDoc Object [Pair] (List1 ServiceKey) (List1 ServiceKey)
-> SchemaP SwaggerDoc Object [Pair] Service (List1 ServiceKey)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (List1 ServiceKey) (List1 ServiceKey)
-> SchemaP
     SwaggerDoc Object [Pair] (List1 ServiceKey) (List1 ServiceKey)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"public_keys" SchemaP
  NamedSwaggerDoc Value Value (List1 ServiceKey) (List1 ServiceKey)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  ([Asset] -> Set ServiceTag -> Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service [Asset]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Service
     (Set ServiceTag -> Bool -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> [Asset]
serviceAssets (Service -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] Service [Asset]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"assets" (ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Service
  (Set ServiceTag -> Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service (Set ServiceTag)
-> SchemaP SwaggerDoc Object [Pair] Service (Bool -> Service)
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> Set ServiceTag
serviceTags (Service -> Set ServiceTag)
-> SchemaP
     SwaggerDoc Object [Pair] (Set ServiceTag) (Set ServiceTag)
-> SchemaP SwaggerDoc Object [Pair] Service (Set ServiceTag)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
-> SchemaP
     SwaggerDoc Object [Pair] (Set ServiceTag) (Set ServiceTag)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"tags" (ValueSchema NamedSwaggerDoc ServiceTag
-> SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc ServiceTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] Service (Bool -> Service)
-> SchemaP SwaggerDoc Object [Pair] Service Bool
-> SchemaP SwaggerDoc Object [Pair] Service Service
forall a b.
SchemaP SwaggerDoc Object [Pair] Service (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Service a
-> SchemaP SwaggerDoc Object [Pair] Service b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Service -> Bool
serviceEnabled (Service -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Service Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"enabled" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | A /secret/ bearer token used to authenticate and authorise requests @towards@
-- a 'Service' via inclusion in the HTTP 'Authorization' header.
newtype ServiceToken = ServiceToken AsciiBase64Url
  deriving stock (ServiceToken -> ServiceToken -> Bool
(ServiceToken -> ServiceToken -> Bool)
-> (ServiceToken -> ServiceToken -> Bool) -> Eq ServiceToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServiceToken -> ServiceToken -> Bool
== :: ServiceToken -> ServiceToken -> Bool
$c/= :: ServiceToken -> ServiceToken -> Bool
/= :: ServiceToken -> ServiceToken -> Bool
Eq, Int -> ServiceToken -> ShowS
[ServiceToken] -> ShowS
ServiceToken -> String
(Int -> ServiceToken -> ShowS)
-> (ServiceToken -> String)
-> ([ServiceToken] -> ShowS)
-> Show ServiceToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServiceToken -> ShowS
showsPrec :: Int -> ServiceToken -> ShowS
$cshow :: ServiceToken -> String
show :: ServiceToken -> String
$cshowList :: [ServiceToken] -> ShowS
showList :: [ServiceToken] -> ShowS
Show, (forall x. ServiceToken -> Rep ServiceToken x)
-> (forall x. Rep ServiceToken x -> ServiceToken)
-> Generic ServiceToken
forall x. Rep ServiceToken x -> ServiceToken
forall x. ServiceToken -> Rep ServiceToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServiceToken -> Rep ServiceToken x
from :: forall x. ServiceToken -> Rep ServiceToken x
$cto :: forall x. Rep ServiceToken x -> ServiceToken
to :: forall x. Rep ServiceToken x -> ServiceToken
Generic)
  deriving newtype (ServiceToken -> Builder
(ServiceToken -> Builder) -> ToByteString ServiceToken
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: ServiceToken -> Builder
builder :: ServiceToken -> Builder
ToByteString, Parser ServiceToken
Parser ServiceToken -> FromByteString ServiceToken
forall a. Parser a -> FromByteString a
$cparser :: Parser ServiceToken
parser :: Parser ServiceToken
FromByteString, [ServiceToken] -> Value
[ServiceToken] -> Encoding
ServiceToken -> Value
ServiceToken -> Encoding
(ServiceToken -> Value)
-> (ServiceToken -> Encoding)
-> ([ServiceToken] -> Value)
-> ([ServiceToken] -> Encoding)
-> ToJSON ServiceToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ServiceToken -> Value
toJSON :: ServiceToken -> Value
$ctoEncoding :: ServiceToken -> Encoding
toEncoding :: ServiceToken -> Encoding
$ctoJSONList :: [ServiceToken] -> Value
toJSONList :: [ServiceToken] -> Value
$ctoEncodingList :: [ServiceToken] -> Encoding
toEncodingList :: [ServiceToken] -> Encoding
ToJSON, Value -> Parser [ServiceToken]
Value -> Parser ServiceToken
(Value -> Parser ServiceToken)
-> (Value -> Parser [ServiceToken]) -> FromJSON ServiceToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ServiceToken
parseJSON :: Value -> Parser ServiceToken
$cparseJSONList :: Value -> Parser [ServiceToken]
parseJSONList :: Value -> Parser [ServiceToken]
FromJSON, Gen ServiceToken
Gen ServiceToken
-> (ServiceToken -> [ServiceToken]) -> Arbitrary ServiceToken
ServiceToken -> [ServiceToken]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ServiceToken
arbitrary :: Gen ServiceToken
$cshrink :: ServiceToken -> [ServiceToken]
shrink :: ServiceToken -> [ServiceToken]
Arbitrary, ValueSchema NamedSwaggerDoc ServiceToken
ValueSchema NamedSwaggerDoc ServiceToken -> ToSchema ServiceToken
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: ValueSchema NamedSwaggerDoc ServiceToken
schema :: ValueSchema NamedSwaggerDoc ServiceToken
ToSchema)

instance S.ToSchema ServiceToken where
  declareNamedSchema :: Proxy ServiceToken -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ServiceToken
_ = Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
tweak (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
S.declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)
    where
      tweak :: Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
tweak = (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b.
(a -> b)
-> DeclareT (Definitions Schema) Identity a
-> DeclareT (Definitions Schema) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NamedSchema -> NamedSchema)
 -> Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ (Schema -> Identity Schema) -> NamedSchema -> Identity NamedSchema
forall s a. HasSchema s a => Lens' s a
Lens' NamedSchema Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSchema -> Identity NamedSchema)
-> ((Maybe Value -> Identity (Maybe Value))
    -> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> NamedSchema
-> Identity NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
 -> NamedSchema -> Identity NamedSchema)
-> Value -> NamedSchema -> NamedSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
tok
      tok :: Value
tok = Value
"sometoken"

deriving instance Cql.Cql ServiceToken

--------------------------------------------------------------------------------
-- ServiceProfile

-- | Public profile of a service as seen by users.
data ServiceProfile = ServiceProfile
  { ServiceProfile -> ServiceId
serviceProfileId :: ServiceId,
    ServiceProfile -> ProviderId
serviceProfileProvider :: ProviderId,
    ServiceProfile -> Name
serviceProfileName :: Name,
    ServiceProfile -> Text
serviceProfileSummary :: Text,
    ServiceProfile -> Text
serviceProfileDescr :: Text,
    ServiceProfile -> [Asset]
serviceProfileAssets :: [Asset],
    ServiceProfile -> Set ServiceTag
serviceProfileTags :: Set ServiceTag,
    ServiceProfile -> Bool
serviceProfileEnabled :: Bool
  }
  deriving stock (ServiceProfile -> ServiceProfile -> Bool
(ServiceProfile -> ServiceProfile -> Bool)
-> (ServiceProfile -> ServiceProfile -> Bool) -> Eq ServiceProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServiceProfile -> ServiceProfile -> Bool
== :: ServiceProfile -> ServiceProfile -> Bool
$c/= :: ServiceProfile -> ServiceProfile -> Bool
/= :: ServiceProfile -> ServiceProfile -> Bool
Eq, Int -> ServiceProfile -> ShowS
[ServiceProfile] -> ShowS
ServiceProfile -> String
(Int -> ServiceProfile -> ShowS)
-> (ServiceProfile -> String)
-> ([ServiceProfile] -> ShowS)
-> Show ServiceProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServiceProfile -> ShowS
showsPrec :: Int -> ServiceProfile -> ShowS
$cshow :: ServiceProfile -> String
show :: ServiceProfile -> String
$cshowList :: [ServiceProfile] -> ShowS
showList :: [ServiceProfile] -> ShowS
Show, (forall x. ServiceProfile -> Rep ServiceProfile x)
-> (forall x. Rep ServiceProfile x -> ServiceProfile)
-> Generic ServiceProfile
forall x. Rep ServiceProfile x -> ServiceProfile
forall x. ServiceProfile -> Rep ServiceProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServiceProfile -> Rep ServiceProfile x
from :: forall x. ServiceProfile -> Rep ServiceProfile x
$cto :: forall x. Rep ServiceProfile x -> ServiceProfile
to :: forall x. Rep ServiceProfile x -> ServiceProfile
Generic)
  deriving (Gen ServiceProfile
Gen ServiceProfile
-> (ServiceProfile -> [ServiceProfile]) -> Arbitrary ServiceProfile
ServiceProfile -> [ServiceProfile]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ServiceProfile
arbitrary :: Gen ServiceProfile
$cshrink :: ServiceProfile -> [ServiceProfile]
shrink :: ServiceProfile -> [ServiceProfile]
Arbitrary) via (GenericUniform ServiceProfile)
  deriving (Typeable ServiceProfile
Typeable ServiceProfile =>
(Proxy ServiceProfile -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ServiceProfile
Proxy ServiceProfile -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ServiceProfile -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ServiceProfile -> Declare (Definitions Schema) NamedSchema
S.ToSchema, [ServiceProfile] -> Value
[ServiceProfile] -> Encoding
ServiceProfile -> Value
ServiceProfile -> Encoding
(ServiceProfile -> Value)
-> (ServiceProfile -> Encoding)
-> ([ServiceProfile] -> Value)
-> ([ServiceProfile] -> Encoding)
-> ToJSON ServiceProfile
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ServiceProfile -> Value
toJSON :: ServiceProfile -> Value
$ctoEncoding :: ServiceProfile -> Encoding
toEncoding :: ServiceProfile -> Encoding
$ctoJSONList :: [ServiceProfile] -> Value
toJSONList :: [ServiceProfile] -> Value
$ctoEncodingList :: [ServiceProfile] -> Encoding
toEncodingList :: [ServiceProfile] -> Encoding
ToJSON, Value -> Parser [ServiceProfile]
Value -> Parser ServiceProfile
(Value -> Parser ServiceProfile)
-> (Value -> Parser [ServiceProfile]) -> FromJSON ServiceProfile
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ServiceProfile
parseJSON :: Value -> Parser ServiceProfile
$cparseJSONList :: Value -> Parser [ServiceProfile]
parseJSONList :: Value -> Parser [ServiceProfile]
FromJSON) via (Schema ServiceProfile)

instance ToSchema ServiceProfile where
  schema :: ValueSchema NamedSwaggerDoc ServiceProfile
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile ServiceProfile
-> ValueSchema NamedSwaggerDoc ServiceProfile
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ServiceProfile" (SchemaP SwaggerDoc Object [Pair] ServiceProfile ServiceProfile
 -> ValueSchema NamedSwaggerDoc ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile ServiceProfile
-> ValueSchema NamedSwaggerDoc ServiceProfile
forall a b. (a -> b) -> a -> b
$
      ServiceId
-> ProviderId
-> Name
-> Text
-> Text
-> [Asset]
-> Set ServiceTag
-> Bool
-> ServiceProfile
ServiceProfile
        (ServiceId
 -> ProviderId
 -> Name
 -> Text
 -> Text
 -> [Asset]
 -> Set ServiceTag
 -> Bool
 -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile ServiceId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceProfile
     (ProviderId
      -> Name
      -> Text
      -> Text
      -> [Asset]
      -> Set ServiceTag
      -> Bool
      -> ServiceProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceProfile -> ServiceId
serviceProfileId (ServiceProfile -> ServiceId)
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile ServiceId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceProfile
  (ProviderId
   -> Name
   -> Text
   -> Text
   -> [Asset]
   -> Set ServiceTag
   -> Bool
   -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile ProviderId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceProfile
     (Name
      -> Text
      -> Text
      -> [Asset]
      -> Set ServiceTag
      -> Bool
      -> ServiceProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfile -> ProviderId
serviceProfileProvider (ServiceProfile -> ProviderId)
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile ProviderId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"provider" SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceProfile
  (Name
   -> Text
   -> Text
   -> [Asset]
   -> Set ServiceTag
   -> Bool
   -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceProfile
     (Text
      -> Text -> [Asset] -> Set ServiceTag -> Bool -> ServiceProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfile -> Name
serviceProfileName (ServiceProfile -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceProfile
  (Text
   -> Text -> [Asset] -> Set ServiceTag -> Bool -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceProfile
     (Text -> [Asset] -> Set ServiceTag -> Bool -> ServiceProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfile -> Text
serviceProfileSummary (ServiceProfile -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"summary" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceProfile
  (Text -> [Asset] -> Set ServiceTag -> Bool -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceProfile
     ([Asset] -> Set ServiceTag -> Bool -> ServiceProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfile -> Text
serviceProfileDescr (ServiceProfile -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"description" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceProfile
  ([Asset] -> Set ServiceTag -> Bool -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile [Asset]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceProfile
     (Set ServiceTag -> Bool -> ServiceProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfile -> [Asset]
serviceProfileAssets (ServiceProfile -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile [Asset]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"assets" (ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceProfile
  (Set ServiceTag -> Bool -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile (Set ServiceTag)
-> SchemaP
     SwaggerDoc Object [Pair] ServiceProfile (Bool -> ServiceProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfile -> Set ServiceTag
serviceProfileTags (ServiceProfile -> Set ServiceTag)
-> SchemaP
     SwaggerDoc Object [Pair] (Set ServiceTag) (Set ServiceTag)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile (Set ServiceTag)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
-> SchemaP
     SwaggerDoc Object [Pair] (Set ServiceTag) (Set ServiceTag)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"tags" (ValueSchema NamedSwaggerDoc ServiceTag
-> SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc ServiceTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc Object [Pair] ServiceProfile (Bool -> ServiceProfile)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Bool
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile ServiceProfile
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfile -> Bool
serviceProfileEnabled (ServiceProfile -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] ServiceProfile Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"enabled" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- ServiceProfilePage

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

instance ToSchema ServiceProfilePage where
  schema :: ValueSchema NamedSwaggerDoc ServiceProfilePage
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] ServiceProfilePage ServiceProfilePage
-> ValueSchema NamedSwaggerDoc ServiceProfilePage
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ServiceProfile" (SchemaP
   SwaggerDoc Object [Pair] ServiceProfilePage ServiceProfilePage
 -> ValueSchema NamedSwaggerDoc ServiceProfilePage)
-> SchemaP
     SwaggerDoc Object [Pair] ServiceProfilePage ServiceProfilePage
-> ValueSchema NamedSwaggerDoc ServiceProfilePage
forall a b. (a -> b) -> a -> b
$
      Bool -> [ServiceProfile] -> ServiceProfilePage
ServiceProfilePage
        (Bool -> [ServiceProfile] -> ServiceProfilePage)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfilePage Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ServiceProfilePage
     ([ServiceProfile] -> ServiceProfilePage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceProfilePage -> Bool
serviceProfilePageHasMore (ServiceProfilePage -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] ServiceProfilePage Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"has_more" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ServiceProfilePage
  ([ServiceProfile] -> ServiceProfilePage)
-> SchemaP
     SwaggerDoc Object [Pair] ServiceProfilePage [ServiceProfile]
-> SchemaP
     SwaggerDoc Object [Pair] ServiceProfilePage ServiceProfilePage
forall a b.
SchemaP SwaggerDoc Object [Pair] ServiceProfilePage (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ServiceProfilePage a
-> SchemaP SwaggerDoc Object [Pair] ServiceProfilePage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ServiceProfilePage -> [ServiceProfile]
serviceProfilePageResults (ServiceProfilePage -> [ServiceProfile])
-> SchemaP
     SwaggerDoc Object [Pair] [ServiceProfile] [ServiceProfile]
-> SchemaP
     SwaggerDoc Object [Pair] ServiceProfilePage [ServiceProfile]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [ServiceProfile] [ServiceProfile]
-> SchemaP
     SwaggerDoc Object [Pair] [ServiceProfile] [ServiceProfile]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"services" (ValueSchema NamedSwaggerDoc ServiceProfile
-> SchemaP SwaggerDoc Value Value [ServiceProfile] [ServiceProfile]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc ServiceProfile
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- NewService

-- | Input data for registering a new service.
data NewService = NewService
  { NewService -> Name
newServiceName :: Name,
    NewService -> Range 1 128 Text
newServiceSummary :: Range 1 128 Text,
    NewService -> Range 1 1024 Text
newServiceDescr :: Range 1 1024 Text,
    NewService -> HttpsUrl
newServiceUrl :: HttpsUrl,
    NewService -> ServiceKeyPEM
newServiceKey :: ServiceKeyPEM,
    NewService -> Maybe ServiceToken
newServiceToken :: Maybe ServiceToken,
    NewService -> [Asset]
newServiceAssets :: [Asset],
    NewService -> Range 1 3 (Set ServiceTag)
newServiceTags :: Range 1 3 (Set ServiceTag)
  }
  deriving stock (NewService -> NewService -> Bool
(NewService -> NewService -> Bool)
-> (NewService -> NewService -> Bool) -> Eq NewService
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewService -> NewService -> Bool
== :: NewService -> NewService -> Bool
$c/= :: NewService -> NewService -> Bool
/= :: NewService -> NewService -> Bool
Eq, Int -> NewService -> ShowS
[NewService] -> ShowS
NewService -> String
(Int -> NewService -> ShowS)
-> (NewService -> String)
-> ([NewService] -> ShowS)
-> Show NewService
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewService -> ShowS
showsPrec :: Int -> NewService -> ShowS
$cshow :: NewService -> String
show :: NewService -> String
$cshowList :: [NewService] -> ShowS
showList :: [NewService] -> ShowS
Show, (forall x. NewService -> Rep NewService x)
-> (forall x. Rep NewService x -> NewService) -> Generic NewService
forall x. Rep NewService x -> NewService
forall x. NewService -> Rep NewService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewService -> Rep NewService x
from :: forall x. NewService -> Rep NewService x
$cto :: forall x. Rep NewService x -> NewService
to :: forall x. Rep NewService x -> NewService
Generic)
  deriving (Gen NewService
Gen NewService
-> (NewService -> [NewService]) -> Arbitrary NewService
NewService -> [NewService]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewService
arbitrary :: Gen NewService
$cshrink :: NewService -> [NewService]
shrink :: NewService -> [NewService]
Arbitrary) via (GenericUniform NewService)
  deriving (Typeable NewService
Typeable NewService =>
(Proxy NewService -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewService
Proxy NewService -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewService -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewService -> Declare (Definitions Schema) NamedSchema
S.ToSchema, [NewService] -> Value
[NewService] -> Encoding
NewService -> Value
NewService -> Encoding
(NewService -> Value)
-> (NewService -> Encoding)
-> ([NewService] -> Value)
-> ([NewService] -> Encoding)
-> ToJSON NewService
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewService -> Value
toJSON :: NewService -> Value
$ctoEncoding :: NewService -> Encoding
toEncoding :: NewService -> Encoding
$ctoJSONList :: [NewService] -> Value
toJSONList :: [NewService] -> Value
$ctoEncodingList :: [NewService] -> Encoding
toEncodingList :: [NewService] -> Encoding
ToJSON, Value -> Parser [NewService]
Value -> Parser NewService
(Value -> Parser NewService)
-> (Value -> Parser [NewService]) -> FromJSON NewService
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewService
parseJSON :: Value -> Parser NewService
$cparseJSONList :: Value -> Parser [NewService]
parseJSONList :: Value -> Parser [NewService]
FromJSON) via (Schema NewService)

instance ToSchema NewService where
  schema :: ValueSchema NamedSwaggerDoc NewService
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] NewService NewService
-> ValueSchema NamedSwaggerDoc NewService
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NewService" (SchemaP SwaggerDoc Object [Pair] NewService NewService
 -> ValueSchema NamedSwaggerDoc NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService NewService
-> ValueSchema NamedSwaggerDoc NewService
forall a b. (a -> b) -> a -> b
$
      Name
-> Range 1 128 Text
-> Range 1 1024 Text
-> HttpsUrl
-> ServiceKeyPEM
-> Maybe ServiceToken
-> [Asset]
-> Range 1 3 (Set ServiceTag)
-> NewService
NewService
        (Name
 -> Range 1 128 Text
 -> Range 1 1024 Text
 -> HttpsUrl
 -> ServiceKeyPEM
 -> Maybe ServiceToken
 -> [Asset]
 -> Range 1 3 (Set ServiceTag)
 -> NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewService
     (Range 1 128 Text
      -> Range 1 1024 Text
      -> HttpsUrl
      -> ServiceKeyPEM
      -> Maybe ServiceToken
      -> [Asset]
      -> Range 1 3 (Set ServiceTag)
      -> NewService)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewService -> Name
newServiceName (NewService -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] NewService Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewService
  (Range 1 128 Text
   -> Range 1 1024 Text
   -> HttpsUrl
   -> ServiceKeyPEM
   -> Maybe ServiceToken
   -> [Asset]
   -> Range 1 3 (Set ServiceTag)
   -> NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService (Range 1 128 Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewService
     (Range 1 1024 Text
      -> HttpsUrl
      -> ServiceKeyPEM
      -> Maybe ServiceToken
      -> [Asset]
      -> Range 1 3 (Set ServiceTag)
      -> NewService)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewService a
-> SchemaP SwaggerDoc Object [Pair] NewService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewService -> Range 1 128 Text
newServiceSummary (NewService -> Range 1 128 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 128 Text) (Range 1 128 Text)
-> SchemaP SwaggerDoc Object [Pair] NewService (Range 1 128 Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 128 Text) (Range 1 128 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 128 Text) (Range 1 128 Text)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"summary" SchemaP
  NamedSwaggerDoc Value Value (Range 1 128 Text) (Range 1 128 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewService
  (Range 1 1024 Text
   -> HttpsUrl
   -> ServiceKeyPEM
   -> Maybe ServiceToken
   -> [Asset]
   -> Range 1 3 (Set ServiceTag)
   -> NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService (Range 1 1024 Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewService
     (HttpsUrl
      -> ServiceKeyPEM
      -> Maybe ServiceToken
      -> [Asset]
      -> Range 1 3 (Set ServiceTag)
      -> NewService)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewService a
-> SchemaP SwaggerDoc Object [Pair] NewService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewService -> Range 1 1024 Text
newServiceDescr (NewService -> Range 1 1024 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 1024 Text) (Range 1 1024 Text)
-> SchemaP SwaggerDoc Object [Pair] NewService (Range 1 1024 Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 1024 Text) (Range 1 1024 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 1024 Text) (Range 1 1024 Text)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"description" SchemaP
  NamedSwaggerDoc Value Value (Range 1 1024 Text) (Range 1 1024 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewService
  (HttpsUrl
   -> ServiceKeyPEM
   -> Maybe ServiceToken
   -> [Asset]
   -> Range 1 3 (Set ServiceTag)
   -> NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService HttpsUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewService
     (ServiceKeyPEM
      -> Maybe ServiceToken
      -> [Asset]
      -> Range 1 3 (Set ServiceTag)
      -> NewService)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewService a
-> SchemaP SwaggerDoc Object [Pair] NewService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewService -> HttpsUrl
newServiceUrl (NewService -> HttpsUrl)
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] NewService HttpsUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"base_url" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewService
  (ServiceKeyPEM
   -> Maybe ServiceToken
   -> [Asset]
   -> Range 1 3 (Set ServiceTag)
   -> NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService ServiceKeyPEM
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewService
     (Maybe ServiceToken
      -> [Asset] -> Range 1 3 (Set ServiceTag) -> NewService)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewService a
-> SchemaP SwaggerDoc Object [Pair] NewService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewService -> ServiceKeyPEM
newServiceKey (NewService -> ServiceKeyPEM)
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
-> SchemaP SwaggerDoc Object [Pair] NewService ServiceKeyPEM
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"public_key" SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewService
  (Maybe ServiceToken
   -> [Asset] -> Range 1 3 (Set ServiceTag) -> NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService (Maybe ServiceToken)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewService
     ([Asset] -> Range 1 3 (Set ServiceTag) -> NewService)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewService a
-> SchemaP SwaggerDoc Object [Pair] NewService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewService -> Maybe ServiceToken
newServiceToken (NewService -> Maybe ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceToken) (Maybe ServiceToken)
-> SchemaP SwaggerDoc Object [Pair] NewService (Maybe ServiceToken)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ServiceToken (Maybe ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceToken) (Maybe ServiceToken)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> ValueSchema NamedSwaggerDoc ServiceToken
-> SchemaP
     SwaggerDoc Object [Pair] ServiceToken (Maybe ServiceToken)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"auth_token" ValueSchema NamedSwaggerDoc ServiceToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewService
  ([Asset] -> Range 1 3 (Set ServiceTag) -> NewService)
-> SchemaP SwaggerDoc Object [Pair] NewService [Asset]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewService
     (Range 1 3 (Set ServiceTag) -> NewService)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewService a
-> SchemaP SwaggerDoc Object [Pair] NewService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewService -> [Asset]
newServiceAssets (NewService -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] NewService [Asset]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"assets" (ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewService
  (Range 1 3 (Set ServiceTag) -> NewService)
-> SchemaP
     SwaggerDoc Object [Pair] NewService (Range 1 3 (Set ServiceTag))
-> SchemaP SwaggerDoc Object [Pair] NewService NewService
forall a b.
SchemaP SwaggerDoc Object [Pair] NewService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewService a
-> SchemaP SwaggerDoc Object [Pair] NewService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewService -> Range 1 3 (Set ServiceTag)
newServiceTags (NewService -> Range 1 3 (Set ServiceTag))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 3 (Set ServiceTag))
     (Range 1 3 (Set ServiceTag))
-> SchemaP
     SwaggerDoc Object [Pair] NewService (Range 1 3 (Set ServiceTag))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 3 (Set ServiceTag))
     (Range 1 3 (Set ServiceTag))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 3 (Set ServiceTag))
     (Range 1 3 (Set ServiceTag))
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"tags" (Range 1 3 (Set ServiceTag) -> Set ServiceTag
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 3 (Set ServiceTag) -> Set ServiceTag)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Set ServiceTag)
     (Range 1 3 (Set ServiceTag))
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 3 (Set ServiceTag))
     (Range 1 3 (Set ServiceTag))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Set ServiceTag)
     (Range 1 3 (Set ServiceTag))
forall (n :: Nat) (m :: Nat) d v w a b.
(KnownNat n, KnownNat m, Within a n m,
 HasRangedSchemaDocModifier d b) =>
SchemaP d v w a b -> SchemaP d v w a (Range n m b)
rangedSchema (ValueSchema NamedSwaggerDoc ServiceTag
-> SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc ServiceTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

-- | Response data upon adding a new service.
data NewServiceResponse = NewServiceResponse
  { NewServiceResponse -> ServiceId
rsNewServiceId :: ServiceId,
    -- | The generated bearer token that we will use for
    -- authenticating requests towards the service, if none was
    -- provided in the 'NewService' request.
    NewServiceResponse -> Maybe ServiceToken
rsNewServiceToken :: Maybe ServiceToken
  }
  deriving stock (NewServiceResponse -> NewServiceResponse -> Bool
(NewServiceResponse -> NewServiceResponse -> Bool)
-> (NewServiceResponse -> NewServiceResponse -> Bool)
-> Eq NewServiceResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewServiceResponse -> NewServiceResponse -> Bool
== :: NewServiceResponse -> NewServiceResponse -> Bool
$c/= :: NewServiceResponse -> NewServiceResponse -> Bool
/= :: NewServiceResponse -> NewServiceResponse -> Bool
Eq, Int -> NewServiceResponse -> ShowS
[NewServiceResponse] -> ShowS
NewServiceResponse -> String
(Int -> NewServiceResponse -> ShowS)
-> (NewServiceResponse -> String)
-> ([NewServiceResponse] -> ShowS)
-> Show NewServiceResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewServiceResponse -> ShowS
showsPrec :: Int -> NewServiceResponse -> ShowS
$cshow :: NewServiceResponse -> String
show :: NewServiceResponse -> String
$cshowList :: [NewServiceResponse] -> ShowS
showList :: [NewServiceResponse] -> ShowS
Show, (forall x. NewServiceResponse -> Rep NewServiceResponse x)
-> (forall x. Rep NewServiceResponse x -> NewServiceResponse)
-> Generic NewServiceResponse
forall x. Rep NewServiceResponse x -> NewServiceResponse
forall x. NewServiceResponse -> Rep NewServiceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewServiceResponse -> Rep NewServiceResponse x
from :: forall x. NewServiceResponse -> Rep NewServiceResponse x
$cto :: forall x. Rep NewServiceResponse x -> NewServiceResponse
to :: forall x. Rep NewServiceResponse x -> NewServiceResponse
Generic)
  deriving (Gen NewServiceResponse
Gen NewServiceResponse
-> (NewServiceResponse -> [NewServiceResponse])
-> Arbitrary NewServiceResponse
NewServiceResponse -> [NewServiceResponse]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewServiceResponse
arbitrary :: Gen NewServiceResponse
$cshrink :: NewServiceResponse -> [NewServiceResponse]
shrink :: NewServiceResponse -> [NewServiceResponse]
Arbitrary) via (GenericUniform NewServiceResponse)
  deriving (Typeable NewServiceResponse
Typeable NewServiceResponse =>
(Proxy NewServiceResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewServiceResponse
Proxy NewServiceResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewServiceResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewServiceResponse
-> Declare (Definitions Schema) NamedSchema
S.ToSchema, [NewServiceResponse] -> Value
[NewServiceResponse] -> Encoding
NewServiceResponse -> Value
NewServiceResponse -> Encoding
(NewServiceResponse -> Value)
-> (NewServiceResponse -> Encoding)
-> ([NewServiceResponse] -> Value)
-> ([NewServiceResponse] -> Encoding)
-> ToJSON NewServiceResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewServiceResponse -> Value
toJSON :: NewServiceResponse -> Value
$ctoEncoding :: NewServiceResponse -> Encoding
toEncoding :: NewServiceResponse -> Encoding
$ctoJSONList :: [NewServiceResponse] -> Value
toJSONList :: [NewServiceResponse] -> Value
$ctoEncodingList :: [NewServiceResponse] -> Encoding
toEncodingList :: [NewServiceResponse] -> Encoding
ToJSON, Value -> Parser [NewServiceResponse]
Value -> Parser NewServiceResponse
(Value -> Parser NewServiceResponse)
-> (Value -> Parser [NewServiceResponse])
-> FromJSON NewServiceResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewServiceResponse
parseJSON :: Value -> Parser NewServiceResponse
$cparseJSONList :: Value -> Parser [NewServiceResponse]
parseJSONList :: Value -> Parser [NewServiceResponse]
FromJSON) via (Schema NewServiceResponse)

instance ToSchema NewServiceResponse where
  schema :: ValueSchema NamedSwaggerDoc NewServiceResponse
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] NewServiceResponse NewServiceResponse
-> ValueSchema NamedSwaggerDoc NewServiceResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NewServiceResponse" (SchemaP
   SwaggerDoc Object [Pair] NewServiceResponse NewServiceResponse
 -> ValueSchema NamedSwaggerDoc NewServiceResponse)
-> SchemaP
     SwaggerDoc Object [Pair] NewServiceResponse NewServiceResponse
-> ValueSchema NamedSwaggerDoc NewServiceResponse
forall a b. (a -> b) -> a -> b
$
      ServiceId -> Maybe ServiceToken -> NewServiceResponse
NewServiceResponse
        (ServiceId -> Maybe ServiceToken -> NewServiceResponse)
-> SchemaP SwaggerDoc Object [Pair] NewServiceResponse ServiceId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewServiceResponse
     (Maybe ServiceToken -> NewServiceResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewServiceResponse -> ServiceId
rsNewServiceId (NewServiceResponse -> ServiceId)
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] NewServiceResponse ServiceId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewServiceResponse
  (Maybe ServiceToken -> NewServiceResponse)
-> SchemaP
     SwaggerDoc Object [Pair] NewServiceResponse (Maybe ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] NewServiceResponse NewServiceResponse
forall a b.
SchemaP SwaggerDoc Object [Pair] NewServiceResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewServiceResponse a
-> SchemaP SwaggerDoc Object [Pair] NewServiceResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewServiceResponse -> Maybe ServiceToken
rsNewServiceToken (NewServiceResponse -> Maybe ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceToken) (Maybe ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] NewServiceResponse (Maybe ServiceToken)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ServiceToken (Maybe ServiceToken)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceToken) (Maybe ServiceToken)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> ValueSchema NamedSwaggerDoc ServiceToken
-> SchemaP
     SwaggerDoc Object [Pair] ServiceToken (Maybe ServiceToken)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"auth_token" ValueSchema NamedSwaggerDoc ServiceToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- UpdateService

-- | Update service profile information.
data UpdateService = UpdateService
  { UpdateService -> Maybe Name
updateServiceName :: Maybe Name,
    UpdateService -> Maybe (Range 1 128 Text)
updateServiceSummary :: Maybe (Range 1 128 Text),
    UpdateService -> Maybe (Range 1 1024 Text)
updateServiceDescr :: Maybe (Range 1 1024 Text),
    UpdateService -> Maybe [Asset]
updateServiceAssets :: Maybe [Asset],
    UpdateService -> Maybe (Range 1 3 (Set ServiceTag))
updateServiceTags :: Maybe (Range 1 3 (Set ServiceTag))
  }
  deriving stock (UpdateService -> UpdateService -> Bool
(UpdateService -> UpdateService -> Bool)
-> (UpdateService -> UpdateService -> Bool) -> Eq UpdateService
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateService -> UpdateService -> Bool
== :: UpdateService -> UpdateService -> Bool
$c/= :: UpdateService -> UpdateService -> Bool
/= :: UpdateService -> UpdateService -> Bool
Eq, Int -> UpdateService -> ShowS
[UpdateService] -> ShowS
UpdateService -> String
(Int -> UpdateService -> ShowS)
-> (UpdateService -> String)
-> ([UpdateService] -> ShowS)
-> Show UpdateService
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateService -> ShowS
showsPrec :: Int -> UpdateService -> ShowS
$cshow :: UpdateService -> String
show :: UpdateService -> String
$cshowList :: [UpdateService] -> ShowS
showList :: [UpdateService] -> ShowS
Show, (forall x. UpdateService -> Rep UpdateService x)
-> (forall x. Rep UpdateService x -> UpdateService)
-> Generic UpdateService
forall x. Rep UpdateService x -> UpdateService
forall x. UpdateService -> Rep UpdateService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateService -> Rep UpdateService x
from :: forall x. UpdateService -> Rep UpdateService x
$cto :: forall x. Rep UpdateService x -> UpdateService
to :: forall x. Rep UpdateService x -> UpdateService
Generic)
  deriving (Gen UpdateService
Gen UpdateService
-> (UpdateService -> [UpdateService]) -> Arbitrary UpdateService
UpdateService -> [UpdateService]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UpdateService
arbitrary :: Gen UpdateService
$cshrink :: UpdateService -> [UpdateService]
shrink :: UpdateService -> [UpdateService]
Arbitrary) via (GenericUniform UpdateService)
  deriving (Typeable UpdateService
Typeable UpdateService =>
(Proxy UpdateService -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UpdateService
Proxy UpdateService -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UpdateService -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UpdateService -> Declare (Definitions Schema) NamedSchema
S.ToSchema, Value -> Parser [UpdateService]
Value -> Parser UpdateService
(Value -> Parser UpdateService)
-> (Value -> Parser [UpdateService]) -> FromJSON UpdateService
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UpdateService
parseJSON :: Value -> Parser UpdateService
$cparseJSONList :: Value -> Parser [UpdateService]
parseJSONList :: Value -> Parser [UpdateService]
FromJSON, [UpdateService] -> Value
[UpdateService] -> Encoding
UpdateService -> Value
UpdateService -> Encoding
(UpdateService -> Value)
-> (UpdateService -> Encoding)
-> ([UpdateService] -> Value)
-> ([UpdateService] -> Encoding)
-> ToJSON UpdateService
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UpdateService -> Value
toJSON :: UpdateService -> Value
$ctoEncoding :: UpdateService -> Encoding
toEncoding :: UpdateService -> Encoding
$ctoJSONList :: [UpdateService] -> Value
toJSONList :: [UpdateService] -> Value
$ctoEncodingList :: [UpdateService] -> Encoding
toEncodingList :: [UpdateService] -> Encoding
ToJSON) via (Schema UpdateService)

instance ToSchema UpdateService where
  schema :: ValueSchema NamedSwaggerDoc UpdateService
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UpdateService UpdateService
-> ValueSchema NamedSwaggerDoc UpdateService
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UpdateService" (SchemaP SwaggerDoc Object [Pair] UpdateService UpdateService
 -> ValueSchema NamedSwaggerDoc UpdateService)
-> SchemaP SwaggerDoc Object [Pair] UpdateService UpdateService
-> ValueSchema NamedSwaggerDoc UpdateService
forall a b. (a -> b) -> a -> b
$
      Maybe Name
-> Maybe (Range 1 128 Text)
-> Maybe (Range 1 1024 Text)
-> Maybe [Asset]
-> Maybe (Range 1 3 (Set ServiceTag))
-> UpdateService
UpdateService
        (Maybe Name
 -> Maybe (Range 1 128 Text)
 -> Maybe (Range 1 1024 Text)
 -> Maybe [Asset]
 -> Maybe (Range 1 3 (Set ServiceTag))
 -> UpdateService)
-> SchemaP SwaggerDoc Object [Pair] UpdateService (Maybe Name)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateService
     (Maybe (Range 1 128 Text)
      -> Maybe (Range 1 1024 Text)
      -> Maybe [Asset]
      -> Maybe (Range 1 3 (Set ServiceTag))
      -> UpdateService)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateService -> Maybe Name
updateServiceName (UpdateService -> Maybe Name)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Name) (Maybe Name)
-> SchemaP SwaggerDoc Object [Pair] UpdateService (Maybe Name)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Name (Maybe Name)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Name) (Maybe Name)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name (Maybe Name)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateService
  (Maybe (Range 1 128 Text)
   -> Maybe (Range 1 1024 Text)
   -> Maybe [Asset]
   -> Maybe (Range 1 3 (Set ServiceTag))
   -> UpdateService)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateService (Maybe (Range 1 128 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateService
     (Maybe (Range 1 1024 Text)
      -> Maybe [Asset]
      -> Maybe (Range 1 3 (Set ServiceTag))
      -> UpdateService)
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateService a
-> SchemaP SwaggerDoc Object [Pair] UpdateService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateService -> Maybe (Range 1 128 Text)
updateServiceSummary (UpdateService -> Maybe (Range 1 128 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 128 Text))
     (Maybe (Range 1 128 Text))
-> SchemaP
     SwaggerDoc Object [Pair] UpdateService (Maybe (Range 1 128 Text))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 128 Text)
  (Maybe (Range 1 128 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 128 Text))
     (Maybe (Range 1 128 Text))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 128 Text) (Range 1 128 Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 128 Text)
     (Maybe (Range 1 128 Text))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"summary" SchemaP
  NamedSwaggerDoc Value Value (Range 1 128 Text) (Range 1 128 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateService
  (Maybe (Range 1 1024 Text)
   -> Maybe [Asset]
   -> Maybe (Range 1 3 (Set ServiceTag))
   -> UpdateService)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateService (Maybe (Range 1 1024 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateService
     (Maybe [Asset]
      -> Maybe (Range 1 3 (Set ServiceTag)) -> UpdateService)
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateService a
-> SchemaP SwaggerDoc Object [Pair] UpdateService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateService -> Maybe (Range 1 1024 Text)
updateServiceDescr (UpdateService -> Maybe (Range 1 1024 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 1024 Text))
     (Maybe (Range 1 1024 Text))
-> SchemaP
     SwaggerDoc Object [Pair] UpdateService (Maybe (Range 1 1024 Text))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 1024 Text)
  (Maybe (Range 1 1024 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 1024 Text))
     (Maybe (Range 1 1024 Text))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 1024 Text) (Range 1 1024 Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 1024 Text)
     (Maybe (Range 1 1024 Text))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"description" SchemaP
  NamedSwaggerDoc Value Value (Range 1 1024 Text) (Range 1 1024 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateService
  (Maybe [Asset]
   -> Maybe (Range 1 3 (Set ServiceTag)) -> UpdateService)
-> SchemaP SwaggerDoc Object [Pair] UpdateService (Maybe [Asset])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateService
     (Maybe (Range 1 3 (Set ServiceTag)) -> UpdateService)
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateService a
-> SchemaP SwaggerDoc Object [Pair] UpdateService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateService -> Maybe [Asset]
updateServiceAssets (UpdateService -> Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] (Maybe [Asset]) (Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] UpdateService (Maybe [Asset])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] (Maybe [Asset]) (Maybe [Asset])
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"assets" (SchemaP SwaggerDoc Value Value [Asset] [Asset]
 -> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset]))
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
forall a b. (a -> b) -> a -> b
$ ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateService
  (Maybe (Range 1 3 (Set ServiceTag)) -> UpdateService)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateService
     (Maybe (Range 1 3 (Set ServiceTag)))
-> SchemaP SwaggerDoc Object [Pair] UpdateService UpdateService
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateService a
-> SchemaP SwaggerDoc Object [Pair] UpdateService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateService -> Maybe (Range 1 3 (Set ServiceTag))
updateServiceTags (UpdateService -> Maybe (Range 1 3 (Set ServiceTag)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 3 (Set ServiceTag)))
     (Maybe (Range 1 3 (Set ServiceTag)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateService
     (Maybe (Range 1 3 (Set ServiceTag)))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 3 (Set ServiceTag))
  (Maybe (Range 1 3 (Set ServiceTag)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 3 (Set ServiceTag)))
     (Maybe (Range 1 3 (Set ServiceTag)))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 3 (Set ServiceTag))
     (Range 1 3 (Set ServiceTag))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 3 (Set ServiceTag))
     (Maybe (Range 1 3 (Set ServiceTag)))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"tags" (Range 1 3 (Set ServiceTag) -> Set ServiceTag
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 3 (Set ServiceTag) -> Set ServiceTag)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Set ServiceTag)
     (Range 1 3 (Set ServiceTag))
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 3 (Set ServiceTag))
     (Range 1 3 (Set ServiceTag))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Set ServiceTag)
     (Range 1 3 (Set ServiceTag))
forall (n :: Nat) (m :: Nat) d v w a b.
(KnownNat n, KnownNat m, Within a n m,
 HasRangedSchemaDocModifier d b) =>
SchemaP d v w a b -> SchemaP d v w a (Range n m b)
rangedSchema (ValueSchema NamedSwaggerDoc ServiceTag
-> SchemaP SwaggerDoc Value Value (Set ServiceTag) (Set ServiceTag)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc ServiceTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)))

--------------------------------------------------------------------------------
-- UpdateServiceConn

-- | Update service connection information.
-- This operation requires re-authentication via password.
data UpdateServiceConn = UpdateServiceConn
  { UpdateServiceConn -> PlainTextPassword6
updateServiceConnPassword :: PlainTextPassword6,
    UpdateServiceConn -> Maybe HttpsUrl
updateServiceConnUrl :: Maybe HttpsUrl,
    UpdateServiceConn -> Maybe (Range 1 2 [ServiceKeyPEM])
updateServiceConnKeys :: Maybe (Range 1 2 [ServiceKeyPEM]),
    UpdateServiceConn -> Maybe (Range 1 2 [ServiceToken])
updateServiceConnTokens :: Maybe (Range 1 2 [ServiceToken]),
    UpdateServiceConn -> Maybe Bool
updateServiceConnEnabled :: Maybe Bool
  }
  deriving stock (UpdateServiceConn -> UpdateServiceConn -> Bool
(UpdateServiceConn -> UpdateServiceConn -> Bool)
-> (UpdateServiceConn -> UpdateServiceConn -> Bool)
-> Eq UpdateServiceConn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateServiceConn -> UpdateServiceConn -> Bool
== :: UpdateServiceConn -> UpdateServiceConn -> Bool
$c/= :: UpdateServiceConn -> UpdateServiceConn -> Bool
/= :: UpdateServiceConn -> UpdateServiceConn -> Bool
Eq, Int -> UpdateServiceConn -> ShowS
[UpdateServiceConn] -> ShowS
UpdateServiceConn -> String
(Int -> UpdateServiceConn -> ShowS)
-> (UpdateServiceConn -> String)
-> ([UpdateServiceConn] -> ShowS)
-> Show UpdateServiceConn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateServiceConn -> ShowS
showsPrec :: Int -> UpdateServiceConn -> ShowS
$cshow :: UpdateServiceConn -> String
show :: UpdateServiceConn -> String
$cshowList :: [UpdateServiceConn] -> ShowS
showList :: [UpdateServiceConn] -> ShowS
Show, (forall x. UpdateServiceConn -> Rep UpdateServiceConn x)
-> (forall x. Rep UpdateServiceConn x -> UpdateServiceConn)
-> Generic UpdateServiceConn
forall x. Rep UpdateServiceConn x -> UpdateServiceConn
forall x. UpdateServiceConn -> Rep UpdateServiceConn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateServiceConn -> Rep UpdateServiceConn x
from :: forall x. UpdateServiceConn -> Rep UpdateServiceConn x
$cto :: forall x. Rep UpdateServiceConn x -> UpdateServiceConn
to :: forall x. Rep UpdateServiceConn x -> UpdateServiceConn
Generic)
  deriving (Gen UpdateServiceConn
Gen UpdateServiceConn
-> (UpdateServiceConn -> [UpdateServiceConn])
-> Arbitrary UpdateServiceConn
UpdateServiceConn -> [UpdateServiceConn]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UpdateServiceConn
arbitrary :: Gen UpdateServiceConn
$cshrink :: UpdateServiceConn -> [UpdateServiceConn]
shrink :: UpdateServiceConn -> [UpdateServiceConn]
Arbitrary) via (GenericUniform UpdateServiceConn)
  deriving (Typeable UpdateServiceConn
Typeable UpdateServiceConn =>
(Proxy UpdateServiceConn
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UpdateServiceConn
Proxy UpdateServiceConn -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UpdateServiceConn -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UpdateServiceConn -> Declare (Definitions Schema) NamedSchema
S.ToSchema, [UpdateServiceConn] -> Value
[UpdateServiceConn] -> Encoding
UpdateServiceConn -> Value
UpdateServiceConn -> Encoding
(UpdateServiceConn -> Value)
-> (UpdateServiceConn -> Encoding)
-> ([UpdateServiceConn] -> Value)
-> ([UpdateServiceConn] -> Encoding)
-> ToJSON UpdateServiceConn
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UpdateServiceConn -> Value
toJSON :: UpdateServiceConn -> Value
$ctoEncoding :: UpdateServiceConn -> Encoding
toEncoding :: UpdateServiceConn -> Encoding
$ctoJSONList :: [UpdateServiceConn] -> Value
toJSONList :: [UpdateServiceConn] -> Value
$ctoEncodingList :: [UpdateServiceConn] -> Encoding
toEncodingList :: [UpdateServiceConn] -> Encoding
ToJSON, Value -> Parser [UpdateServiceConn]
Value -> Parser UpdateServiceConn
(Value -> Parser UpdateServiceConn)
-> (Value -> Parser [UpdateServiceConn])
-> FromJSON UpdateServiceConn
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UpdateServiceConn
parseJSON :: Value -> Parser UpdateServiceConn
$cparseJSONList :: Value -> Parser [UpdateServiceConn]
parseJSONList :: Value -> Parser [UpdateServiceConn]
FromJSON) via (Schema UpdateServiceConn)

instance ToSchema UpdateServiceConn where
  schema :: ValueSchema NamedSwaggerDoc UpdateServiceConn
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceConn UpdateServiceConn
-> ValueSchema NamedSwaggerDoc UpdateServiceConn
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UpdateServiceConn" (SchemaP
   SwaggerDoc Object [Pair] UpdateServiceConn UpdateServiceConn
 -> ValueSchema NamedSwaggerDoc UpdateServiceConn)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceConn UpdateServiceConn
-> ValueSchema NamedSwaggerDoc UpdateServiceConn
forall a b. (a -> b) -> a -> b
$
      PlainTextPassword6
-> Maybe HttpsUrl
-> Maybe (Range 1 2 [ServiceKeyPEM])
-> Maybe (Range 1 2 [ServiceToken])
-> Maybe Bool
-> UpdateServiceConn
UpdateServiceConn
        (PlainTextPassword6
 -> Maybe HttpsUrl
 -> Maybe (Range 1 2 [ServiceKeyPEM])
 -> Maybe (Range 1 2 [ServiceToken])
 -> Maybe Bool
 -> UpdateServiceConn)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceConn PlainTextPassword6
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe HttpsUrl
      -> Maybe (Range 1 2 [ServiceKeyPEM])
      -> Maybe (Range 1 2 [ServiceToken])
      -> Maybe Bool
      -> UpdateServiceConn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateServiceConn -> PlainTextPassword6
updateServiceConnPassword (UpdateServiceConn -> PlainTextPassword6)
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceConn PlainTextPassword6
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword6 PlainTextPassword6
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateServiceConn
  (Maybe HttpsUrl
   -> Maybe (Range 1 2 [ServiceKeyPEM])
   -> Maybe (Range 1 2 [ServiceToken])
   -> Maybe Bool
   -> UpdateServiceConn)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceConn (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe (Range 1 2 [ServiceKeyPEM])
      -> Maybe (Range 1 2 [ServiceToken])
      -> Maybe Bool
      -> UpdateServiceConn)
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateServiceConn (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn a
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateServiceConn -> Maybe HttpsUrl
updateServiceConnUrl (UpdateServiceConn -> Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceConn (Maybe HttpsUrl)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"base_url" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateServiceConn
  (Maybe (Range 1 2 [ServiceKeyPEM])
   -> Maybe (Range 1 2 [ServiceToken])
   -> Maybe Bool
   -> UpdateServiceConn)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe (Range 1 2 [ServiceKeyPEM]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe (Range 1 2 [ServiceToken])
      -> Maybe Bool -> UpdateServiceConn)
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateServiceConn (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn a
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateServiceConn -> Maybe (Range 1 2 [ServiceKeyPEM])
updateServiceConnKeys (UpdateServiceConn -> Maybe (Range 1 2 [ServiceKeyPEM]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 2 [ServiceKeyPEM]))
     (Maybe (Range 1 2 [ServiceKeyPEM]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe (Range 1 2 [ServiceKeyPEM]))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 2 [ServiceKeyPEM])
  (Maybe (Range 1 2 [ServiceKeyPEM]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 2 [ServiceKeyPEM]))
     (Maybe (Range 1 2 [ServiceKeyPEM]))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 2 [ServiceKeyPEM])
     (Range 1 2 [ServiceKeyPEM])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 2 [ServiceKeyPEM])
     (Maybe (Range 1 2 [ServiceKeyPEM]))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"public_keys" (Range 1 2 [ServiceKeyPEM] -> [ServiceKeyPEM]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 2 [ServiceKeyPEM] -> [ServiceKeyPEM])
-> SchemaP
     SwaggerDoc Value Value [ServiceKeyPEM] (Range 1 2 [ServiceKeyPEM])
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 2 [ServiceKeyPEM])
     (Range 1 2 [ServiceKeyPEM])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Value Value [ServiceKeyPEM] [ServiceKeyPEM]
-> SchemaP
     SwaggerDoc Value Value [ServiceKeyPEM] (Range 1 2 [ServiceKeyPEM])
forall (n :: Nat) (m :: Nat) d v w a b.
(KnownNat n, KnownNat m, Within a n m,
 HasRangedSchemaDocModifier d b) =>
SchemaP d v w a b -> SchemaP d v w a (Range n m b)
rangedSchema (SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> SchemaP SwaggerDoc Value Value [ServiceKeyPEM] [ServiceKeyPEM]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateServiceConn
  (Maybe (Range 1 2 [ServiceToken])
   -> Maybe Bool -> UpdateServiceConn)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe (Range 1 2 [ServiceToken]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe Bool -> UpdateServiceConn)
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateServiceConn (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn a
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateServiceConn -> Maybe (Range 1 2 [ServiceToken])
updateServiceConnTokens (UpdateServiceConn -> Maybe (Range 1 2 [ServiceToken]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 2 [ServiceToken]))
     (Maybe (Range 1 2 [ServiceToken]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceConn
     (Maybe (Range 1 2 [ServiceToken]))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 2 [ServiceToken])
  (Maybe (Range 1 2 [ServiceToken]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 2 [ServiceToken]))
     (Maybe (Range 1 2 [ServiceToken]))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 2 [ServiceToken])
     (Range 1 2 [ServiceToken])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 2 [ServiceToken])
     (Maybe (Range 1 2 [ServiceToken]))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"auth_tokens" (Range 1 2 [ServiceToken] -> [ServiceToken]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 2 [ServiceToken] -> [ServiceToken])
-> SchemaP
     SwaggerDoc Value Value [ServiceToken] (Range 1 2 [ServiceToken])
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 2 [ServiceToken])
     (Range 1 2 [ServiceToken])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Value Value [ServiceToken] [ServiceToken]
-> SchemaP
     SwaggerDoc Value Value [ServiceToken] (Range 1 2 [ServiceToken])
forall (n :: Nat) (m :: Nat) d v w a b.
(KnownNat n, KnownNat m, Within a n m,
 HasRangedSchemaDocModifier d b) =>
SchemaP d v w a b -> SchemaP d v w a (Range n m b)
rangedSchema (ValueSchema NamedSwaggerDoc ServiceToken
-> SchemaP SwaggerDoc Value Value [ServiceToken] [ServiceToken]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc ServiceToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateServiceConn
  (Maybe Bool -> UpdateServiceConn)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn (Maybe Bool)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceConn UpdateServiceConn
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateServiceConn (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn a
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateServiceConn -> Maybe Bool
updateServiceConnEnabled (UpdateServiceConn -> Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceConn (Maybe Bool)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) (Maybe Bool)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"enabled" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

mkUpdateServiceConn :: PlainTextPassword6 -> UpdateServiceConn
mkUpdateServiceConn :: PlainTextPassword6 -> UpdateServiceConn
mkUpdateServiceConn PlainTextPassword6
pw = PlainTextPassword6
-> Maybe HttpsUrl
-> Maybe (Range 1 2 [ServiceKeyPEM])
-> Maybe (Range 1 2 [ServiceToken])
-> Maybe Bool
-> UpdateServiceConn
UpdateServiceConn PlainTextPassword6
pw Maybe HttpsUrl
forall a. Maybe a
Nothing Maybe (Range 1 2 [ServiceKeyPEM])
forall a. Maybe a
Nothing Maybe (Range 1 2 [ServiceToken])
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- DeleteService

-- | Input data for a service deletion request.
newtype DeleteService = DeleteService
  {DeleteService -> PlainTextPassword6
deleteServicePassword :: PlainTextPassword6}
  deriving stock (DeleteService -> DeleteService -> Bool
(DeleteService -> DeleteService -> Bool)
-> (DeleteService -> DeleteService -> Bool) -> Eq DeleteService
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteService -> DeleteService -> Bool
== :: DeleteService -> DeleteService -> Bool
$c/= :: DeleteService -> DeleteService -> Bool
/= :: DeleteService -> DeleteService -> Bool
Eq, Int -> DeleteService -> ShowS
[DeleteService] -> ShowS
DeleteService -> String
(Int -> DeleteService -> ShowS)
-> (DeleteService -> String)
-> ([DeleteService] -> ShowS)
-> Show DeleteService
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteService -> ShowS
showsPrec :: Int -> DeleteService -> ShowS
$cshow :: DeleteService -> String
show :: DeleteService -> String
$cshowList :: [DeleteService] -> ShowS
showList :: [DeleteService] -> ShowS
Show)
  deriving newtype (Gen DeleteService
Gen DeleteService
-> (DeleteService -> [DeleteService]) -> Arbitrary DeleteService
DeleteService -> [DeleteService]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen DeleteService
arbitrary :: Gen DeleteService
$cshrink :: DeleteService -> [DeleteService]
shrink :: DeleteService -> [DeleteService]
Arbitrary)
  deriving (Typeable DeleteService
Typeable DeleteService =>
(Proxy DeleteService -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DeleteService
Proxy DeleteService -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy DeleteService -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DeleteService -> Declare (Definitions Schema) NamedSchema
S.ToSchema, [DeleteService] -> Value
[DeleteService] -> Encoding
DeleteService -> Value
DeleteService -> Encoding
(DeleteService -> Value)
-> (DeleteService -> Encoding)
-> ([DeleteService] -> Value)
-> ([DeleteService] -> Encoding)
-> ToJSON DeleteService
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DeleteService -> Value
toJSON :: DeleteService -> Value
$ctoEncoding :: DeleteService -> Encoding
toEncoding :: DeleteService -> Encoding
$ctoJSONList :: [DeleteService] -> Value
toJSONList :: [DeleteService] -> Value
$ctoEncodingList :: [DeleteService] -> Encoding
toEncodingList :: [DeleteService] -> Encoding
ToJSON, Value -> Parser [DeleteService]
Value -> Parser DeleteService
(Value -> Parser DeleteService)
-> (Value -> Parser [DeleteService]) -> FromJSON DeleteService
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DeleteService
parseJSON :: Value -> Parser DeleteService
$cparseJSONList :: Value -> Parser [DeleteService]
parseJSONList :: Value -> Parser [DeleteService]
FromJSON) via (Schema DeleteService)

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

--------------------------------------------------------------------------------
-- UpdateServiceWhitelist

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

instance ToSchema UpdateServiceWhitelist where
  schema :: ValueSchema NamedSwaggerDoc UpdateServiceWhitelist
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceWhitelist
     UpdateServiceWhitelist
-> ValueSchema NamedSwaggerDoc UpdateServiceWhitelist
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UpdateServiceWhitelist" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   UpdateServiceWhitelist
   UpdateServiceWhitelist
 -> ValueSchema NamedSwaggerDoc UpdateServiceWhitelist)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceWhitelist
     UpdateServiceWhitelist
-> ValueSchema NamedSwaggerDoc UpdateServiceWhitelist
forall a b. (a -> b) -> a -> b
$
      ProviderId -> ServiceId -> Bool -> UpdateServiceWhitelist
UpdateServiceWhitelist
        (ProviderId -> ServiceId -> Bool -> UpdateServiceWhitelist)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceWhitelist ProviderId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceWhitelist
     (ServiceId -> Bool -> UpdateServiceWhitelist)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateServiceWhitelist -> ProviderId
updateServiceWhitelistProvider (UpdateServiceWhitelist -> ProviderId)
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceWhitelist ProviderId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"provider" SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateServiceWhitelist
  (ServiceId -> Bool -> UpdateServiceWhitelist)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceWhitelist ServiceId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceWhitelist
     (Bool -> UpdateServiceWhitelist)
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist a
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateServiceWhitelist -> ServiceId
updateServiceWhitelistService (UpdateServiceWhitelist -> ServiceId)
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
-> SchemaP
     SwaggerDoc Object [Pair] UpdateServiceWhitelist ServiceId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UpdateServiceWhitelist
  (Bool -> UpdateServiceWhitelist)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateServiceWhitelist
     UpdateServiceWhitelist
forall a b.
SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist a
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpdateServiceWhitelist -> Bool
updateServiceWhitelistStatus (UpdateServiceWhitelist -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] UpdateServiceWhitelist Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"whitelisted" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data UpdateServiceWhitelistResp
  = UpdateServiceWhitelistRespChanged
  | UpdateServiceWhitelistRespUnchanged

-- basically the same as the instance for CheckBlacklistResponse
instance
  AsUnion
    '[ RespondEmpty 200 "UpdateServiceWhitelistRespChanged",
       RespondEmpty 204 "UpdateServiceWhitelistRespUnchanged"
     ]
    UpdateServiceWhitelistResp
  where
  toUnion :: UpdateServiceWhitelistResp
-> Union
     (ResponseTypes
        '[RespondEmpty 200 "UpdateServiceWhitelistRespChanged",
          RespondEmpty 204 "UpdateServiceWhitelistRespUnchanged"])
toUnion UpdateServiceWhitelistResp
UpdateServiceWhitelistRespChanged = I () -> NS I '[(), ()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ())
  toUnion UpdateServiceWhitelistResp
UpdateServiceWhitelistRespUnchanged = NS I '[()] -> NS I '[(), ()]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I () -> NS I '[()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ()))
  fromUnion :: Union
  (ResponseTypes
     '[RespondEmpty 200 "UpdateServiceWhitelistRespChanged",
       RespondEmpty 204 "UpdateServiceWhitelistRespUnchanged"])
-> UpdateServiceWhitelistResp
fromUnion (Z (I ())) = UpdateServiceWhitelistResp
UpdateServiceWhitelistRespChanged
  fromUnion (S (Z (I ()))) = UpdateServiceWhitelistResp
UpdateServiceWhitelistRespUnchanged
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}