From 6a641e5178d260fd30d49dadf572100cf2428847 Mon Sep 17 00:00:00 2001
From: Greg Hale <imalsogreg@gmail.com>
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