add tables as pact values

pact/Pact/Core/IR/Eval/Runtime/Types.hs

@@ -13,8 +13,7 @@
 {-# LANGUAGE InstanceSigs #-}
 
 module Pact.Core.IR.Eval.Runtime.Types
-  ( TableValue(..)
-  , ErrorState(..)
+  (ErrorState(..)
   , EvalCapType(..)) where
 
 
@@ -26,21 +25,10 @@ import Control.DeepSeq
 import Pact.Core.Names
 
 import Pact.Core.PactValue
-import Pact.Core.Hash
-import Pact.Core.Type
 import Pact.Core.Capabilities
 import Pact.Core.Environment
 
 
-data TableValue
-  = TableValue
-  { _tvName :: !TableName
-  , _tvHash :: !ModuleHash
-  , _tvSchema :: !Schema
-  } deriving (Show, Generic)
-
-instance NFData TableValue
-
 -- | State to preserve in the error handler
 data ErrorState i
   = ErrorState (CapState QualifiedName PactValue) [StackFrame i] (NonEmpty RecursionCheck)

pact/Pact/Core/Names.hs

@@ -66,6 +66,8 @@ module Pact.Core.Names
  , parseFullyQualifiedName
  , VerifierName(..)
  , renderTableName
+ , jsonSafeRenderTableName
+ , parseJsonSafeTableName
  , HashedModuleName(..)
  , renderHashedModuleName
  , parseHashedModuleName
@@ -454,6 +456,13 @@ moduleNameParser = do
     p1 <- identParser
     pure (ModuleName p1 (Just (NamespaceName ns)))
 
+jsonSafeTableNameParser :: Parser TableName
+jsonSafeTableNameParser = do
+  p <- moduleNameParser
+  _ <- MP.char ':'
+  ident <- identParser
+  pure (TableName ident p)
+
 hashedModuleNameParser :: Parser HashedModuleName
 hashedModuleNameParser = do
   mn <- moduleNameParser
@@ -557,3 +566,11 @@ renderTableName (TableName tbl mn) = renderModuleName mn <> "_" <> tbl
 renderHashedModuleName :: HashedModuleName -> Text
 renderHashedModuleName (HashedModuleName mn mh) =
   renderModuleName mn <> "{" <> moduleHashToText mh <> "}"
+
+-- | Map the user's table name into a set of names suitable for
+--   storage in the persistence backend.
+jsonSafeRenderTableName :: TableName -> Text
+jsonSafeRenderTableName (TableName tbl mn) = renderModuleName mn <> ":" <> tbl
+
+parseJsonSafeTableName :: Text -> Maybe TableName
+parseJsonSafeTableName = MP.parseMaybe (jsonSafeTableNameParser <* MP.eof)

pact/Pact/Core/PactValue.hs

@@ -29,6 +29,7 @@ module Pact.Core.PactValue
  , _PUnit
  , synthesizePvType
  , pactValueToText
+ , TableValue(..)
  ) where
 
 import Control.Lens
@@ -53,16 +54,30 @@ import Pact.Core.Literal
 import Pact.Core.Pretty
 import Pact.Core.ModRefs
 import Pact.Core.Capabilities
+import Pact.Core.Hash
 
 import qualified Pact.Core.Pretty as Pretty
 
+data TableValue
+  = TableValue
+  { _tvName :: !TableName
+  , _tvHash :: !ModuleHash
+  , _tvSchema :: !Schema
+  } deriving (Show, Eq, Ord, Generic)
+
+instance Pretty TableValue where
+  pretty (TableValue n _ _) = pretty (renderTableName n)
+
+instance NFData TableValue
+
 data PactValue
   = PLiteral !Literal
   | PList !(Vector PactValue)
   | PGuard !(Guard QualifiedName PactValue)
   | PObject !(Map Field PactValue)
   | PModRef !ModRef
   | PCapToken !(CapToken FullyQualifiedName PactValue)
+  | PTable !TableValue
   | PTime !PactTime.UTCTime
   -- Note:
   -- This ord instance is dangerous. Be careful of comparisons with it
@@ -117,6 +132,7 @@ instance Pretty PactValue where
     PCapToken (CapToken fqn args) ->
       "CapToken" <> pretty (CapToken (fqnToQualName fqn) args)
     PTime t -> dquotes $ pretty (formatLTime t)
+    PTable t -> pretty t
 
 
 pactValueToText :: PactValue -> Text
@@ -161,6 +177,8 @@ pactValueToText = \case
     qualName = fqnToQualName qn
     in T.concat ["CapToken(", renderQualName qualName, args',")"] -- Todo: check
   PTime t -> tdquotes $ formatLTime t
+  PTable (TableValue tn _ _) ->
+    renderTableName tn
   where
     tdquotes x = T.concat ["\"",x,"\""]
     tshow :: Show a => a -> Text
@@ -180,6 +198,7 @@ synthesizePvType = \case
   PObject _ -> TyAnyObject
   PCapToken {} -> TyCapToken
   PTime _ -> TyTime
+  PTable sc -> TyTable (_tvSchema sc)
 
 
 

pact/Pact/Core/Persistence/SQLite.hs

@@ -128,12 +128,15 @@ createSysTables db = do
   where
     mkTbl tbl = do
       SQL.exec db (cStmt tbl)
+      SQL.exec db (indexStmt tbl)
       mkTblStatement db tbl
     cStmt tbl = "CREATE TABLE IF NOT EXISTS \"" <> tbl <> "\" \
-                \ (txid UNSIGNED BIG INT, \
-                \  rowkey TEXT, \
-                \  rowdata BLOB, \
-                \  UNIQUE (txid, rowkey))"
+                \ (rowkey TEXT,  \
+                \  txid UNSIGNED BIGINT NOT NULL, \
+                \  rowdata BLOB NOT NULL, \
+                \  UNIQUE (txid, rowkey));"
+    indexStmt tbl =
+      "CREATE INDEX IF NOT EXISTS " <> tbl <> "_ix" <> " ON " <> tbl <> " (txid DESC);"
 
 data TblStatements
   = TblStatements

pact/Pact/Core/Serialise/CBOR_V1.hs

@@ -980,6 +980,24 @@ instance Serialise (SerialiseV1 name) => Serialise (SerialiseV1 (CapToken name P
     SerialiseV1 <$> (CapToken <$> decodeS <*> decodeS)
   {-# INLINE decode #-}
 
+instance Serialise (SerialiseV1 TableName) where
+  encode (SerialiseV1 (TableName tn mn)) =
+    encodeListLen 2 <> encode tn <> encodeS mn
+  {-# INLINE encode #-}
+  decode = do
+    safeDecodeListLen 2 "TableName"
+    SerialiseV1 <$> (TableName <$> decode <*> decodeS)
+  {-# INLINE decode #-}
+
+instance Serialise (SerialiseV1 TableValue) where
+  encode (SerialiseV1 (TableValue tn k v)) =
+    encodeListLen 3 <> encodeS tn <> encodeS k <> encodeS v
+  {-# INLINE encode #-}
+  decode = do
+    safeDecodeListLen 3 "TableValue"
+    SerialiseV1 <$> (TableValue <$> decodeS <*> decodeS <*> decodeS)
+  {-# INLINE decode #-}
+
 instance Serialise (SerialiseV1 PactValue) where
   encode (SerialiseV1 pv) =
     encodeListLen 2 <>
@@ -991,6 +1009,7 @@ instance Serialise (SerialiseV1 PactValue) where
       PModRef mr -> encodeWord 4 <> encodeS mr
       PCapToken ct -> encodeWord 5 <> encodeS ct
       PTime (UTCTime (NominalDiffTime pt)) -> encodeWord 6 <> encode pt
+      PTable t -> encodeWord 7 <> encodeS t
   {-# INLINE encode #-}
   decode = do
     safeDecodeListLen 2 "PactValue"
@@ -1002,6 +1021,7 @@ instance Serialise (SerialiseV1 PactValue) where
       4 -> PModRef <$> decodeS
       5 -> PCapToken <$> decodeS
       6 -> PTime . UTCTime . NominalDiffTime <$> decode
+      7 -> PTable <$> decodeS
       _ -> fail "unexpected decoding"
   {-# INLINE decode #-}
 

pact/Pact/Core/SizeOf.hs

@@ -366,6 +366,8 @@ makeSizeOf ''DefManagedMeta
 makeSizeOf ''DefCapMeta
 makeSizeOf ''Governance
 makeSizeOf ''ModRef
+makeSizeOf ''TableName
+makeSizeOf ''TableValue
 makeSizeOf ''PactValue
 makeSizeOf ''DefPactContinuation
 makeSizeOf ''Provenance

pact/Pact/Core/StableEncoding.hs

@@ -48,6 +48,7 @@ import Pact.Core.PactValue
 import Pact.Time
 import Data.Maybe (fromMaybe)
 import Pact.Core.Namespace
+import Pact.Core.Type
 
 -- | JSON serialization for 'readInteger' and public meta info;
 -- accepts both a String version (parsed as a Pact integer),
@@ -485,6 +486,31 @@ instance J.Encode (StableEncoding UTCTime) where
   build (StableEncoding utc) = encoder timeCodec utc
   {-# INLINABLE build #-}
 
+instance J.Encode (StableEncoding PrimType) where
+
+
+instance J.Encode (StableEncoding Type) where
+  build (StableEncoding ty) = case ty of
+    TyPrim p -> J.build (StableEncoding p)
+
+instance J.Encode (StableEncoding TableName) where
+  build (StableEncoding tn) =
+    J.build $ jsonSafeRenderTableName tn
+  {-# INLINABLE build #-}
+
+instance JD.FromJSON (StableEncoding TableName) where
+  parseJSON = JD.withText "TableName" $ \t -> case parseJsonSafeTableName t of
+    Just tn -> pure $ StableEncoding tn
+    _ -> fail "could not parse table name"
+
+instance J.Encode (StableEncoding TableValue) where
+  build (StableEncoding (TableValue tn mh sc)) = J.object
+    [ "`tableName" J..= StableEncoding tn
+    , "`moduleHash" J..= StableEncoding mh
+    , "`schema" J..= StableEncoding sc
+    ]
+  {-# INLINABLE build #-}
+
 -- | Stable encoding of `PactValue`
 instance J.Encode (StableEncoding PactValue) where
   build (StableEncoding pv) = case pv of
@@ -495,6 +521,7 @@ instance J.Encode (StableEncoding PactValue) where
     PModRef mr -> J.build (StableEncoding mr)
     PCapToken ct -> J.build (StableEncoding ct)
     PTime pt -> J.build (StableEncoding pt)
+    PTable t -> J.build (StableEncoding t)
   {-# INLINABLE build #-}
 
 instance JD.FromJSON (StableEncoding PactValue) where