{-# 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 System.Environment as Env
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

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
/= :: TelemetryInfo -> TelemetryInfo -> Bool
$c/= :: TelemetryInfo -> TelemetryInfo -> Bool
== :: TelemetryInfo -> TelemetryInfo -> Bool
$c== :: TelemetryInfo -> TelemetryInfo -> Bool
Eq, Int -> TelemetryInfo -> ShowS
[TelemetryInfo] -> ShowS
TelemetryInfo -> String
(Int -> TelemetryInfo -> ShowS)
-> (TelemetryInfo -> String)
-> ([TelemetryInfo] -> ShowS)
-> Show TelemetryInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TelemetryInfo] -> ShowS
$cshowList :: [TelemetryInfo] -> ShowS
show :: TelemetryInfo -> String
$cshow :: TelemetryInfo -> String
showsPrec :: Int -> TelemetryInfo -> ShowS
$cshowsPrec :: Int -> 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 :: IO ()
reportTelemetry :: IO ()
reportTelemetry = do
    Bool
isDisabled <- Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\String
value -> String
value String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1") (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
Env.lookupEnv String
"IHP_TELEMETRY_DISABLED"
    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 ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Text
forall a. Show a => a -> Text
show [(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 (String -> [(ByteString, ByteString)] -> IO (Response ByteString)
forall a. Postable a => String -> a -> IO (Response ByteString)
Wreq.post String
"https://ihp-telemetry.digitallyinduced.com/CreateEvent" [(ByteString, ByteString)]
payload)
        case Either IOException (Response ByteString)
result of
            Left (IOException
e :: IOException) -> Text -> IO ()
putStrLn (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 ()
putStrLn Text
"IHP Telemetry is activated. This can be disabled by setting env variable IHP_TELEMETRY_DISABLED=1"

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 (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    let opsys :: String
opsys
         | String
System.os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"linux" Bool -> Bool -> Bool
&& Bool
iswin = String
"linux (WSL)"
         | Bool
otherwise = String
System.os
    TelemetryInfo -> IO TelemetryInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure TelemetryInfo :: Text -> Text -> Text -> Text -> TelemetryInfo
TelemetryInfo { $sel:ihpVersion:TelemetryInfo :: Text
ihpVersion = Text
Version.ihpVersion, $sel:os:TelemetryInfo :: Text
os = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
opsys, $sel:arch:TelemetryInfo :: Text
arch = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
System.arch, Text
projectId :: Text
$sel:projectId:TelemetryInfo :: 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 <- String -> IO Text
TIO.readFile String
"/proc/version"
    Bool -> IO Bool
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
    String
cwd <- IO String
Directory.getCurrentDirectory
    String
cwd
        String -> (String -> ByteString) -> ByteString
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> String -> 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 (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
projectId :: Text
arch :: Text
os :: Text
ihpVersion :: Text
$sel:projectId:TelemetryInfo :: TelemetryInfo -> Text
$sel:arch:TelemetryInfo :: TelemetryInfo -> Text
$sel:os:TelemetryInfo :: TelemetryInfo -> Text
$sel:ihpVersion:TelemetryInfo :: TelemetryInfo -> 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)]