Merge pull request #65 from rzk-lang/provenance

Name the build in the footer and in a crash report

Author: fizruk

CHANGELOG.md

@@ -6,6 +6,8 @@ All notable changes to this project are documented here. The format follows [Kee
 
 ### Added
 
+- The game names the build it is. A footer line carries the engine version, and the commit the content was bundled from when the bundle step knew it, and both are stamped into the "Copy issue report" text. A crash report that cannot be tied to a build is much harder to act on, and the engine version also pins which rzk it was built against, since the changelog records that per release. The commit comes from `RZK_GAME_SOURCE`, which `rzk-game-action` sets to the building commit; a bundle built locally carries nothing and the game says nothing.
+
 - Four optional `game.yaml` fields, each replacing something the engine would otherwise say for itself: `subtitle` (the line under the title), `completion` (what a player reads once everything is done, as Markdown, so a game can point at what comes next), `repository` (where the content lives, shown in a footer), and `edit-url` (a template containing `{file}`, which gives every page a link to its own source). `repository` and `edit-url` are for content only. A checker crash stays reported to the engine's own tracker, which is not the author's to receive.
 
 ### Fixed

app/Main.hs

@@ -37,6 +37,9 @@ import qualified Data.Text          as T
 import           Data.Text.Encoding (encodeUtf8)
 import           Text.Read          (readMaybe)
 
+import           Paths_rzk_game     (version)
+import           Data.Version       (showVersion)
+
 import qualified RzkGame.Content    as Content
 import           RzkGame.Content    (apHomLevel, arrInArrLevel, composeLevel,
                                      composeWitnessLevel, constTriangleLevel,
@@ -97,6 +100,14 @@ mkGameEnv info chapters =
 requiresTypingAt :: GameEnv -> Int -> Bool
 requiresTypingAt env i = head (drop i (envRequiresTyping env))
 
+-- | Which engine build this is, from the package version.
+--
+-- Shown in the footer and stamped into a crash report. A report that cannot be
+-- tied to a build is much harder to act on, and the version also pins which rzk
+-- the engine was built against, since the changelog records that per release.
+engineVersion :: T.Text
+engineVersion = T.pack (showVersion version)
+
 -- | The engine's own wording, used when a game overrides neither.
 defaultSubtitle, defaultCompletion :: T.Text
 defaultSubtitle   = "An interactive Rzk proof game. Fill the holes."
@@ -1264,13 +1275,21 @@ editLink env itemId = case editLinkFor (envInfo env) itemId of
 -- receive, so the crash panel keeps its own hardcoded tracker and the two are
 -- deliberately kept apart on the page.
 gameFooter :: GameEnv -> View Model Action
-gameFooter env = case gameInfoRepository (envInfo env) of
-  Nothing   -> text ""
-  Just repo -> H.footer_ [ P.class_ "game-footer" ]
-    [ text "Found something to fix in this game? "
-    , H.a_ [ P.href_ (ms repo), P.target_ "_blank" ] [ text "Its source is here" ]
-    , text "."
-    ]
+gameFooter env = H.footer_ [ P.class_ "game-footer" ]
+  ( contentLink <> [ H.span_ [ P.class_ "build-line" ] [ text (ms buildLine) ] ] )
+  where
+    contentLink = case gameInfoRepository (envInfo env) of
+      Nothing   -> []
+      Just repo ->
+        [ text "Found something to fix in this game? "
+        , H.a_ [ P.href_ (ms repo), P.target_ "_blank" ] [ text "Its source is here" ]
+        , text ". "
+        ]
+    -- Which build this is. The engine version pins which rzk it was built
+    -- against, since the changelog records that per release, so naming rzk here
+    -- as well would only be a second thing to keep in step.
+    buildLine = "rzk-game " <> engineVersion
+      <> maybe "" (\src -> " · content " <> T.take 7 src) (gameInfoSource (envInfo env))
 
 -- | A dismissible banner reporting the result of an import applied at the last
 -- reload (see 'applyPendingImport'): how many items were restored, or why the
@@ -1616,7 +1635,7 @@ puzzleSlotView env m sid ix z =
              -- result shows normally, with any gate notice below it.
              , if m ^. result == Solved && levelGated lvl
                   && not (null gate && null forbidden)
-                 then text "" else resultView lvl (m ^. editable) (m ^. result)
+                 then text "" else resultView env lvl (m ^. editable) (m ^. result)
              , gateView lvl (m ^. result) gate
              , forbiddenGateView lvl forbidden
              , hintsView m lvl
@@ -2181,10 +2200,14 @@ slotLabel (SlotPuzzle _ ix z) = tshow (ix + 1) <> ". " <> levelTitle (puzzleLeve
 -- | A ready-to-paste bug report for a checker crash: the level's prelude, the
 -- player's current definition, and the error. The "Copy issue report" button in
 -- the crash panel puts this on the clipboard, GitHub-Markdown formatted.
-crashReport :: Level -> T.Text -> T.Text -> T.Text
-crashReport lvl editable err = T.unlines
+crashReport :: GameEnv -> Level -> T.Text -> T.Text -> T.Text
+crashReport env lvl editable err = T.unlines
   [ "The rzk typechecker crashed in rzk-game."
   , ""
+  , "**Build:** rzk-game " <> engineVersion
+      <> ", game " <> gameInfoId (envInfo env)
+      <> maybe "" (" at " <>) (gameInfoSource (envInfo env))
+  , ""
   , "**Prelude:**"
   , "```rzk"
   , T.stripEnd (levelPrelude lvl)
@@ -2228,8 +2251,8 @@ checkStatusView m = H.div_ [] (parenNote <> staleNote)
     message u x = "● Unbalanced brackets: " <> T.intercalate " and " (parts u x) <> "."
     parts u x = [ tshow u <> " unclosed (" | u > 0 ] <> [ tshow x <> " stray )" | x > 0 ]
 
-resultView :: Level -> MisoString -> CheckResult -> View Model Action
-resultView lvl editable = \case
+resultView :: GameEnv -> Level -> MisoString -> CheckResult -> View Model Action
+resultView env lvl editable = \case
   NotChecked     -> H.pre_ [] [ text "(press Check)" ]
   ParseError e _ -> H.pre_ [ P.class_ "err" ] [ text (ms ("Parse error:\n" <> e)) ]
   -- The rzk type-error formatter is verbose (a "when typechecking …" trace per
@@ -2262,7 +2285,7 @@ resultView lvl editable = \case
       [ H.p_ [] [ text "⚠ The checker hit a bug on this input, not necessarily a mistake in your proof." ]
       , H.p_ []
           [ H.button_ [ P.class_ "copy-report"
-                      , H.onClick (CopyText (ms (crashReport lvl (fromMisoString editable) e)))
+                      , H.onClick (CopyText (ms (crashReport env lvl (fromMisoString editable) e)))
                       , P.title_ "Copy a ready-to-paste issue report (prelude, your definition, and the error)" ]
               [ text "📋 Copy issue report" ]
           , text " then "

bundler/Bundle.hs

@@ -33,7 +33,7 @@ import           Data.Text.Encoding   (encodeUtf8)
 import qualified Data.Text.IO         as TIO
 import qualified Data.Yaml            as Y
 import           System.Directory     (createDirectoryIfMissing)
-import           System.Environment   (getArgs)
+import           System.Environment   (getArgs, lookupEnv)
 import           System.Exit          (die)
 import           System.FilePath      (takeDirectory, (</>))
 
@@ -56,7 +56,12 @@ main = do
 
   files <- traverse (readLevelFile gameDir) (refMap (fileRefs config))
 
-  let bundle = A.object [ "config" A..= config, "files" A..= files ]
+  -- Where this bundle's content came from, when the caller says. CI knows the
+  -- commit and the engine does not, so it is stamped in rather than derived, and
+  -- a local bundle simply carries nothing.
+  msource <- lookupEnv "RZK_GAME_SOURCE"
+  let source = [ "source" A..= s | Just s <- [msource], not (null s) ]
+      bundle = A.object ([ "config" A..= config, "files" A..= files ] <> source)
   createDirectoryIfMissing True (takeDirectory outJson)
   BL.writeFile outJson (A.encode bundle)
   putStrLn ("Wrote " <> outJson <> " ("

rzk-game.cabal

@@ -44,6 +44,10 @@ library
 executable rzk-game
   main-is:          Main.hs
   hs-source-dirs:   app
+  -- The package version, so the app can name the build it is. A bug report that
+  -- cannot be tied to a build is much harder to act on.
+  other-modules:    Paths_rzk_game
+  autogen-modules:  Paths_rzk_game
   build-depends:
       base
     , containers

src/RzkGame/Loader.hs

@@ -56,6 +56,7 @@ buildGame bs = do
            , gameInfoCompletion = gsCompletion cfg
            , gameInfoRepository = gsRepository cfg
            , gameInfoEditUrl    = gsEditUrl cfg
+           , gameInfoSource     = bundleSource bundle
            , gameInfoSources    = sourceMap files
            }
        , chapters )

src/RzkGame/Section.hs

@@ -137,6 +137,8 @@ data GameInfo = GameInfo
   , gameInfoCompletion :: Maybe Text  -- ^ shown when everything is done
   , gameInfoRepository :: Maybe Text  -- ^ where the content lives
   , gameInfoEditUrl    :: Maybe Text  -- ^ template with @{file}@, for per-item links
+  , gameInfoSource     :: Maybe Text
+    -- ^ the commit the content was bundled from, when the bundle step knew it
   , gameInfoSources    :: Map Text Text
     -- ^ item id to source path, so an item can link to its own file. Kept beside
     -- the items rather than on them: the built-in game is Haskell values with no
@@ -146,7 +148,7 @@ data GameInfo = GameInfo
 
 -- | A game with only the two facts every game has. The loader fills in the rest.
 gameInfo :: Text -> Text -> GameInfo
-gameInfo gid title = GameInfo gid title Nothing Nothing Nothing Nothing Map.empty
+gameInfo gid title = GameInfo gid title Nothing Nothing Nothing Nothing Nothing Map.empty
 
 -- | The source path an item was loaded from, if the game came from a bundle.
 sourceOf :: GameInfo -> Text -> Maybe Text

src/RzkGame/Spec.hs

@@ -66,12 +66,16 @@ import           RzkGame.Level       (Hint (..), InventoryEntry (..),
 data Bundle = Bundle
   { bundleConfig :: GameSpec
   , bundleFiles  :: Map Text FileSpec
+  , bundleSource :: Maybe Text
+    -- ^ where the content came from, stamped by the bundle step when the caller
+    -- knows (CI does, a local run does not).
   } deriving (Eq, Show)
 
 instance FromJSON Bundle where
   parseJSON = withObject "Bundle" $ \o -> Bundle
     <$> o .: "config"
     <*> o .:? "files" .!= mempty
+    <*> o .:? "source"
 
 -- | The table of contents (the @game.yaml@): a title and the ordered chapters.
 data GameSpec = GameSpec

static/index.html

@@ -309,6 +309,8 @@
     .game-footer { margin: 2.5rem 0 1rem; padding-top: .8rem;
                    border-top: 1px solid #eee; font-size: .85rem; color: #888; }
     .game-footer a { color: #666; }
+    .build-line { color: #aaa; font-variant-numeric: tabular-nums;
+                  white-space: nowrap; }
     .edit-link { margin: .2rem 0 .6rem; font-size: .8rem; }
     .edit-link a { color: #999; text-decoration: none; }
     .edit-link a:hover { color: #555; text-decoration: underline; }