{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module OpenTelemetry.Resource.Host.Detector (
  detectHost,
  builtInHostDetectors,
  HostDetector,
) where

import Control.Monad
import qualified Data.Text as T
import Network.BSD
import OpenTelemetry.Resource.Host
import System.Info (arch)


adaptedArch :: T.Text
adaptedArch :: Text
adaptedArch = case String
arch of
  String
"aarch64" -> Text
"arm64"
  String
"arm" -> Text
"arm32"
  String
"x86_64" -> Text
"amd64"
  String
"i386" -> Text
"x86"
  String
"ia64" -> Text
"ia64"
  String
"powerpc" -> Text
"ppc32"
  String
"powerpc64" -> Text
"ppc64"
  String
"powerpc64le" -> Text
"ppc64"
  String
other -> String -> Text
T.pack String
other


-- | Detect as much host information as possible
detectHost :: IO Host
detectHost :: IO Host
detectHost = do
  Maybe Host
mhost <- (Maybe Host -> IO (Maybe Host) -> IO (Maybe Host))
-> Maybe Host -> [IO (Maybe Host)] -> IO (Maybe Host)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Maybe Host -> IO (Maybe Host) -> IO (Maybe Host)
forall {f :: * -> *} {a}.
Applicative f =>
Maybe a -> f (Maybe a) -> f (Maybe a)
go Maybe Host
forall a. Maybe a
Nothing [IO (Maybe Host)]
builtInHostDetectors
  Host -> IO Host
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Host -> IO Host) -> Host -> IO Host
forall a b. (a -> b) -> a -> b
$ case Maybe Host
mhost of
    Maybe Host
Nothing -> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Host
Host Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
    Just Host
host -> Host
host
  where
    go :: Maybe a -> f (Maybe a) -> f (Maybe a)
go Maybe a
Nothing f (Maybe a)
hostDetector = f (Maybe a)
hostDetector
    go mhost :: Maybe a
mhost@(Just a
_host) f (Maybe a)
_ = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
mhost


{- | A set of detectors for e.g. AWS, GCP, and other cloud providers.

 Currently only emits hostName and hostArch. Additional detectors are
 welcome via PR.
-}
builtInHostDetectors :: [HostDetector]
builtInHostDetectors :: [IO (Maybe Host)]
builtInHostDetectors =
  [ -- TODO
    -- AWS support
    -- GCP support
    -- any other user contributed
    IO (Maybe Host)
fallbackHostDetector
  ]


type HostDetector = IO (Maybe Host)


fallbackHostDetector :: HostDetector
fallbackHostDetector :: IO (Maybe Host)
fallbackHostDetector =
  Host -> Maybe Host
forall a. a -> Maybe a
Just (Host -> Maybe Host) -> IO Host -> IO (Maybe Host)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    let hostId :: Maybe a
hostId = Maybe a
forall a. Maybe a
Nothing
        hostType :: Maybe a
hostType = Maybe a
forall a. Maybe a
Nothing
        hostArch :: Maybe Text
hostArch = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
adaptedArch
        hostImageName :: Maybe a
hostImageName = Maybe a
forall a. Maybe a
Nothing
        hostImageId :: Maybe a
hostImageId = Maybe a
forall a. Maybe a
Nothing
        hostImageVersion :: Maybe a
hostImageVersion = Maybe a
forall a. Maybe a
Nothing
    Maybe Text
hostName <- Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> IO String -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHostName
    Host -> IO Host
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Host {Maybe Text
forall a. Maybe a
hostId :: forall a. Maybe a
hostType :: forall a. Maybe a
hostArch :: Maybe Text
hostImageName :: forall a. Maybe a
hostImageId :: forall a. Maybe a
hostImageVersion :: forall a. Maybe a
hostName :: Maybe Text
hostId :: Maybe Text
hostName :: Maybe Text
hostType :: Maybe Text
hostArch :: Maybe Text
hostImageName :: Maybe Text
hostImageId :: Maybe Text
hostImageVersion :: Maybe Text
..}