-- 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.Internal.BulkPush where

import Control.Lens
import Data.Aeson
import Data.Id
import Data.OpenApi qualified as Swagger
import Data.Schema (ValueSchema)
import Data.Schema qualified as S
import Imports
import Wire.API.Internal.Notification

data PushTarget = PushTarget
  { PushTarget -> UserId
ptUserId :: !UserId,
    PushTarget -> ConnId
ptConnId :: !ConnId
  }
  deriving
    ( PushTarget -> PushTarget -> Bool
(PushTarget -> PushTarget -> Bool)
-> (PushTarget -> PushTarget -> Bool) -> Eq PushTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PushTarget -> PushTarget -> Bool
== :: PushTarget -> PushTarget -> Bool
$c/= :: PushTarget -> PushTarget -> Bool
/= :: PushTarget -> PushTarget -> Bool
Eq,
      Eq PushTarget
Eq PushTarget =>
(PushTarget -> PushTarget -> Ordering)
-> (PushTarget -> PushTarget -> Bool)
-> (PushTarget -> PushTarget -> Bool)
-> (PushTarget -> PushTarget -> Bool)
-> (PushTarget -> PushTarget -> Bool)
-> (PushTarget -> PushTarget -> PushTarget)
-> (PushTarget -> PushTarget -> PushTarget)
-> Ord PushTarget
PushTarget -> PushTarget -> Bool
PushTarget -> PushTarget -> Ordering
PushTarget -> PushTarget -> PushTarget
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 :: PushTarget -> PushTarget -> Ordering
compare :: PushTarget -> PushTarget -> Ordering
$c< :: PushTarget -> PushTarget -> Bool
< :: PushTarget -> PushTarget -> Bool
$c<= :: PushTarget -> PushTarget -> Bool
<= :: PushTarget -> PushTarget -> Bool
$c> :: PushTarget -> PushTarget -> Bool
> :: PushTarget -> PushTarget -> Bool
$c>= :: PushTarget -> PushTarget -> Bool
>= :: PushTarget -> PushTarget -> Bool
$cmax :: PushTarget -> PushTarget -> PushTarget
max :: PushTarget -> PushTarget -> PushTarget
$cmin :: PushTarget -> PushTarget -> PushTarget
min :: PushTarget -> PushTarget -> PushTarget
Ord,
      Int -> PushTarget -> ShowS
[PushTarget] -> ShowS
PushTarget -> String
(Int -> PushTarget -> ShowS)
-> (PushTarget -> String)
-> ([PushTarget] -> ShowS)
-> Show PushTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PushTarget -> ShowS
showsPrec :: Int -> PushTarget -> ShowS
$cshow :: PushTarget -> String
show :: PushTarget -> String
$cshowList :: [PushTarget] -> ShowS
showList :: [PushTarget] -> ShowS
Show,
      (forall x. PushTarget -> Rep PushTarget x)
-> (forall x. Rep PushTarget x -> PushTarget) -> Generic PushTarget
forall x. Rep PushTarget x -> PushTarget
forall x. PushTarget -> Rep PushTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PushTarget -> Rep PushTarget x
from :: forall x. PushTarget -> Rep PushTarget x
$cto :: forall x. Rep PushTarget x -> PushTarget
to :: forall x. Rep PushTarget x -> PushTarget
Generic
    )
  deriving (Value -> Parser [PushTarget]
Value -> Parser PushTarget
(Value -> Parser PushTarget)
-> (Value -> Parser [PushTarget]) -> FromJSON PushTarget
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PushTarget
parseJSON :: Value -> Parser PushTarget
$cparseJSONList :: Value -> Parser [PushTarget]
parseJSONList :: Value -> Parser [PushTarget]
FromJSON, [PushTarget] -> Value
[PushTarget] -> Encoding
PushTarget -> Value
PushTarget -> Encoding
(PushTarget -> Value)
-> (PushTarget -> Encoding)
-> ([PushTarget] -> Value)
-> ([PushTarget] -> Encoding)
-> ToJSON PushTarget
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PushTarget -> Value
toJSON :: PushTarget -> Value
$ctoEncoding :: PushTarget -> Encoding
toEncoding :: PushTarget -> Encoding
$ctoJSONList :: [PushTarget] -> Value
toJSONList :: [PushTarget] -> Value
$ctoEncodingList :: [PushTarget] -> Encoding
toEncodingList :: [PushTarget] -> Encoding
ToJSON, Typeable PushTarget
Typeable PushTarget =>
(Proxy PushTarget -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PushTarget
Proxy PushTarget -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PushTarget -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PushTarget -> Declare (Definitions Schema) NamedSchema
Swagger.ToSchema) via S.Schema PushTarget

instance S.ToSchema PushTarget where
  schema :: ValueSchema NamedSwaggerDoc PushTarget
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] PushTarget PushTarget
-> ValueSchema NamedSwaggerDoc PushTarget
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
S.object Text
"PushTarget" (SchemaP SwaggerDoc Object [Pair] PushTarget PushTarget
 -> ValueSchema NamedSwaggerDoc PushTarget)
-> SchemaP SwaggerDoc Object [Pair] PushTarget PushTarget
-> ValueSchema NamedSwaggerDoc PushTarget
forall a b. (a -> b) -> a -> b
$
      UserId -> ConnId -> PushTarget
PushTarget
        (UserId -> ConnId -> PushTarget)
-> SchemaP SwaggerDoc Object [Pair] PushTarget UserId
-> SchemaP
     SwaggerDoc Object [Pair] PushTarget (ConnId -> PushTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PushTarget -> UserId
ptUserId (PushTarget -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] PushTarget UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= 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
S.field Text
"user_id" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema
        SchemaP SwaggerDoc Object [Pair] PushTarget (ConnId -> PushTarget)
-> SchemaP SwaggerDoc Object [Pair] PushTarget ConnId
-> SchemaP SwaggerDoc Object [Pair] PushTarget PushTarget
forall a b.
SchemaP SwaggerDoc Object [Pair] PushTarget (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PushTarget a
-> SchemaP SwaggerDoc Object [Pair] PushTarget b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PushTarget -> ConnId
ptConnId (PushTarget -> ConnId)
-> SchemaP SwaggerDoc Object [Pair] ConnId ConnId
-> SchemaP SwaggerDoc Object [Pair] PushTarget ConnId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> SchemaP NamedSwaggerDoc Value Value ConnId ConnId
-> SchemaP SwaggerDoc Object [Pair] ConnId ConnId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"conn_id" SchemaP NamedSwaggerDoc Value Value ConnId ConnId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema

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

instance S.ToSchema BulkPushRequest where
  schema :: ValueSchema NamedSwaggerDoc BulkPushRequest
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] BulkPushRequest BulkPushRequest
-> ValueSchema NamedSwaggerDoc BulkPushRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
S.object Text
"BulkPushRequest" (SchemaP SwaggerDoc Object [Pair] BulkPushRequest BulkPushRequest
 -> ValueSchema NamedSwaggerDoc BulkPushRequest)
-> SchemaP SwaggerDoc Object [Pair] BulkPushRequest BulkPushRequest
-> ValueSchema NamedSwaggerDoc BulkPushRequest
forall a b. (a -> b) -> a -> b
$
      [(Notification, [PushTarget])] -> BulkPushRequest
BulkPushRequest
        ([(Notification, [PushTarget])] -> BulkPushRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     BulkPushRequest
     [(Notification, [PushTarget])]
-> SchemaP SwaggerDoc Object [Pair] BulkPushRequest BulkPushRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BulkPushRequest -> [(Notification, [PushTarget])]
fromBulkPushRequest (BulkPushRequest -> [(Notification, [PushTarget])])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [(Notification, [PushTarget])]
     [(Notification, [PushTarget])]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     BulkPushRequest
     [(Notification, [PushTarget])]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     [(Notification, [PushTarget])]
     [(Notification, [PushTarget])]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [(Notification, [PushTarget])]
     [(Notification, [PushTarget])]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"bulkpush_req" (ValueSchema NamedSwaggerDoc (Notification, [PushTarget])
-> SchemaP
     SwaggerDoc
     Value
     Value
     [(Notification, [PushTarget])]
     [(Notification, [PushTarget])]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
S.array ValueSchema NamedSwaggerDoc (Notification, [PushTarget])
bulkpushReqItemSchema)
    where
      bulkpushReqItemSchema :: ValueSchema S.NamedSwaggerDoc (Notification, [PushTarget])
      bulkpushReqItemSchema :: ValueSchema NamedSwaggerDoc (Notification, [PushTarget])
bulkpushReqItemSchema =
        Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Notification, [PushTarget])
     (Notification, [PushTarget])
-> ValueSchema NamedSwaggerDoc (Notification, [PushTarget])
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
S.object Text
"(Notification, [PushTarget])" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   (Notification, [PushTarget])
   (Notification, [PushTarget])
 -> ValueSchema NamedSwaggerDoc (Notification, [PushTarget]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Notification, [PushTarget])
     (Notification, [PushTarget])
-> ValueSchema NamedSwaggerDoc (Notification, [PushTarget])
forall a b. (a -> b) -> a -> b
$
          (,)
            (Notification -> [PushTarget] -> (Notification, [PushTarget]))
-> SchemaP
     SwaggerDoc Object [Pair] (Notification, [PushTarget]) Notification
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Notification, [PushTarget])
     ([PushTarget] -> (Notification, [PushTarget]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Notification, [PushTarget]) -> Notification
forall a b. (a, b) -> a
fst ((Notification, [PushTarget]) -> Notification)
-> SchemaP SwaggerDoc Object [Pair] Notification Notification
-> SchemaP
     SwaggerDoc Object [Pair] (Notification, [PushTarget]) Notification
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> SchemaP NamedSwaggerDoc Value Value Notification Notification
-> SchemaP SwaggerDoc Object [Pair] Notification Notification
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"notification" SchemaP NamedSwaggerDoc Value Value Notification Notification
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema
            SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Notification, [PushTarget])
  ([PushTarget] -> (Notification, [PushTarget]))
-> SchemaP
     SwaggerDoc Object [Pair] (Notification, [PushTarget]) [PushTarget]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Notification, [PushTarget])
     (Notification, [PushTarget])
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (Notification, [PushTarget]) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Notification, [PushTarget]) a
-> SchemaP SwaggerDoc Object [Pair] (Notification, [PushTarget]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Notification, [PushTarget]) -> [PushTarget]
forall a b. (a, b) -> b
snd ((Notification, [PushTarget]) -> [PushTarget])
-> SchemaP SwaggerDoc Object [Pair] [PushTarget] [PushTarget]
-> SchemaP
     SwaggerDoc Object [Pair] (Notification, [PushTarget]) [PushTarget]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> SchemaP SwaggerDoc Value Value [PushTarget] [PushTarget]
-> SchemaP SwaggerDoc Object [Pair] [PushTarget] [PushTarget]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"targets" (ValueSchema NamedSwaggerDoc PushTarget
-> SchemaP SwaggerDoc Value Value [PushTarget] [PushTarget]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
S.array ValueSchema NamedSwaggerDoc PushTarget
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema)

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

instance S.ToSchema PushStatus where
  schema :: ValueSchema NamedSwaggerDoc PushStatus
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
S.enum @Text Text
"PushStatus" (SchemaP [Value] Text (Alt Maybe Text) PushStatus PushStatus
 -> ValueSchema NamedSwaggerDoc PushStatus)
-> SchemaP [Value] Text (Alt Maybe Text) PushStatus PushStatus
-> ValueSchema NamedSwaggerDoc PushStatus
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) PushStatus PushStatus]
-> SchemaP [Value] Text (Alt Maybe Text) PushStatus PushStatus
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> PushStatus
-> SchemaP [Value] Text (Alt Maybe Text) PushStatus PushStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
S.element Text
"push_status_ok" PushStatus
PushStatusOk,
          Text
-> PushStatus
-> SchemaP [Value] Text (Alt Maybe Text) PushStatus PushStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
S.element Text
"push_status_gone" PushStatus
PushStatusGone
        ]

newtype BulkPushResponse = BulkPushResponse
  { BulkPushResponse -> [(NotificationId, PushTarget, PushStatus)]
fromBulkPushResponse :: [(NotificationId, PushTarget, PushStatus)]
  }
  deriving
    ( BulkPushResponse -> BulkPushResponse -> Bool
(BulkPushResponse -> BulkPushResponse -> Bool)
-> (BulkPushResponse -> BulkPushResponse -> Bool)
-> Eq BulkPushResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulkPushResponse -> BulkPushResponse -> Bool
== :: BulkPushResponse -> BulkPushResponse -> Bool
$c/= :: BulkPushResponse -> BulkPushResponse -> Bool
/= :: BulkPushResponse -> BulkPushResponse -> Bool
Eq,
      Int -> BulkPushResponse -> ShowS
[BulkPushResponse] -> ShowS
BulkPushResponse -> String
(Int -> BulkPushResponse -> ShowS)
-> (BulkPushResponse -> String)
-> ([BulkPushResponse] -> ShowS)
-> Show BulkPushResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulkPushResponse -> ShowS
showsPrec :: Int -> BulkPushResponse -> ShowS
$cshow :: BulkPushResponse -> String
show :: BulkPushResponse -> String
$cshowList :: [BulkPushResponse] -> ShowS
showList :: [BulkPushResponse] -> ShowS
Show,
      (forall x. BulkPushResponse -> Rep BulkPushResponse x)
-> (forall x. Rep BulkPushResponse x -> BulkPushResponse)
-> Generic BulkPushResponse
forall x. Rep BulkPushResponse x -> BulkPushResponse
forall x. BulkPushResponse -> Rep BulkPushResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BulkPushResponse -> Rep BulkPushResponse x
from :: forall x. BulkPushResponse -> Rep BulkPushResponse x
$cto :: forall x. Rep BulkPushResponse x -> BulkPushResponse
to :: forall x. Rep BulkPushResponse x -> BulkPushResponse
Generic
    )
  deriving (Value -> Parser [BulkPushResponse]
Value -> Parser BulkPushResponse
(Value -> Parser BulkPushResponse)
-> (Value -> Parser [BulkPushResponse])
-> FromJSON BulkPushResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser BulkPushResponse
parseJSON :: Value -> Parser BulkPushResponse
$cparseJSONList :: Value -> Parser [BulkPushResponse]
parseJSONList :: Value -> Parser [BulkPushResponse]
FromJSON, [BulkPushResponse] -> Value
[BulkPushResponse] -> Encoding
BulkPushResponse -> Value
BulkPushResponse -> Encoding
(BulkPushResponse -> Value)
-> (BulkPushResponse -> Encoding)
-> ([BulkPushResponse] -> Value)
-> ([BulkPushResponse] -> Encoding)
-> ToJSON BulkPushResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BulkPushResponse -> Value
toJSON :: BulkPushResponse -> Value
$ctoEncoding :: BulkPushResponse -> Encoding
toEncoding :: BulkPushResponse -> Encoding
$ctoJSONList :: [BulkPushResponse] -> Value
toJSONList :: [BulkPushResponse] -> Value
$ctoEncodingList :: [BulkPushResponse] -> Encoding
toEncodingList :: [BulkPushResponse] -> Encoding
ToJSON, Typeable BulkPushResponse
Typeable BulkPushResponse =>
(Proxy BulkPushResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema BulkPushResponse
Proxy BulkPushResponse -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy BulkPushResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy BulkPushResponse -> Declare (Definitions Schema) NamedSchema
Swagger.ToSchema) via S.Schema BulkPushResponse

instance S.ToSchema BulkPushResponse where
  schema :: ValueSchema NamedSwaggerDoc BulkPushResponse
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] BulkPushResponse BulkPushResponse
-> ValueSchema NamedSwaggerDoc BulkPushResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
S.object Text
"BulkPushResponse" (SchemaP SwaggerDoc Object [Pair] BulkPushResponse BulkPushResponse
 -> ValueSchema NamedSwaggerDoc BulkPushResponse)
-> SchemaP
     SwaggerDoc Object [Pair] BulkPushResponse BulkPushResponse
-> ValueSchema NamedSwaggerDoc BulkPushResponse
forall a b. (a -> b) -> a -> b
$
      [(NotificationId, PushTarget, PushStatus)] -> BulkPushResponse
BulkPushResponse
        ([(NotificationId, PushTarget, PushStatus)] -> BulkPushResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     BulkPushResponse
     [(NotificationId, PushTarget, PushStatus)]
-> SchemaP
     SwaggerDoc Object [Pair] BulkPushResponse BulkPushResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BulkPushResponse -> [(NotificationId, PushTarget, PushStatus)]
fromBulkPushResponse (BulkPushResponse -> [(NotificationId, PushTarget, PushStatus)])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [(NotificationId, PushTarget, PushStatus)]
     [(NotificationId, PushTarget, PushStatus)]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     BulkPushResponse
     [(NotificationId, PushTarget, PushStatus)]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     [(NotificationId, PushTarget, PushStatus)]
     [(NotificationId, PushTarget, PushStatus)]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     [(NotificationId, PushTarget, PushStatus)]
     [(NotificationId, PushTarget, PushStatus)]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"bulkpush_resp" (ValueSchema
  NamedSwaggerDoc (NotificationId, PushTarget, PushStatus)
-> SchemaP
     SwaggerDoc
     Value
     Value
     [(NotificationId, PushTarget, PushStatus)]
     [(NotificationId, PushTarget, PushStatus)]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
S.array ValueSchema
  NamedSwaggerDoc (NotificationId, PushTarget, PushStatus)
bulkPushResponseSchema)
    where
      bulkPushResponseSchema :: ValueSchema S.NamedSwaggerDoc (NotificationId, PushTarget, PushStatus)
      bulkPushResponseSchema :: ValueSchema
  NamedSwaggerDoc (NotificationId, PushTarget, PushStatus)
bulkPushResponseSchema =
        Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     (NotificationId, PushTarget, PushStatus)
-> ValueSchema
     NamedSwaggerDoc (NotificationId, PushTarget, PushStatus)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
S.object Text
"(NotificationId, PushTarget, PushStatus)" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   (NotificationId, PushTarget, PushStatus)
   (NotificationId, PushTarget, PushStatus)
 -> ValueSchema
      NamedSwaggerDoc (NotificationId, PushTarget, PushStatus))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     (NotificationId, PushTarget, PushStatus)
-> ValueSchema
     NamedSwaggerDoc (NotificationId, PushTarget, PushStatus)
forall a b. (a -> b) -> a -> b
$
          (,,)
            (NotificationId
 -> PushTarget
 -> PushStatus
 -> (NotificationId, PushTarget, PushStatus))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     NotificationId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     (PushTarget
      -> PushStatus -> (NotificationId, PushTarget, PushStatus))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  NotificationId
  (NotificationId, PushTarget, PushStatus)
  NotificationId
-> (NotificationId, PushTarget, PushStatus) -> NotificationId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  NotificationId
  (NotificationId, PushTarget, PushStatus)
  NotificationId
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (NotificationId, PushTarget, PushStatus)
  (NotificationId, PushTarget, PushStatus)
  NotificationId
  NotificationId
_1 ((NotificationId, PushTarget, PushStatus) -> NotificationId)
-> SchemaP SwaggerDoc Object [Pair] NotificationId NotificationId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     NotificationId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> SchemaP
     NamedSwaggerDoc Value Value NotificationId NotificationId
-> SchemaP SwaggerDoc Object [Pair] NotificationId NotificationId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"notif_id" SchemaP NamedSwaggerDoc Value Value NotificationId NotificationId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema
            SchemaP
  SwaggerDoc
  Object
  [Pair]
  (NotificationId, PushTarget, PushStatus)
  (PushTarget
   -> PushStatus -> (NotificationId, PushTarget, PushStatus))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     PushTarget
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     (PushStatus -> (NotificationId, PushTarget, PushStatus))
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (NotificationId, PushTarget, PushStatus)
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (NotificationId, PushTarget, PushStatus) a
-> SchemaP
     SwaggerDoc Object [Pair] (NotificationId, PushTarget, PushStatus) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Getting
  PushTarget (NotificationId, PushTarget, PushStatus) PushTarget
-> (NotificationId, PushTarget, PushStatus) -> PushTarget
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  PushTarget (NotificationId, PushTarget, PushStatus) PushTarget
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (NotificationId, PushTarget, PushStatus)
  (NotificationId, PushTarget, PushStatus)
  PushTarget
  PushTarget
_2 ((NotificationId, PushTarget, PushStatus) -> PushTarget)
-> SchemaP SwaggerDoc Object [Pair] PushTarget PushTarget
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     PushTarget
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> ValueSchema NamedSwaggerDoc PushTarget
-> SchemaP SwaggerDoc Object [Pair] PushTarget PushTarget
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"target" ValueSchema NamedSwaggerDoc PushTarget
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema
            SchemaP
  SwaggerDoc
  Object
  [Pair]
  (NotificationId, PushTarget, PushStatus)
  (PushStatus -> (NotificationId, PushTarget, PushStatus))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     PushStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     (NotificationId, PushTarget, PushStatus)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (NotificationId, PushTarget, PushStatus)
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (NotificationId, PushTarget, PushStatus) a
-> SchemaP
     SwaggerDoc Object [Pair] (NotificationId, PushTarget, PushStatus) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Getting
  PushStatus (NotificationId, PushTarget, PushStatus) PushStatus
-> (NotificationId, PushTarget, PushStatus) -> PushStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  PushStatus (NotificationId, PushTarget, PushStatus) PushStatus
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (NotificationId, PushTarget, PushStatus)
  (NotificationId, PushTarget, PushStatus)
  PushStatus
  PushStatus
_3 ((NotificationId, PushTarget, PushStatus) -> PushStatus)
-> SchemaP SwaggerDoc Object [Pair] PushStatus PushStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NotificationId, PushTarget, PushStatus)
     PushStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> ValueSchema NamedSwaggerDoc PushStatus
-> SchemaP SwaggerDoc Object [Pair] PushStatus PushStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"status" ValueSchema NamedSwaggerDoc PushStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema