diff --git a/cabal.project b/cabal.project index d2b983366..05f55ad99 100644 --- a/cabal.project +++ b/cabal.project @@ -101,8 +101,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/pact-5.git - tag: ebb66271ecce7cac1a7901a15658ad1b8233743a - --sha256: 1c362q6jpiq7gndypxci5bdpcm7hxbpg90fim4c977pxphsbiv1k + tag: 827d01b384fb2c6b3d84fea51aff41a1c81ea04e + --sha256: 13ja4zwjwc5h5rmlan5dsasn7mj3g9613hnyhkfrjw5zkbrw7ipl source-repository-package type: git diff --git a/src/Chainweb/Pact/Backend/InMemDb.hs b/src/Chainweb/Pact/Backend/InMemDb.hs index e2d26514a..2baa61fb8 100644 --- a/src/Chainweb/Pact/Backend/InMemDb.hs +++ b/src/Chainweb/Pact/Backend/InMemDb.hs @@ -22,8 +22,8 @@ module Chainweb.Pact.Backend.InMemDb import Prelude hiding (lookup) import Control.Lens import Data.ByteString (ByteString) -import Data.Map.Strict(Map) -import Data.Map.Strict qualified as Map +import Data.HashMap.Strict(HashMap) +import Data.HashMap.Strict qualified as HashMap import Pact.Core.Persistence import Pact.Core.Builtin @@ -33,6 +33,8 @@ import Pact.Core.Names import Pact.Core.Namespace import Pact.Core.DefPacts.Types import Pact.Core.IR.Term (ModuleCode) +import Data.Hashable +import Data.Maybe data Entry a = ReadEntry !Int !a @@ -45,13 +47,12 @@ data Entry a makePrisms ''Entry data Store = Store - -- TODO: hashmap instead of map? Or maybe an intmap? - { userTables :: Map TableName (Map RowKey (Entry RowData)) - , keySets :: Map KeySetName (Entry KeySet) - , modules :: Map ModuleName (Entry (ModuleData CoreBuiltin Info)) - , namespaces :: Map NamespaceName (Entry Namespace) - , defPacts :: Map DefPactId (Entry (Maybe DefPactExec)) - , moduleSources :: Map HashedModuleName (Entry ModuleCode) + { userTables :: HashMap TableName (HashMap RowKey (Entry RowData)) + , keySets :: HashMap KeySetName (Entry KeySet) + , modules :: HashMap ModuleName (Entry (ModuleData CoreBuiltin Info)) + , namespaces :: HashMap NamespaceName (Entry Namespace) + , defPacts :: HashMap DefPactId (Entry (Maybe DefPactExec)) + , moduleSources :: HashMap HashedModuleName (Entry ModuleCode) } deriving (Show, Eq) @@ -65,9 +66,7 @@ insert insert d k v Store {..} = case d of DUserTables tn -> Store { userTables = - Map.insertWith - (\new old -> mergeEntries old new) - tn (Map.singleton k v) userTables + userTables & at tn %~ Just . insertProperlyInto . fromMaybe mempty , ..} DKeySets -> Store {keySets = insertProperlyInto keySets, ..} DModules -> Store {modules = insertProperlyInto modules, ..} @@ -75,32 +74,28 @@ insert d k v Store {..} = case d of DDefPacts -> Store {defPacts = insertProperlyInto defPacts, ..} DModuleSource -> Store {moduleSources = insertProperlyInto moduleSources, ..} where - insertProperlyInto :: Ord k => Map k (Entry v) -> Map k (Entry v) - insertProperlyInto m = Map.insertWith takeLatestEntry k v m + insertProperlyInto :: Hashable k => HashMap k (Entry v) -> HashMap k (Entry v) + insertProperlyInto m = HashMap.insertWith (\new old -> takeLatestEntry old new) k v m lookup :: Domain k v CoreBuiltin Info -> k -> Store -> Maybe (Entry v) lookup d k Store {..} = case d of - DUserTables tn -> Map.lookup tn userTables >>= Map.lookup k - DKeySets -> Map.lookup k keySets - DModules -> Map.lookup k modules - DNamespaces -> Map.lookup k namespaces - DDefPacts -> Map.lookup k defPacts - DModuleSource -> Map.lookup k moduleSources + DUserTables tn -> HashMap.lookup tn userTables >>= HashMap.lookup k + DKeySets -> HashMap.lookup k keySets + DModules -> HashMap.lookup k modules + DNamespaces -> HashMap.lookup k namespaces + DDefPacts -> HashMap.lookup k defPacts + DModuleSource -> HashMap.lookup k moduleSources keys :: Domain k v CoreBuiltin Info -> Store -> [k] keys d Store {..} = case d of - DUserTables tn -> maybe [] Map.keys $ Map.lookup tn userTables - DKeySets -> Map.keys keySets - DModules -> Map.keys modules - DNamespaces -> Map.keys namespaces - DDefPacts -> Map.keys defPacts - DModuleSource -> Map.keys moduleSources - -mergeEntries :: Ord k => Map k (Entry a) -> Map k (Entry a) -> Map k (Entry a) -mergeEntries oldMap newMap = - Map.unionWith takeLatestEntry oldMap newMap + DUserTables tn -> maybe [] HashMap.keys $ HashMap.lookup tn userTables + DKeySets -> HashMap.keys keySets + DModules -> HashMap.keys modules + DNamespaces -> HashMap.keys namespaces + DDefPacts -> HashMap.keys defPacts + DModuleSource -> HashMap.keys moduleSources takeLatestEntry :: Entry a -> Entry a -> Entry a takeLatestEntry ReadEntry {} newEntry = newEntry diff --git a/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs b/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs index 8ccfc3eea..bb5e1d63e 100644 --- a/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs +++ b/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs @@ -87,6 +87,7 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.DList as DL import Data.List(sort) import qualified Data.HashSet as HashSet +import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Text as T @@ -693,23 +694,29 @@ commitBlockStateToDatabase db hsh bh blockHandle = do -> IO () backendWriteUpdateBatch store = do writeTable (domainToTableName Pact.DKeySets) - $ M.mapMaybeWithKey (prepRow . convKeySetName) $ InMemDb.keySets store + $ mapMaybe (uncurry $ prepRow . convKeySetName) + $ HashMap.toList (InMemDb.keySets store) writeTable (domainToTableName Pact.DModules) - $ M.mapMaybeWithKey (prepRow . convModuleName) $ InMemDb.modules store + $ mapMaybe (uncurry $ prepRow . convModuleName) + $ HashMap.toList (InMemDb.modules store) writeTable (domainToTableName Pact.DNamespaces) - $ M.mapMaybeWithKey (prepRow . convNamespaceName) $ InMemDb.namespaces store + $ mapMaybe (uncurry $ prepRow . convNamespaceName) + $ HashMap.toList (InMemDb.namespaces store) writeTable (domainToTableName Pact.DDefPacts) - $ M.mapMaybeWithKey (prepRow . convPactId) $ InMemDb.defPacts store + $ mapMaybe (uncurry $ prepRow . convPactId) + $ HashMap.toList (InMemDb.defPacts store) writeTable (domainToTableName Pact.DModuleSource) - $ M.mapMaybeWithKey (prepRow . convHashedModuleName) $ InMemDb.moduleSources store + $ mapMaybe (uncurry $ prepRow . convHashedModuleName) + $ HashMap.toList (InMemDb.moduleSources store) iforM_ (InMemDb.userTables store) $ \tableName tableContents -> do writeTable (domainToTableName (Pact.DUserTables tableName)) - $ M.mapMaybeWithKey (prepRow . convRowKey) tableContents + $ mapMaybe (uncurry $ prepRow . convRowKey) + $ HashMap.toList tableContents where domainToTableName = SQ3.Utf8 . T.encodeUtf8 . Pact.renderDomain @@ -721,7 +728,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do ] prepRow _ InMemDb.ReadEntry {} = Nothing - writeTable :: SQ3.Utf8 -> M.Map k [SType] -> IO () + writeTable :: SQ3.Utf8 -> [[SType]] -> IO () writeTable table writes = when (not (null writes)) $ do execMulti db q writes markTableMutation table bh @@ -743,9 +750,8 @@ commitBlockStateToDatabase db hsh bh blockHandle = do , SBlob (runPutS (encodeBlockHash hsh)) , SInt (fromIntegral t) ] - where - stmt = - "INSERT INTO BlockHistory ('blockheight','hash','endingtxid') VALUES (?,?,?);" + where + stmt = "INSERT INTO BlockHistory ('blockheight','hash','endingtxid') VALUES (?,?,?);" createUserTable :: SQ3.Utf8 -> IO () createUserTable tablename = do @@ -756,7 +762,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do -- to drop it if we rewind past this block. markTableCreation tablename = exec' db insertstmt insertargs - where + where insertstmt = "INSERT OR IGNORE INTO VersionedTableCreation VALUES (?,?)" insertargs = [SText tablename, SInt (fromIntegral bh)] @@ -766,9 +772,9 @@ commitBlockStateToDatabase db hsh bh blockHandle = do let txs = _pendingSuccessfulTxs $ _blockHandlePending blockHandle dbIndexTransactions txs - where + where toRow b = [SBlob b, SInt (fromIntegral bh)] dbIndexTransactions txs = do let rows = map toRow $ toList txs - execMulti db "INSERT INTO TransactionIndex (txhash, blockheight) \ - \ VALUES (?, ?)" rows + let q = "INSERT INTO TransactionIndex (txhash, blockheight) VALUES (?, ?)" + execMulti db q rows diff --git a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs index 852f40d60..f93038fde 100644 --- a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs +++ b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs @@ -40,8 +40,8 @@ import Control.Monad.Reader import Control.Monad.Trans.Resource import Data.Decimal import Data.Functor.Product +import Data.HashMap.Strict qualified as HashMap import Data.IORef -import Data.Map qualified as Map import Data.Maybe (fromMaybe) import Data.Set qualified as Set import Data.String (fromString) @@ -467,9 +467,9 @@ applyCmdSpec rdb = readFromAfterGenesis v rdb $ do ? P.fun _pendingWrites ? P.checkAll [ P.fun InMemDb.userTables - ? P.alignExact ? Map.fromList + ? P.alignExact ? HashMap.fromList [ TableName "coin-table" (ModuleName "coin" Nothing) :=> - P.alignExact ? Map.fromList + P.alignExact ? HashMap.fromList [ RowKey "NoMiner" :=> P.match InMemDb._WriteEntry P.succeed , RowKey "sender00" :=> @@ -478,7 +478,7 @@ applyCmdSpec rdb = readFromAfterGenesis v rdb $ do ] , P.fun InMemDb.modules - ? P.alignExact ? Map.fromList + ? P.alignExact ? HashMap.fromList [ ModuleName "coin" Nothing :=> P.match InMemDb._ReadEntry P.succeed ] @@ -889,7 +889,7 @@ testWritesFromFailedTxDontMakeItIn rdb = readFromAfterGenesis v rdb $ do ? P.fail "no writes made to module table" , P.fun InMemDb.userTables ? P.match (ix (TableName "coin-table" (ModuleName "coin" Nothing))) - ? P.alignExact ? Map.fromList + ? P.alignExact ? HashMap.fromList [ RowKey "NoMiner" :=> P.match InMemDb._WriteEntry P.succeed , RowKey "sender00" :=> P.match InMemDb._WriteEntry P.succeed ]