wip

pact-core-tests/Pact/Core/Gen/Serialise.hs

@@ -38,8 +38,8 @@ moduleNameGen =  do
 publicKeyTextGen :: Gen PublicKeyText
 publicKeyTextGen = PublicKeyText <$> identGen
 
-ksPredicateGen :: Gen (KSPredicate n)
-ksPredicateGen = Gen.elements [minBound .. maxBound]
+-- ksPredicateGen :: Gen (KSPredicate n)
+-- ksPredicateGen = Gen.element [minBound .. maxBound]
 
 keySetNameGen :: Gen KeySetName
 keySetNameGen = KeySetName <$> identGen

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

@@ -17,7 +17,9 @@ import qualified Data.ByteString as B
 
 import Pact.Core.Gas
 import Pact.Core.Literal
-import Pact.Core.Persistence
+-- import Pact.Core.Persistence
+import Pact.Core.Persistence.MockPersistence
+import Pact.Core.Serialise
 import Pact.Core.Interpreter
 
 import Pact.Core.Repl.Utils

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

@@ -28,17 +28,17 @@ documentVersionGen = DocumentVersion <$> Gen.word32 (Range.linear 0 100)
 documentGen :: Gen a -> Gen (Document a)
 documentGen g = Document <$> documentVersionGen <*> documentFormatGen <*> g
 
-serialiseModule :: Property
-serialiseModule = property $ do
-  m <- forAll evalModuleGen
-  let
-    encoded = _encodeModule serialiseCBOR m
-  case _decodeModule serialiseCBOR encoded of
-    Left _ -> fail "asas"
-    Right (Document v f c) -> do
-      v === DocumentVersion 0
-      f === DocumentCBOR
-      m === c
+-- serialiseModule :: Property
+-- serialiseModule = property $ do
+--   m <- forAll evalModuleGen
+--   let
+--     encoded = _encodeModuleData serialiseCBOR m
+--   case _decodeModuleData serialiseCBOR encoded of
+--     Left _ -> fail "asas"
+--     Right (Document v f c) -> do
+--       v === DocumentVersion 0
+--       f === DocumentCBOR
+--       m === c
 
 tests :: TestTree
 tests = testGroup "Serialise Roundtrip"
@@ -87,8 +87,10 @@ tests = testGroup "Serialise Roundtrip"
     , testProperty "DefTable" $ serialiseRoundtrip defTableGen
     , testProperty "Step" $ serialiseRoundtrip stepGen
     , testProperty "DefPact" $ serialiseRoundtrip defPactGen
-    ],
-    testGroup "CBOR Serialise"
-      [ testProperty "Module roundtrip" serialiseModule
-      ]
+    -- , testProperty "ReplBuiltins" $ serialiseRoundtrip replBuiltinsGen
+    -- , testProperty "ReplRawBuiltin" $ serialiseRoundtrip replRawBuiltinGen
+    ] 
+    -- testGroup "CBOR Serialise"
+    --   [ testProperty "Module roundtrip" serialiseModule
+    --   ]
   ]

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

@@ -15,17 +15,17 @@ import Data.Text (Text)
 import qualified Database.SQLite3 as SQL
 
 import Pact.Core.Guards (KeySetName(_keySetName))
-import Pact.Core.Names (ModuleName, renderModuleName)
+import Pact.Core.Names (renderModuleName)
 import Pact.Core.Persistence (PactDb(..), Domain(..),
                               Purity(PImpure)
-                             , FQKS, WriteType(..)
+                             ,WriteType(..)
                              )
 -- import Pact.Core.Repl.Utils (ReplEvalM)
 import Pact.Core.Serialise
 
 withSqlitePactDb
   :: (MonadIO m, MonadBaseControl IO m)
-  => PactSerialise
+  => PactSerialise b i
   -> Text
   -> (PactDb b i -> m a)
   -> m a
@@ -39,7 +39,7 @@ withSqlitePactDb serial connectionString act =
 
 -- | Create all tables that should exist in a fresh pact db,
 --   or ensure that they are already created.
-initializePactDb :: PactSerialise -> SQL.Database  -> IO (PactDb b i)
+initializePactDb :: PactSerialise b i -> SQL.Database  -> IO (PactDb b i)
 initializePactDb serial db = do
   -- liftIO (createTables db)
   pure $ PactDb
@@ -55,8 +55,8 @@ initializePactDb serial db = do
     , _pdbGetTxLog = undefined
     }
 
-write' :: forall k v b i. PactSerialise -> SQL.Database -> WriteType -> Domain k v b i -> k -> v -> IO ()
-write' serial db wt domain k v = case domain of
+write' :: forall k v b i. PactSerialise b i -> SQL.Database -> WriteType -> Domain k v b i -> k -> v -> IO ()
+write' serial db _wt domain k v = case domain of
   DKeySets -> withStmt db "INSERT INTO SYS_keysets (rowkey, rowdata) VALUES (?,?)" $ \stmt -> do
       let encoded = _encodeKeySet serial v
       SQL.bind stmt [SQL.SQLText (_keySetName k), SQL.SQLBlob encoded]
@@ -65,7 +65,7 @@ write' serial db wt domain k v = case domain of
         SQL.Row -> fail "invariant viaolation"
   _ -> undefined
 
-read' :: forall k v b i. PactSerialise -> SQL.Database -> Domain k v b i -> k -> IO (Maybe v)
+read' :: forall k v b i. PactSerialise b i -> SQL.Database -> Domain k v b i -> k -> IO (Maybe v)
 read' serial db domain k = case domain of
   DKeySets -> withStmt db "SELECT rowdata FROM SYS_keysets ORDER BY txid DESCENDING WHERE rowkey = ? LIMIT 1" $ \stmt -> do
       SQL.bind stmt [SQL.SQLText (_keySetName k)]
@@ -86,16 +86,12 @@ read' serial db domain k = case domain of
           1 <- SQL.columnCount stmt
           [SQL.SQLBlob value] <- SQL.columns stmt
           SQL.Done <- SQL.step stmt
-          case _decodeModule serial value of
+          case _decodeModuleData serial value of
             Left _ -> pure Nothing
             Right (Document _ _ c) -> pure (Just c)
-  DUserTables tbl -> readRowData tbl
-  DDefPacts -> readDefPacts
+  DUserTables _tbl -> pure Nothing
+  DDefPacts -> pure Nothing
   DNamespaces -> pure Nothing
-  where
-    readModules = pure @IO Nothing
-    readRowData _tbl = pure Nothing
-    readDefPacts = pure @IO Nothing
 
 -- Utility functions
 withStmt :: SQL.Database -> Text -> (SQL.Statement -> IO a) -> IO a

pact-core/Pact/Core/Repl.hs

@@ -28,7 +28,8 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Set as Set
 
-import Pact.Core.Persistence
+--import Pact.Core.Persistence
+import Pact.Core.Persistence.MockPersistence
 import Pact.Core.Pretty
 import Pact.Core.Builtin
 import Pact.Core.Names

pact-core/Pact/Core/Repl/Compile.hs

@@ -35,6 +35,7 @@ import Pact.Core.IR.Term
 import Pact.Core.Compile
 import Pact.Core.Interpreter
 import Pact.Core.Environment
+import Pact.Core.Serialise
 
 
 import Pact.Core.IR.Eval.Runtime
@@ -83,7 +84,7 @@ interpretReplProgram (SourceCode _ source) display = do
           oldSrc <- use replCurrSource
           evalState .= def
           pactdb <- liftIO mockPactDb
-          _ <- withSqlitePactDb "" pure
+          _ <- withSqlitePactDb (serialiseCBOR :: PactSerialise ReplRawBuiltin ()) "" pure
           replPactDb .= pactdb
           replEvalEnv .= defaultEvalEnv pactdb replRawBuiltinMap
           out <- loadFile (T.unpack txt) display

pact-core/Pact/Core/Serialise.hs

@@ -13,8 +13,8 @@ import Data.Word (Word32)
 
 import Pact.Core.Info
 import Pact.Core.Builtin
-import Pact.Core.IR.Term
---import Pact.Core.Persistence
+--import Pact.Core.IR.Term
+import Pact.Core.Persistence
 import Pact.Core.Guards
 import Pact.Core.Names
 
@@ -63,24 +63,24 @@ data DecodeError
 
 -- | A Serializer that encodes in CBOR at the latest version, and attempts
 --   to decode at each possible version, starting from the most recent.
-defaultSerializeForDatabase :: PactSerialise
+defaultSerializeForDatabase :: PactSerialise b i
 defaultSerializeForDatabase = undefined
 
 
 -- | The main serialization API for Pact entities.
-data PactSerialise
+data PactSerialise b i
   = PactSerialise
-  { _encodeModule :: EvalModule RawBuiltin SpanInfo -> ByteString -- TODO: This should be ModuleData
-  , _decodeModule :: ByteString -> Either DecodeError (Document (EvalModule RawBuiltin SpanInfo))
+  { _encodeModuleData :: ModuleData RawBuiltin SpanInfo -> ByteString
+  , _decodeModuleData :: ByteString -> Either DecodeError (Document (ModuleData b i))
   , _encodeKeySet :: KeySet FullyQualifiedName -> ByteString
   , _decodeKeySet :: ByteString -> Either DecodeError (Document (KeySet FullyQualifiedName))
   }
 
 
-serialiseCBOR :: PactSerialise
+serialiseCBOR :: (S.Serialise b, S.Serialise i) => PactSerialise b i
 serialiseCBOR = PactSerialise
-  { _encodeModule = toStrictByteString . S.encode . Document version format
-  , _decodeModule = first toErr . S.deserialiseOrFail . fromStrict
+  { _encodeModuleData = toStrictByteString . S.encode . Document version format
+  , _decodeModuleData = first toErr . S.deserialiseOrFail . fromStrict
   , _encodeKeySet = toStrictByteString . S.encode . Document version format
   , _decodeKeySet = first toErr . S.deserialiseOrFail . fromStrict
   }

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

@@ -674,3 +674,78 @@ instance Serialise RawBuiltin where
     108 -> pure RawDefineNamespace
     109 -> pure RawDescribeNamespace
     _ -> fail "unexpeced decoding"
+
+
+instance Serialise ReplBuiltins where
+  encode = encodeWord . fromIntegral . fromEnum
+  decode = toEnum . fromIntegral <$> decodeWord
+  -- encode = \case
+  --   RExpect -> encodeWord 0
+  --   RExpectFailure -> encodeWord 1
+  --   RExpectFailureMatch -> encodeWord 2
+  --   RExpectThat -> encodeWord 3
+  --   RPrint -> encodeWord 4
+  --   REnvStackFrame -> encodeWord 5
+  --   REnvChainData -> encodeWord 6
+  --   REnvData -> encodeWord 7
+  --   REnvEvents -> encodeWord 8
+  --   REnvHash -> encodeWord 9
+  --   REnvKeys -> encodeWord 10
+  --   REnvSigs -> encodeWord 11
+  --   RBeginTx -> encodeWord 12
+  --   RBeginNamedTx -> encodeWord 13
+  --   RCommitTx -> encodeWord 14
+  --   RRollbackTx -> encodeWord 15
+  --   RSigKeyset -> encodeWord 16
+  --   RTestCapability -> encodeWord 17
+  --   REnvExecConfig -> encodeWord 18
+  --   REnvNamespacePolicy -> encodeWord 19
+  --   RContinuePact -> encodeWord 20
+  --   RContinuePactRollback -> encodeWord 21
+  --   RContinuePactRollbackYield -> encodeWord 22
+  --   RPactState -> encodeWord 23
+  --   RResetPactState -> encodeWord 24
+  -- decode = decodeWord >>= \case
+  --   0 -> pure RExpect
+  --   1 -> pure RExpectFailure
+  --   2 -> pure RExpectFailureMatch
+  --   3 -> pure RExpectThat
+  -- | RPrint
+  -- | REnvStackFrame
+  -- | REnvChainData
+  -- | REnvData
+  -- | REnvEvents
+  -- | REnvHash
+  -- | REnvKeys
+  -- | REnvSigs
+  -- | RBeginTx
+  -- | RBeginNamedTx
+  -- | RCommitTx
+  -- | RRollbackTx
+  -- | RSigKeyset
+  -- | RTestCapability
+  -- | REnvExecConfig
+  -- | REnvNamespacePolicy
+  -- -- | REnvGas
+  -- -- | REnvGasLimit
+  -- -- | REnvGasLog
+  -- -- | REnvGasModel
+  -- -- | REnvGasPrice
+  -- -- | REnvGasRate
+  -- -- | REnvNamespacePolicy
+  -- -- Defpact
+  -- | RContinuePact
+  -- | RContinuePactRollback
+  -- | RContinuePactRollbackYield
+  -- | RPactState
+  -- | RResetPactState
+
+
+instance Serialise ReplRawBuiltin where
+  encode (RBuiltinWrap b) = encodeWord 0 <> encode b
+  encode (RBuiltinRepl r) = encodeWord 1 <> encode r
+
+  decode = decodeWord >>= \case
+    0 -> RBuiltinWrap <$> decode
+    1 -> RBuiltinRepl <$> decode
+    _ -> fail "unexpected decoding"