Merge pull request #57 from input-output-hk/PLT-3985

PLT-3985 - Show initial time for counterexamples in a human readable way

changelog.d/20231116_023007_pablo.lamela_PLT_3985.md

@@ -0,0 +1,42 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Removed
+
+- A bullet item for the Removed category.
+
+-->
+<!--
+### Added
+
+- A bullet item for the Added category.
+
+-->
+<!--
+### Changed
+
+- A bullet item for the Changed category.
+
+-->
+<!--
+### Deprecated
+
+- A bullet item for the Deprecated category.
+
+-->
+
+### Fixed
+
+- Fix a legacy vestige that caused the initial time of counterexamples produced by the static analysis to be shown as a slot number.
+
+
+<!--
+### Security
+
+- A bullet item for the Security category.
+
+-->

marlowe-playground-client/README.md

@@ -15,7 +15,7 @@ Now we will build and run the front end:
 ```bash
 [nix-shell] $ cd marlowe-playground-client
 # Generate the purescript bridge files
-[nix-shell] $ generate-purs
+[nix-shell] $ generate-purescript
 # Download javascript dependencies (we use ci to use the package-lock.json)
 [nix-shell] $ npm ci
 # Install purescript depdendencies

marlowe-playground-client/generated/Marlowe/Symbolic/Types/Response.purs

@@ -27,6 +27,32 @@ import Language.Marlowe.Core.V1.Semantics.Types
   )
 import Type.Proxy (Proxy(Proxy))
 
+newtype POSIXTimeWrapper = POSIXTimeWrapper BigInt
+
+derive instance Eq POSIXTimeWrapper
+
+derive instance Ord POSIXTimeWrapper
+
+instance Show POSIXTimeWrapper where
+  show a = genericShow a
+
+instance EncodeJson POSIXTimeWrapper where
+  encodeJson = defer \_ -> E.encode $ unwrap >$< E.value
+
+instance DecodeJson POSIXTimeWrapper where
+  decodeJson = defer \_ -> D.decode $ (POSIXTimeWrapper <$> D.value)
+
+derive instance Generic POSIXTimeWrapper _
+
+derive instance Newtype POSIXTimeWrapper _
+
+--------------------------------------------------------------------------------
+
+_POSIXTimeWrapper :: Iso' POSIXTimeWrapper BigInt
+_POSIXTimeWrapper = _Newtype
+
+--------------------------------------------------------------------------------
+
 newtype Response = Response
   { result :: Result
   , durationMs :: BigInt
@@ -65,7 +91,7 @@ _Response = _Newtype
 data Result
   = Valid
   | CounterExample
-      { initialSlot :: BigInt
+      { initialTime :: POSIXTimeWrapper
       , transactionList :: Array TransactionInput
       , transactionWarning :: Array TransactionWarning
       }
@@ -77,10 +103,10 @@ instance Show Result where
 instance EncodeJson Result where
   encodeJson = defer \_ -> case _ of
     Valid -> encodeJson { tag: "Valid", contents: jsonNull }
-    CounterExample { initialSlot, transactionList, transactionWarning } ->
+    CounterExample { initialTime, transactionList, transactionWarning } ->
       encodeJson
         { tag: "CounterExample"
-        , initialSlot: flip E.encode initialSlot E.value
+        , initialTime: flip E.encode initialTime E.value
         , transactionList: flip E.encode transactionList E.value
         , transactionWarning: flip E.encode transactionWarning E.value
         }
@@ -93,7 +119,7 @@ instance DecodeJson Result where
         [ "Valid" /\ pure Valid
         , "CounterExample" /\
             ( CounterExample <$> D.object "CounterExample"
-                { initialSlot: D.value :: _ BigInt
+                { initialTime: D.value :: _ POSIXTimeWrapper
                 , transactionList: D.value :: _ (Array TransactionInput)
                 , transactionWarning: D.value :: _ (Array TransactionWarning)
                 }
@@ -112,7 +138,7 @@ _Valid = prism' (const Valid) case _ of
 
 _CounterExample
   :: Prism' Result
-       { initialSlot :: BigInt
+       { initialTime :: POSIXTimeWrapper
        , transactionList :: Array TransactionInput
        , transactionWarning :: Array TransactionWarning
        }

marlowe-playground-client/src/StaticAnalysis/BottomPanel.purs

@@ -5,12 +5,15 @@ module StaticAnalysis.BottomPanel
 import Prologue hiding (div)
 
 import Data.Array as Array
+import Data.BigInt.Argonaut (toNumber)
 import Data.BigInt.Argonaut as BigInt
+import Data.DateTime.Instant (instant)
 import Data.Lens (to, (^.))
 import Data.List (List(..), null, toUnfoldable, (:))
 import Data.List as List
 import Data.List.NonEmpty (toList)
-import Data.Time.Duration (Minutes)
+import Data.Newtype (unwrap)
+import Data.Time.Duration (Milliseconds(..), Minutes)
 import Effect.Aff.Class (class MonadAff)
 import Halogen (ComponentHTML)
 import Halogen.Classes (btn, spaceBottom, spaceRight, spaceTop, spanText)
@@ -32,7 +35,7 @@ import Halogen.HTML
   )
 import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Properties (classes, enabled)
-import Humanize (humanizeInterval, humanizeValue)
+import Humanize (humanizeInstant, humanizeInterval, humanizeValue)
 import Icons (Icon(..), icon)
 import Language.Marlowe.Core.V1.Semantics.Types
   ( ChoiceId(..)
@@ -185,7 +188,7 @@ warningAnalysisResult tzOffset staticSubResult = div
       ]
     Success
       ( R.CounterExample
-          { initialSlot, transactionList, transactionWarning }
+          { initialTime, transactionList, transactionWarning }
       ) ->
       [ h3 [ classes [ ClassName "analysis-result-title" ] ]
           [ text "Warning Analysis Result: Warnings Found" ]
@@ -196,8 +199,15 @@ warningAnalysisResult tzOffset staticSubResult = div
               , displayWarningList transactionWarning
               ]
           , li_
-              [ spanText "Initial slot: "
-              , b_ [ spanText (BigInt.toString initialSlot) ]
+              [ spanText "Initial time: "
+              , b_
+                  [ spanText $
+                      case
+                        instant $ Milliseconds $ toNumber $ unwrap initialTime
+                        of
+                        Just inst -> humanizeInstant tzOffset inst
+                        Nothing -> "Error parsing time"
+                  ]
               ]
           , li_
               [ spanText "Offending sequence: "

marlowe-playground-server/app/PSGenerator.hs

@@ -222,6 +222,7 @@ myTypes =
        , equal . genericShow . argonaut $ mkSumType @Owner
        , equal . genericShow . argonaut $ mkSumType @Auth.AuthStatus
        , order . equal . genericShow . argonaut $ mkSumType @Auth.AuthRole
+       , order . equal . genericShow . argonaut $ mkSumType @MSRes.POSIXTimeWrapper
        , argonaut $ mkSumType @CompilationError
        , argonaut $ mkSumType @InterpreterError
        , argonaut $ mkSumType @Warning

marlowe-symbolic/src/Marlowe/Symbolic/Server.hs

@@ -22,7 +22,7 @@ import Formatting.Clock (timeSpecs)
 import Language.Marlowe (POSIXTime (..), TransactionInput, TransactionWarning)
 import Language.Marlowe.Analysis.FSSemantics (warningsTraceCustom)
 import Marlowe.Symbolic.Types.Request (Request (..))
-import Marlowe.Symbolic.Types.Response (Response (..), Result (..))
+import Marlowe.Symbolic.Types.Response (POSIXTimeWrapper (..), Response (..), Result (..))
 import Servant (Application, JSON, Post, ReqBody, Server, serve, (:>))
 import System.Clock (Clock (Monotonic), diffTimeSpec, getTime, toNanoSecs)
 
@@ -35,9 +35,9 @@ makeResult (Left err) = Error (show err)
 makeResult (Right res) =
   case res of
         Nothing -> Valid
-        Just (POSIXTime sn, ti, tw) ->
+        Just (POSIXTime iti, ti, tw) ->
           CounterExample
-            { initialSlot = sn
+            { initialTime = POSIXTimeWrapper iti
             , transactionList = ti
             , transactionWarning = tw
             }

marlowe-symbolic/src/Marlowe/Symbolic/Types/Response.hs

@@ -1,13 +1,19 @@
 {-# LANGUAGE DeriveGeneric #-}
 module Marlowe.Symbolic.Types.Response where
 
-import Data.Aeson (FromJSON, ToJSON)
 import GHC.Generics
+import Data.Aeson (FromJSON, ToJSON)
 import Language.Marlowe.Core.V1.Semantics (TransactionInput, TransactionWarning)
 
+newtype POSIXTimeWrapper = POSIXTimeWrapper Integer
+  deriving (Generic)
+
+instance ToJSON POSIXTimeWrapper
+instance FromJSON POSIXTimeWrapper
+
 data Result = Valid
             | CounterExample
-                { initialSlot        :: Integer
+                { initialTime        :: POSIXTimeWrapper
                 , transactionList    :: [TransactionInput]
                 , transactionWarning :: [TransactionWarning]
                 }

nix/shell.nix

@@ -49,6 +49,7 @@ _cabalProject:
     pkgs.act
     pkgs.gawk
     pkgs.nil
+    pkgs.scriv
     pkgs.z3
     pkgs.which
     pkgs.prefetch-npm-deps

web-common-marlowe/src/Humanize.purs

@@ -4,6 +4,7 @@ module Humanize
   , humanizeDuration
   , formatDate
   , formatDate'
+  , humanizeInstant
   , formatInstant
   , formatDateTime'
   , formatDateTime
@@ -76,6 +77,13 @@ toLocalDateTime :: Minutes -> Instant -> Maybe DateTime
 toLocalDateTime tzOffset = adjust (over Minutes negate tzOffset :: Minutes)
   <<< toDateTime
 
+humanizeInstant :: Minutes -> Instant -> String
+humanizeInstant tzOffset time =
+  let
+    date /\ time = formatInstant tzOffset time
+  in
+    date <> " at " <> time
+
 formatInstant :: Minutes -> Instant -> (Tuple String String)
 formatInstant tzOffset time =
   let