Added tracking of 'build' command in telemetry.

waspc/cli/Command/Call.hs

@@ -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

waspc/cli/Command/Telemetry.hs

@@ -9,6 +9,7 @@ import           Data.Maybe                (isJust)
 import qualified System.Environment        as ENV
 
 import           Command                   (Command, CommandError (..))
+import qualified Command.Call
 import           Command.Telemetry.Common  (ensureTelemetryCacheDirExists)
 import qualified Command.Telemetry.Project as TlmProject
 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 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.
-considerSendingData :: Command ()
-considerSendingData = (`catchError` const (return ())) $ do
+considerSendingData :: Command.Call.Call -> Command ()
+considerSendingData cmdCall = (`catchError` const (return ())) $ do
     isTelemetryDisabled <- liftIO $ isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
     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)
     case maybeProjectHash of
         Nothing -> return ()
-        Just projectHash -> liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash
+        Just projectHash -> liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall

waspc/cli/Command/Telemetry/Project.hs

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

waspc/cli/Main.hs

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