add pactValueToText

pact-tests/pact-tests/format-regression.repl

@@ -0,0 +1,54 @@
+(module some-module g
+  (defcap g () true)
+
+  (defschema some-guard a:guard)
+  (deftable my-guards:{some-guard})
+
+  (defcap CAPGUARD (a:integer b:integer) (+ a b))
+
+  (defun my-module-guard () (create-module-guard "beepboop"))
+
+  (defpact my-pact ()
+    (step
+      (let ((blah 1))
+      (write my-guards "g1" {"a":(create-pact-guard "1")})
+      (write my-guards "g2" {"a":(create-capability-pact-guard (CAPGUARD 1 23))})
+      )
+      )
+    (step 42069)
+  )
+  )
+
+
+(env-data
+  { "ks1":["robert"]
+  , "ks2":{"keys":["robert", "jose", "edmund", "chessai"], "pred":"keys-2"}}
+  )
+(create-table my-guards)
+(my-pact)
+
+
+;  (env-exec-config ['DisablePact44]) ; Uncomment to test with prod backcompat
+(define-keyset "my-ks" (read-keyset "ks2"))
+
+(expect "integer regression" "123" (format "{}" [123]))
+(expect "decimal regression 1" "123.0" (format "{}" [123.0]))
+(expect "decimal regression 2" "123.456" (format "{}" [123.456]))
+(expect "bool regression" "[true, false]" (format "{}" [[true, false]]))
+(expect "time regression" "\"2024-07-22T12:00:00Z\"" (format "{}" [(time "2024-07-22T12:00:00Z")]))
+(expect "object regression" "{\"goodbye\": \"bob\",\"hello\": 1}" (format "{}" [{"hello":1, "goodbye":"bob"}]))
+(expect "list regression" "[1, 2, 3, 4.567]" (format "{}" [[1 2 3 4.567]]))
+(expect "modref regression" "some-module" (format "{}" [some-module]))
+(expect "captoken regression" "CapToken(some-module.CAPGUARD 1 2)" (format "{}" [(CAPGUARD 1 2)])) ; Comment to test with prod
+
+; Guards regressions
+(expect "keyset-regression-1" "KeySet {keys: [robert],pred: keys-all}" (format "{}" [(read-keyset "ks1")]))
+(expect "keyset-regression-2" "KeySet {keys: [chessai, edmund, jose, robert],pred: keys-2}" (format "{}" [(read-keyset "ks2")]))
+(expect "capguard-regression-1" "CapabilityGuard {name: some-module.CAPGUARD,args: [2, 3],pactId: }" (format "{}" [(create-capability-guard (CAPGUARD 2 3))]))
+(expect "capguard-regression-2" "CapabilityGuard {name: some-module.CAPGUARD,args: [1, 23],pactId: DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g}" (format "{}" [(at "a" (read my-guards "g2"))]))
+(expect "modguard-regression-1" "ModuleGuard {module: some-module,name: beepboop}" (format "{}" [(my-module-guard)]))
+(expect "keyset ref guard regression" "'my-ks" (format "{}" [(keyset-ref-guard "my-ks")]))
+(expect "pact guard guard regression" "PactGuard {pactId: DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g,name: 1}" (format "{}" [(at "a" (read my-guards "g1"))]))
+
+
+

pact/Pact/Core/Guards.hs

@@ -130,7 +130,7 @@ instance NFData KSPredicate
 predicateToText ::  KSPredicate -> Text
 predicateToText = \case
     KeysAll -> "keys-all"
-    Keys2 -> "keys2"
+    Keys2 -> "keys-2"
     KeysAny -> "keys-any"
     CustomPredicate pn -> renderParsedTyName pn
 

pact/Pact/Core/IR/Eval/Runtime/Utils.hs

@@ -95,7 +95,6 @@ import Pact.Core.Capabilities
 import Pact.Core.Hash
 import Pact.Core.SizeOf
 import Pact.Core.StableEncoding
-import qualified Pact.Core.Pretty as Pretty
 import qualified Pact.Core.Principal as Pr
 
 emitReservedEvent :: Text -> [PactValue] -> ModuleHash -> EvalM e b i ()
@@ -517,7 +516,10 @@ readKeyset' info ksn = do
           parseObj d = do
             keys <- M.lookup (Field "keys") d
             keyText <- preview _PList keys >>= traverse (fmap PublicKeyText . preview (_PLiteral . _LString))
-            predRaw <- M.lookup (Field "pred") d
+            -- In prod if `pred` isn't present, then it defaults to `keys-all`.
+            -- We want to make the default a `PString` in case the value is present
+            -- but of the wrong format, so this can fail
+            let predRaw = maybe (PString "keys-all") id (M.lookup (Field "pred") d)
             p <- preview (_PLiteral . _LString) predRaw
             let ks = S.fromList (V.toList keyText)
             pure (ks, p)
@@ -541,7 +543,7 @@ renderPactValue :: i -> PactValue -> EvalM e b i Text
 renderPactValue info pv = do
   sz <- sizeOf info SizeOfV0 pv
   chargeGasArgs info $ GConcat $ TextConcat $ GasTextLength $ fromIntegral sz
-  pure $ Pretty.renderCompactText pv
+  pure $ pactValueToText pv -- Pretty.renderCompactText pv
 
 
 createPrincipalForGuard

pact/Pact/Core/PactValue.hs

@@ -28,20 +28,23 @@ module Pact.Core.PactValue
  , pattern PUnit
  , _PUnit
  , synthesizePvType
+ , pactValueToText
  ) where
 
 import Control.Lens
 import Data.Vector(Vector)
 import Data.Map.Strict(Map)
 import Data.Text(Text)
-import Data.Decimal(Decimal)
+import Data.Decimal
 
 import Control.DeepSeq
 import GHC.Generics
 
 import qualified Data.Vector as V
 import qualified Data.Map.Strict as M
 import qualified Pact.Time as PactTime
+import qualified Data.Set as S
+import qualified Data.Text as T
 
 import Pact.Core.Type
 import Pact.Core.Names
@@ -96,6 +99,14 @@ _PUnit = _PLiteral . _LUnit
 
 type FQCapToken = CapToken FullyQualifiedName PactValue
 
+-- | ISO8601 Thyme format
+simpleISO8601 :: String
+simpleISO8601 = "%Y-%m-%dT%H:%M:%SZ"
+
+formatLTime :: PactTime.UTCTime -> Text
+formatLTime = T.pack . PactTime.formatTime simpleISO8601
+{-# INLINE formatLTime #-}
+
 instance Pretty PactValue where
   pretty = \case
     PLiteral lit -> pretty lit
@@ -105,7 +116,61 @@ instance Pretty PactValue where
     PModRef md -> pretty md
     PCapToken (CapToken fqn args) ->
       "CapToken" <> pretty (CapToken (fqnToQualName fqn) args)
-    PTime t -> pretty (PactTime.formatTime "%Y-%m-%d %H:%M:%S%Q %Z" t)
+    PTime t -> dquotes $ pretty (formatLTime t)
+
+
+pactValueToText :: PactValue -> Text
+pactValueToText = \case
+  PLiteral lit -> case lit of
+    LString s -> tdquotes s
+    LInteger i -> tshow i
+    LDecimal d ->
+      if roundTo 0 d == d then
+        tshow (roundTo 0 d) <> ".0"
+      else tshow d
+    LUnit -> "()"
+    LBool b -> if b then "true" else "false"
+  PList l -> let
+    l' = pactValueToText <$> V.toList l
+    in tlist l'
+  PGuard g -> case g of
+    GKeyset (KeySet ks f) -> let
+      keys = tlist (fmap _pubKey $ S.toList ks)
+      p = predicateToText f
+      in tcurly "KeySet" [("keys", keys), ("pred", p)]
+    GKeySetRef ksn -> T.concat ["'", renderKeySetName ksn]
+    GUserGuard (UserGuard f args) -> let
+      f' = renderQualName f
+      args' = tlist (pactValueToText <$> args)
+      in tcurly "UserGuard" [("fun", f'), ("args", args')]
+    GCapabilityGuard (CapabilityGuard n args pid) -> let
+      mpid = [("pactId", maybe mempty _defPactId pid)]
+      pvs = pactValueToText <$> args
+      elems = [("name", renderQualName n), ("args", tlist pvs)] ++ mpid
+      in tcurly "CapabilityGuard" elems
+    GModuleGuard (ModuleGuard mn n) ->
+      tcurly "ModuleGuard" [("module", renderModuleName mn), ("name", n)]
+    GDefPactGuard (DefPactGuard pid n) ->
+      tcurly "PactGuard" [("pactId", _defPactId pid), ("name", n)]
+  PObject o -> let
+    o' = fmap (\(Field f, pv) -> T.concat [tdquotes f, ": ", pactValueToText pv]) $ M.toList o
+    in T.concat ["{",T.intercalate "," o', "}"]
+  PModRef (ModRef mn _) ->
+    renderModuleName mn
+  PCapToken (CapToken qn args) -> let
+    args' = if null args then mempty else " " <> T.intercalate " " (pactValueToText <$> args)
+    qualName = fqnToQualName qn
+    in T.concat ["CapToken(", renderQualName qualName, args',")"] -- Todo: check
+  PTime t -> tdquotes $ formatLTime t
+  where
+    tdquotes x = T.concat ["\"",x,"\""]
+    tshow :: Show a => a -> Text
+    tshow = T.pack . show
+    tlist l = T.concat ["[",T.intercalate ", " l, "]"]
+    tcurly :: Text -> [(Text, Text)] -> Text
+    tcurly n l = let
+      l' = fmap (\(k, v) -> T.concat [k, ": ", v]) l
+      in T.concat [n, " {", T.intercalate "," l', "}"]
 
 synthesizePvType :: PactValue -> Type
 synthesizePvType = \case