Extend telemetry data to log when users ignored the telemetry popup (#4403)

Previously, we did not send any message when users simply clicked away
the telemetry popup. Now we send a special message similar to the
opt-out message which only includes the machine id.

I’ve also changed the opt-out message to include the machine id.

changelog_begin
changelog_end

compiler/daml-extension/src/extension.ts

@@ -234,6 +234,9 @@ export function createLanguageClient(config: vscode.WorkspaceConfiguration, tele
         args.push('--telemetry');
     } else if (telemetryConsent === false){
         args.push('--optOutTelemetry')
+    } else if (telemetryConsent == undefined) {
+        // The user has not made an explicit choice.
+        args.push('--telemetry-ignored')
     }
     const extraArgsString = config.get("extraArguments", "").trim();
     // split on an empty string returns an array with a single empty string

compiler/damlc/lib/DA/Cli/Damlc.hs

@@ -372,15 +372,18 @@ execIde telemetry (Debug debug) enableScenarioService options =
             threshold
             "LanguageServer"
           let withLogger f = case telemetry of
-                  OptedIn ->
+                  TelemetryOptedIn ->
                     let logOfInterest prio = prio `elem` [Logger.Telemetry, Logger.Warning, Logger.Error] in
                     Logger.GCP.withGcpLogger logOfInterest loggerH $ \gcpState loggerH' -> do
                       Logger.GCP.logMetaData gcpState
                       f loggerH'
-                  OptedOut -> Logger.GCP.withGcpLogger (const False) loggerH $ \gcpState loggerH -> do
+                  TelemetryOptedOut -> Logger.GCP.withGcpLogger (const False) loggerH $ \gcpState loggerH -> do
                       Logger.GCP.logOptOut gcpState
                       f loggerH
-                  Undecided -> f loggerH
+                  TelemetryIgnored -> Logger.GCP.withGcpLogger (const False) loggerH $ \gcpState loggerH -> do
+                      Logger.GCP.logIgnored gcpState
+                      f loggerH
+                  TelemetryDisabled -> f loggerH
           dlintDataDir <- locateRunfiles $ mainWorkspace </> "compiler/damlc/daml-ide-core"
           options <- pure options
               { optScenarioService = enableScenarioService

compiler/damlc/lib/DA/Cli/Options.hs

@@ -151,24 +151,20 @@ newtype InitPkgDb = InitPkgDb Bool
 initPkgDbOpt :: Parser InitPkgDb
 initPkgDbOpt = InitPkgDb <$> flagYesNoAuto "init-package-db" True "Initialize package database" idm
 
-data Telemetry = OptedIn | OptedOut | Undecided
+data Telemetry
+    = TelemetryOptedIn -- ^ User has explicitly opted in
+    | TelemetryOptedOut -- ^ User has explicitly opted out
+    | TelemetryIgnored -- ^ User has clicked away the telemetry dialog without making a choice
+    | TelemetryDisabled -- ^ No options have been supplied so telemetry is
+               -- disabled. You’ll never get this in the IDE but it is
+               -- used when invoking the compiler from a terminal.
+
 telemetryOpt :: Parser Telemetry
-telemetryOpt = do
-    let optInS = "telemetry"
-        optOutS = "optOutTelemetry"
-    optIn <-
-        switch $
-        help "Send crash data + telemetry to Digital Asset" <> long optInS
-    optOut <-
-        switch $
-        help "Opt out of sending crash data + telemetry to Digital Asset" <> long optOutS
-    pure $ case (optIn, optOut) of
-        (False, False) -> Undecided
-        (True, False) -> OptedIn
-        (False, True) -> OptedOut
-        (True, True) ->
-            error $
-            "Both --"++optInS++" and --"++optOutS++" have been selected, you either have to opt into telemetry or opt out"
+telemetryOpt = fromMaybe TelemetryDisabled <$> optional (optIn <|> optOut <|> optIgnored)
+  where
+    optIn = flag' TelemetryOptedIn $ hidden <> long "telemetry"
+    optOut = flag' TelemetryOptedOut $ hidden <> long "optOutTelemetry"
+    optIgnored = flag' TelemetryIgnored $ hidden <> long "telemetry-ignored"
 
 -- Parse helper for non-empty string lists separated by the given separator
 stringsSepBy :: Char -> ReadM [String]

libs-haskell/da-hs-base/src/DA/Service/Logger/Impl/GCP.hs

@@ -20,6 +20,7 @@ module DA.Service.Logger.Impl.GCP
     , GCPState(..)
     , initialiseGcpState
     , logOptOut
+    , logIgnored
     , logMetaData
     , SendResult(..)
     , isSuccess
@@ -335,14 +336,28 @@ fetchMachineID gcp = do
         generateID
 
 -- | If it hasn't already been done log that the user has opted out of telemetry.
--- This assumes that the logger has already been
 logOptOut :: GCPState -> IO ()
 logOptOut gcp = do
     let fp = optedOutFile gcp
     exists <- doesFileExist fp
-    let msg :: T.Text = "Opted out of telemetry"
+    metadata <- getMetaData gcp
+    let val = disabledMessage metadata "Opted out of telemetry"
     unless exists do
-        logGCP gcp Lgr.Info msg (writeFile fp "")
+        logGCP gcp Lgr.Info val (writeFile fp "")
+
+-- | Turn a message describing why telemetry was disabled (opt-out or no choice made) into an Aeson value
+-- that includes the machine id.
+disabledMessage :: MetaData -> T.Text -> Aeson.Value
+disabledMessage metadata msg =
+    -- The slightly odd format here is to make sure that we don’t break old queries before machineID was part of opt-out messages.
+    toJSON $ HM.insert "machineID" (toJSON $ machineID metadata) $ toJsonObject (toJSON msg)
+
+-- Log that the user clicked away the telemetry popup without making a choice.
+logIgnored :: GCPState -> IO ()
+logIgnored gcp = do
+    metadata <- getMetaData gcp
+    let val = disabledMessage metadata "No telemetry choice"
+    logGCP gcp Lgr.Info val (pure ())
 
 today :: IO Time.Day
 today = Time.utctDay <$> getCurrentTime