{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-} {- | = HeadlessExperimental This domain provides experimental commands only supported in headless mode. -} module CDP.Domains.HeadlessExperimental (module CDP.Domains.HeadlessExperimental) 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 'HeadlessExperimental.ScreenshotParams'. -- Encoding options for a screenshot. data HeadlessExperimentalScreenshotParamsFormat = HeadlessExperimentalScreenshotParamsFormatJpeg | HeadlessExperimentalScreenshotParamsFormatPng deriving (Ord, Eq, Show, Read) instance FromJSON HeadlessExperimentalScreenshotParamsFormat where parseJSON = A.withText "HeadlessExperimentalScreenshotParamsFormat" $ \v -> case v of "jpeg" -> pure HeadlessExperimentalScreenshotParamsFormatJpeg "png" -> pure HeadlessExperimentalScreenshotParamsFormatPng "_" -> fail "failed to parse HeadlessExperimentalScreenshotParamsFormat" instance ToJSON HeadlessExperimentalScreenshotParamsFormat where toJSON v = A.String $ case v of HeadlessExperimentalScreenshotParamsFormatJpeg -> "jpeg" HeadlessExperimentalScreenshotParamsFormatPng -> "png" data HeadlessExperimentalScreenshotParams = HeadlessExperimentalScreenshotParams { -- | Image compression format (defaults to png). headlessExperimentalScreenshotParamsFormat :: Maybe HeadlessExperimentalScreenshotParamsFormat, -- | Compression quality from range [0..100] (jpeg only). headlessExperimentalScreenshotParamsQuality :: Maybe Int } deriving (Eq, Show) instance FromJSON HeadlessExperimentalScreenshotParams where parseJSON = A.withObject "HeadlessExperimentalScreenshotParams" $ \o -> HeadlessExperimentalScreenshotParams <$> o A..:? "format" <*> o A..:? "quality" instance ToJSON HeadlessExperimentalScreenshotParams where toJSON p = A.object $ catMaybes [ ("format" A..=) <$> (headlessExperimentalScreenshotParamsFormat p), ("quality" A..=) <$> (headlessExperimentalScreenshotParamsQuality p) ] -- | Sends a BeginFrame to the target and returns when the frame was completed. Optionally captures a -- screenshot from the resulting frame. Requires that the target was created with enabled -- BeginFrameControl. Designed for use with --run-all-compositor-stages-before-draw, see also -- https://goo.gle/chrome-headless-rendering for more background. -- | Parameters of the 'HeadlessExperimental.beginFrame' command. data PHeadlessExperimentalBeginFrame = PHeadlessExperimentalBeginFrame { -- | Timestamp of this BeginFrame in Renderer TimeTicks (milliseconds of uptime). If not set, -- the current time will be used. pHeadlessExperimentalBeginFrameFrameTimeTicks :: Maybe Double, -- | The interval between BeginFrames that is reported to the compositor, in milliseconds. -- Defaults to a 60 frames/second interval, i.e. about 16.666 milliseconds. pHeadlessExperimentalBeginFrameInterval :: Maybe Double, -- | Whether updates should not be committed and drawn onto the display. False by default. If -- true, only side effects of the BeginFrame will be run, such as layout and animations, but -- any visual updates may not be visible on the display or in screenshots. pHeadlessExperimentalBeginFrameNoDisplayUpdates :: Maybe Bool, -- | If set, a screenshot of the frame will be captured and returned in the response. Otherwise, -- no screenshot will be captured. Note that capturing a screenshot can fail, for example, -- during renderer initialization. In such a case, no screenshot data will be returned. pHeadlessExperimentalBeginFrameScreenshot :: Maybe HeadlessExperimentalScreenshotParams } deriving (Eq, Show) pHeadlessExperimentalBeginFrame :: PHeadlessExperimentalBeginFrame pHeadlessExperimentalBeginFrame = PHeadlessExperimentalBeginFrame Nothing Nothing Nothing Nothing instance ToJSON PHeadlessExperimentalBeginFrame where toJSON p = A.object $ catMaybes [ ("frameTimeTicks" A..=) <$> (pHeadlessExperimentalBeginFrameFrameTimeTicks p), ("interval" A..=) <$> (pHeadlessExperimentalBeginFrameInterval p), ("noDisplayUpdates" A..=) <$> (pHeadlessExperimentalBeginFrameNoDisplayUpdates p), ("screenshot" A..=) <$> (pHeadlessExperimentalBeginFrameScreenshot p) ] data HeadlessExperimentalBeginFrame = HeadlessExperimentalBeginFrame { -- | Whether the BeginFrame resulted in damage and, thus, a new frame was committed to the -- display. Reported for diagnostic uses, may be removed in the future. headlessExperimentalBeginFrameHasDamage :: Bool, -- | Base64-encoded image data of the screenshot, if one was requested and successfully taken. (Encoded as a base64 string when passed over JSON) headlessExperimentalBeginFrameScreenshotData :: Maybe T.Text } deriving (Eq, Show) instance FromJSON HeadlessExperimentalBeginFrame where parseJSON = A.withObject "HeadlessExperimentalBeginFrame" $ \o -> HeadlessExperimentalBeginFrame <$> o A..: "hasDamage" <*> o A..:? "screenshotData" instance Command PHeadlessExperimentalBeginFrame where type CommandResponse PHeadlessExperimentalBeginFrame = HeadlessExperimentalBeginFrame commandName _ = "HeadlessExperimental.beginFrame" -- | Disables headless events for the target. -- | Parameters of the 'HeadlessExperimental.disable' command. data PHeadlessExperimentalDisable = PHeadlessExperimentalDisable deriving (Eq, Show) pHeadlessExperimentalDisable :: PHeadlessExperimentalDisable pHeadlessExperimentalDisable = PHeadlessExperimentalDisable instance ToJSON PHeadlessExperimentalDisable where toJSON _ = A.Null instance Command PHeadlessExperimentalDisable where type CommandResponse PHeadlessExperimentalDisable = () commandName _ = "HeadlessExperimental.disable" fromJSON = const . A.Success . const () -- | Enables headless events for the target. -- | Parameters of the 'HeadlessExperimental.enable' command. data PHeadlessExperimentalEnable = PHeadlessExperimentalEnable deriving (Eq, Show) pHeadlessExperimentalEnable :: PHeadlessExperimentalEnable pHeadlessExperimentalEnable = PHeadlessExperimentalEnable instance ToJSON PHeadlessExperimentalEnable where toJSON _ = A.Null instance Command PHeadlessExperimentalEnable where type CommandResponse PHeadlessExperimentalEnable = () commandName _ = "HeadlessExperimental.enable" fromJSON = const . A.Success . const ()