{-# LANGUAGE TemplateHaskell #-}
{-|
Module: IHP.Telemetry
Description: Reports IHP Version + OS to digitally induced
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.Telemetry where

import IHP.Prelude
import qualified IHP.Version as Version
import qualified System.Info as System
import qualified Network.Wreq as Wreq
import qualified Control.Exception as Exception
import qualified Crypto.Hash.SHA512 as SHA512
import qualified System.Directory as Directory
import qualified Data.ByteString.Base16 as Base16
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

import qualified IHP.Log.Types as Log
import qualified IHP.Log as Log
import qualified IHP.EnvVar as EnvVar

data TelemetryInfo = TelemetryInfo
    { TelemetryInfo -> Text
ihpVersion :: !Text
    , TelemetryInfo -> Text
os :: !Text
    , TelemetryInfo -> Text
arch :: !Text
    , TelemetryInfo -> Text
projectId :: !Text
    } deriving (TelemetryInfo -> TelemetryInfo -> Bool
(TelemetryInfo -> TelemetryInfo -> Bool)
-> (TelemetryInfo -> TelemetryInfo -> Bool) -> Eq TelemetryInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TelemetryInfo -> TelemetryInfo -> Bool
== :: TelemetryInfo -> TelemetryInfo -> Bool
$c/= :: TelemetryInfo -> TelemetryInfo -> Bool
/= :: TelemetryInfo -> TelemetryInfo -> Bool
Eq, Int -> TelemetryInfo -> ShowS
[TelemetryInfo] -> ShowS
TelemetryInfo -> FilePath
(Int -> TelemetryInfo -> ShowS)
-> (TelemetryInfo -> FilePath)
-> ([TelemetryInfo] -> ShowS)
-> Show TelemetryInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TelemetryInfo -> ShowS
showsPrec :: Int -> TelemetryInfo -> ShowS
$cshow :: TelemetryInfo -> FilePath
show :: TelemetryInfo -> FilePath
$cshowList :: [TelemetryInfo] -> ShowS
showList :: [TelemetryInfo] -> ShowS
Show)

-- | Reports telemetry info to the IHP Telemetry server
--
-- This can be disabled by setting the env var IHP_TELEMETRY_DISABLED=1
reportTelemetry :: (?context :: context, Log.LoggingProvider context) => IO ()
reportTelemetry :: forall context.
(?context::context, LoggingProvider context) =>
IO ()
reportTelemetry = do
    Bool
isDisabled <- ByteString -> Bool -> IO Bool
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> result -> monad result
EnvVar.envOrDefault ByteString
"IHP_TELEMETRY_DISABLED" Bool
False
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isDisabled do
        [(ByteString, ByteString)]
payload <- TelemetryInfo -> [(ByteString, ByteString)]
toPayload (TelemetryInfo -> [(ByteString, ByteString)])
-> IO TelemetryInfo -> IO [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TelemetryInfo
getTelemetryInfo
        Text -> IO ()
forall context string.
(?context::context, LoggingProvider context, ToLogStr string) =>
string -> IO ()
Log.info ([(ByteString, ByteString)] -> Text
forall a. Show a => a -> Text
tshow [(ByteString, ByteString)]
payload)
        Either IOException (Response ByteString)
result <- IO (Response ByteString)
-> IO (Either IOException (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (FilePath -> [(ByteString, ByteString)] -> IO (Response ByteString)
forall a. Postable a => FilePath -> a -> IO (Response ByteString)
Wreq.post FilePath
"https://ihp-telemetry.digitallyinduced.com/CreateEvent" [(ByteString, ByteString)]
payload)
        case Either IOException (Response ByteString)
result of
            Left (IOException
e :: IOException) -> Text -> IO ()
forall context string.
(?context::context, LoggingProvider context, ToLogStr string) =>
string -> IO ()
Log.warn (Text
"Telemetry failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a. Show a => a -> Text
show IOException
e)
            Right Response ByteString
_ -> Text -> IO ()
forall context string.
(?context::context, LoggingProvider context, ToLogStr string) =>
string -> IO ()
Log.info (Text
"IHP Telemetry is activated. This can be disabled by setting env variable IHP_TELEMETRY_DISABLED=1" :: Text)

getTelemetryInfo :: IO TelemetryInfo
getTelemetryInfo :: IO TelemetryInfo
getTelemetryInfo = do
    Text
projectId <- IO Text
getProjectId
    Bool
iswin <- IO Bool
isWindows IO Bool -> (IOException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    let opsys :: FilePath
opsys
         | FilePath
System.os FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"linux" Bool -> Bool -> Bool
&& Bool
iswin = FilePath
"linux (WSL)"
         | Bool
otherwise = FilePath
System.os
    TelemetryInfo -> IO TelemetryInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TelemetryInfo { $sel:ihpVersion:TelemetryInfo :: Text
ihpVersion = Text
Version.ihpVersion, $sel:os:TelemetryInfo :: Text
os = FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs FilePath
opsys, $sel:arch:TelemetryInfo :: Text
arch = FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs FilePath
System.arch, Text
$sel:projectId:TelemetryInfo :: Text
projectId :: Text
projectId }

-- this seems to be the generally accepted way of detecting running under the Windows Subsystem for Linux
isWindows :: IO Bool
isWindows :: IO Bool
isWindows = do
    Text
p <- FilePath -> IO Text
TIO.readFile FilePath
"/proc/version"
    Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf Text
"microsoft" (Text -> Text
T.toLower Text
p)    -- WSL1 is Microsoft, WSL2 is microsoft

-- | The project id is a an anonymous identifier to keep track of distinct projects.
--
-- The project id is a hash of the current working directory. We use sha512 to make sure no one
-- is able to get back the original path from the hash.
getProjectId :: IO Text
getProjectId :: IO Text
getProjectId = do
    FilePath
cwd <- IO FilePath
Directory.getCurrentDirectory
    FilePath
cwd
        FilePath -> (FilePath -> ByteString) -> ByteString
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> FilePath -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs
        ByteString -> (ByteString -> ByteString) -> ByteString
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ByteString -> ByteString
SHA512.hash
        ByteString -> (ByteString -> ByteString) -> ByteString
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ByteString -> ByteString
Base16.encode
        ByteString -> (ByteString -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs
        Text -> (Text -> IO Text) -> IO Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Transforms a telemetry info into a payload to be used with the telemetry request
toPayload :: TelemetryInfo -> [(ByteString, ByteString)]
toPayload :: TelemetryInfo -> [(ByteString, ByteString)]
toPayload TelemetryInfo { Text
$sel:ihpVersion:TelemetryInfo :: TelemetryInfo -> Text
$sel:os:TelemetryInfo :: TelemetryInfo -> Text
$sel:arch:TelemetryInfo :: TelemetryInfo -> Text
$sel:projectId:TelemetryInfo :: TelemetryInfo -> Text
ihpVersion :: Text
os :: Text
arch :: Text
projectId :: Text
.. } = [(ByteString
"ihpVersion", Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
ihpVersion), (ByteString
"os", Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
os), (ByteString
"arch", Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
arch), (ByteString
"projectId", Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
projectId)]