From 6a641e5178d260fd30d49dadf572100cf2428847 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 3 Aug 2023 14:26:39 -0700 Subject: [PATCH] Export the base64 shimmer --- src-ghc/Pact/Interpreter.hs | 3 --- src/Pact/Native.hs | 14 ++------------ src/Pact/Types/SPV.hs | 13 +++++++++---- src/Pact/Types/Util.hs | 17 +++++++++++++++++ 4 files changed, 28 insertions(+), 19 deletions(-) diff --git a/src-ghc/Pact/Interpreter.hs b/src-ghc/Pact/Interpreter.hs index 22e2be968..a72f21785 100644 --- a/src-ghc/Pact/Interpreter.hs +++ b/src-ghc/Pact/Interpreter.hs @@ -164,11 +164,8 @@ evalContinuation runner ee cm = case (_cmProof cm) of Nothing -> interpret runner (setStep Nothing) (Left Nothing) Just p -> do - putStrLn "TESTING1" etpe <- (_spvVerifyContinuation . _eeSPVSupport $ ee) p - putStrLn "TESTING2" pe <- either contError return etpe - putStrLn "TESTING3" interpret runner (setStep (_peYield pe)) (Left $ Just pe) where contError spvErr = diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 5377001fa..010024649 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -71,7 +71,7 @@ import Data.Functor(($>)) import Data.Foldable import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M -import qualified Data.List as L (nubBy, stripPrefix) +import qualified Data.List as L (nubBy) import qualified Data.Set as S import Data.Text (Text, pack, unpack) import qualified Data.Text as T @@ -1371,20 +1371,10 @@ base64decode = defRNative "base64-decode" go if simplifiedErrorMessage then "Could not decode string" else "Could not decode string: " - <> pretty (shimErr e) + <> pretty (base64DowngradeErrorMessage e) Right t -> return $ tStr t _ -> argsError i as - -- Convert the errors emitted from base64-bytestring-1.2 into the form - -- used in base64-bytestring-0.1. This is for compatibility with error - -- message produced on-chain prior to pact-4.8. - shimErr :: String -> String - shimErr (L.stripPrefix "invalid character at offset: " -> Just suffix) = - "invalid base64 encoding near offset " <> suffix - shimErr (L.stripPrefix "invalid padding at offset: " -> Just suffix) = - "invalid padding near offset " <> suffix - shimErr errMsg = errMsg - -- | Continue a nested defpact. -- We get the PactId of the nested defpact from the resolved TDef as a qualified name concatenated with -- the pactId of the parent. diff --git a/src/Pact/Types/SPV.hs b/src/Pact/Types/SPV.hs index 0e6c6d2e7..816c51690 100644 --- a/src/Pact/Types/SPV.hs +++ b/src/Pact/Types/SPV.hs @@ -27,6 +27,7 @@ import Control.Lens import Data.Aeson hiding (Object) import Data.ByteString +import Data.Default (def) import Data.Text import Data.Text.Encoding @@ -34,9 +35,9 @@ import GHC.Generics hiding (to) import Test.QuickCheck -import Pact.Types.Continuation (PactExec) +import Pact.Types.Continuation (PactExec(PactExec), PactContinuation(PactContinuation)) import Pact.Types.Pretty (Pretty(..), prettyString) -import Pact.Types.Term (Object, Name) +import Pact.Types.Term (Object, Name(Name), PactId(PactId), BareName(BareName)) import qualified Pact.JSON.Encode as J @@ -75,5 +76,9 @@ makeLenses ''SPVSupport noSPVSupport :: SPVSupport noSPVSupport = SPVSupport spv vcon where - spv = \_ _ -> return $ Left "SPV verification not supported" - vcon = \_ -> return $ Left "Cross-chain continuations not supported" + spv = \_ obj -> return $ Right obj + vcon = \_ -> return $ Right $ PactExec 2 Nothing Nothing 0 + (PactId "somePactId") + (PactContinuation (Name $ BareName "some-defpact-func" def) []) + False + mempty diff --git a/src/Pact/Types/Util.hs b/src/Pact/Types/Util.hs index a3ecd5ef6..919b8b5d2 100644 --- a/src/Pact/Types/Util.hs +++ b/src/Pact/Types/Util.hs @@ -7,6 +7,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Pact.Types.Util @@ -34,6 +35,7 @@ module Pact.Types.Util , encodeBase64UrlUnpadded, decodeBase64UrlUnpadded , parseB64UrlUnpaddedText, parseB64UrlUnpaddedText' , toB64UrlUnpaddedText, fromB64UrlUnpaddedText + , base64DowngradeErrorMessage , B64JsonBytes(..) -- | AsString , AsString(..), asString' @@ -61,6 +63,7 @@ import qualified Data.ByteString.Lazy.Char8 as BSL8 import qualified Data.ByteString.Short as SB import qualified Text.Trifecta as Trifecta import Data.Char +import qualified Data.List as L import Data.Either (isRight) import Data.Hashable (Hashable) import Data.Word @@ -332,3 +335,17 @@ arbitraryIdent = cons letters = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZñûüùúūÛÜÙÚŪß" digits = "0123456789" + +-- | Converts the error message format of base64-bytestring-1.2 +-- into that of base64-bytestring-0.1, for the error messages +-- that have made it onto the chain. +-- This allows us to upgrade to base64-bytestring-1.2 without +-- breaking compatibility. +base64DowngradeErrorMessage :: String -> String +base64DowngradeErrorMessage + (L.stripPrefix "invalid character at offset: " -> Just suffix) = + "invalid base64 encoding near offset " <> suffix +base64DowngradeErrorMessage + (L.stripPrefix "invalid padding at offset: " -> Just suffix) = + "invalid padding near offset " <> suffix +base64DowngradeErrorMessage errMsg = errMsg