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


{- |
= Tethering

The Tethering domain defines methods and events for browser port binding.
-}


module CDP.Domains.Tethering (module CDP.Domains.Tethering) 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




-- | Type of the 'Tethering.accepted' event.
data TetheringAccepted = TetheringAccepted
  {
    -- | Port number that was successfully bound.
    TetheringAccepted -> Int
tetheringAcceptedPort :: Int,
    -- | Connection id to be used.
    TetheringAccepted -> Text
tetheringAcceptedConnectionId :: T.Text
  }
  deriving (TetheringAccepted -> TetheringAccepted -> Bool
(TetheringAccepted -> TetheringAccepted -> Bool)
-> (TetheringAccepted -> TetheringAccepted -> Bool)
-> Eq TetheringAccepted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TetheringAccepted -> TetheringAccepted -> Bool
$c/= :: TetheringAccepted -> TetheringAccepted -> Bool
== :: TetheringAccepted -> TetheringAccepted -> Bool
$c== :: TetheringAccepted -> TetheringAccepted -> Bool
Eq, Int -> TetheringAccepted -> ShowS
[TetheringAccepted] -> ShowS
TetheringAccepted -> String
(Int -> TetheringAccepted -> ShowS)
-> (TetheringAccepted -> String)
-> ([TetheringAccepted] -> ShowS)
-> Show TetheringAccepted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TetheringAccepted] -> ShowS
$cshowList :: [TetheringAccepted] -> ShowS
show :: TetheringAccepted -> String
$cshow :: TetheringAccepted -> String
showsPrec :: Int -> TetheringAccepted -> ShowS
$cshowsPrec :: Int -> TetheringAccepted -> ShowS
Show)
instance FromJSON TetheringAccepted where
  parseJSON :: Value -> Parser TetheringAccepted
parseJSON = String
-> (Object -> Parser TetheringAccepted)
-> Value
-> Parser TetheringAccepted
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TetheringAccepted" ((Object -> Parser TetheringAccepted)
 -> Value -> Parser TetheringAccepted)
-> (Object -> Parser TetheringAccepted)
-> Value
-> Parser TetheringAccepted
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Text -> TetheringAccepted
TetheringAccepted
    (Int -> Text -> TetheringAccepted)
-> Parser Int -> Parser (Text -> TetheringAccepted)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"port"
    Parser (Text -> TetheringAccepted)
-> Parser Text -> Parser TetheringAccepted
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
"connectionId"
instance Event TetheringAccepted where
  eventName :: Proxy TetheringAccepted -> String
eventName Proxy TetheringAccepted
_ = String
"Tethering.accepted"

-- | Request browser port binding.

-- | Parameters of the 'Tethering.bind' command.
data PTetheringBind = PTetheringBind
  {
    -- | Port number to bind.
    PTetheringBind -> Int
pTetheringBindPort :: Int
  }
  deriving (PTetheringBind -> PTetheringBind -> Bool
(PTetheringBind -> PTetheringBind -> Bool)
-> (PTetheringBind -> PTetheringBind -> Bool) -> Eq PTetheringBind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTetheringBind -> PTetheringBind -> Bool
$c/= :: PTetheringBind -> PTetheringBind -> Bool
== :: PTetheringBind -> PTetheringBind -> Bool
$c== :: PTetheringBind -> PTetheringBind -> Bool
Eq, Int -> PTetheringBind -> ShowS
[PTetheringBind] -> ShowS
PTetheringBind -> String
(Int -> PTetheringBind -> ShowS)
-> (PTetheringBind -> String)
-> ([PTetheringBind] -> ShowS)
-> Show PTetheringBind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTetheringBind] -> ShowS
$cshowList :: [PTetheringBind] -> ShowS
show :: PTetheringBind -> String
$cshow :: PTetheringBind -> String
showsPrec :: Int -> PTetheringBind -> ShowS
$cshowsPrec :: Int -> PTetheringBind -> ShowS
Show)
pTetheringBind
  {-
  -- | Port number to bind.
  -}
  :: Int
  -> PTetheringBind
pTetheringBind :: Int -> PTetheringBind
pTetheringBind
  Int
arg_pTetheringBindPort
  = Int -> PTetheringBind
PTetheringBind
    Int
arg_pTetheringBindPort
instance ToJSON PTetheringBind where
  toJSON :: PTetheringBind -> Value
toJSON PTetheringBind
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
"port" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PTetheringBind -> Int
pTetheringBindPort PTetheringBind
p)
    ]
instance Command PTetheringBind where
  type CommandResponse PTetheringBind = ()
  commandName :: Proxy PTetheringBind -> String
commandName Proxy PTetheringBind
_ = String
"Tethering.bind"
  fromJSON :: Proxy PTetheringBind
-> Value -> Result (CommandResponse PTetheringBind)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTetheringBind -> Result ())
-> Proxy PTetheringBind
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTetheringBind -> ())
-> Proxy PTetheringBind
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTetheringBind -> ()
forall a b. a -> b -> a
const ()

-- | Request browser port unbinding.

-- | Parameters of the 'Tethering.unbind' command.
data PTetheringUnbind = PTetheringUnbind
  {
    -- | Port number to unbind.
    PTetheringUnbind -> Int
pTetheringUnbindPort :: Int
  }
  deriving (PTetheringUnbind -> PTetheringUnbind -> Bool
(PTetheringUnbind -> PTetheringUnbind -> Bool)
-> (PTetheringUnbind -> PTetheringUnbind -> Bool)
-> Eq PTetheringUnbind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PTetheringUnbind -> PTetheringUnbind -> Bool
$c/= :: PTetheringUnbind -> PTetheringUnbind -> Bool
== :: PTetheringUnbind -> PTetheringUnbind -> Bool
$c== :: PTetheringUnbind -> PTetheringUnbind -> Bool
Eq, Int -> PTetheringUnbind -> ShowS
[PTetheringUnbind] -> ShowS
PTetheringUnbind -> String
(Int -> PTetheringUnbind -> ShowS)
-> (PTetheringUnbind -> String)
-> ([PTetheringUnbind] -> ShowS)
-> Show PTetheringUnbind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PTetheringUnbind] -> ShowS
$cshowList :: [PTetheringUnbind] -> ShowS
show :: PTetheringUnbind -> String
$cshow :: PTetheringUnbind -> String
showsPrec :: Int -> PTetheringUnbind -> ShowS
$cshowsPrec :: Int -> PTetheringUnbind -> ShowS
Show)
pTetheringUnbind
  {-
  -- | Port number to unbind.
  -}
  :: Int
  -> PTetheringUnbind
pTetheringUnbind :: Int -> PTetheringUnbind
pTetheringUnbind
  Int
arg_pTetheringUnbindPort
  = Int -> PTetheringUnbind
PTetheringUnbind
    Int
arg_pTetheringUnbindPort
instance ToJSON PTetheringUnbind where
  toJSON :: PTetheringUnbind -> Value
toJSON PTetheringUnbind
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
"port" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (PTetheringUnbind -> Int
pTetheringUnbindPort PTetheringUnbind
p)
    ]
instance Command PTetheringUnbind where
  type CommandResponse PTetheringUnbind = ()
  commandName :: Proxy PTetheringUnbind -> String
commandName Proxy PTetheringUnbind
_ = String
"Tethering.unbind"
  fromJSON :: Proxy PTetheringUnbind
-> Value -> Result (CommandResponse PTetheringUnbind)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PTetheringUnbind -> Result ())
-> Proxy PTetheringUnbind
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PTetheringUnbind -> ())
-> Proxy PTetheringUnbind
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PTetheringUnbind -> ()
forall a b. a -> b -> a
const ()