{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}


{- |
= BackgroundService

Defines events for background web platform features.
-}


module CDP.Domains.BackgroundService (module CDP.Domains.BackgroundService) where

import           Control.Applicative  ((<$>))
import           Control.Monad
import           Control.Monad.Loops
import           Control.Monad.Trans  (liftIO)
import qualified Data.Map             as M
import           Data.Maybe          
import Data.Functor.Identity
import Data.String
import qualified Data.Text as T
import qualified Data.List as List
import qualified Data.Text.IO         as TI
import qualified Data.Vector          as V
import Data.Aeson.Types (Parser(..))
import           Data.Aeson           (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Aeson           as A
import qualified Network.HTTP.Simple as Http
import qualified Network.URI          as Uri
import qualified Network.WebSockets as WS
import Control.Concurrent
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Data.Proxy
import System.Random
import GHC.Generics
import Data.Char
import Data.Default

import CDP.Internal.Utils


import CDP.Domains.DOMPageNetworkEmulationSecurity as DOMPageNetworkEmulationSecurity
import CDP.Domains.ServiceWorker as ServiceWorker


-- | Type 'BackgroundService.ServiceName'.
--   The Background Service that will be associated with the commands/events.
--   Every Background Service operates independently, but they share the same
--   API.
data BackgroundServiceServiceName = BackgroundServiceServiceNameBackgroundFetch | BackgroundServiceServiceNameBackgroundSync | BackgroundServiceServiceNamePushMessaging | BackgroundServiceServiceNameNotifications | BackgroundServiceServiceNamePaymentHandler | BackgroundServiceServiceNamePeriodicBackgroundSync
  deriving (Eq BackgroundServiceServiceName
Eq BackgroundServiceServiceName
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> Ordering)
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> Bool)
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> Bool)
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> Bool)
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> Bool)
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> BackgroundServiceServiceName)
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> BackgroundServiceServiceName)
-> Ord BackgroundServiceServiceName
BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Ordering
BackgroundServiceServiceName
-> BackgroundServiceServiceName -> BackgroundServiceServiceName
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
min :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> BackgroundServiceServiceName
$cmin :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> BackgroundServiceServiceName
max :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> BackgroundServiceServiceName
$cmax :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> BackgroundServiceServiceName
>= :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
$c>= :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
> :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
$c> :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
<= :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
$c<= :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
< :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
$c< :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
compare :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Ordering
$ccompare :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Ordering
$cp1Ord :: Eq BackgroundServiceServiceName
Ord, BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
(BackgroundServiceServiceName
 -> BackgroundServiceServiceName -> Bool)
-> (BackgroundServiceServiceName
    -> BackgroundServiceServiceName -> Bool)
-> Eq BackgroundServiceServiceName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
$c/= :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
== :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
$c== :: BackgroundServiceServiceName
-> BackgroundServiceServiceName -> Bool
Eq, Int -> BackgroundServiceServiceName -> ShowS
[BackgroundServiceServiceName] -> ShowS
BackgroundServiceServiceName -> String
(Int -> BackgroundServiceServiceName -> ShowS)
-> (BackgroundServiceServiceName -> String)
-> ([BackgroundServiceServiceName] -> ShowS)
-> Show BackgroundServiceServiceName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundServiceServiceName] -> ShowS
$cshowList :: [BackgroundServiceServiceName] -> ShowS
show :: BackgroundServiceServiceName -> String
$cshow :: BackgroundServiceServiceName -> String
showsPrec :: Int -> BackgroundServiceServiceName -> ShowS
$cshowsPrec :: Int -> BackgroundServiceServiceName -> ShowS
Show, ReadPrec [BackgroundServiceServiceName]
ReadPrec BackgroundServiceServiceName
Int -> ReadS BackgroundServiceServiceName
ReadS [BackgroundServiceServiceName]
(Int -> ReadS BackgroundServiceServiceName)
-> ReadS [BackgroundServiceServiceName]
-> ReadPrec BackgroundServiceServiceName
-> ReadPrec [BackgroundServiceServiceName]
-> Read BackgroundServiceServiceName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BackgroundServiceServiceName]
$creadListPrec :: ReadPrec [BackgroundServiceServiceName]
readPrec :: ReadPrec BackgroundServiceServiceName
$creadPrec :: ReadPrec BackgroundServiceServiceName
readList :: ReadS [BackgroundServiceServiceName]
$creadList :: ReadS [BackgroundServiceServiceName]
readsPrec :: Int -> ReadS BackgroundServiceServiceName
$creadsPrec :: Int -> ReadS BackgroundServiceServiceName
Read)
instance FromJSON BackgroundServiceServiceName where
  parseJSON :: Value -> Parser BackgroundServiceServiceName
parseJSON = String
-> (Text -> Parser BackgroundServiceServiceName)
-> Value
-> Parser BackgroundServiceServiceName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BackgroundServiceServiceName" ((Text -> Parser BackgroundServiceServiceName)
 -> Value -> Parser BackgroundServiceServiceName)
-> (Text -> Parser BackgroundServiceServiceName)
-> Value
-> Parser BackgroundServiceServiceName
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"backgroundFetch" -> BackgroundServiceServiceName -> Parser BackgroundServiceServiceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackgroundServiceServiceName
BackgroundServiceServiceNameBackgroundFetch
    Text
"backgroundSync" -> BackgroundServiceServiceName -> Parser BackgroundServiceServiceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackgroundServiceServiceName
BackgroundServiceServiceNameBackgroundSync
    Text
"pushMessaging" -> BackgroundServiceServiceName -> Parser BackgroundServiceServiceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackgroundServiceServiceName
BackgroundServiceServiceNamePushMessaging
    Text
"notifications" -> BackgroundServiceServiceName -> Parser BackgroundServiceServiceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackgroundServiceServiceName
BackgroundServiceServiceNameNotifications
    Text
"paymentHandler" -> BackgroundServiceServiceName -> Parser BackgroundServiceServiceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackgroundServiceServiceName
BackgroundServiceServiceNamePaymentHandler
    Text
"periodicBackgroundSync" -> BackgroundServiceServiceName -> Parser BackgroundServiceServiceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackgroundServiceServiceName
BackgroundServiceServiceNamePeriodicBackgroundSync
    Text
"_" -> String -> Parser BackgroundServiceServiceName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse BackgroundServiceServiceName"
instance ToJSON BackgroundServiceServiceName where
  toJSON :: BackgroundServiceServiceName -> Value
toJSON BackgroundServiceServiceName
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case BackgroundServiceServiceName
v of
    BackgroundServiceServiceName
BackgroundServiceServiceNameBackgroundFetch -> Text
"backgroundFetch"
    BackgroundServiceServiceName
BackgroundServiceServiceNameBackgroundSync -> Text
"backgroundSync"
    BackgroundServiceServiceName
BackgroundServiceServiceNamePushMessaging -> Text
"pushMessaging"
    BackgroundServiceServiceName
BackgroundServiceServiceNameNotifications -> Text
"notifications"
    BackgroundServiceServiceName
BackgroundServiceServiceNamePaymentHandler -> Text
"paymentHandler"
    BackgroundServiceServiceName
BackgroundServiceServiceNamePeriodicBackgroundSync -> Text
"periodicBackgroundSync"

-- | Type 'BackgroundService.EventMetadata'.
--   A key-value pair for additional event information to pass along.
data BackgroundServiceEventMetadata = BackgroundServiceEventMetadata
  {
    BackgroundServiceEventMetadata -> Text
backgroundServiceEventMetadataKey :: T.Text,
    BackgroundServiceEventMetadata -> Text
backgroundServiceEventMetadataValue :: T.Text
  }
  deriving (BackgroundServiceEventMetadata
-> BackgroundServiceEventMetadata -> Bool
(BackgroundServiceEventMetadata
 -> BackgroundServiceEventMetadata -> Bool)
-> (BackgroundServiceEventMetadata
    -> BackgroundServiceEventMetadata -> Bool)
-> Eq BackgroundServiceEventMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundServiceEventMetadata
-> BackgroundServiceEventMetadata -> Bool
$c/= :: BackgroundServiceEventMetadata
-> BackgroundServiceEventMetadata -> Bool
== :: BackgroundServiceEventMetadata
-> BackgroundServiceEventMetadata -> Bool
$c== :: BackgroundServiceEventMetadata
-> BackgroundServiceEventMetadata -> Bool
Eq, Int -> BackgroundServiceEventMetadata -> ShowS
[BackgroundServiceEventMetadata] -> ShowS
BackgroundServiceEventMetadata -> String
(Int -> BackgroundServiceEventMetadata -> ShowS)
-> (BackgroundServiceEventMetadata -> String)
-> ([BackgroundServiceEventMetadata] -> ShowS)
-> Show BackgroundServiceEventMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundServiceEventMetadata] -> ShowS
$cshowList :: [BackgroundServiceEventMetadata] -> ShowS
show :: BackgroundServiceEventMetadata -> String
$cshow :: BackgroundServiceEventMetadata -> String
showsPrec :: Int -> BackgroundServiceEventMetadata -> ShowS
$cshowsPrec :: Int -> BackgroundServiceEventMetadata -> ShowS
Show)
instance FromJSON BackgroundServiceEventMetadata where
  parseJSON :: Value -> Parser BackgroundServiceEventMetadata
parseJSON = String
-> (Object -> Parser BackgroundServiceEventMetadata)
-> Value
-> Parser BackgroundServiceEventMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BackgroundServiceEventMetadata" ((Object -> Parser BackgroundServiceEventMetadata)
 -> Value -> Parser BackgroundServiceEventMetadata)
-> (Object -> Parser BackgroundServiceEventMetadata)
-> Value
-> Parser BackgroundServiceEventMetadata
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> BackgroundServiceEventMetadata
BackgroundServiceEventMetadata
    (Text -> Text -> BackgroundServiceEventMetadata)
-> Parser Text -> Parser (Text -> BackgroundServiceEventMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"key"
    Parser (Text -> BackgroundServiceEventMetadata)
-> Parser Text -> Parser BackgroundServiceEventMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
instance ToJSON BackgroundServiceEventMetadata where
  toJSON :: BackgroundServiceEventMetadata -> Value
toJSON BackgroundServiceEventMetadata
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"key" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (BackgroundServiceEventMetadata -> Text
backgroundServiceEventMetadataKey BackgroundServiceEventMetadata
p),
    (Text
"value" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (BackgroundServiceEventMetadata -> Text
backgroundServiceEventMetadataValue BackgroundServiceEventMetadata
p)
    ]

-- | Type 'BackgroundService.BackgroundServiceEvent'.
data BackgroundServiceBackgroundServiceEvent = BackgroundServiceBackgroundServiceEvent
  {
    -- | Timestamp of the event (in seconds).
    BackgroundServiceBackgroundServiceEvent -> NetworkTimeSinceEpoch
backgroundServiceBackgroundServiceEventTimestamp :: DOMPageNetworkEmulationSecurity.NetworkTimeSinceEpoch,
    -- | The origin this event belongs to.
    BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventOrigin :: T.Text,
    -- | The Service Worker ID that initiated the event.
    BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventServiceWorkerRegistrationId :: ServiceWorker.ServiceWorkerRegistrationID,
    -- | The Background Service this event belongs to.
    BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceServiceName
backgroundServiceBackgroundServiceEventService :: BackgroundServiceServiceName,
    -- | A description of the event.
    BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventEventName :: T.Text,
    -- | An identifier that groups related events together.
    BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventInstanceId :: T.Text,
    -- | A list of event-specific information.
    BackgroundServiceBackgroundServiceEvent
-> [BackgroundServiceEventMetadata]
backgroundServiceBackgroundServiceEventEventMetadata :: [BackgroundServiceEventMetadata]
  }
  deriving (BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceBackgroundServiceEvent -> Bool
(BackgroundServiceBackgroundServiceEvent
 -> BackgroundServiceBackgroundServiceEvent -> Bool)
-> (BackgroundServiceBackgroundServiceEvent
    -> BackgroundServiceBackgroundServiceEvent -> Bool)
-> Eq BackgroundServiceBackgroundServiceEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceBackgroundServiceEvent -> Bool
$c/= :: BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceBackgroundServiceEvent -> Bool
== :: BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceBackgroundServiceEvent -> Bool
$c== :: BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceBackgroundServiceEvent -> Bool
Eq, Int -> BackgroundServiceBackgroundServiceEvent -> ShowS
[BackgroundServiceBackgroundServiceEvent] -> ShowS
BackgroundServiceBackgroundServiceEvent -> String
(Int -> BackgroundServiceBackgroundServiceEvent -> ShowS)
-> (BackgroundServiceBackgroundServiceEvent -> String)
-> ([BackgroundServiceBackgroundServiceEvent] -> ShowS)
-> Show BackgroundServiceBackgroundServiceEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundServiceBackgroundServiceEvent] -> ShowS
$cshowList :: [BackgroundServiceBackgroundServiceEvent] -> ShowS
show :: BackgroundServiceBackgroundServiceEvent -> String
$cshow :: BackgroundServiceBackgroundServiceEvent -> String
showsPrec :: Int -> BackgroundServiceBackgroundServiceEvent -> ShowS
$cshowsPrec :: Int -> BackgroundServiceBackgroundServiceEvent -> ShowS
Show)
instance FromJSON BackgroundServiceBackgroundServiceEvent where
  parseJSON :: Value -> Parser BackgroundServiceBackgroundServiceEvent
parseJSON = String
-> (Object -> Parser BackgroundServiceBackgroundServiceEvent)
-> Value
-> Parser BackgroundServiceBackgroundServiceEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BackgroundServiceBackgroundServiceEvent" ((Object -> Parser BackgroundServiceBackgroundServiceEvent)
 -> Value -> Parser BackgroundServiceBackgroundServiceEvent)
-> (Object -> Parser BackgroundServiceBackgroundServiceEvent)
-> Value
-> Parser BackgroundServiceBackgroundServiceEvent
forall a b. (a -> b) -> a -> b
$ \Object
o -> NetworkTimeSinceEpoch
-> Text
-> Text
-> BackgroundServiceServiceName
-> Text
-> Text
-> [BackgroundServiceEventMetadata]
-> BackgroundServiceBackgroundServiceEvent
BackgroundServiceBackgroundServiceEvent
    (NetworkTimeSinceEpoch
 -> Text
 -> Text
 -> BackgroundServiceServiceName
 -> Text
 -> Text
 -> [BackgroundServiceEventMetadata]
 -> BackgroundServiceBackgroundServiceEvent)
-> Parser NetworkTimeSinceEpoch
-> Parser
     (Text
      -> Text
      -> BackgroundServiceServiceName
      -> Text
      -> Text
      -> [BackgroundServiceEventMetadata]
      -> BackgroundServiceBackgroundServiceEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser NetworkTimeSinceEpoch
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"timestamp"
    Parser
  (Text
   -> Text
   -> BackgroundServiceServiceName
   -> Text
   -> Text
   -> [BackgroundServiceEventMetadata]
   -> BackgroundServiceBackgroundServiceEvent)
-> Parser Text
-> Parser
     (Text
      -> BackgroundServiceServiceName
      -> Text
      -> Text
      -> [BackgroundServiceEventMetadata]
      -> BackgroundServiceBackgroundServiceEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"origin"
    Parser
  (Text
   -> BackgroundServiceServiceName
   -> Text
   -> Text
   -> [BackgroundServiceEventMetadata]
   -> BackgroundServiceBackgroundServiceEvent)
-> Parser Text
-> Parser
     (BackgroundServiceServiceName
      -> Text
      -> Text
      -> [BackgroundServiceEventMetadata]
      -> BackgroundServiceBackgroundServiceEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"serviceWorkerRegistrationId"
    Parser
  (BackgroundServiceServiceName
   -> Text
   -> Text
   -> [BackgroundServiceEventMetadata]
   -> BackgroundServiceBackgroundServiceEvent)
-> Parser BackgroundServiceServiceName
-> Parser
     (Text
      -> Text
      -> [BackgroundServiceEventMetadata]
      -> BackgroundServiceBackgroundServiceEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BackgroundServiceServiceName
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"service"
    Parser
  (Text
   -> Text
   -> [BackgroundServiceEventMetadata]
   -> BackgroundServiceBackgroundServiceEvent)
-> Parser Text
-> Parser
     (Text
      -> [BackgroundServiceEventMetadata]
      -> BackgroundServiceBackgroundServiceEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"eventName"
    Parser
  (Text
   -> [BackgroundServiceEventMetadata]
   -> BackgroundServiceBackgroundServiceEvent)
-> Parser Text
-> Parser
     ([BackgroundServiceEventMetadata]
      -> BackgroundServiceBackgroundServiceEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"instanceId"
    Parser
  ([BackgroundServiceEventMetadata]
   -> BackgroundServiceBackgroundServiceEvent)
-> Parser [BackgroundServiceEventMetadata]
-> Parser BackgroundServiceBackgroundServiceEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [BackgroundServiceEventMetadata]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"eventMetadata"
instance ToJSON BackgroundServiceBackgroundServiceEvent where
  toJSON :: BackgroundServiceBackgroundServiceEvent -> Value
toJSON BackgroundServiceBackgroundServiceEvent
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"timestamp" Text -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkTimeSinceEpoch -> Maybe NetworkTimeSinceEpoch
forall a. a -> Maybe a
Just (BackgroundServiceBackgroundServiceEvent -> NetworkTimeSinceEpoch
backgroundServiceBackgroundServiceEventTimestamp BackgroundServiceBackgroundServiceEvent
p),
    (Text
"origin" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventOrigin BackgroundServiceBackgroundServiceEvent
p),
    (Text
"serviceWorkerRegistrationId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventServiceWorkerRegistrationId BackgroundServiceBackgroundServiceEvent
p),
    (Text
"service" Text -> BackgroundServiceServiceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BackgroundServiceServiceName -> Pair)
-> Maybe BackgroundServiceServiceName -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackgroundServiceServiceName -> Maybe BackgroundServiceServiceName
forall a. a -> Maybe a
Just (BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceServiceName
backgroundServiceBackgroundServiceEventService BackgroundServiceBackgroundServiceEvent
p),
    (Text
"eventName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventEventName BackgroundServiceBackgroundServiceEvent
p),
    (Text
"instanceId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (BackgroundServiceBackgroundServiceEvent -> Text
backgroundServiceBackgroundServiceEventInstanceId BackgroundServiceBackgroundServiceEvent
p),
    (Text
"eventMetadata" Text -> [BackgroundServiceEventMetadata] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([BackgroundServiceEventMetadata] -> Pair)
-> Maybe [BackgroundServiceEventMetadata] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BackgroundServiceEventMetadata]
-> Maybe [BackgroundServiceEventMetadata]
forall a. a -> Maybe a
Just (BackgroundServiceBackgroundServiceEvent
-> [BackgroundServiceEventMetadata]
backgroundServiceBackgroundServiceEventEventMetadata BackgroundServiceBackgroundServiceEvent
p)
    ]

-- | Type of the 'BackgroundService.recordingStateChanged' event.
data BackgroundServiceRecordingStateChanged = BackgroundServiceRecordingStateChanged
  {
    BackgroundServiceRecordingStateChanged -> Bool
backgroundServiceRecordingStateChangedIsRecording :: Bool,
    BackgroundServiceRecordingStateChanged
-> BackgroundServiceServiceName
backgroundServiceRecordingStateChangedService :: BackgroundServiceServiceName
  }
  deriving (BackgroundServiceRecordingStateChanged
-> BackgroundServiceRecordingStateChanged -> Bool
(BackgroundServiceRecordingStateChanged
 -> BackgroundServiceRecordingStateChanged -> Bool)
-> (BackgroundServiceRecordingStateChanged
    -> BackgroundServiceRecordingStateChanged -> Bool)
-> Eq BackgroundServiceRecordingStateChanged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundServiceRecordingStateChanged
-> BackgroundServiceRecordingStateChanged -> Bool
$c/= :: BackgroundServiceRecordingStateChanged
-> BackgroundServiceRecordingStateChanged -> Bool
== :: BackgroundServiceRecordingStateChanged
-> BackgroundServiceRecordingStateChanged -> Bool
$c== :: BackgroundServiceRecordingStateChanged
-> BackgroundServiceRecordingStateChanged -> Bool
Eq, Int -> BackgroundServiceRecordingStateChanged -> ShowS
[BackgroundServiceRecordingStateChanged] -> ShowS
BackgroundServiceRecordingStateChanged -> String
(Int -> BackgroundServiceRecordingStateChanged -> ShowS)
-> (BackgroundServiceRecordingStateChanged -> String)
-> ([BackgroundServiceRecordingStateChanged] -> ShowS)
-> Show BackgroundServiceRecordingStateChanged
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundServiceRecordingStateChanged] -> ShowS
$cshowList :: [BackgroundServiceRecordingStateChanged] -> ShowS
show :: BackgroundServiceRecordingStateChanged -> String
$cshow :: BackgroundServiceRecordingStateChanged -> String
showsPrec :: Int -> BackgroundServiceRecordingStateChanged -> ShowS
$cshowsPrec :: Int -> BackgroundServiceRecordingStateChanged -> ShowS
Show)
instance FromJSON BackgroundServiceRecordingStateChanged where
  parseJSON :: Value -> Parser BackgroundServiceRecordingStateChanged
parseJSON = String
-> (Object -> Parser BackgroundServiceRecordingStateChanged)
-> Value
-> Parser BackgroundServiceRecordingStateChanged
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BackgroundServiceRecordingStateChanged" ((Object -> Parser BackgroundServiceRecordingStateChanged)
 -> Value -> Parser BackgroundServiceRecordingStateChanged)
-> (Object -> Parser BackgroundServiceRecordingStateChanged)
-> Value
-> Parser BackgroundServiceRecordingStateChanged
forall a b. (a -> b) -> a -> b
$ \Object
o -> Bool
-> BackgroundServiceServiceName
-> BackgroundServiceRecordingStateChanged
BackgroundServiceRecordingStateChanged
    (Bool
 -> BackgroundServiceServiceName
 -> BackgroundServiceRecordingStateChanged)
-> Parser Bool
-> Parser
     (BackgroundServiceServiceName
      -> BackgroundServiceRecordingStateChanged)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"isRecording"
    Parser
  (BackgroundServiceServiceName
   -> BackgroundServiceRecordingStateChanged)
-> Parser BackgroundServiceServiceName
-> Parser BackgroundServiceRecordingStateChanged
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BackgroundServiceServiceName
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"service"
instance Event BackgroundServiceRecordingStateChanged where
  eventName :: Proxy BackgroundServiceRecordingStateChanged -> String
eventName Proxy BackgroundServiceRecordingStateChanged
_ = String
"BackgroundService.recordingStateChanged"

-- | Type of the 'BackgroundService.backgroundServiceEventReceived' event.
data BackgroundServiceBackgroundServiceEventReceived = BackgroundServiceBackgroundServiceEventReceived
  {
    BackgroundServiceBackgroundServiceEventReceived
-> BackgroundServiceBackgroundServiceEvent
backgroundServiceBackgroundServiceEventReceivedBackgroundServiceEvent :: BackgroundServiceBackgroundServiceEvent
  }
  deriving (BackgroundServiceBackgroundServiceEventReceived
-> BackgroundServiceBackgroundServiceEventReceived -> Bool
(BackgroundServiceBackgroundServiceEventReceived
 -> BackgroundServiceBackgroundServiceEventReceived -> Bool)
-> (BackgroundServiceBackgroundServiceEventReceived
    -> BackgroundServiceBackgroundServiceEventReceived -> Bool)
-> Eq BackgroundServiceBackgroundServiceEventReceived
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundServiceBackgroundServiceEventReceived
-> BackgroundServiceBackgroundServiceEventReceived -> Bool
$c/= :: BackgroundServiceBackgroundServiceEventReceived
-> BackgroundServiceBackgroundServiceEventReceived -> Bool
== :: BackgroundServiceBackgroundServiceEventReceived
-> BackgroundServiceBackgroundServiceEventReceived -> Bool
$c== :: BackgroundServiceBackgroundServiceEventReceived
-> BackgroundServiceBackgroundServiceEventReceived -> Bool
Eq, Int -> BackgroundServiceBackgroundServiceEventReceived -> ShowS
[BackgroundServiceBackgroundServiceEventReceived] -> ShowS
BackgroundServiceBackgroundServiceEventReceived -> String
(Int -> BackgroundServiceBackgroundServiceEventReceived -> ShowS)
-> (BackgroundServiceBackgroundServiceEventReceived -> String)
-> ([BackgroundServiceBackgroundServiceEventReceived] -> ShowS)
-> Show BackgroundServiceBackgroundServiceEventReceived
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundServiceBackgroundServiceEventReceived] -> ShowS
$cshowList :: [BackgroundServiceBackgroundServiceEventReceived] -> ShowS
show :: BackgroundServiceBackgroundServiceEventReceived -> String
$cshow :: BackgroundServiceBackgroundServiceEventReceived -> String
showsPrec :: Int -> BackgroundServiceBackgroundServiceEventReceived -> ShowS
$cshowsPrec :: Int -> BackgroundServiceBackgroundServiceEventReceived -> ShowS
Show)
instance FromJSON BackgroundServiceBackgroundServiceEventReceived where
  parseJSON :: Value -> Parser BackgroundServiceBackgroundServiceEventReceived
parseJSON = String
-> (Object
    -> Parser BackgroundServiceBackgroundServiceEventReceived)
-> Value
-> Parser BackgroundServiceBackgroundServiceEventReceived
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BackgroundServiceBackgroundServiceEventReceived" ((Object -> Parser BackgroundServiceBackgroundServiceEventReceived)
 -> Value -> Parser BackgroundServiceBackgroundServiceEventReceived)
-> (Object
    -> Parser BackgroundServiceBackgroundServiceEventReceived)
-> Value
-> Parser BackgroundServiceBackgroundServiceEventReceived
forall a b. (a -> b) -> a -> b
$ \Object
o -> BackgroundServiceBackgroundServiceEvent
-> BackgroundServiceBackgroundServiceEventReceived
BackgroundServiceBackgroundServiceEventReceived
    (BackgroundServiceBackgroundServiceEvent
 -> BackgroundServiceBackgroundServiceEventReceived)
-> Parser BackgroundServiceBackgroundServiceEvent
-> Parser BackgroundServiceBackgroundServiceEventReceived
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser BackgroundServiceBackgroundServiceEvent
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"backgroundServiceEvent"
instance Event BackgroundServiceBackgroundServiceEventReceived where
  eventName :: Proxy BackgroundServiceBackgroundServiceEventReceived -> String
eventName Proxy BackgroundServiceBackgroundServiceEventReceived
_ = String
"BackgroundService.backgroundServiceEventReceived"

-- | Enables event updates for the service.

-- | Parameters of the 'BackgroundService.startObserving' command.
data PBackgroundServiceStartObserving = PBackgroundServiceStartObserving
  {
    PBackgroundServiceStartObserving -> BackgroundServiceServiceName
pBackgroundServiceStartObservingService :: BackgroundServiceServiceName
  }
  deriving (PBackgroundServiceStartObserving
-> PBackgroundServiceStartObserving -> Bool
(PBackgroundServiceStartObserving
 -> PBackgroundServiceStartObserving -> Bool)
-> (PBackgroundServiceStartObserving
    -> PBackgroundServiceStartObserving -> Bool)
-> Eq PBackgroundServiceStartObserving
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBackgroundServiceStartObserving
-> PBackgroundServiceStartObserving -> Bool
$c/= :: PBackgroundServiceStartObserving
-> PBackgroundServiceStartObserving -> Bool
== :: PBackgroundServiceStartObserving
-> PBackgroundServiceStartObserving -> Bool
$c== :: PBackgroundServiceStartObserving
-> PBackgroundServiceStartObserving -> Bool
Eq, Int -> PBackgroundServiceStartObserving -> ShowS
[PBackgroundServiceStartObserving] -> ShowS
PBackgroundServiceStartObserving -> String
(Int -> PBackgroundServiceStartObserving -> ShowS)
-> (PBackgroundServiceStartObserving -> String)
-> ([PBackgroundServiceStartObserving] -> ShowS)
-> Show PBackgroundServiceStartObserving
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBackgroundServiceStartObserving] -> ShowS
$cshowList :: [PBackgroundServiceStartObserving] -> ShowS
show :: PBackgroundServiceStartObserving -> String
$cshow :: PBackgroundServiceStartObserving -> String
showsPrec :: Int -> PBackgroundServiceStartObserving -> ShowS
$cshowsPrec :: Int -> PBackgroundServiceStartObserving -> ShowS
Show)
pBackgroundServiceStartObserving
  :: BackgroundServiceServiceName
  -> PBackgroundServiceStartObserving
pBackgroundServiceStartObserving :: BackgroundServiceServiceName -> PBackgroundServiceStartObserving
pBackgroundServiceStartObserving
  BackgroundServiceServiceName
arg_pBackgroundServiceStartObservingService
  = BackgroundServiceServiceName -> PBackgroundServiceStartObserving
PBackgroundServiceStartObserving
    BackgroundServiceServiceName
arg_pBackgroundServiceStartObservingService
instance ToJSON PBackgroundServiceStartObserving where
  toJSON :: PBackgroundServiceStartObserving -> Value
toJSON PBackgroundServiceStartObserving
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"service" Text -> BackgroundServiceServiceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BackgroundServiceServiceName -> Pair)
-> Maybe BackgroundServiceServiceName -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackgroundServiceServiceName -> Maybe BackgroundServiceServiceName
forall a. a -> Maybe a
Just (PBackgroundServiceStartObserving -> BackgroundServiceServiceName
pBackgroundServiceStartObservingService PBackgroundServiceStartObserving
p)
    ]
instance Command PBackgroundServiceStartObserving where
  type CommandResponse PBackgroundServiceStartObserving = ()
  commandName :: Proxy PBackgroundServiceStartObserving -> String
commandName Proxy PBackgroundServiceStartObserving
_ = String
"BackgroundService.startObserving"
  fromJSON :: Proxy PBackgroundServiceStartObserving
-> Value
-> Result (CommandResponse PBackgroundServiceStartObserving)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBackgroundServiceStartObserving -> Result ())
-> Proxy PBackgroundServiceStartObserving
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBackgroundServiceStartObserving -> ())
-> Proxy PBackgroundServiceStartObserving
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBackgroundServiceStartObserving -> ()
forall a b. a -> b -> a
const ()

-- | Disables event updates for the service.

-- | Parameters of the 'BackgroundService.stopObserving' command.
data PBackgroundServiceStopObserving = PBackgroundServiceStopObserving
  {
    PBackgroundServiceStopObserving -> BackgroundServiceServiceName
pBackgroundServiceStopObservingService :: BackgroundServiceServiceName
  }
  deriving (PBackgroundServiceStopObserving
-> PBackgroundServiceStopObserving -> Bool
(PBackgroundServiceStopObserving
 -> PBackgroundServiceStopObserving -> Bool)
-> (PBackgroundServiceStopObserving
    -> PBackgroundServiceStopObserving -> Bool)
-> Eq PBackgroundServiceStopObserving
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBackgroundServiceStopObserving
-> PBackgroundServiceStopObserving -> Bool
$c/= :: PBackgroundServiceStopObserving
-> PBackgroundServiceStopObserving -> Bool
== :: PBackgroundServiceStopObserving
-> PBackgroundServiceStopObserving -> Bool
$c== :: PBackgroundServiceStopObserving
-> PBackgroundServiceStopObserving -> Bool
Eq, Int -> PBackgroundServiceStopObserving -> ShowS
[PBackgroundServiceStopObserving] -> ShowS
PBackgroundServiceStopObserving -> String
(Int -> PBackgroundServiceStopObserving -> ShowS)
-> (PBackgroundServiceStopObserving -> String)
-> ([PBackgroundServiceStopObserving] -> ShowS)
-> Show PBackgroundServiceStopObserving
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBackgroundServiceStopObserving] -> ShowS
$cshowList :: [PBackgroundServiceStopObserving] -> ShowS
show :: PBackgroundServiceStopObserving -> String
$cshow :: PBackgroundServiceStopObserving -> String
showsPrec :: Int -> PBackgroundServiceStopObserving -> ShowS
$cshowsPrec :: Int -> PBackgroundServiceStopObserving -> ShowS
Show)
pBackgroundServiceStopObserving
  :: BackgroundServiceServiceName
  -> PBackgroundServiceStopObserving
pBackgroundServiceStopObserving :: BackgroundServiceServiceName -> PBackgroundServiceStopObserving
pBackgroundServiceStopObserving
  BackgroundServiceServiceName
arg_pBackgroundServiceStopObservingService
  = BackgroundServiceServiceName -> PBackgroundServiceStopObserving
PBackgroundServiceStopObserving
    BackgroundServiceServiceName
arg_pBackgroundServiceStopObservingService
instance ToJSON PBackgroundServiceStopObserving where
  toJSON :: PBackgroundServiceStopObserving -> Value
toJSON PBackgroundServiceStopObserving
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"service" Text -> BackgroundServiceServiceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BackgroundServiceServiceName -> Pair)
-> Maybe BackgroundServiceServiceName -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackgroundServiceServiceName -> Maybe BackgroundServiceServiceName
forall a. a -> Maybe a
Just (PBackgroundServiceStopObserving -> BackgroundServiceServiceName
pBackgroundServiceStopObservingService PBackgroundServiceStopObserving
p)
    ]
instance Command PBackgroundServiceStopObserving where
  type CommandResponse PBackgroundServiceStopObserving = ()
  commandName :: Proxy PBackgroundServiceStopObserving -> String
commandName Proxy PBackgroundServiceStopObserving
_ = String
"BackgroundService.stopObserving"
  fromJSON :: Proxy PBackgroundServiceStopObserving
-> Value
-> Result (CommandResponse PBackgroundServiceStopObserving)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBackgroundServiceStopObserving -> Result ())
-> Proxy PBackgroundServiceStopObserving
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBackgroundServiceStopObserving -> ())
-> Proxy PBackgroundServiceStopObserving
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBackgroundServiceStopObserving -> ()
forall a b. a -> b -> a
const ()

-- | Set the recording state for the service.

-- | Parameters of the 'BackgroundService.setRecording' command.
data PBackgroundServiceSetRecording = PBackgroundServiceSetRecording
  {
    PBackgroundServiceSetRecording -> Bool
pBackgroundServiceSetRecordingShouldRecord :: Bool,
    PBackgroundServiceSetRecording -> BackgroundServiceServiceName
pBackgroundServiceSetRecordingService :: BackgroundServiceServiceName
  }
  deriving (PBackgroundServiceSetRecording
-> PBackgroundServiceSetRecording -> Bool
(PBackgroundServiceSetRecording
 -> PBackgroundServiceSetRecording -> Bool)
-> (PBackgroundServiceSetRecording
    -> PBackgroundServiceSetRecording -> Bool)
-> Eq PBackgroundServiceSetRecording
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBackgroundServiceSetRecording
-> PBackgroundServiceSetRecording -> Bool
$c/= :: PBackgroundServiceSetRecording
-> PBackgroundServiceSetRecording -> Bool
== :: PBackgroundServiceSetRecording
-> PBackgroundServiceSetRecording -> Bool
$c== :: PBackgroundServiceSetRecording
-> PBackgroundServiceSetRecording -> Bool
Eq, Int -> PBackgroundServiceSetRecording -> ShowS
[PBackgroundServiceSetRecording] -> ShowS
PBackgroundServiceSetRecording -> String
(Int -> PBackgroundServiceSetRecording -> ShowS)
-> (PBackgroundServiceSetRecording -> String)
-> ([PBackgroundServiceSetRecording] -> ShowS)
-> Show PBackgroundServiceSetRecording
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBackgroundServiceSetRecording] -> ShowS
$cshowList :: [PBackgroundServiceSetRecording] -> ShowS
show :: PBackgroundServiceSetRecording -> String
$cshow :: PBackgroundServiceSetRecording -> String
showsPrec :: Int -> PBackgroundServiceSetRecording -> ShowS
$cshowsPrec :: Int -> PBackgroundServiceSetRecording -> ShowS
Show)
pBackgroundServiceSetRecording
  :: Bool
  -> BackgroundServiceServiceName
  -> PBackgroundServiceSetRecording
pBackgroundServiceSetRecording :: Bool
-> BackgroundServiceServiceName -> PBackgroundServiceSetRecording
pBackgroundServiceSetRecording
  Bool
arg_pBackgroundServiceSetRecordingShouldRecord
  BackgroundServiceServiceName
arg_pBackgroundServiceSetRecordingService
  = Bool
-> BackgroundServiceServiceName -> PBackgroundServiceSetRecording
PBackgroundServiceSetRecording
    Bool
arg_pBackgroundServiceSetRecordingShouldRecord
    BackgroundServiceServiceName
arg_pBackgroundServiceSetRecordingService
instance ToJSON PBackgroundServiceSetRecording where
  toJSON :: PBackgroundServiceSetRecording -> Value
toJSON PBackgroundServiceSetRecording
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"shouldRecord" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PBackgroundServiceSetRecording -> Bool
pBackgroundServiceSetRecordingShouldRecord PBackgroundServiceSetRecording
p),
    (Text
"service" Text -> BackgroundServiceServiceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BackgroundServiceServiceName -> Pair)
-> Maybe BackgroundServiceServiceName -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackgroundServiceServiceName -> Maybe BackgroundServiceServiceName
forall a. a -> Maybe a
Just (PBackgroundServiceSetRecording -> BackgroundServiceServiceName
pBackgroundServiceSetRecordingService PBackgroundServiceSetRecording
p)
    ]
instance Command PBackgroundServiceSetRecording where
  type CommandResponse PBackgroundServiceSetRecording = ()
  commandName :: Proxy PBackgroundServiceSetRecording -> String
commandName Proxy PBackgroundServiceSetRecording
_ = String
"BackgroundService.setRecording"
  fromJSON :: Proxy PBackgroundServiceSetRecording
-> Value -> Result (CommandResponse PBackgroundServiceSetRecording)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBackgroundServiceSetRecording -> Result ())
-> Proxy PBackgroundServiceSetRecording
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBackgroundServiceSetRecording -> ())
-> Proxy PBackgroundServiceSetRecording
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBackgroundServiceSetRecording -> ()
forall a b. a -> b -> a
const ()

-- | Clears all stored data for the service.

-- | Parameters of the 'BackgroundService.clearEvents' command.
data PBackgroundServiceClearEvents = PBackgroundServiceClearEvents
  {
    PBackgroundServiceClearEvents -> BackgroundServiceServiceName
pBackgroundServiceClearEventsService :: BackgroundServiceServiceName
  }
  deriving (PBackgroundServiceClearEvents
-> PBackgroundServiceClearEvents -> Bool
(PBackgroundServiceClearEvents
 -> PBackgroundServiceClearEvents -> Bool)
-> (PBackgroundServiceClearEvents
    -> PBackgroundServiceClearEvents -> Bool)
-> Eq PBackgroundServiceClearEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBackgroundServiceClearEvents
-> PBackgroundServiceClearEvents -> Bool
$c/= :: PBackgroundServiceClearEvents
-> PBackgroundServiceClearEvents -> Bool
== :: PBackgroundServiceClearEvents
-> PBackgroundServiceClearEvents -> Bool
$c== :: PBackgroundServiceClearEvents
-> PBackgroundServiceClearEvents -> Bool
Eq, Int -> PBackgroundServiceClearEvents -> ShowS
[PBackgroundServiceClearEvents] -> ShowS
PBackgroundServiceClearEvents -> String
(Int -> PBackgroundServiceClearEvents -> ShowS)
-> (PBackgroundServiceClearEvents -> String)
-> ([PBackgroundServiceClearEvents] -> ShowS)
-> Show PBackgroundServiceClearEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBackgroundServiceClearEvents] -> ShowS
$cshowList :: [PBackgroundServiceClearEvents] -> ShowS
show :: PBackgroundServiceClearEvents -> String
$cshow :: PBackgroundServiceClearEvents -> String
showsPrec :: Int -> PBackgroundServiceClearEvents -> ShowS
$cshowsPrec :: Int -> PBackgroundServiceClearEvents -> ShowS
Show)
pBackgroundServiceClearEvents
  :: BackgroundServiceServiceName
  -> PBackgroundServiceClearEvents
pBackgroundServiceClearEvents :: BackgroundServiceServiceName -> PBackgroundServiceClearEvents
pBackgroundServiceClearEvents
  BackgroundServiceServiceName
arg_pBackgroundServiceClearEventsService
  = BackgroundServiceServiceName -> PBackgroundServiceClearEvents
PBackgroundServiceClearEvents
    BackgroundServiceServiceName
arg_pBackgroundServiceClearEventsService
instance ToJSON PBackgroundServiceClearEvents where
  toJSON :: PBackgroundServiceClearEvents -> Value
toJSON PBackgroundServiceClearEvents
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"service" Text -> BackgroundServiceServiceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (BackgroundServiceServiceName -> Pair)
-> Maybe BackgroundServiceServiceName -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackgroundServiceServiceName -> Maybe BackgroundServiceServiceName
forall a. a -> Maybe a
Just (PBackgroundServiceClearEvents -> BackgroundServiceServiceName
pBackgroundServiceClearEventsService PBackgroundServiceClearEvents
p)
    ]
instance Command PBackgroundServiceClearEvents where
  type CommandResponse PBackgroundServiceClearEvents = ()
  commandName :: Proxy PBackgroundServiceClearEvents -> String
commandName Proxy PBackgroundServiceClearEvents
_ = String
"BackgroundService.clearEvents"
  fromJSON :: Proxy PBackgroundServiceClearEvents
-> Value -> Result (CommandResponse PBackgroundServiceClearEvents)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PBackgroundServiceClearEvents -> Result ())
-> Proxy PBackgroundServiceClearEvents
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PBackgroundServiceClearEvents -> ())
-> Proxy PBackgroundServiceClearEvents
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PBackgroundServiceClearEvents -> ()
forall a b. a -> b -> a
const ()