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


{- |
= IO

Input/Output operations for streams produced by DevTools.
-}


module CDP.Domains.IO (module CDP.Domains.IO) 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.Runtime as Runtime


-- | Type 'IO.StreamHandle'.
--   This is either obtained from another method or specified as `blob:&lt;uuid&gt;` where
--   `&lt;uuid&gt` is an UUID of a Blob.
type IOStreamHandle = T.Text

-- | Close the stream, discard any temporary backing storage.

-- | Parameters of the 'IO.close' command.
data PIOClose = PIOClose
  {
    -- | Handle of the stream to close.
    PIOClose -> IOStreamHandle
pIOCloseHandle :: IOStreamHandle
  }
  deriving (PIOClose -> PIOClose -> Bool
(PIOClose -> PIOClose -> Bool)
-> (PIOClose -> PIOClose -> Bool) -> Eq PIOClose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIOClose -> PIOClose -> Bool
$c/= :: PIOClose -> PIOClose -> Bool
== :: PIOClose -> PIOClose -> Bool
$c== :: PIOClose -> PIOClose -> Bool
Eq, Int -> PIOClose -> ShowS
[PIOClose] -> ShowS
PIOClose -> String
(Int -> PIOClose -> ShowS)
-> (PIOClose -> String) -> ([PIOClose] -> ShowS) -> Show PIOClose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIOClose] -> ShowS
$cshowList :: [PIOClose] -> ShowS
show :: PIOClose -> String
$cshow :: PIOClose -> String
showsPrec :: Int -> PIOClose -> ShowS
$cshowsPrec :: Int -> PIOClose -> ShowS
Show)
pIOClose
  {-
  -- | Handle of the stream to close.
  -}
  :: IOStreamHandle
  -> PIOClose
pIOClose :: IOStreamHandle -> PIOClose
pIOClose
  IOStreamHandle
arg_pIOCloseHandle
  = IOStreamHandle -> PIOClose
PIOClose
    IOStreamHandle
arg_pIOCloseHandle
instance ToJSON PIOClose where
  toJSON :: PIOClose -> Value
toJSON PIOClose
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 [
    (IOStreamHandle
"handle" IOStreamHandle -> IOStreamHandle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => IOStreamHandle -> v -> kv
A..=) (IOStreamHandle -> Pair) -> Maybe IOStreamHandle -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOStreamHandle -> Maybe IOStreamHandle
forall a. a -> Maybe a
Just (PIOClose -> IOStreamHandle
pIOCloseHandle PIOClose
p)
    ]
instance Command PIOClose where
  type CommandResponse PIOClose = ()
  commandName :: Proxy PIOClose -> String
commandName Proxy PIOClose
_ = String
"IO.close"
  fromJSON :: Proxy PIOClose -> Value -> Result (CommandResponse PIOClose)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PIOClose -> Result ())
-> Proxy PIOClose
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PIOClose -> ()) -> Proxy PIOClose -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PIOClose -> ()
forall a b. a -> b -> a
const ()

-- | Read a chunk of the stream

-- | Parameters of the 'IO.read' command.
data PIORead = PIORead
  {
    -- | Handle of the stream to read.
    PIORead -> IOStreamHandle
pIOReadHandle :: IOStreamHandle,
    -- | Seek to the specified offset before reading (if not specificed, proceed with offset
    --   following the last read). Some types of streams may only support sequential reads.
    PIORead -> Maybe Int
pIOReadOffset :: Maybe Int,
    -- | Maximum number of bytes to read (left upon the agent discretion if not specified).
    PIORead -> Maybe Int
pIOReadSize :: Maybe Int
  }
  deriving (PIORead -> PIORead -> Bool
(PIORead -> PIORead -> Bool)
-> (PIORead -> PIORead -> Bool) -> Eq PIORead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIORead -> PIORead -> Bool
$c/= :: PIORead -> PIORead -> Bool
== :: PIORead -> PIORead -> Bool
$c== :: PIORead -> PIORead -> Bool
Eq, Int -> PIORead -> ShowS
[PIORead] -> ShowS
PIORead -> String
(Int -> PIORead -> ShowS)
-> (PIORead -> String) -> ([PIORead] -> ShowS) -> Show PIORead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIORead] -> ShowS
$cshowList :: [PIORead] -> ShowS
show :: PIORead -> String
$cshow :: PIORead -> String
showsPrec :: Int -> PIORead -> ShowS
$cshowsPrec :: Int -> PIORead -> ShowS
Show)
pIORead
  {-
  -- | Handle of the stream to read.
  -}
  :: IOStreamHandle
  -> PIORead
pIORead :: IOStreamHandle -> PIORead
pIORead
  IOStreamHandle
arg_pIOReadHandle
  = IOStreamHandle -> Maybe Int -> Maybe Int -> PIORead
PIORead
    IOStreamHandle
arg_pIOReadHandle
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Int
forall a. Maybe a
Nothing
instance ToJSON PIORead where
  toJSON :: PIORead -> Value
toJSON PIORead
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 [
    (IOStreamHandle
"handle" IOStreamHandle -> IOStreamHandle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => IOStreamHandle -> v -> kv
A..=) (IOStreamHandle -> Pair) -> Maybe IOStreamHandle -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOStreamHandle -> Maybe IOStreamHandle
forall a. a -> Maybe a
Just (PIORead -> IOStreamHandle
pIOReadHandle PIORead
p),
    (IOStreamHandle
"offset" IOStreamHandle -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => IOStreamHandle -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIORead -> Maybe Int
pIOReadOffset PIORead
p),
    (IOStreamHandle
"size" IOStreamHandle -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => IOStreamHandle -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIORead -> Maybe Int
pIOReadSize PIORead
p)
    ]
data IORead = IORead
  {
    -- | Set if the data is base64-encoded
    IORead -> Maybe Bool
iOReadBase64Encoded :: Maybe Bool,
    -- | Data that were read.
    IORead -> IOStreamHandle
iOReadData :: T.Text,
    -- | Set if the end-of-file condition occurred while reading.
    IORead -> Bool
iOReadEof :: Bool
  }
  deriving (IORead -> IORead -> Bool
(IORead -> IORead -> Bool)
-> (IORead -> IORead -> Bool) -> Eq IORead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IORead -> IORead -> Bool
$c/= :: IORead -> IORead -> Bool
== :: IORead -> IORead -> Bool
$c== :: IORead -> IORead -> Bool
Eq, Int -> IORead -> ShowS
[IORead] -> ShowS
IORead -> String
(Int -> IORead -> ShowS)
-> (IORead -> String) -> ([IORead] -> ShowS) -> Show IORead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IORead] -> ShowS
$cshowList :: [IORead] -> ShowS
show :: IORead -> String
$cshow :: IORead -> String
showsPrec :: Int -> IORead -> ShowS
$cshowsPrec :: Int -> IORead -> ShowS
Show)
instance FromJSON IORead where
  parseJSON :: Value -> Parser IORead
parseJSON = String -> (Object -> Parser IORead) -> Value -> Parser IORead
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IORead" ((Object -> Parser IORead) -> Value -> Parser IORead)
-> (Object -> Parser IORead) -> Value -> Parser IORead
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Bool -> IOStreamHandle -> Bool -> IORead
IORead
    (Maybe Bool -> IOStreamHandle -> Bool -> IORead)
-> Parser (Maybe Bool) -> Parser (IOStreamHandle -> Bool -> IORead)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> IOStreamHandle -> Parser (Maybe Bool)
forall a.
FromJSON a =>
Object -> IOStreamHandle -> Parser (Maybe a)
A..:? IOStreamHandle
"base64Encoded"
    Parser (IOStreamHandle -> Bool -> IORead)
-> Parser IOStreamHandle -> Parser (Bool -> IORead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> IOStreamHandle -> Parser IOStreamHandle
forall a. FromJSON a => Object -> IOStreamHandle -> Parser a
A..: IOStreamHandle
"data"
    Parser (Bool -> IORead) -> Parser Bool -> Parser IORead
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> IOStreamHandle -> Parser Bool
forall a. FromJSON a => Object -> IOStreamHandle -> Parser a
A..: IOStreamHandle
"eof"
instance Command PIORead where
  type CommandResponse PIORead = IORead
  commandName :: Proxy PIORead -> String
commandName Proxy PIORead
_ = String
"IO.read"

-- | Return UUID of Blob object specified by a remote object id.

-- | Parameters of the 'IO.resolveBlob' command.
data PIOResolveBlob = PIOResolveBlob
  {
    -- | Object id of a Blob object wrapper.
    PIOResolveBlob -> IOStreamHandle
pIOResolveBlobObjectId :: Runtime.RuntimeRemoteObjectId
  }
  deriving (PIOResolveBlob -> PIOResolveBlob -> Bool
(PIOResolveBlob -> PIOResolveBlob -> Bool)
-> (PIOResolveBlob -> PIOResolveBlob -> Bool) -> Eq PIOResolveBlob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PIOResolveBlob -> PIOResolveBlob -> Bool
$c/= :: PIOResolveBlob -> PIOResolveBlob -> Bool
== :: PIOResolveBlob -> PIOResolveBlob -> Bool
$c== :: PIOResolveBlob -> PIOResolveBlob -> Bool
Eq, Int -> PIOResolveBlob -> ShowS
[PIOResolveBlob] -> ShowS
PIOResolveBlob -> String
(Int -> PIOResolveBlob -> ShowS)
-> (PIOResolveBlob -> String)
-> ([PIOResolveBlob] -> ShowS)
-> Show PIOResolveBlob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PIOResolveBlob] -> ShowS
$cshowList :: [PIOResolveBlob] -> ShowS
show :: PIOResolveBlob -> String
$cshow :: PIOResolveBlob -> String
showsPrec :: Int -> PIOResolveBlob -> ShowS
$cshowsPrec :: Int -> PIOResolveBlob -> ShowS
Show)
pIOResolveBlob
  {-
  -- | Object id of a Blob object wrapper.
  -}
  :: Runtime.RuntimeRemoteObjectId
  -> PIOResolveBlob
pIOResolveBlob :: IOStreamHandle -> PIOResolveBlob
pIOResolveBlob
  IOStreamHandle
arg_pIOResolveBlobObjectId
  = IOStreamHandle -> PIOResolveBlob
PIOResolveBlob
    IOStreamHandle
arg_pIOResolveBlobObjectId
instance ToJSON PIOResolveBlob where
  toJSON :: PIOResolveBlob -> Value
toJSON PIOResolveBlob
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 [
    (IOStreamHandle
"objectId" IOStreamHandle -> IOStreamHandle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => IOStreamHandle -> v -> kv
A..=) (IOStreamHandle -> Pair) -> Maybe IOStreamHandle -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOStreamHandle -> Maybe IOStreamHandle
forall a. a -> Maybe a
Just (PIOResolveBlob -> IOStreamHandle
pIOResolveBlobObjectId PIOResolveBlob
p)
    ]
data IOResolveBlob = IOResolveBlob
  {
    -- | UUID of the specified Blob.
    IOResolveBlob -> IOStreamHandle
iOResolveBlobUuid :: T.Text
  }
  deriving (IOResolveBlob -> IOResolveBlob -> Bool
(IOResolveBlob -> IOResolveBlob -> Bool)
-> (IOResolveBlob -> IOResolveBlob -> Bool) -> Eq IOResolveBlob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IOResolveBlob -> IOResolveBlob -> Bool
$c/= :: IOResolveBlob -> IOResolveBlob -> Bool
== :: IOResolveBlob -> IOResolveBlob -> Bool
$c== :: IOResolveBlob -> IOResolveBlob -> Bool
Eq, Int -> IOResolveBlob -> ShowS
[IOResolveBlob] -> ShowS
IOResolveBlob -> String
(Int -> IOResolveBlob -> ShowS)
-> (IOResolveBlob -> String)
-> ([IOResolveBlob] -> ShowS)
-> Show IOResolveBlob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IOResolveBlob] -> ShowS
$cshowList :: [IOResolveBlob] -> ShowS
show :: IOResolveBlob -> String
$cshow :: IOResolveBlob -> String
showsPrec :: Int -> IOResolveBlob -> ShowS
$cshowsPrec :: Int -> IOResolveBlob -> ShowS
Show)
instance FromJSON IOResolveBlob where
  parseJSON :: Value -> Parser IOResolveBlob
parseJSON = String
-> (Object -> Parser IOResolveBlob)
-> Value
-> Parser IOResolveBlob
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"IOResolveBlob" ((Object -> Parser IOResolveBlob) -> Value -> Parser IOResolveBlob)
-> (Object -> Parser IOResolveBlob)
-> Value
-> Parser IOResolveBlob
forall a b. (a -> b) -> a -> b
$ \Object
o -> IOStreamHandle -> IOResolveBlob
IOResolveBlob
    (IOStreamHandle -> IOResolveBlob)
-> Parser IOStreamHandle -> Parser IOResolveBlob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> IOStreamHandle -> Parser IOStreamHandle
forall a. FromJSON a => Object -> IOStreamHandle -> Parser a
A..: IOStreamHandle
"uuid"
instance Command PIOResolveBlob where
  type CommandResponse PIOResolveBlob = IOResolveBlob
  commandName :: Proxy PIOResolveBlob -> String
commandName Proxy PIOResolveBlob
_ = String
"IO.resolveBlob"