cleanup

pact-core-tests/Pact/Core/Test/PersistenceTests.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
 -- |
 
 module Pact.Core.Test.PersistenceTests where
@@ -7,7 +6,6 @@ import Control.Monad.IO.Class (liftIO)
 import Hedgehog (Gen, Property, (===), forAll, property)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Hedgehog
-import Test.Tasty.HUnit
 import qualified Hedgehog.Gen as Gen
 
 import Pact.Core.Names (FullyQualifiedName)
@@ -19,10 +17,8 @@ import Pact.Core.Persistence.SQLite
 import Pact.Core.Persistence (WriteType(Insert), readKeySet, writeKeySet, writeModule, readModule
                              ,writeDefPacts, readDefPacts, readNamespace, writeNamespace
                              , Domain(..), PactDb(_pdbKeys))
-import Pact.Core.Serialise.LegacyPact
 import Data.Foldable (forM_)
 import qualified Data.Text as T
-import Data.String.QQ
 
 testsWithSerial :: (Show b, Show i, Eq b, Eq i) => PactSerialise b i -> Gen b -> Gen i -> [TestTree]
 testsWithSerial serial b i =
@@ -35,42 +31,35 @@ testsWithSerial serial b i =
 tests :: TestTree
 tests = testGroup "Persistence Roundtrip"
   [ testGroup "CBOR encoding/decoding" $ testsWithSerial serialisePact builtinGen (pure ())
-  , testGroup "Regression tests"  [ex1]
   ]
 
-
-ex1 :: TestTree
-ex1 = testCase "DefPact" $
-  assertEqual ""  (Right Nothing) (decodeDefPactExec1 bs)
-  where
-    bs = [s|{"executed":null,"pactId":"44AZc5R-mnuF_ehKF_qXHMzHDnqjVcsdXmRaVbo8g6s","stepHasRollback":false,"step":0,"yield":{"data":{"amount":1,"receiver":"3b60fc72f90fde59d32799c89f550b959b2e9c86f6f8a880af5120c7e62507eb","receiver-guard":{"pred":"keys-all","keys":["3b60fc72f90fde59d32799c89f550b959b2e9c86f6f8a880af5120c7e62507eb"]}},"provenance":{"targetChainId":"0","moduleHash":"ut_J_ZNkoyaPUEJhiwVeWnkSQn9JT9sQCWKdjjVVrWo"}},"continuation":{"args":["9645627f5dad4029f091128e17a030ed15ff6dc554d276824deabbb546488e35","3b60fc72f90fde59d32799c89f550b959b2e9c86f6f8a880af5120c7e62507eb",{"pred":"keys-all","keys":["3b60fc72f90fde59d32799c89f550b959b2e9c86f6f8a880af5120c7e62507eb"]},"0",1],"def":"coin.transfer-crosschain"},"stepCount":2}|]
-
-
 readExistingDb :: FilePath -> IO ()
 readExistingDb fp = withSqlitePactDb serialisePact (T.pack fp) $ \pdb -> do
   keys <- _pdbKeys pdb DKeySets
   forM_ keys $ \k -> do
     print k
     Just _ <- readKeySet pdb k
     pure ()
-
-  -- TODO: Implement testing against pact sqlite files
 
- -- k <- SELECT name FROM sqlite_master WHERE type='table';
-
-
+  -- TODO: fails
   -- keys' <- _pdbKeys pdb DNamespaces
   -- forM_ keys' $ \k -> do
   --   Just n <- readNamespace pdb k
   --   print n
   --   pure ()
-  
-  keys'' <- _pdbKeys pdb DDefPacts
-  forM_ keys'' $ \k -> do
+
+  keys' <- _pdbKeys pdb DDefPacts
+  forM_ keys' $ \k -> do
     print k
     Just _n <- readDefPacts pdb k
     pure ()
 
+  -- TODO: fails
+  -- keys <- _pdbKeys pdb DModules
+  -- forM_ keys $ \mn -> do
+  --   print mn
+  --   Just _ <- readModule pdb mn
+  --   pure ()
 
 
 keysetPersistRoundtrip :: PactSerialise b i -> Gen (KeySet FullyQualifiedName) -> Property

pact-core.cabal

@@ -252,8 +252,7 @@ test-suite core-tests
     , tasty-hedgehog
     , serialise
     , cborg
-    , string-qq
-
+
   other-modules:
     , Pact.Core.Test.ReplTests
     , Pact.Core.Test.LexerParserTests

pact-core/Pact/Core/Persistence/SQLite.hs

@@ -10,7 +10,6 @@ module Pact.Core.Persistence.SQLite (
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Exception.Lifted (bracket)
 import Control.Monad.IO.Class (MonadIO, liftIO)
--- import qualified Data.Text as T
 import Data.IORef (newIORef, IORef, readIORef, atomicModifyIORef')
 import Data.Text (Text)
 import Control.Lens (view)
@@ -20,7 +19,7 @@ import Pact.Core.Guards (renderKeySetName, KeySetName(..))
 import Pact.Core.Names (renderModuleName, DefPactId(..), NamespaceName(..), TableName(..), RowKey(..), parseRenderedModuleName)
 import Pact.Core.Persistence (PactDb(..), Domain(..),
                               Purity(PImpure)
-                             ,WriteType(..) --, RowData(..)
+                             ,WriteType(..)
                              ,toUserTable
                              ,ExecutionMode(..), TxId(..)
                              )

pact-core/Pact/Core/Serialise/LegacyPact.hs

@@ -152,8 +152,11 @@ instance JD.FromJSON (DefPactContinuation FullyQualifiedName PactValue) where
 
 instance JD.FromJSON FullyQualifiedName where
   parseJSON = JD.withText "QualifiedName" $ \n -> case T.split (== '.') n  of
-    [mod', name] -> pure (FullyQualifiedName (ModuleName mod' Nothing) name (ModuleHash defaultPactHash))
+    [mod', name] -> pure (FullyQualifiedName (ModuleName mod' Nothing) name mh)
+    [ns, mod', name] -> pure (FullyQualifiedName (ModuleName mod' (Just (NamespaceName ns))) name mh)
     _ -> fail "unexpeced parsing"
+    where
+      mh = ModuleHash defaultPactHash
 
 -- instance JD.FromJSON QualifiedName where
 --   parseJSON = JD.withText "QualifiedName" $ \n -> case T.split (== '.') n  of
@@ -313,5 +316,14 @@ fromLegacyPactValue = \case
     Legacy_LTime utc -> PTime utc
   Legacy_PList v -> PList (fromLegacyPactValue <$> v)
   Legacy_PObject o -> PObject (fromLegacyPactValue <$> o)
-  Legacy_PGuard _g -> undefined
+  Legacy_PGuard g -> PGuard (guardToPactValue g)
   Legacy_PModRef mref -> PModRef mref
+
+
+guardToPactValue :: Guard FullyQualifiedName LegacyPactValue -> Guard FullyQualifiedName PactValue
+guardToPactValue = \case
+  (GKeyset ks) -> GKeyset ks
+  (GKeySetRef kref) -> GKeySetRef kref
+  (GUserGuard (UserGuard n tm)) -> GUserGuard (UserGuard n (fromLegacyPactValue <$> tm))
+  (GCapabilityGuard (CapabilityGuard n args i)) -> GCapabilityGuard (CapabilityGuard n (fromLegacyPactValue <$> args) i)
+  (GModuleGuard mg) -> GModuleGuard mg