{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-} {- | = Tracing -} module CDP.Domains.Tracing (module CDP.Domains.Tracing) 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.IO as IO -- | Type 'Tracing.MemoryDumpConfig'. -- Configuration for memory dump. Used only when "memory-infra" category is enabled. type TracingMemoryDumpConfig = [(T.Text, T.Text)] -- | Type 'Tracing.TraceConfig'. data TracingTraceConfigRecordMode = TracingTraceConfigRecordModeRecordUntilFull | TracingTraceConfigRecordModeRecordContinuously | TracingTraceConfigRecordModeRecordAsMuchAsPossible | TracingTraceConfigRecordModeEchoToConsole deriving (Ord, Eq, Show, Read) instance FromJSON TracingTraceConfigRecordMode where parseJSON = A.withText "TracingTraceConfigRecordMode" $ \v -> case v of "recordUntilFull" -> pure TracingTraceConfigRecordModeRecordUntilFull "recordContinuously" -> pure TracingTraceConfigRecordModeRecordContinuously "recordAsMuchAsPossible" -> pure TracingTraceConfigRecordModeRecordAsMuchAsPossible "echoToConsole" -> pure TracingTraceConfigRecordModeEchoToConsole "_" -> fail "failed to parse TracingTraceConfigRecordMode" instance ToJSON TracingTraceConfigRecordMode where toJSON v = A.String $ case v of TracingTraceConfigRecordModeRecordUntilFull -> "recordUntilFull" TracingTraceConfigRecordModeRecordContinuously -> "recordContinuously" TracingTraceConfigRecordModeRecordAsMuchAsPossible -> "recordAsMuchAsPossible" TracingTraceConfigRecordModeEchoToConsole -> "echoToConsole" data TracingTraceConfig = TracingTraceConfig { -- | Controls how the trace buffer stores data. tracingTraceConfigRecordMode :: Maybe TracingTraceConfigRecordMode, -- | Size of the trace buffer in kilobytes. If not specified or zero is passed, a default value -- of 200 MB would be used. tracingTraceConfigTraceBufferSizeInKb :: Maybe Double, -- | Turns on JavaScript stack sampling. tracingTraceConfigEnableSampling :: Maybe Bool, -- | Turns on system tracing. tracingTraceConfigEnableSystrace :: Maybe Bool, -- | Turns on argument filter. tracingTraceConfigEnableArgumentFilter :: Maybe Bool, -- | Included category filters. tracingTraceConfigIncludedCategories :: Maybe [T.Text], -- | Excluded category filters. tracingTraceConfigExcludedCategories :: Maybe [T.Text], -- | Configuration to synthesize the delays in tracing. tracingTraceConfigSyntheticDelays :: Maybe [T.Text], -- | Configuration for memory dump triggers. Used only when "memory-infra" category is enabled. tracingTraceConfigMemoryDumpConfig :: Maybe TracingMemoryDumpConfig } deriving (Eq, Show) instance FromJSON TracingTraceConfig where parseJSON = A.withObject "TracingTraceConfig" $ \o -> TracingTraceConfig <$> o A..:? "recordMode" <*> o A..:? "traceBufferSizeInKb" <*> o A..:? "enableSampling" <*> o A..:? "enableSystrace" <*> o A..:? "enableArgumentFilter" <*> o A..:? "includedCategories" <*> o A..:? "excludedCategories" <*> o A..:? "syntheticDelays" <*> o A..:? "memoryDumpConfig" instance ToJSON TracingTraceConfig where toJSON p = A.object $ catMaybes [ ("recordMode" A..=) <$> (tracingTraceConfigRecordMode p), ("traceBufferSizeInKb" A..=) <$> (tracingTraceConfigTraceBufferSizeInKb p), ("enableSampling" A..=) <$> (tracingTraceConfigEnableSampling p), ("enableSystrace" A..=) <$> (tracingTraceConfigEnableSystrace p), ("enableArgumentFilter" A..=) <$> (tracingTraceConfigEnableArgumentFilter p), ("includedCategories" A..=) <$> (tracingTraceConfigIncludedCategories p), ("excludedCategories" A..=) <$> (tracingTraceConfigExcludedCategories p), ("syntheticDelays" A..=) <$> (tracingTraceConfigSyntheticDelays p), ("memoryDumpConfig" A..=) <$> (tracingTraceConfigMemoryDumpConfig p) ] -- | Type 'Tracing.StreamFormat'. -- Data format of a trace. Can be either the legacy JSON format or the -- protocol buffer format. Note that the JSON format will be deprecated soon. data TracingStreamFormat = TracingStreamFormatJson | TracingStreamFormatProto deriving (Ord, Eq, Show, Read) instance FromJSON TracingStreamFormat where parseJSON = A.withText "TracingStreamFormat" $ \v -> case v of "json" -> pure TracingStreamFormatJson "proto" -> pure TracingStreamFormatProto "_" -> fail "failed to parse TracingStreamFormat" instance ToJSON TracingStreamFormat where toJSON v = A.String $ case v of TracingStreamFormatJson -> "json" TracingStreamFormatProto -> "proto" -- | Type 'Tracing.StreamCompression'. -- Compression type to use for traces returned via streams. data TracingStreamCompression = TracingStreamCompressionNone | TracingStreamCompressionGzip deriving (Ord, Eq, Show, Read) instance FromJSON TracingStreamCompression where parseJSON = A.withText "TracingStreamCompression" $ \v -> case v of "none" -> pure TracingStreamCompressionNone "gzip" -> pure TracingStreamCompressionGzip "_" -> fail "failed to parse TracingStreamCompression" instance ToJSON TracingStreamCompression where toJSON v = A.String $ case v of TracingStreamCompressionNone -> "none" TracingStreamCompressionGzip -> "gzip" -- | Type 'Tracing.MemoryDumpLevelOfDetail'. -- Details exposed when memory request explicitly declared. -- Keep consistent with memory_dump_request_args.h and -- memory_instrumentation.mojom data TracingMemoryDumpLevelOfDetail = TracingMemoryDumpLevelOfDetailBackground | TracingMemoryDumpLevelOfDetailLight | TracingMemoryDumpLevelOfDetailDetailed deriving (Ord, Eq, Show, Read) instance FromJSON TracingMemoryDumpLevelOfDetail where parseJSON = A.withText "TracingMemoryDumpLevelOfDetail" $ \v -> case v of "background" -> pure TracingMemoryDumpLevelOfDetailBackground "light" -> pure TracingMemoryDumpLevelOfDetailLight "detailed" -> pure TracingMemoryDumpLevelOfDetailDetailed "_" -> fail "failed to parse TracingMemoryDumpLevelOfDetail" instance ToJSON TracingMemoryDumpLevelOfDetail where toJSON v = A.String $ case v of TracingMemoryDumpLevelOfDetailBackground -> "background" TracingMemoryDumpLevelOfDetailLight -> "light" TracingMemoryDumpLevelOfDetailDetailed -> "detailed" -- | Type 'Tracing.TracingBackend'. -- Backend type to use for tracing. `chrome` uses the Chrome-integrated -- tracing service and is supported on all platforms. `system` is only -- supported on Chrome OS and uses the Perfetto system tracing service. -- `auto` chooses `system` when the perfettoConfig provided to Tracing.start -- specifies at least one non-Chrome data source; otherwise uses `chrome`. data TracingTracingBackend = TracingTracingBackendAuto | TracingTracingBackendChrome | TracingTracingBackendSystem deriving (Ord, Eq, Show, Read) instance FromJSON TracingTracingBackend where parseJSON = A.withText "TracingTracingBackend" $ \v -> case v of "auto" -> pure TracingTracingBackendAuto "chrome" -> pure TracingTracingBackendChrome "system" -> pure TracingTracingBackendSystem "_" -> fail "failed to parse TracingTracingBackend" instance ToJSON TracingTracingBackend where toJSON v = A.String $ case v of TracingTracingBackendAuto -> "auto" TracingTracingBackendChrome -> "chrome" TracingTracingBackendSystem -> "system" -- | Type of the 'Tracing.bufferUsage' event. data TracingBufferUsage = TracingBufferUsage { -- | A number in range [0..1] that indicates the used size of event buffer as a fraction of its -- total size. tracingBufferUsagePercentFull :: Maybe Double, -- | An approximate number of events in the trace log. tracingBufferUsageEventCount :: Maybe Double, -- | A number in range [0..1] that indicates the used size of event buffer as a fraction of its -- total size. tracingBufferUsageValue :: Maybe Double } deriving (Eq, Show) instance FromJSON TracingBufferUsage where parseJSON = A.withObject "TracingBufferUsage" $ \o -> TracingBufferUsage <$> o A..:? "percentFull" <*> o A..:? "eventCount" <*> o A..:? "value" instance Event TracingBufferUsage where eventName _ = "Tracing.bufferUsage" -- | Type of the 'Tracing.dataCollected' event. data TracingDataCollected = TracingDataCollected { tracingDataCollectedValue :: [[(T.Text, T.Text)]] } deriving (Eq, Show) instance FromJSON TracingDataCollected where parseJSON = A.withObject "TracingDataCollected" $ \o -> TracingDataCollected <$> o A..: "value" instance Event TracingDataCollected where eventName _ = "Tracing.dataCollected" -- | Type of the 'Tracing.tracingComplete' event. data TracingTracingComplete = TracingTracingComplete { -- | Indicates whether some trace data is known to have been lost, e.g. because the trace ring -- buffer wrapped around. tracingTracingCompleteDataLossOccurred :: Bool, -- | A handle of the stream that holds resulting trace data. tracingTracingCompleteStream :: Maybe IO.IOStreamHandle, -- | Trace data format of returned stream. tracingTracingCompleteTraceFormat :: Maybe TracingStreamFormat, -- | Compression format of returned stream. tracingTracingCompleteStreamCompression :: Maybe TracingStreamCompression } deriving (Eq, Show) instance FromJSON TracingTracingComplete where parseJSON = A.withObject "TracingTracingComplete" $ \o -> TracingTracingComplete <$> o A..: "dataLossOccurred" <*> o A..:? "stream" <*> o A..:? "traceFormat" <*> o A..:? "streamCompression" instance Event TracingTracingComplete where eventName _ = "Tracing.tracingComplete" -- | Stop trace events collection. -- | Parameters of the 'Tracing.end' command. data PTracingEnd = PTracingEnd deriving (Eq, Show) pTracingEnd :: PTracingEnd pTracingEnd = PTracingEnd instance ToJSON PTracingEnd where toJSON _ = A.Null instance Command PTracingEnd where type CommandResponse PTracingEnd = () commandName _ = "Tracing.end" fromJSON = const . A.Success . const () -- | Gets supported tracing categories. -- | Parameters of the 'Tracing.getCategories' command. data PTracingGetCategories = PTracingGetCategories deriving (Eq, Show) pTracingGetCategories :: PTracingGetCategories pTracingGetCategories = PTracingGetCategories instance ToJSON PTracingGetCategories where toJSON _ = A.Null data TracingGetCategories = TracingGetCategories { -- | A list of supported tracing categories. tracingGetCategoriesCategories :: [T.Text] } deriving (Eq, Show) instance FromJSON TracingGetCategories where parseJSON = A.withObject "TracingGetCategories" $ \o -> TracingGetCategories <$> o A..: "categories" instance Command PTracingGetCategories where type CommandResponse PTracingGetCategories = TracingGetCategories commandName _ = "Tracing.getCategories" -- | Record a clock sync marker in the trace. -- | Parameters of the 'Tracing.recordClockSyncMarker' command. data PTracingRecordClockSyncMarker = PTracingRecordClockSyncMarker { -- | The ID of this clock sync marker pTracingRecordClockSyncMarkerSyncId :: T.Text } deriving (Eq, Show) pTracingRecordClockSyncMarker {- -- | The ID of this clock sync marker -} :: T.Text -> PTracingRecordClockSyncMarker pTracingRecordClockSyncMarker arg_pTracingRecordClockSyncMarkerSyncId = PTracingRecordClockSyncMarker arg_pTracingRecordClockSyncMarkerSyncId instance ToJSON PTracingRecordClockSyncMarker where toJSON p = A.object $ catMaybes [ ("syncId" A..=) <$> Just (pTracingRecordClockSyncMarkerSyncId p) ] instance Command PTracingRecordClockSyncMarker where type CommandResponse PTracingRecordClockSyncMarker = () commandName _ = "Tracing.recordClockSyncMarker" fromJSON = const . A.Success . const () -- | Request a global memory dump. -- | Parameters of the 'Tracing.requestMemoryDump' command. data PTracingRequestMemoryDump = PTracingRequestMemoryDump { -- | Enables more deterministic results by forcing garbage collection pTracingRequestMemoryDumpDeterministic :: Maybe Bool, -- | Specifies level of details in memory dump. Defaults to "detailed". pTracingRequestMemoryDumpLevelOfDetail :: Maybe TracingMemoryDumpLevelOfDetail } deriving (Eq, Show) pTracingRequestMemoryDump :: PTracingRequestMemoryDump pTracingRequestMemoryDump = PTracingRequestMemoryDump Nothing Nothing instance ToJSON PTracingRequestMemoryDump where toJSON p = A.object $ catMaybes [ ("deterministic" A..=) <$> (pTracingRequestMemoryDumpDeterministic p), ("levelOfDetail" A..=) <$> (pTracingRequestMemoryDumpLevelOfDetail p) ] data TracingRequestMemoryDump = TracingRequestMemoryDump { -- | GUID of the resulting global memory dump. tracingRequestMemoryDumpDumpGuid :: T.Text, -- | True iff the global memory dump succeeded. tracingRequestMemoryDumpSuccess :: Bool } deriving (Eq, Show) instance FromJSON TracingRequestMemoryDump where parseJSON = A.withObject "TracingRequestMemoryDump" $ \o -> TracingRequestMemoryDump <$> o A..: "dumpGuid" <*> o A..: "success" instance Command PTracingRequestMemoryDump where type CommandResponse PTracingRequestMemoryDump = TracingRequestMemoryDump commandName _ = "Tracing.requestMemoryDump" -- | Start trace events collection. -- | Parameters of the 'Tracing.start' command. data PTracingStartTransferMode = PTracingStartTransferModeReportEvents | PTracingStartTransferModeReturnAsStream deriving (Ord, Eq, Show, Read) instance FromJSON PTracingStartTransferMode where parseJSON = A.withText "PTracingStartTransferMode" $ \v -> case v of "ReportEvents" -> pure PTracingStartTransferModeReportEvents "ReturnAsStream" -> pure PTracingStartTransferModeReturnAsStream "_" -> fail "failed to parse PTracingStartTransferMode" instance ToJSON PTracingStartTransferMode where toJSON v = A.String $ case v of PTracingStartTransferModeReportEvents -> "ReportEvents" PTracingStartTransferModeReturnAsStream -> "ReturnAsStream" data PTracingStart = PTracingStart { -- | If set, the agent will issue bufferUsage events at this interval, specified in milliseconds pTracingStartBufferUsageReportingInterval :: Maybe Double, -- | Whether to report trace events as series of dataCollected events or to save trace to a -- stream (defaults to `ReportEvents`). pTracingStartTransferMode :: Maybe PTracingStartTransferMode, -- | Trace data format to use. This only applies when using `ReturnAsStream` -- transfer mode (defaults to `json`). pTracingStartStreamFormat :: Maybe TracingStreamFormat, -- | Compression format to use. This only applies when using `ReturnAsStream` -- transfer mode (defaults to `none`) pTracingStartStreamCompression :: Maybe TracingStreamCompression, pTracingStartTraceConfig :: Maybe TracingTraceConfig, -- | Base64-encoded serialized perfetto.protos.TraceConfig protobuf message -- When specified, the parameters `categories`, `options`, `traceConfig` -- are ignored. (Encoded as a base64 string when passed over JSON) pTracingStartPerfettoConfig :: Maybe T.Text, -- | Backend type (defaults to `auto`) pTracingStartTracingBackend :: Maybe TracingTracingBackend } deriving (Eq, Show) pTracingStart :: PTracingStart pTracingStart = PTracingStart Nothing Nothing Nothing Nothing Nothing Nothing Nothing instance ToJSON PTracingStart where toJSON p = A.object $ catMaybes [ ("bufferUsageReportingInterval" A..=) <$> (pTracingStartBufferUsageReportingInterval p), ("transferMode" A..=) <$> (pTracingStartTransferMode p), ("streamFormat" A..=) <$> (pTracingStartStreamFormat p), ("streamCompression" A..=) <$> (pTracingStartStreamCompression p), ("traceConfig" A..=) <$> (pTracingStartTraceConfig p), ("perfettoConfig" A..=) <$> (pTracingStartPerfettoConfig p), ("tracingBackend" A..=) <$> (pTracingStartTracingBackend p) ] instance Command PTracingStart where type CommandResponse PTracingStart = () commandName _ = "Tracing.start" fromJSON = const . A.Success . const ()