{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Wire.API.Push.V2
  ( Push (..),
    newPush,
    pushRecipients,
    pushOrigin,
    pushConnections,
    pushOriginConnection,
    pushTransient,
    pushNativeIncludeOrigin,
    pushNativeEncrypt,
    pushNativeAps,
    pushNativePriority,
    pushPayload,
    singletonPayload,
    Recipient (..),
    RecipientClients (..),
    recipient,
    recipientId,
    recipientRoute,
    recipientClients,
    Route (..),
    ApsData,
    ApsLocKey (..),
    ApsSound (..),
    apsData,
    apsLocKey,
    apsLocArgs,
    apsSound,
    apsBadge,

    -- * Priority (re-export)
    Priority (..),

    -- * PushToken (re-export)
    PushTokenList (..),
    PushToken,
    pushToken,
    tokenTransport,
    tokenApp,
    tokenClient,
    token,

    -- * PushToken fields (re-export)
    Token (..),
    Transport (..),
    AppName (..),
  )
where

import Control.Lens (makeLenses, (?~))
import Data.Aeson (FromJSON (..), Object, ToJSON (..))
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Id
import Data.Json.Util
import Data.List1
import Data.List1 qualified as List1
import Data.OpenApi qualified as S
import Data.Range
import Data.Schema
import Data.Set qualified as Set
import Imports
import Wire.API.Message (Priority (..))
import Wire.API.Push.V2.Token
import Wire.Arbitrary

-----------------------------------------------------------------------------
-- Route

data Route
  = -- | Sends notification on all channels including push notifications to
    -- mobile clients. Note that transient messages never cause a push
    -- notification.
    RouteAny
  | -- | Avoids causing push notification for mobile clients.
    RouteDirect
  deriving (Route -> Route -> Bool
(Route -> Route -> Bool) -> (Route -> Route -> Bool) -> Eq Route
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Route -> Route -> Bool
== :: Route -> Route -> Bool
$c/= :: Route -> Route -> Bool
/= :: Route -> Route -> Bool
Eq, Eq Route
Eq Route =>
(Route -> Route -> Ordering)
-> (Route -> Route -> Bool)
-> (Route -> Route -> Bool)
-> (Route -> Route -> Bool)
-> (Route -> Route -> Bool)
-> (Route -> Route -> Route)
-> (Route -> Route -> Route)
-> Ord Route
Route -> Route -> Bool
Route -> Route -> Ordering
Route -> Route -> Route
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 :: Route -> Route -> Ordering
compare :: Route -> Route -> Ordering
$c< :: Route -> Route -> Bool
< :: Route -> Route -> Bool
$c<= :: Route -> Route -> Bool
<= :: Route -> Route -> Bool
$c> :: Route -> Route -> Bool
> :: Route -> Route -> Bool
$c>= :: Route -> Route -> Bool
>= :: Route -> Route -> Bool
$cmax :: Route -> Route -> Route
max :: Route -> Route -> Route
$cmin :: Route -> Route -> Route
min :: Route -> Route -> Route
Ord, Int -> Route
Route -> Int
Route -> [Route]
Route -> Route
Route -> Route -> [Route]
Route -> Route -> Route -> [Route]
(Route -> Route)
-> (Route -> Route)
-> (Int -> Route)
-> (Route -> Int)
-> (Route -> [Route])
-> (Route -> Route -> [Route])
-> (Route -> Route -> [Route])
-> (Route -> Route -> Route -> [Route])
-> Enum Route
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 :: Route -> Route
succ :: Route -> Route
$cpred :: Route -> Route
pred :: Route -> Route
$ctoEnum :: Int -> Route
toEnum :: Int -> Route
$cfromEnum :: Route -> Int
fromEnum :: Route -> Int
$cenumFrom :: Route -> [Route]
enumFrom :: Route -> [Route]
$cenumFromThen :: Route -> Route -> [Route]
enumFromThen :: Route -> Route -> [Route]
$cenumFromTo :: Route -> Route -> [Route]
enumFromTo :: Route -> Route -> [Route]
$cenumFromThenTo :: Route -> Route -> Route -> [Route]
enumFromThenTo :: Route -> Route -> Route -> [Route]
Enum, Route
Route -> Route -> Bounded Route
forall a. a -> a -> Bounded a
$cminBound :: Route
minBound :: Route
$cmaxBound :: Route
maxBound :: Route
Bounded, Int -> Route -> ShowS
[Route] -> ShowS
Route -> [Char]
(Int -> Route -> ShowS)
-> (Route -> [Char]) -> ([Route] -> ShowS) -> Show Route
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Route -> ShowS
showsPrec :: Int -> Route -> ShowS
$cshow :: Route -> [Char]
show :: Route -> [Char]
$cshowList :: [Route] -> ShowS
showList :: [Route] -> ShowS
Show, (forall x. Route -> Rep Route x)
-> (forall x. Rep Route x -> Route) -> Generic Route
forall x. Rep Route x -> Route
forall x. Route -> Rep Route x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Route -> Rep Route x
from :: forall x. Route -> Rep Route x
$cto :: forall x. Rep Route x -> Route
to :: forall x. Rep Route x -> Route
Generic)
  deriving (Gen Route
Gen Route -> (Route -> [Route]) -> Arbitrary Route
Route -> [Route]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Route
arbitrary :: Gen Route
$cshrink :: Route -> [Route]
shrink :: Route -> [Route]
Arbitrary) via GenericUniform Route
  deriving (Value -> Parser [Route]
Value -> Parser Route
(Value -> Parser Route)
-> (Value -> Parser [Route]) -> FromJSON Route
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Route
parseJSON :: Value -> Parser Route
$cparseJSONList :: Value -> Parser [Route]
parseJSONList :: Value -> Parser [Route]
FromJSON, [Route] -> Value
[Route] -> Encoding
Route -> Value
Route -> Encoding
(Route -> Value)
-> (Route -> Encoding)
-> ([Route] -> Value)
-> ([Route] -> Encoding)
-> ToJSON Route
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Route -> Value
toJSON :: Route -> Value
$ctoEncoding :: Route -> Encoding
toEncoding :: Route -> Encoding
$ctoJSONList :: [Route] -> Value
toJSONList :: [Route] -> Value
$ctoEncodingList :: [Route] -> Encoding
toEncodingList :: [Route] -> Encoding
ToJSON, Typeable Route
Typeable Route =>
(Proxy Route -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Route
Proxy Route -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Route -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Route -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Route)

instance ToSchema Route where
  schema :: ValueSchema NamedSwaggerDoc Route
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
"Route" (SchemaP [Value] Text (Alt Maybe Text) Route Route
 -> ValueSchema NamedSwaggerDoc Route)
-> SchemaP [Value] Text (Alt Maybe Text) Route Route
-> ValueSchema NamedSwaggerDoc Route
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) Route Route]
-> SchemaP [Value] Text (Alt Maybe Text) Route Route
forall a. Monoid a => [a] -> a
mconcat
        [ Text -> Route -> SchemaP [Value] Text (Alt Maybe Text) Route Route
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"any" Route
RouteAny,
          Text -> Route -> SchemaP [Value] Text (Alt Maybe Text) Route Route
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"direct" Route
RouteDirect
        ]

-----------------------------------------------------------------------------
-- Recipient

-- FUTUREWORK: this is a duplicate of the type in "Wire.NotificationSubsystem" (even though
-- the latter lacks a few possibly deprecated fields). consolidate!
data Recipient = Recipient
  { Recipient -> UserId
_recipientId :: !UserId,
    Recipient -> Route
_recipientRoute :: !Route,
    Recipient -> RecipientClients
_recipientClients :: !RecipientClients
  }
  deriving (Int -> Recipient -> ShowS
[Recipient] -> ShowS
Recipient -> [Char]
(Int -> Recipient -> ShowS)
-> (Recipient -> [Char])
-> ([Recipient] -> ShowS)
-> Show Recipient
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Recipient -> ShowS
showsPrec :: Int -> Recipient -> ShowS
$cshow :: Recipient -> [Char]
show :: Recipient -> [Char]
$cshowList :: [Recipient] -> ShowS
showList :: [Recipient] -> ShowS
Show, Recipient -> Recipient -> Bool
(Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool) -> Eq Recipient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Recipient -> Recipient -> Bool
== :: Recipient -> Recipient -> Bool
$c/= :: Recipient -> Recipient -> Bool
/= :: Recipient -> Recipient -> Bool
Eq, Eq Recipient
Eq Recipient =>
(Recipient -> Recipient -> Ordering)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Recipient)
-> (Recipient -> Recipient -> Recipient)
-> Ord Recipient
Recipient -> Recipient -> Bool
Recipient -> Recipient -> Ordering
Recipient -> Recipient -> Recipient
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 :: Recipient -> Recipient -> Ordering
compare :: Recipient -> Recipient -> Ordering
$c< :: Recipient -> Recipient -> Bool
< :: Recipient -> Recipient -> Bool
$c<= :: Recipient -> Recipient -> Bool
<= :: Recipient -> Recipient -> Bool
$c> :: Recipient -> Recipient -> Bool
> :: Recipient -> Recipient -> Bool
$c>= :: Recipient -> Recipient -> Bool
>= :: Recipient -> Recipient -> Bool
$cmax :: Recipient -> Recipient -> Recipient
max :: Recipient -> Recipient -> Recipient
$cmin :: Recipient -> Recipient -> Recipient
min :: Recipient -> Recipient -> Recipient
Ord, (forall x. Recipient -> Rep Recipient x)
-> (forall x. Rep Recipient x -> Recipient) -> Generic Recipient
forall x. Rep Recipient x -> Recipient
forall x. Recipient -> Rep Recipient x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Recipient -> Rep Recipient x
from :: forall x. Recipient -> Rep Recipient x
$cto :: forall x. Rep Recipient x -> Recipient
to :: forall x. Rep Recipient x -> Recipient
Generic)
  deriving (Value -> Parser [Recipient]
Value -> Parser Recipient
(Value -> Parser Recipient)
-> (Value -> Parser [Recipient]) -> FromJSON Recipient
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Recipient
parseJSON :: Value -> Parser Recipient
$cparseJSONList :: Value -> Parser [Recipient]
parseJSONList :: Value -> Parser [Recipient]
FromJSON, [Recipient] -> Value
[Recipient] -> Encoding
Recipient -> Value
Recipient -> Encoding
(Recipient -> Value)
-> (Recipient -> Encoding)
-> ([Recipient] -> Value)
-> ([Recipient] -> Encoding)
-> ToJSON Recipient
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Recipient -> Value
toJSON :: Recipient -> Value
$ctoEncoding :: Recipient -> Encoding
toEncoding :: Recipient -> Encoding
$ctoJSONList :: [Recipient] -> Value
toJSONList :: [Recipient] -> Value
$ctoEncodingList :: [Recipient] -> Encoding
toEncodingList :: [Recipient] -> Encoding
ToJSON, Typeable Recipient
Typeable Recipient =>
(Proxy Recipient -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Recipient
Proxy Recipient -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Recipient -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Recipient -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Recipient)

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

instance Semigroup RecipientClients where
  RecipientClients
RecipientClientsAll <> :: RecipientClients -> RecipientClients -> RecipientClients
<> RecipientClients
_ = RecipientClients
RecipientClientsAll
  RecipientClients
_ <> RecipientClients
RecipientClientsAll = RecipientClients
RecipientClientsAll
  RecipientClientsSome List1 ClientId
cs1 <> RecipientClientsSome List1 ClientId
cs2 =
    List1 ClientId -> RecipientClients
RecipientClientsSome (List1 ClientId
cs1 List1 ClientId -> List1 ClientId -> List1 ClientId
forall a. Semigroup a => a -> a -> a
<> List1 ClientId
cs2)

instance ToSchema Recipient where
  schema :: ValueSchema NamedSwaggerDoc Recipient
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Recipient Recipient
-> ValueSchema NamedSwaggerDoc Recipient
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Recipient" (SchemaP SwaggerDoc Object [Pair] Recipient Recipient
 -> ValueSchema NamedSwaggerDoc Recipient)
-> SchemaP SwaggerDoc Object [Pair] Recipient Recipient
-> ValueSchema NamedSwaggerDoc Recipient
forall a b. (a -> b) -> a -> b
$
      UserId -> Route -> RecipientClients -> Recipient
Recipient
        (UserId -> Route -> RecipientClients -> Recipient)
-> SchemaP SwaggerDoc Object [Pair] Recipient UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Recipient
     (Route -> RecipientClients -> Recipient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recipient -> UserId
_recipientId (Recipient -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] Recipient UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"user_id" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Recipient
  (Route -> RecipientClients -> Recipient)
-> SchemaP SwaggerDoc Object [Pair] Recipient Route
-> SchemaP
     SwaggerDoc Object [Pair] Recipient (RecipientClients -> Recipient)
forall a b.
SchemaP SwaggerDoc Object [Pair] Recipient (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Recipient a
-> SchemaP SwaggerDoc Object [Pair] Recipient b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Recipient -> Route
_recipientRoute (Recipient -> Route)
-> SchemaP SwaggerDoc Object [Pair] Route Route
-> SchemaP SwaggerDoc Object [Pair] Recipient Route
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc Route
-> SchemaP SwaggerDoc Object [Pair] Route Route
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"route" ValueSchema NamedSwaggerDoc Route
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] Recipient (RecipientClients -> Recipient)
-> SchemaP SwaggerDoc Object [Pair] Recipient RecipientClients
-> SchemaP SwaggerDoc Object [Pair] Recipient Recipient
forall a b.
SchemaP SwaggerDoc Object [Pair] Recipient (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Recipient a
-> SchemaP SwaggerDoc Object [Pair] Recipient b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Recipient -> RecipientClients
_recipientClients (Recipient -> RecipientClients)
-> SchemaP
     SwaggerDoc Object [Pair] RecipientClients RecipientClients
-> SchemaP SwaggerDoc Object [Pair] Recipient RecipientClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value RecipientClients RecipientClients
-> SchemaP
     SwaggerDoc Object [Pair] RecipientClients RecipientClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"clients" SchemaP
  NamedSwaggerDoc Value Value RecipientClients RecipientClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance ToSchema RecipientClients where
  schema :: SchemaP
  NamedSwaggerDoc Value Value RecipientClients RecipientClients
schema = NamedSwaggerDoc
-> (Value -> Parser RecipientClients)
-> (RecipientClients -> Maybe Value)
-> SchemaP
     NamedSwaggerDoc Value Value RecipientClients RecipientClients
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema NamedSwaggerDoc
d Value -> Parser RecipientClients
i RecipientClients -> Maybe Value
o
    where
      d :: NamedSwaggerDoc
      d :: NamedSwaggerDoc
d =
        forall a. ToSchema a => NamedSwaggerDoc
swaggerDoc @[ClientId]
          NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
    -> Schema -> Identity Schema)
-> (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> OpenApiType -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiArray)
          NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"List of clientIds. Empty means `all clients`.")

      i :: A.Value -> A.Parser RecipientClients
      i :: Value -> Parser RecipientClients
i Value
v =
        forall a. FromJSON a => Value -> Parser a
parseJSON @[ClientId] Value
v Parser [ClientId]
-> ([ClientId] -> Parser RecipientClients)
-> Parser RecipientClients
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          [] -> RecipientClients -> Parser RecipientClients
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecipientClients
RecipientClientsAll
          ClientId
c : [ClientId]
cs -> RecipientClients -> Parser RecipientClients
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List1 ClientId -> RecipientClients
RecipientClientsSome (ClientId -> [ClientId] -> List1 ClientId
forall a. a -> [a] -> List1 a
list1 ClientId
c [ClientId]
cs))

      o :: RecipientClients -> Maybe A.Value
      o :: RecipientClients -> Maybe Value
o =
        Value -> Maybe Value
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value)
-> (RecipientClients -> Value) -> RecipientClients -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ClientId] -> Value
forall a. ToJSON a => a -> Value
toJSON ([ClientId] -> Value)
-> (RecipientClients -> [ClientId]) -> RecipientClients -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
          RecipientClientsSome List1 ClientId
cs -> List1 ClientId -> [ClientId]
forall a. List1 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 ClientId
cs
          RecipientClients
RecipientClientsAll -> []

makeLenses ''Recipient

recipient :: UserId -> Route -> Recipient
recipient :: UserId -> Route -> Recipient
recipient UserId
u Route
r = UserId -> Route -> RecipientClients -> Recipient
Recipient UserId
u Route
r RecipientClients
RecipientClientsAll

-----------------------------------------------------------------------------
-- ApsData

newtype ApsSound = ApsSound {ApsSound -> Text
fromSound :: Text}
  deriving (ApsSound -> ApsSound -> Bool
(ApsSound -> ApsSound -> Bool)
-> (ApsSound -> ApsSound -> Bool) -> Eq ApsSound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApsSound -> ApsSound -> Bool
== :: ApsSound -> ApsSound -> Bool
$c/= :: ApsSound -> ApsSound -> Bool
/= :: ApsSound -> ApsSound -> Bool
Eq, Int -> ApsSound -> ShowS
[ApsSound] -> ShowS
ApsSound -> [Char]
(Int -> ApsSound -> ShowS)
-> (ApsSound -> [Char]) -> ([ApsSound] -> ShowS) -> Show ApsSound
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApsSound -> ShowS
showsPrec :: Int -> ApsSound -> ShowS
$cshow :: ApsSound -> [Char]
show :: ApsSound -> [Char]
$cshowList :: [ApsSound] -> ShowS
showList :: [ApsSound] -> ShowS
Show, [ApsSound] -> Value
[ApsSound] -> Encoding
ApsSound -> Value
ApsSound -> Encoding
(ApsSound -> Value)
-> (ApsSound -> Encoding)
-> ([ApsSound] -> Value)
-> ([ApsSound] -> Encoding)
-> ToJSON ApsSound
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ApsSound -> Value
toJSON :: ApsSound -> Value
$ctoEncoding :: ApsSound -> Encoding
toEncoding :: ApsSound -> Encoding
$ctoJSONList :: [ApsSound] -> Value
toJSONList :: [ApsSound] -> Value
$ctoEncodingList :: [ApsSound] -> Encoding
toEncodingList :: [ApsSound] -> Encoding
ToJSON, Value -> Parser [ApsSound]
Value -> Parser ApsSound
(Value -> Parser ApsSound)
-> (Value -> Parser [ApsSound]) -> FromJSON ApsSound
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ApsSound
parseJSON :: Value -> Parser ApsSound
$cparseJSONList :: Value -> Parser [ApsSound]
parseJSONList :: Value -> Parser [ApsSound]
FromJSON, Gen ApsSound
Gen ApsSound -> (ApsSound -> [ApsSound]) -> Arbitrary ApsSound
ApsSound -> [ApsSound]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ApsSound
arbitrary :: Gen ApsSound
$cshrink :: ApsSound -> [ApsSound]
shrink :: ApsSound -> [ApsSound]
Arbitrary)

instance ToSchema ApsSound where
  schema :: ValueSchema NamedSwaggerDoc ApsSound
schema =
    NamedSwaggerDoc
-> (Value -> Parser ApsSound)
-> (ApsSound -> Maybe Value)
-> ValueSchema NamedSwaggerDoc ApsSound
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema NamedSwaggerDoc
d Value -> Parser ApsSound
i ApsSound -> Maybe Value
o
    where
      d :: NamedSwaggerDoc
d =
        forall a. ToSchema a => NamedSwaggerDoc
swaggerDoc @Text
          NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
    -> Schema -> Identity Schema)
-> (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> OpenApiType -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString)
          NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"ApsSound")

      i :: Value -> Parser ApsSound
i = [Char] -> (Text -> Parser ApsSound) -> Value -> Parser ApsSound
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
A.withText [Char]
"ApsSound" (ApsSound -> Parser ApsSound
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApsSound -> Parser ApsSound)
-> (Text -> ApsSound) -> Text -> Parser ApsSound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ApsSound
ApsSound)
      o :: ApsSound -> Maybe Value
o = Value -> Maybe Value
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value)
-> (ApsSound -> Value) -> ApsSound -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
A.String (Text -> Value) -> (ApsSound -> Text) -> ApsSound -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApsSound -> Text
fromSound

newtype ApsLocKey = ApsLocKey {ApsLocKey -> Text
fromLocKey :: Text}
  deriving (ApsLocKey -> ApsLocKey -> Bool
(ApsLocKey -> ApsLocKey -> Bool)
-> (ApsLocKey -> ApsLocKey -> Bool) -> Eq ApsLocKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApsLocKey -> ApsLocKey -> Bool
== :: ApsLocKey -> ApsLocKey -> Bool
$c/= :: ApsLocKey -> ApsLocKey -> Bool
/= :: ApsLocKey -> ApsLocKey -> Bool
Eq, Int -> ApsLocKey -> ShowS
[ApsLocKey] -> ShowS
ApsLocKey -> [Char]
(Int -> ApsLocKey -> ShowS)
-> (ApsLocKey -> [Char])
-> ([ApsLocKey] -> ShowS)
-> Show ApsLocKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApsLocKey -> ShowS
showsPrec :: Int -> ApsLocKey -> ShowS
$cshow :: ApsLocKey -> [Char]
show :: ApsLocKey -> [Char]
$cshowList :: [ApsLocKey] -> ShowS
showList :: [ApsLocKey] -> ShowS
Show, [ApsLocKey] -> Value
[ApsLocKey] -> Encoding
ApsLocKey -> Value
ApsLocKey -> Encoding
(ApsLocKey -> Value)
-> (ApsLocKey -> Encoding)
-> ([ApsLocKey] -> Value)
-> ([ApsLocKey] -> Encoding)
-> ToJSON ApsLocKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ApsLocKey -> Value
toJSON :: ApsLocKey -> Value
$ctoEncoding :: ApsLocKey -> Encoding
toEncoding :: ApsLocKey -> Encoding
$ctoJSONList :: [ApsLocKey] -> Value
toJSONList :: [ApsLocKey] -> Value
$ctoEncodingList :: [ApsLocKey] -> Encoding
toEncodingList :: [ApsLocKey] -> Encoding
ToJSON, Value -> Parser [ApsLocKey]
Value -> Parser ApsLocKey
(Value -> Parser ApsLocKey)
-> (Value -> Parser [ApsLocKey]) -> FromJSON ApsLocKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ApsLocKey
parseJSON :: Value -> Parser ApsLocKey
$cparseJSONList :: Value -> Parser [ApsLocKey]
parseJSONList :: Value -> Parser [ApsLocKey]
FromJSON, Gen ApsLocKey
Gen ApsLocKey -> (ApsLocKey -> [ApsLocKey]) -> Arbitrary ApsLocKey
ApsLocKey -> [ApsLocKey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ApsLocKey
arbitrary :: Gen ApsLocKey
$cshrink :: ApsLocKey -> [ApsLocKey]
shrink :: ApsLocKey -> [ApsLocKey]
Arbitrary)

instance ToSchema ApsLocKey where
  schema :: ValueSchema NamedSwaggerDoc ApsLocKey
schema =
    NamedSwaggerDoc
-> (Value -> Parser ApsLocKey)
-> (ApsLocKey -> Maybe Value)
-> ValueSchema NamedSwaggerDoc ApsLocKey
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema NamedSwaggerDoc
d Value -> Parser ApsLocKey
i ApsLocKey -> Maybe Value
o
    where
      d :: NamedSwaggerDoc
d =
        forall a. ToSchema a => NamedSwaggerDoc
swaggerDoc @Text
          NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
    -> Schema -> Identity Schema)
-> (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> OpenApiType -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString)
          NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"ApsLocKey")

      i :: Value -> Parser ApsLocKey
i = [Char] -> (Text -> Parser ApsLocKey) -> Value -> Parser ApsLocKey
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
A.withText [Char]
"ApsLocKey" (ApsLocKey -> Parser ApsLocKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApsLocKey -> Parser ApsLocKey)
-> (Text -> ApsLocKey) -> Text -> Parser ApsLocKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ApsLocKey
ApsLocKey)
      o :: ApsLocKey -> Maybe Value
o = Value -> Maybe Value
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value)
-> (ApsLocKey -> Value) -> ApsLocKey -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
A.String (Text -> Value) -> (ApsLocKey -> Text) -> ApsLocKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApsLocKey -> Text
fromLocKey

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

apsData :: ApsLocKey -> [Text] -> ApsData
apsData :: ApsLocKey -> [Text] -> ApsData
apsData ApsLocKey
lk [Text]
la = ApsLocKey -> [Text] -> Maybe ApsSound -> Bool -> ApsData
ApsData ApsLocKey
lk [Text]
la Maybe ApsSound
forall a. Maybe a
Nothing Bool
True

instance ToSchema ApsData where
  schema :: ValueSchema NamedSwaggerDoc ApsData
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ApsData ApsData
-> ValueSchema NamedSwaggerDoc ApsData
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ApsData" (SchemaP SwaggerDoc Object [Pair] ApsData ApsData
 -> ValueSchema NamedSwaggerDoc ApsData)
-> SchemaP SwaggerDoc Object [Pair] ApsData ApsData
-> ValueSchema NamedSwaggerDoc ApsData
forall a b. (a -> b) -> a -> b
$
      ApsLocKey -> [Text] -> Maybe ApsSound -> Bool -> ApsData
ApsData
        (ApsLocKey -> [Text] -> Maybe ApsSound -> Bool -> ApsData)
-> SchemaP SwaggerDoc Object [Pair] ApsData ApsLocKey
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ApsData
     ([Text] -> Maybe ApsSound -> Bool -> ApsData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApsData -> ApsLocKey
_apsLocKey (ApsData -> ApsLocKey)
-> SchemaP SwaggerDoc Object [Pair] ApsLocKey ApsLocKey
-> SchemaP SwaggerDoc Object [Pair] ApsData ApsLocKey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc ApsLocKey
-> SchemaP SwaggerDoc Object [Pair] ApsLocKey ApsLocKey
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"loc_key" ValueSchema NamedSwaggerDoc ApsLocKey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ApsData
  ([Text] -> Maybe ApsSound -> Bool -> ApsData)
-> SchemaP SwaggerDoc Object [Pair] ApsData [Text]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ApsData
     (Maybe ApsSound -> Bool -> ApsData)
forall a b.
SchemaP SwaggerDoc Object [Pair] ApsData (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ApsData a
-> SchemaP SwaggerDoc Object [Pair] ApsData b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> (ApsData -> [Text])
-> SchemaP SwaggerDoc Value Value [Text] [Text]
-> [Text]
-> SchemaP SwaggerDoc Object [Pair] ApsData [Text]
forall {doc'} {a} {b} {b}.
HasSchemaRef doc' =>
Text
-> (a -> b)
-> SchemaP doc' Value Value b b
-> b
-> SchemaP SwaggerDoc Object [Pair] a b
withDefault Text
"loc_args" ApsData -> [Text]
_apsLocArgs (ValueSchema NamedSwaggerDoc Text
-> SchemaP SwaggerDoc Value Value [Text] [Text]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema) []
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ApsData
  (Maybe ApsSound -> Bool -> ApsData)
-> SchemaP SwaggerDoc Object [Pair] ApsData (Maybe ApsSound)
-> SchemaP SwaggerDoc Object [Pair] ApsData (Bool -> ApsData)
forall a b.
SchemaP SwaggerDoc Object [Pair] ApsData (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ApsData a
-> SchemaP SwaggerDoc Object [Pair] ApsData b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ApsData -> Maybe ApsSound
_apsSound (ApsData -> Maybe ApsSound)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ApsSound) (Maybe ApsSound)
-> SchemaP SwaggerDoc Object [Pair] ApsData (Maybe ApsSound)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe ApsSound) ApsSound
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ApsSound) (Maybe ApsSound)
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
"sound" (Value
-> ValueSchema NamedSwaggerDoc ApsSound
-> SchemaP NamedSwaggerDoc Value Value (Maybe ApsSound) ApsSound
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null ValueSchema NamedSwaggerDoc ApsSound
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema) -- keep null for backwards compat
        SchemaP SwaggerDoc Object [Pair] ApsData (Bool -> ApsData)
-> SchemaP SwaggerDoc Object [Pair] ApsData Bool
-> SchemaP SwaggerDoc Object [Pair] ApsData ApsData
forall a b.
SchemaP SwaggerDoc Object [Pair] ApsData (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ApsData a
-> SchemaP SwaggerDoc Object [Pair] ApsData b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> (ApsData -> Bool)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> Bool
-> SchemaP SwaggerDoc Object [Pair] ApsData Bool
forall {doc'} {a} {b} {b}.
HasSchemaRef doc' =>
Text
-> (a -> b)
-> SchemaP doc' Value Value b b
-> b
-> SchemaP SwaggerDoc Object [Pair] a b
withDefault Text
"badge" ApsData -> Bool
_apsBadge SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema Bool
True
    where
      withDefault :: Text
-> (a -> b)
-> SchemaP doc' Value Value b b
-> b
-> SchemaP SwaggerDoc Object [Pair] a b
withDefault Text
fn a -> b
f SchemaP doc' Value Value b b
s b
def = ((b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (a -> Maybe b)
-> SchemaP SwaggerDoc Object [Pair] (Maybe b) (Maybe b)
-> SchemaP SwaggerDoc Object [Pair] a (Maybe b)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] b (Maybe b)
-> SchemaP SwaggerDoc Object [Pair] (Maybe b) (Maybe b)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP doc' Value Value b b
-> SchemaP SwaggerDoc Object [Pair] b (Maybe b)
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
fn SchemaP doc' Value Value b b
s)) SchemaP SwaggerDoc Object [Pair] a (Maybe b)
-> (Maybe b -> b) -> SchemaP SwaggerDoc Object [Pair] a b
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
def

makeLenses ''ApsData

-----------------------------------------------------------------------------
-- Push

-- FUTUREWORK: this is a duplicate of the type in "Wire.NotificationSubsystem" (even though
-- the latter lacks a few possibly deprecated fields). consolidate!
data Push = Push
  { -- | Recipients
    --
    -- REFACTOR: '_pushRecipients' should be @Set (Recipient, Maybe (NonEmptySet ConnId))@, and
    -- '_pushConnections' should go away.  Rationale: the current setup only works under the
    -- assumption that no 'ConnId' is used by two 'Recipient's.  This is *probably* correct, but
    -- not in any contract.  (Changing this may require a new version module, since we need to
    -- support both the old and the new data type simultaneously during upgrade.)
    Push -> Range 1 1024 (Set Recipient)
_pushRecipients :: Range 1 1024 (Set Recipient),
    -- | Originating user
    --
    -- 'Nothing' here means that the originating user is on another backend.
    --
    -- REFACTOR: where is this required, and for what?  or can it be removed?  (see also: #531)
    Push -> Maybe UserId
_pushOrigin :: !(Maybe UserId),
    -- | Destination connections.  If empty, ignore.  Otherwise, filter the connections derived
    -- from '_pushRecipients' and only push to those contained in this set.
    --
    -- REFACTOR: change this to @_pushConnectionWhitelist :: Maybe (Set ConnId)@.
    Push -> Set ConnId
_pushConnections :: !(Set ConnId),
    -- | Originating connection, if any.
    Push -> Maybe ConnId
_pushOriginConnection :: !(Maybe ConnId),
    -- | Transient payloads are not forwarded to the notification stream.
    Push -> Bool
_pushTransient :: !Bool,
    -- | Whether to send native notifications to other clients
    -- of the originating user, if he is among the recipients.
    Push -> Bool
_pushNativeIncludeOrigin :: !Bool,
    -- | Should native push payloads be encrypted?
    --
    -- REFACTOR: this make no sense any more since native push notifications have no more payload.
    -- https://github.com/wireapp/wire-server/pull/546
    Push -> Bool
_pushNativeEncrypt :: !Bool,
    -- | APNs-specific metadata (needed eg. in "Brig.IO.Intra.toApsData").
    Push -> Maybe ApsData
_pushNativeAps :: !(Maybe ApsData),
    -- | Native push priority.
    Push -> Priority
_pushNativePriority :: !Priority,
    -- | Opaque payload
    Push -> List1 Object
_pushPayload :: !(List1 Object)
  }
  deriving (Push -> Push -> Bool
(Push -> Push -> Bool) -> (Push -> Push -> Bool) -> Eq Push
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Push -> Push -> Bool
== :: Push -> Push -> Bool
$c/= :: Push -> Push -> Bool
/= :: Push -> Push -> Bool
Eq, Int -> Push -> ShowS
[Push] -> ShowS
Push -> [Char]
(Int -> Push -> ShowS)
-> (Push -> [Char]) -> ([Push] -> ShowS) -> Show Push
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Push -> ShowS
showsPrec :: Int -> Push -> ShowS
$cshow :: Push -> [Char]
show :: Push -> [Char]
$cshowList :: [Push] -> ShowS
showList :: [Push] -> ShowS
Show)
  deriving (Value -> Parser [Push]
Value -> Parser Push
(Value -> Parser Push) -> (Value -> Parser [Push]) -> FromJSON Push
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Push
parseJSON :: Value -> Parser Push
$cparseJSONList :: Value -> Parser [Push]
parseJSONList :: Value -> Parser [Push]
FromJSON, [Push] -> Value
[Push] -> Encoding
Push -> Value
Push -> Encoding
(Push -> Value)
-> (Push -> Encoding)
-> ([Push] -> Value)
-> ([Push] -> Encoding)
-> ToJSON Push
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Push -> Value
toJSON :: Push -> Value
$ctoEncoding :: Push -> Encoding
toEncoding :: Push -> Encoding
$ctoJSONList :: [Push] -> Value
toJSONList :: [Push] -> Value
$ctoEncodingList :: [Push] -> Encoding
toEncodingList :: [Push] -> Encoding
ToJSON, Typeable Push
Typeable Push =>
(Proxy Push -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Push
Proxy Push -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Push -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Push -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Push)

newPush :: Maybe UserId -> Range 1 1024 (Set Recipient) -> List1 Object -> Push
newPush :: Maybe UserId
-> Range 1 1024 (Set Recipient) -> List1 Object -> Push
newPush Maybe UserId
from Range 1 1024 (Set Recipient)
to List1 Object
pload =
  Push
    { _pushRecipients :: Range 1 1024 (Set Recipient)
_pushRecipients = Range 1 1024 (Set Recipient)
to,
      $sel:_pushOrigin:Push :: Maybe UserId
_pushOrigin = Maybe UserId
from,
      _pushConnections :: Set ConnId
_pushConnections = Set ConnId
forall a. Set a
Set.empty,
      $sel:_pushOriginConnection:Push :: Maybe ConnId
_pushOriginConnection = Maybe ConnId
forall a. Maybe a
Nothing,
      $sel:_pushTransient:Push :: Bool
_pushTransient = Bool
False,
      $sel:_pushNativeIncludeOrigin:Push :: Bool
_pushNativeIncludeOrigin = Bool
True,
      $sel:_pushNativeEncrypt:Push :: Bool
_pushNativeEncrypt = Bool
True,
      $sel:_pushNativeAps:Push :: Maybe ApsData
_pushNativeAps = Maybe ApsData
forall a. Maybe a
Nothing,
      $sel:_pushNativePriority:Push :: Priority
_pushNativePriority = Priority
HighPriority,
      $sel:_pushPayload:Push :: List1 Object
_pushPayload = List1 Object
pload
    }

singletonPayload :: (ToJSONObject a) => a -> List1 Object
singletonPayload :: forall a. ToJSONObject a => a -> List1 Object
singletonPayload = Object -> List1 Object
forall a. a -> List1 a
List1.singleton (Object -> List1 Object) -> (a -> Object) -> a -> List1 Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject

instance ToSchema Push where
  schema :: ValueSchema NamedSwaggerDoc Push
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Push Push
-> ValueSchema NamedSwaggerDoc Push
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Push" (SchemaP SwaggerDoc Object [Pair] Push Push
 -> ValueSchema NamedSwaggerDoc Push)
-> SchemaP SwaggerDoc Object [Pair] Push Push
-> ValueSchema NamedSwaggerDoc Push
forall a b. (a -> b) -> a -> b
$
      Range 1 1024 (Set Recipient)
-> Maybe UserId
-> Set ConnId
-> Maybe ConnId
-> Bool
-> Bool
-> Bool
-> Maybe ApsData
-> Priority
-> List1 Object
-> Push
Push
        (Range 1 1024 (Set Recipient)
 -> Maybe UserId
 -> Set ConnId
 -> Maybe ConnId
 -> Bool
 -> Bool
 -> Bool
 -> Maybe ApsData
 -> Priority
 -> List1 Object
 -> Push)
-> SchemaP
     SwaggerDoc Object [Pair] Push (Range 1 1024 (Set Recipient))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Push
     (Maybe UserId
      -> Set ConnId
      -> Maybe ConnId
      -> Bool
      -> Bool
      -> Bool
      -> Maybe ApsData
      -> Priority
      -> List1 Object
      -> Push)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Range 1 1024 (Set Recipient) -> Set Recipient
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 1024 (Set Recipient) -> Set Recipient)
-> (Push -> Range 1 1024 (Set Recipient)) -> Push -> Set Recipient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Push -> Range 1 1024 (Set Recipient)
_pushRecipients) (Push -> Set Recipient)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set Recipient)
     (Range 1 1024 (Set Recipient))
-> SchemaP
     SwaggerDoc Object [Pair] Push (Range 1 1024 (Set Recipient))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Set Recipient)
     (Range 1 1024 (Set Recipient))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set Recipient)
     (Range 1 1024 (Set Recipient))
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"recipients" (SchemaP SwaggerDoc Value Value (Set Recipient) (Set Recipient)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Set Recipient)
     (Range 1 1024 (Set Recipient))
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 Recipient
-> SchemaP SwaggerDoc Value Value (Set Recipient) (Set Recipient)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc Recipient
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Push
  (Maybe UserId
   -> Set ConnId
   -> Maybe ConnId
   -> Bool
   -> Bool
   -> Bool
   -> Maybe ApsData
   -> Priority
   -> List1 Object
   -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push (Maybe UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Push
     (Set ConnId
      -> Maybe ConnId
      -> Bool
      -> Bool
      -> Bool
      -> Maybe ApsData
      -> Priority
      -> List1 Object
      -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Push -> Maybe UserId
_pushOrigin (Push -> Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UserId) (Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] Push (Maybe UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UserId) (Maybe UserId)
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 UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
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
"origin" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Push
  (Set ConnId
   -> Maybe ConnId
   -> Bool
   -> Bool
   -> Bool
   -> Maybe ApsData
   -> Priority
   -> List1 Object
   -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push (Set ConnId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Push
     (Maybe ConnId
      -> Bool
      -> Bool
      -> Bool
      -> Maybe ApsData
      -> Priority
      -> List1 Object
      -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Set ConnId -> Bool) -> Set ConnId -> Maybe (Set ConnId)
forall {a}. (a -> Bool) -> a -> Maybe a
ifNot Set ConnId -> Bool
forall a. Set a -> Bool
Set.null (Set ConnId -> Maybe (Set ConnId))
-> (Push -> Set ConnId) -> Push -> Maybe (Set ConnId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Push -> Set ConnId
_pushConnections)
          (Push -> Maybe (Set ConnId))
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe (Set ConnId)) (Set ConnId)
-> SchemaP SwaggerDoc Object [Pair] Push (Set ConnId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] (Set ConnId) (Set ConnId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe (Set ConnId)) (Set ConnId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ ((Maybe (Set ConnId) -> Set ConnId)
-> SchemaP
     SwaggerDoc Object [Pair] (Set ConnId) (Maybe (Set ConnId))
-> SchemaP SwaggerDoc Object [Pair] (Set ConnId) (Set ConnId)
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Set ConnId) a
-> SchemaP SwaggerDoc Object [Pair] (Set ConnId) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set ConnId -> Maybe (Set ConnId) -> Set ConnId
forall a. a -> Maybe a -> a
fromMaybe Set ConnId
forall a. Monoid a => a
mempty) (Text
-> SchemaP SwaggerDoc Value Value (Set ConnId) (Set ConnId)
-> SchemaP
     SwaggerDoc Object [Pair] (Set ConnId) (Maybe (Set ConnId))
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
"connections" (ValueSchema NamedSwaggerDoc ConnId
-> SchemaP SwaggerDoc Value Value (Set ConnId) (Set ConnId)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc ConnId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Push
  (Maybe ConnId
   -> Bool
   -> Bool
   -> Bool
   -> Maybe ApsData
   -> Priority
   -> List1 Object
   -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push (Maybe ConnId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Push
     (Bool
      -> Bool
      -> Bool
      -> Maybe ApsData
      -> Priority
      -> List1 Object
      -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Push -> Maybe ConnId
_pushOriginConnection (Push -> Maybe ConnId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe ConnId) (Maybe ConnId)
-> SchemaP SwaggerDoc Object [Pair] Push (Maybe ConnId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ConnId (Maybe ConnId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe ConnId) (Maybe ConnId)
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 ConnId
-> SchemaP SwaggerDoc Object [Pair] ConnId (Maybe ConnId)
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
"origin_connection" ValueSchema NamedSwaggerDoc ConnId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Push
  (Bool
   -> Bool
   -> Bool
   -> Maybe ApsData
   -> Priority
   -> List1 Object
   -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Push
     (Bool -> Bool -> Maybe ApsData -> Priority -> List1 Object -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Bool -> Bool) -> Bool -> Maybe Bool
forall {a}. (a -> Bool) -> a -> Maybe a
ifNot Bool -> Bool
not (Bool -> Maybe Bool) -> (Push -> Bool) -> Push -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Push -> Bool
_pushTransient)
          (Push -> Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
-> SchemaP SwaggerDoc Object [Pair] Push Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_
            ((Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] Bool a
-> SchemaP SwaggerDoc Object [Pair] Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False) (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
"transient" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Push
  (Bool -> Bool -> Maybe ApsData -> Priority -> List1 Object -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Push
     (Bool -> Maybe ApsData -> Priority -> List1 Object -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Bool -> Bool) -> Bool -> Maybe Bool
forall {a}. (a -> Bool) -> a -> Maybe a
ifNot Bool -> Bool
forall a. a -> a
id (Bool -> Maybe Bool) -> (Push -> Bool) -> Push -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Push -> Bool
_pushNativeIncludeOrigin)
          (Push -> Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
-> SchemaP SwaggerDoc Object [Pair] Push Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ ((Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] Bool a
-> SchemaP SwaggerDoc Object [Pair] Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True) (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
"native_include_origin" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Push
  (Bool -> Maybe ApsData -> Priority -> List1 Object -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Push
     (Maybe ApsData -> Priority -> List1 Object -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Bool -> Bool) -> Bool -> Maybe Bool
forall {a}. (a -> Bool) -> a -> Maybe a
ifNot Bool -> Bool
forall a. a -> a
id (Bool -> Maybe Bool) -> (Push -> Bool) -> Push -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Push -> Bool
_pushNativeEncrypt)
          (Push -> Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
-> SchemaP SwaggerDoc Object [Pair] Push Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ ((Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] Bool a
-> SchemaP SwaggerDoc Object [Pair] Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True) (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
"native_encrypt" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Push
  (Maybe ApsData -> Priority -> List1 Object -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push (Maybe ApsData)
-> SchemaP
     SwaggerDoc Object [Pair] Push (Priority -> List1 Object -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Push -> Maybe ApsData
_pushNativeAps (Push -> Maybe ApsData)
-> SchemaP SwaggerDoc Object [Pair] (Maybe ApsData) (Maybe ApsData)
-> SchemaP SwaggerDoc Object [Pair] Push (Maybe ApsData)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ApsData (Maybe ApsData)
-> SchemaP SwaggerDoc Object [Pair] (Maybe ApsData) (Maybe ApsData)
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 ApsData
-> SchemaP SwaggerDoc Object [Pair] ApsData (Maybe ApsData)
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
"native_aps" ValueSchema NamedSwaggerDoc ApsData
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc Object [Pair] Push (Priority -> List1 Object -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push Priority
-> SchemaP SwaggerDoc Object [Pair] Push (List1 Object -> Push)
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Priority -> Bool) -> Priority -> Maybe Priority
forall {a}. (a -> Bool) -> a -> Maybe a
ifNot (Priority -> Priority -> Bool
forall a. Eq a => a -> a -> Bool
== Priority
HighPriority) (Priority -> Maybe Priority)
-> (Push -> Priority) -> Push -> Maybe Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Push -> Priority
_pushNativePriority)
          (Push -> Maybe Priority)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Priority) Priority
-> SchemaP SwaggerDoc Object [Pair] Push Priority
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Priority Priority
-> SchemaP SwaggerDoc Object [Pair] (Maybe Priority) Priority
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Priority -> Maybe Priority -> Priority
forall a. a -> Maybe a -> a
fromMaybe Priority
HighPriority (Maybe Priority -> Priority)
-> SchemaP SwaggerDoc Object [Pair] Priority (Maybe Priority)
-> SchemaP SwaggerDoc Object [Pair] Priority Priority
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value Priority Priority
-> SchemaP SwaggerDoc Object [Pair] Priority (Maybe Priority)
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
"native_priority" SchemaP NamedSwaggerDoc Value Value Priority Priority
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] Push (List1 Object -> Push)
-> SchemaP SwaggerDoc Object [Pair] Push (List1 Object)
-> SchemaP SwaggerDoc Object [Pair] Push Push
forall a b.
SchemaP SwaggerDoc Object [Pair] Push (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Push a
-> SchemaP SwaggerDoc Object [Pair] Push b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Push -> List1 Object
_pushPayload (Push -> List1 Object)
-> SchemaP SwaggerDoc Object [Pair] (List1 Object) (List1 Object)
-> SchemaP SwaggerDoc Object [Pair] Push (List1 Object)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (List1 Object) (List1 Object)
-> SchemaP SwaggerDoc Object [Pair] (List1 Object) (List1 Object)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"payload" SchemaP NamedSwaggerDoc Value Value (List1 Object) (List1 Object)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      ifNot :: (a -> Bool) -> a -> Maybe a
ifNot a -> Bool
f a
a = if a -> Bool
f a
a then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
a

makeLenses ''Push