From 69e9b20181decd7a0eaaa6a2775f13fd92991dfa Mon Sep 17 00:00:00 2001 From: Robert Soeldner Date: Sun, 13 Oct 2024 21:28:33 +0200 Subject: [PATCH] add pactValueToText --- pact-tests/pact-tests/format-regression.repl | 54 +++++++++++++++ pact/Pact/Core/Guards.hs | 2 +- pact/Pact/Core/IR/Eval/Runtime/Utils.hs | 8 ++- pact/Pact/Core/PactValue.hs | 69 +++++++++++++++++++- 4 files changed, 127 insertions(+), 6 deletions(-) create mode 100644 pact-tests/pact-tests/format-regression.repl diff --git a/pact-tests/pact-tests/format-regression.repl b/pact-tests/pact-tests/format-regression.repl new file mode 100644 index 000000000..2f1b71af5 --- /dev/null +++ b/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"))])) + + + diff --git a/pact/Pact/Core/Guards.hs b/pact/Pact/Core/Guards.hs index 1b276153a..84039dbe0 100644 --- a/pact/Pact/Core/Guards.hs +++ b/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 diff --git a/pact/Pact/Core/IR/Eval/Runtime/Utils.hs b/pact/Pact/Core/IR/Eval/Runtime/Utils.hs index 1d19e9781..0a062b038 100644 --- a/pact/Pact/Core/IR/Eval/Runtime/Utils.hs +++ b/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 diff --git a/pact/Pact/Core/PactValue.hs b/pact/Pact/Core/PactValue.hs index cd1c204b2..33023d0b6 100644 --- a/pact/Pact/Core/PactValue.hs +++ b/pact/Pact/Core/PactValue.hs @@ -28,13 +28,14 @@ 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 @@ -42,6 +43,8 @@ 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