{-# LANGUAGE TemplateHaskell #-}
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)
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 }
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)
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
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)]