set consensus state in savepoint

Author: edmundnoble

src/Chainweb/Pact/Backend/ChainwebPactDb.hs

@@ -751,18 +751,19 @@ createVersionedTable tablename db = do
 
 setConsensusState :: SQ3.Database -> ConsensusState -> ExceptT LocatedSQ3Error IO ()
 setConsensusState db cs = do
-    exec' db
-        "INSERT INTO ConsensusState (blockheight, hash, payloadhash, safety) VALUES \
-        \(?, ?, ?, ?);"
-        (toRow "final" $ _consensusStateFinal cs)
-    exec' db
-        "INSERT INTO ConsensusState (blockheight, hash, payloadhash, safety) VALUES \
-        \(?, ?, ?, ?);"
-        (toRow "safe" $ _consensusStateSafe cs)
-    exec' db
-        "INSERT INTO ConsensusState (blockheight, hash, payloadhash, safety) VALUES \
-        \(?, ?, ?, ?);"
-        (toRow "latest" $ _consensusStateLatest cs)
+    withSavepoint db SetConsensusSavePoint $ do
+        exec' db
+            "INSERT INTO ConsensusState (blockheight, hash, payloadhash, safety) VALUES \
+            \(?, ?, ?, ?);"
+            (toRow "final" $ _consensusStateFinal cs)
+        exec' db
+            "INSERT INTO ConsensusState (blockheight, hash, payloadhash, safety) VALUES \
+            \(?, ?, ?, ?);"
+            (toRow "safe" $ _consensusStateSafe cs)
+        exec' db
+            "INSERT INTO ConsensusState (blockheight, hash, payloadhash, safety) VALUES \
+            \(?, ?, ?, ?);"
+            (toRow "latest" $ _consensusStateLatest cs)
     where
     toRow safety SyncState {..} =
         [ SInt $ fromIntegral @BlockHeight @Int64 _syncStateHeight

src/Chainweb/Pact/Backend/Utils.hs

@@ -206,6 +206,7 @@ data SavepointName
     | RewindSavePoint
     | InitSchemaSavePoint
     | ValidateBlockSavePoint
+    | SetConsensusSavePoint
     deriving (Eq, Ord, Enum, Bounded)
 
 instance Show SavepointName where
@@ -218,6 +219,7 @@ instance HasTextRepresentation SavepointName where
     toText RewindSavePoint = "rewind"
     toText InitSchemaSavePoint = "init-schema"
     toText ValidateBlockSavePoint = "validate-block"
+    toText SetConsensusSavePoint = "set-consensus"
     {-# INLINE toText #-}
 
     fromText "read-from" = pure ReadFromSavepoint
@@ -226,6 +228,7 @@ instance HasTextRepresentation SavepointName where
     fromText "rewind" = pure RewindSavePoint
     fromText "init-schema" = pure InitSchemaSavePoint
     fromText "validate-block" = pure ValidateBlockSavePoint
+    fromText "set-consensus" = pure SetConsensusSavePoint
     fromText t = throwM $ TextFormatException
         $ "failed to decode SavepointName " <> t
         <> ". Valid names are " <> T.intercalate ", " (toText @SavepointName <$> [minBound .. maxBound])