Added tracking of 'build' command in telemetry.

This commit is contained in:
Martin Sosic 2021-02-05 14:23:22 +01:00 committed by Martin Šošić
parent 332fe32c4c
commit 0e98099028
4 changed files with 82 additions and 34 deletions

10
waspc/cli/Command/Call.hs Normal file
View File

@ -0,0 +1,10 @@
module Command.Call where
data Call = New String -- project name
| Start
| Clean
| Compile
| Db [String] -- db args
| Build
| Version
| Unknown [String] -- all args

View File

@ -9,6 +9,7 @@ import Data.Maybe (isJust)
import qualified System.Environment as ENV import qualified System.Environment as ENV
import Command (Command, CommandError (..)) import Command (Command, CommandError (..))
import qualified Command.Call
import Command.Telemetry.Common (ensureTelemetryCacheDirExists) import Command.Telemetry.Common (ensureTelemetryCacheDirExists)
import qualified Command.Telemetry.Project as TlmProject import qualified Command.Telemetry.Project as TlmProject
import qualified Command.Telemetry.User as TlmUser import qualified Command.Telemetry.User as TlmUser
@ -17,8 +18,8 @@ import qualified Command.Telemetry.User as TlmUser
-- If we are not in the Wasp project at the moment, nothing happens. -- If we are not in the Wasp project at the moment, nothing happens.
-- If telemetry data was already sent for this project in the last 12 hours, nothing happens. -- If telemetry data was already sent for this project in the last 12 hours, nothing happens.
-- If env var WASP_TELEMETRY_DISABLE is set, nothing happens. -- If env var WASP_TELEMETRY_DISABLE is set, nothing happens.
considerSendingData :: Command () considerSendingData :: Command.Call.Call -> Command ()
considerSendingData = (`catchError` const (return ())) $ do considerSendingData cmdCall = (`catchError` const (return ())) $ do
isTelemetryDisabled <- liftIO $ isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE" isTelemetryDisabled <- liftIO $ isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
when isTelemetryDisabled $ throwError $ CommandError "Telemetry disabled by user." when isTelemetryDisabled $ throwError $ CommandError "Telemetry disabled by user."
@ -29,4 +30,4 @@ considerSendingData = (`catchError` const (return ())) $ do
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing) maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
case maybeProjectHash of case maybeProjectHash of
Nothing -> return () Nothing -> return ()
Just projectHash -> liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash Just projectHash -> liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall

View File

@ -9,7 +9,6 @@ import Command.Common (findWaspProjectRootDirFromCwd)
import Control.Monad (void, when) import Control.Monad (void, when)
import Crypto.Hash (SHA256 (..), hashWith) import Crypto.Hash (SHA256 (..), hashWith)
import Data.Aeson ((.=)) import Data.Aeson ((.=))
import Control.Monad.IO.Class (liftIO)
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.UTF8 as ByteStringLazyUTF8 import qualified Data.ByteString.Lazy.UTF8 as ByteStringLazyUTF8
import qualified Data.ByteString.UTF8 as ByteStringUTF8 import qualified Data.ByteString.UTF8 as ByteStringUTF8
@ -23,27 +22,46 @@ import qualified System.Directory as SD
import qualified System.Info import qualified System.Info
import Command (Command) import Command (Command)
import qualified Command.Call
import Command.Telemetry.Common (TelemetryCacheDir) import Command.Telemetry.Common (TelemetryCacheDir)
import Command.Telemetry.User (UserSignature (..)) import Command.Telemetry.User (UserSignature (..))
import StrongPath (Abs, Dir, File, Path) import StrongPath (Abs, Dir, File, Path)
import qualified StrongPath as SP import qualified StrongPath as SP
considerSendingData :: Path Abs (Dir TelemetryCacheDir) -> UserSignature -> ProjectHash -> IO () considerSendingData :: Path Abs (Dir TelemetryCacheDir) -> UserSignature -> ProjectHash -> Command.Call.Call -> IO ()
considerSendingData telemetryCacheDirPath userSignature projectHash = do considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall = do
projectCache <- liftIO $ readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash projectCache <- readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash
shouldSendData <- liftIO $ case _lastCheckIn projectCache of
let relevantLastCheckIn = case cmdCall of
Command.Call.Build -> _lastCheckInBuild projectCache
_ -> _lastCheckIn projectCache
shouldSendData <- case relevantLastCheckIn of
Nothing -> return True Nothing -> return True
Just lastCheckIn -> do Just lastCheckIn -> isOlderThan12Hours lastCheckIn
when shouldSendData $ do
sendTelemetryData $ getProjectTelemetryData userSignature projectHash cmdCall
projectCache' <- newProjectCache projectCache
writeProjectTelemetryFile telemetryCacheDirPath projectHash projectCache'
where
isOlderThan12Hours :: T.UTCTime -> IO Bool
isOlderThan12Hours time = do
now <- T.getCurrentTime now <- T.getCurrentTime
let secondsSinceLastCheckIn = T.nominalDiffTimeToSeconds (now `T.diffUTCTime` lastCheckIn) let secondsSinceLastCheckIn = T.nominalDiffTimeToSeconds (now `T.diffUTCTime` time)
return $ let numSecondsInHour = 3600 return $ let numSecondsInHour = 3600
in secondsSinceLastCheckIn > 12 * numSecondsInHour in secondsSinceLastCheckIn > 12 * numSecondsInHour
when shouldSendData $ do
liftIO $ sendTelemetryData $ getProjectTelemetryData userSignature projectHash newProjectCache :: ProjectTelemetryCache -> IO ProjectTelemetryCache
now <- liftIO T.getCurrentTime newProjectCache currentProjectCache = do
let projectCache' = projectCache { _lastCheckIn = Just now } now <- T.getCurrentTime
liftIO $ writeProjectTelemetryFile telemetryCacheDirPath projectHash projectCache' return currentProjectCache
{ _lastCheckIn = Just now
, _lastCheckInBuild = case cmdCall of
Command.Call.Build -> Just now
_ -> _lastCheckInBuild currentProjectCache
}
-- * Project hash. -- * Project hash.
@ -58,14 +76,16 @@ getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> find
-- * Project telemetry cache. -- * Project telemetry cache.
data ProjectTelemetryCache = ProjectTelemetryCache data ProjectTelemetryCache = ProjectTelemetryCache
{ _lastCheckIn :: Maybe T.UTCTime } { _lastCheckIn :: Maybe T.UTCTime -- Last time when CLI was called for this project, any command.
, _lastCheckInBuild :: Maybe T.UTCTime -- Last time when CLI was called for this project, with Build command.
}
deriving (Generic, Show) deriving (Generic, Show)
instance Aeson.ToJSON ProjectTelemetryCache instance Aeson.ToJSON ProjectTelemetryCache
instance Aeson.FromJSON ProjectTelemetryCache instance Aeson.FromJSON ProjectTelemetryCache
initialCache :: ProjectTelemetryCache initialCache :: ProjectTelemetryCache
initialCache = ProjectTelemetryCache { _lastCheckIn = Nothing } initialCache = ProjectTelemetryCache { _lastCheckIn = Nothing, _lastCheckInBuild = Nothing }
-- * Project telemetry cache file. -- * Project telemetry cache file.
@ -96,14 +116,18 @@ data ProjectTelemetryData = ProjectTelemetryData
, _projectHash :: ProjectHash , _projectHash :: ProjectHash
, _waspVersion :: String , _waspVersion :: String
, _os :: String , _os :: String
, _isBuild :: Bool
} deriving (Show) } deriving (Show)
getProjectTelemetryData :: UserSignature -> ProjectHash -> ProjectTelemetryData getProjectTelemetryData :: UserSignature -> ProjectHash -> Command.Call.Call -> ProjectTelemetryData
getProjectTelemetryData userSignature projectHash = ProjectTelemetryData getProjectTelemetryData userSignature projectHash cmdCall = ProjectTelemetryData
{ _userSignature = userSignature { _userSignature = userSignature
, _projectHash = projectHash , _projectHash = projectHash
, _waspVersion = showVersion version , _waspVersion = showVersion version
, _os = System.Info.os , _os = System.Info.os
, _isBuild = case cmdCall of
Command.Call.Build -> True
_ -> False
} }
sendTelemetryData :: ProjectTelemetryData -> IO () sendTelemetryData :: ProjectTelemetryData -> IO ()
@ -119,6 +143,7 @@ sendTelemetryData telemetryData = do
, "project_hash" .= _projectHashValue (_projectHash telemetryData) , "project_hash" .= _projectHashValue (_projectHash telemetryData)
, "wasp_version" .= _waspVersion telemetryData , "wasp_version" .= _waspVersion telemetryData
, "os" .= _os telemetryData , "os" .= _os telemetryData
, "is_build" .= _isBuild telemetryData
] ]
] ]
request = HTTP.setRequestBodyJSON reqBodyJson $ request = HTTP.setRequestBodyJSON reqBodyJson $

View File

@ -8,30 +8,41 @@ import Paths_waspc (version)
import System.Environment import System.Environment
import Command (runCommand) import Command (runCommand)
import Command.Build (build)
import qualified Command.Call
import Command.Clean (clean) import Command.Clean (clean)
import Command.Compile (compile) import Command.Compile (compile)
import Command.CreateNewProject (createNewProject) import Command.CreateNewProject (createNewProject)
import Command.Db (runDbCommand, studio) import Command.Db (runDbCommand, studio)
import Command.Db.Migrate (migrateSave, migrateUp) import Command.Db.Migrate (migrateSave, migrateUp)
import Command.Start (start) import Command.Start (start)
import Command.Build (build)
import qualified Command.Telemetry as Telemetry import qualified Command.Telemetry as Telemetry
main :: IO () main :: IO ()
main = do main = do
telemetryThread <- Async.async $ runCommand Telemetry.considerSendingData
args <- getArgs args <- getArgs
case args of let commandCall = case args of
["new", projectName] -> runCommand $ createNewProject projectName ["new", projectName] -> Command.Call.New projectName
["start"] -> runCommand start ["start"] -> Command.Call.Start
["clean"] -> runCommand clean ["clean"] -> Command.Call.Clean
["compile"] -> runCommand compile ["compile"] -> Command.Call.Compile
("db":dbArgs) -> dbCli dbArgs ("db":dbArgs) -> Command.Call.Db dbArgs
["version"] -> printVersion ["version"] -> Command.Call.Version
["build"] -> runCommand build ["build"] -> Command.Call.Build
_ -> printUsage _ -> Command.Call.Unknown args
telemetryThread <- Async.async $ runCommand $ Telemetry.considerSendingData commandCall
case commandCall of
Command.Call.New projectName -> runCommand $ createNewProject projectName
Command.Call.Start -> runCommand start
Command.Call.Clean -> runCommand clean
Command.Call.Compile -> runCommand compile
Command.Call.Db dbArgs -> dbCli dbArgs
Command.Call.Version -> printVersion
Command.Call.Build -> runCommand build
Command.Call.Unknown _ -> printUsage
-- If sending of telemetry data is still not done 1 second since commmand finished, abort it. -- If sending of telemetry data is still not done 1 second since commmand finished, abort it.
-- We also make sure here to catch all errors that might get thrown and silence them. -- We also make sure here to catch all errors that might get thrown and silence them.
@ -50,6 +61,7 @@ printUsage = putStrLn $ unlines
, " start" , " start"
, " clean" , " clean"
, " db <commmand> [command-args]" , " db <commmand> [command-args]"
, " build"
, " version" , " version"
, "" , ""
, "Examples:" , "Examples:"