{-# LANGUAGE  CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  OpenTelemetry.Resource.Process
-- Copyright   :  (c) Ian Duncan, 2021
-- License     :  BSD-3
-- Description :  Standard resources and detectors for system processes
-- Maintainer  :  Ian Duncan
-- Stability   :  experimental
-- Portability :  non-portable (GHC extensions)
--
-----------------------------------------------------------------------------
module OpenTelemetry.Resource.Process where
import Data.Text (Text)
import OpenTelemetry.Resource

-- |  An operating system process.
data Process = Process
  { Process -> Maybe Int
processPid :: Maybe Int
  -- ^ Process identifier (PID).
  --
  -- Example: @1234@
  , Process -> Maybe Text
processExecutableName :: Maybe Text
  -- ^ The name of the process executable. On Linux based systems, can be set to the @Name@ in @proc/[pid]/status@. On Windows, can be set to the base name of @GetProcessImageFileNameW@.
  --
  -- Example: @otelcol@
  , Process -> Maybe Text
processExecutablePath :: Maybe Text
  -- ^ The full path to the process executable. On Linux based systems, can be set to the target of @proc/[pid]/exe@. On Windows, can be set to the result of @GetProcessImageFileNameW@.
  --
  -- Example: @/usr/bin/cmd/otelcol@
  , Process -> Maybe Text
processCommand :: Maybe Text
  -- ^ The command used to launch the process (i.e. the command name). On Linux based systems, can be set to the zeroth string in @proc/[pid]/cmdline@. On Windows, can be set to the first parameter extracted from @GetCommandLineW@.
  --
  -- Example: @cmd/otelcol@
  , Process -> Maybe Text
processCommandLine :: Maybe Text
  -- ^ The full command used to launch the process as a single string representing the full command. On Windows, can be set to the result of @GetCommandLineW@. Do not set this if you have to assemble it just for monitoring; use @process.command_args@ instead.
  --
  -- Example: @C:\cmd\otecol --config="my directory\config.yaml"@
  , Process -> Maybe [Text]
processCommandArgs :: Maybe [Text]
  -- ^ All the command arguments (including the command/executable itself) as received by the process. On Linux-based systems (and some other Unixoid systems supporting procfs), can be set according to the list of null-delimited strings extracted from @proc/[pid]/cmdline@. For libc-based executables, this would be the full argv vector passed to main.	
  --
  -- Example: @[cmd/otecol, --config=config.yaml]@
  , Process -> Maybe Text
processOwner :: Maybe Text
  -- ^ The username of the user that owns the process.	
  --
  -- Example: @root@
  }

instance ToResource Process where
  type ResourceSchema Process = 'Nothing
  toResource :: Process -> Resource (ResourceSchema Process)
toResource Process{Maybe Int
Maybe [Text]
Maybe Text
processOwner :: Maybe Text
processCommandArgs :: Maybe [Text]
processCommandLine :: Maybe Text
processCommand :: Maybe Text
processExecutablePath :: Maybe Text
processExecutableName :: Maybe Text
processPid :: Maybe Int
processOwner :: Process -> Maybe Text
processCommandArgs :: Process -> Maybe [Text]
processCommandLine :: Process -> Maybe Text
processCommand :: Process -> Maybe Text
processExecutablePath :: Process -> Maybe Text
processExecutableName :: Process -> Maybe Text
processPid :: Process -> Maybe Int
..} = [Maybe (Text, Attribute)] -> Resource 'Nothing
forall (r :: Maybe Symbol). [Maybe (Text, Attribute)] -> Resource r
mkResource
    [ Text
"process.pid" Text -> Maybe Int -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Int
processPid
    , Text
"process.executable.name" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processExecutableName
    , Text
"process.executable.path" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processExecutablePath
    , Text
"process.command" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processCommand
    , Text
"process.command_line" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processCommandLine
    , Text
"process.command_args" Text -> Maybe [Text] -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe [Text]
processCommandArgs
    , Text
"process.owner" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processOwner
    ]

-- | The single (language) runtime instance which is monitored.
data ProcessRuntime = ProcessRuntime
  { ProcessRuntime -> Maybe Text
processRuntimeName :: Maybe Text
  -- ^ The name of the runtime of this process. For compiled native binaries, this SHOULD be the name of the compiler.	
  --
  -- Example: @OpenJDK Runtime Environment@
  , ProcessRuntime -> Maybe Text
processRuntimeVersion :: Maybe Text
  -- ^ The version of the runtime of this process, as returned by the runtime without modification.	
  --
  -- Example: @14.0.2@
  , ProcessRuntime -> Maybe Text
processRuntimeDescription :: Maybe Text
  -- ^ An additional description about the runtime of the process, for example a specific vendor customization of the runtime environment.
  --
  -- Example: @Eclipse OpenJ9 Eclipse OpenJ9 VM openj9-0.21.0@
  }

instance ToResource ProcessRuntime where
  type ResourceSchema ProcessRuntime = 'Nothing
  toResource :: ProcessRuntime -> Resource (ResourceSchema ProcessRuntime)
toResource ProcessRuntime{Maybe Text
processRuntimeDescription :: Maybe Text
processRuntimeVersion :: Maybe Text
processRuntimeName :: Maybe Text
processRuntimeDescription :: ProcessRuntime -> Maybe Text
processRuntimeVersion :: ProcessRuntime -> Maybe Text
processRuntimeName :: ProcessRuntime -> Maybe Text
..} = [Maybe (Text, Attribute)] -> Resource 'Nothing
forall (r :: Maybe Symbol). [Maybe (Text, Attribute)] -> Resource r
mkResource
    [ Text
"process.runtime.name" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processRuntimeName
    , Text
"process.runtime.version" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processRuntimeVersion
    , Text
"process.runtime.description" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
processRuntimeDescription
    ]