From b0a5cda1478c12f9144edcae085074de37d21e75 Mon Sep 17 00:00:00 2001 From: jmcardon Date: Mon, 21 Oct 2024 15:04:22 -0400 Subject: [PATCH] add tables as pact values --- pact/Pact/Core/IR/Eval/Runtime/Types.hs | 14 +------------ pact/Pact/Core/Names.hs | 17 ++++++++++++++++ pact/Pact/Core/PactValue.hs | 19 +++++++++++++++++ pact/Pact/Core/Persistence/SQLite.hs | 11 ++++++---- pact/Pact/Core/Serialise/CBOR_V1.hs | 20 ++++++++++++++++++ pact/Pact/Core/SizeOf.hs | 2 ++ pact/Pact/Core/StableEncoding.hs | 27 +++++++++++++++++++++++++ 7 files changed, 93 insertions(+), 17 deletions(-) diff --git a/pact/Pact/Core/IR/Eval/Runtime/Types.hs b/pact/Pact/Core/IR/Eval/Runtime/Types.hs index fdd9fbc35..5a2a0819a 100644 --- a/pact/Pact/Core/IR/Eval/Runtime/Types.hs +++ b/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) diff --git a/pact/Pact/Core/Names.hs b/pact/Pact/Core/Names.hs index feb1316c8..b664c3f68 100644 --- a/pact/Pact/Core/Names.hs +++ b/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) diff --git a/pact/Pact/Core/PactValue.hs b/pact/Pact/Core/PactValue.hs index 1baed9f52..4c6bc9de0 100644 --- a/pact/Pact/Core/PactValue.hs +++ b/pact/Pact/Core/PactValue.hs @@ -29,6 +29,7 @@ module Pact.Core.PactValue , _PUnit , synthesizePvType , pactValueToText + , TableValue(..) ) where import Control.Lens @@ -53,9 +54,22 @@ 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) @@ -63,6 +77,7 @@ data 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) diff --git a/pact/Pact/Core/Persistence/SQLite.hs b/pact/Pact/Core/Persistence/SQLite.hs index dd76ae9c7..7a12d40f3 100644 --- a/pact/Pact/Core/Persistence/SQLite.hs +++ b/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 diff --git a/pact/Pact/Core/Serialise/CBOR_V1.hs b/pact/Pact/Core/Serialise/CBOR_V1.hs index b729e353c..93400eefc 100644 --- a/pact/Pact/Core/Serialise/CBOR_V1.hs +++ b/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 #-} diff --git a/pact/Pact/Core/SizeOf.hs b/pact/Pact/Core/SizeOf.hs index 6e51c28ac..645f1aa88 100644 --- a/pact/Pact/Core/SizeOf.hs +++ b/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 diff --git a/pact/Pact/Core/StableEncoding.hs b/pact/Pact/Core/StableEncoding.hs index 8d3905919..af8584a09 100644 --- a/pact/Pact/Core/StableEncoding.hs +++ b/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