module OpenTelemetry.Resource.Process.Detector where

import qualified Data.Text as T
import System.Environment
    ( getArgs, getProgName, getExecutablePath )
import System.Posix.Process ( getProcessID )
import System.Posix.User (getEffectiveUserName)
import System.Info
import Data.Version
import OpenTelemetry.Resource.Process
import Control.Exception (try, throwIO)
import System.IO.Error

-- | Create a 'Process' 'Resource' based off of the current process' knowledge
-- of itself.
--
-- @since 0.1.0.0
detectProcess :: IO Process
detectProcess :: IO Process
detectProcess = do
  Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Process
Process (Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Process)
-> IO (Maybe Int)
-> IO
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Process)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (ProcessID -> Int) -> ProcessID -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProcessID -> Maybe Int) -> IO ProcessID -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProcessID
getProcessID) IO
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Process)
-> IO (Maybe Text)
-> IO
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Process)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (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
getProgName) IO
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Process)
-> IO (Maybe Text)
-> IO
     (Maybe Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> Process)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (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
getExecutablePath) IO
  (Maybe Text -> Maybe Text -> Maybe [Text] -> Maybe Text -> Process)
-> IO (Maybe Text)
-> IO (Maybe Text -> Maybe [Text] -> Maybe Text -> Process)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing IO (Maybe Text -> Maybe [Text] -> Maybe Text -> Process)
-> IO (Maybe Text) -> IO (Maybe [Text] -> Maybe Text -> Process)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing IO (Maybe [Text] -> Maybe Text -> Process)
-> IO (Maybe [Text]) -> IO (Maybe Text -> Process)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    ([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) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map 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]
getArgs) IO (Maybe Text -> Process) -> IO (Maybe Text) -> IO Process
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    IO (Maybe Text)
tryGetUser

tryGetUser :: IO (Maybe T.Text)
tryGetUser :: IO (Maybe Text)
tryGetUser = do
  Either IOError String
eResult <- IO String -> IO (Either IOError String)
forall e a. Exception e => IO a -> IO (Either e a)
try IO String
getEffectiveUserName
  case Either IOError String
eResult of
    Left IOError
err -> if IOError -> Bool
isDoesNotExistError IOError
err
      then Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      else IOError -> IO (Maybe Text)
forall e a. Exception e => e -> IO a
throwIO IOError
err
    Right String
ok -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
ok

-- | A 'ProcessRuntime' 'Resource' populated with the current process' knoweldge
-- of itself.
--
-- @since 0.0.1.0
detectProcessRuntime :: ProcessRuntime
detectProcessRuntime :: ProcessRuntime
detectProcessRuntime = ProcessRuntime :: Maybe Text -> Maybe Text -> Maybe Text -> ProcessRuntime
ProcessRuntime
  { processRuntimeName :: Maybe Text
processRuntimeName = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
compilerName
  , processRuntimeVersion :: Maybe Text
processRuntimeVersion = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
compilerVersion
  , processRuntimeDescription :: Maybe Text
processRuntimeDescription = Maybe Text
forall a. Maybe a
Nothing
  }