{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  OpenTelemetry.Resource.Host
-- Copyright   :  (c) Ian Duncan, 2021
-- License     :  BSD-3
-- Description :  Information about the underlying general computing instance
-- Maintainer  :  Ian Duncan
-- Stability   :  experimental
-- Portability :  non-portable (GHC extensions)
--
-----------------------------------------------------------------------------
module OpenTelemetry.Resource.Host 
  ( Host (..)
  ) where
import Data.Text (Text)
import OpenTelemetry.Resource (ToResource(..), mkResource, (.=?))

-- | A host is defined as a general computing instance.
data Host = Host
  { Host -> Maybe Text
hostId :: Maybe Text
  -- ^ Unique host ID. For Cloud, this must be the instance_id assigned by the cloud provider.
  , Host -> Maybe Text
hostName :: Maybe Text
  -- ^ Name of the host. On Unix systems, it may contain what the hostname command returns, or the fully qualified hostname, or another name specified by the user.
  , Host -> Maybe Text
hostType :: Maybe Text
  -- ^ Type of host. For Cloud, this must be the machine type.
  , Host -> Maybe Text
hostArch :: Maybe Text
  -- ^ The CPU architecture the host system is running on.
  , Host -> Maybe Text
hostImageName :: Maybe Text
  -- ^ Name of the VM image or OS install the host was instantiated from.
  , Host -> Maybe Text
hostImageId :: Maybe Text
  -- ^ VM image ID. For Cloud, this value is from the provider.
  , Host -> Maybe Text
hostImageVersion :: Maybe Text
  -- ^ The version string of the VM image as defined in Version Attributes.
  }

instance ToResource Host where
  type ResourceSchema Host = 'Nothing
  toResource :: Host -> Resource (ResourceSchema Host)
toResource Host{Maybe Text
hostImageVersion :: Maybe Text
hostImageId :: Maybe Text
hostImageName :: Maybe Text
hostArch :: Maybe Text
hostType :: Maybe Text
hostName :: Maybe Text
hostId :: Maybe Text
hostImageVersion :: Host -> Maybe Text
hostImageId :: Host -> Maybe Text
hostImageName :: Host -> Maybe Text
hostArch :: Host -> Maybe Text
hostType :: Host -> Maybe Text
hostName :: Host -> Maybe Text
hostId :: Host -> Maybe Text
..} = [Maybe (Text, Attribute)] -> Resource 'Nothing
forall (r :: Maybe Symbol). [Maybe (Text, Attribute)] -> Resource r
mkResource
    [ Text
"host.id" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
hostId
    , Text
"host.name" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
hostName
    , Text
"host.type" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
hostType
    , Text
"host.arch" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
hostArch
    , Text
"host.image.name" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
hostImageName
    , Text
"host.image.id" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
hostImageId
    , Text
"host.image.version" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? Maybe Text
hostImageVersion
    ]