Add rawlock package

IntersectMBO · Oct 21, 2024 · 3850112 · 3850112
1 parent 3b8f972
commit 3850112
Show file tree

Hide file tree

Showing 21 changed files with 887 additions and 580 deletions.
diff --git a/README.md b/README.md
@@ -4,6 +4,7 @@
 [![diffusion](https://img.shields.io/badge/ouroboros--consensus--diffusion-0.18.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-diffusion-0.18.0.0/)
 [![protocol](https://img.shields.io/badge/ouroboros--consensus--protocol-0.9.0.2-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-protocol-0.9.0.2/)
 [![cardano](https://img.shields.io/badge/ouroboros--consensus--cardano-0.20.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-cardano-0.20.0.0/)
+[![rawlock](https://img.shields.io/badge/rawlock-0.1.0.0-blue)](https://chap.intersectmbo.org/package/strict-sop-core-0.1.0.0/)
 [![sop-extras](https://img.shields.io/badge/sop--extras-0.2.1.0-blue)](https://chap.intersectmbo.org/package/sop-extras-0.2.1.0/)
 [![strict-sop-core](https://img.shields.io/badge/strict--sop--core-0.1.2.0-blue)](https://chap.intersectmbo.org/package/strict-sop-core-0.1.2.0/)
 

diff --git a/cabal.project b/cabal.project
@@ -23,6 +23,7 @@ packages:
   ouroboros-consensus-cardano
   ouroboros-consensus-protocol
   ouroboros-consensus-diffusion
+  rawlock
   sop-extras
   strict-sop-core
 

diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal
@@ -261,7 +261,6 @@ library
     Ouroboros.Consensus.Util.IOLike
     Ouroboros.Consensus.Util.LeakyBucket
     Ouroboros.Consensus.Util.MonadSTM.NormalForm
-    Ouroboros.Consensus.Util.MonadSTM.RAWLock
     Ouroboros.Consensus.Util.MonadSTM.StrictSVar
     Ouroboros.Consensus.Util.NormalForm.StrictMVar
     Ouroboros.Consensus.Util.NormalForm.StrictTVar
@@ -302,6 +301,7 @@ library
     primitive,
     psqueues ^>=0.2.3,
     quiet ^>=0.2,
+    rawlock ^>=0.1,
     reflection,
     semialign >=1.1,
     serialise ^>=0.2,
@@ -534,7 +534,6 @@ test-suite consensus-test
     Test.Consensus.MiniProtocol.LocalStateQuery.Server
     Test.Consensus.ResourceRegistry
     Test.Consensus.Util.MonadSTM.NormalForm
-    Test.Consensus.Util.MonadSTM.RAWLock
     Test.Consensus.Util.Versioned
 
   build-depends:

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/VolatileDB/Impl.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/VolatileDB/Impl.hs
@@ -119,6 +119,7 @@ import qualified Codec.CBOR.Write as CBOR
 import           Control.Monad (unless, when)
 import           Control.Monad.State.Strict (get, gets, lift, modify, put,
                      state)
+import qualified Control.RAWLock as RAWLock
 import           Control.Tracer (Tracer, nullTracer, traceWith)
 import qualified Data.ByteString.Lazy as Lazy
 import           Data.List as List (foldl')
@@ -141,7 +142,6 @@ import           Ouroboros.Consensus.Storage.VolatileDB.Impl.Types
 import           Ouroboros.Consensus.Storage.VolatileDB.Impl.Util
 import           Ouroboros.Consensus.Util.Args
 import           Ouroboros.Consensus.Util.IOLike
-import qualified Ouroboros.Consensus.Util.MonadSTM.RAWLock as RAWLock
 import           Ouroboros.Consensus.Util.ResourceRegistry
 import           Ouroboros.Network.Block (MaxSlotNo (..))
 import           System.FS.API.Lazy
@@ -233,7 +233,7 @@ closeDBImpl ::
   -> m ()
 closeDBImpl VolatileDBEnv { varInternalState, tracer, hasFS } = do
     mbInternalState <-
-      RAWLock.withWriteAccess varInternalState $ \st -> return (DbClosed, st)
+      RAWLock.withWriteAccess varInternalState $ \st -> return (st, DbClosed)
     case mbInternalState of
       DbClosed -> traceWith tracer DBAlreadyClosed
       DbOpen ost -> do

diff --git a/...os-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/VolatileDB/Impl/State.hs b/...os-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/VolatileDB/Impl/State.hs
@@ -33,6 +33,8 @@ module Ouroboros.Consensus.Storage.VolatileDB.Impl.State (
 
 import           Control.Monad
 import           Control.Monad.State.Strict hiding (withState)
+import           Control.RAWLock (RAWLock)
+import qualified Control.RAWLock as RAWLock
 import           Control.Tracer (Tracer, traceWith)
 import qualified Data.ByteString.Lazy as Lazy
 import           Data.List as List (foldl')
@@ -52,10 +54,8 @@ import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl.Index as Index
 import           Ouroboros.Consensus.Storage.VolatileDB.Impl.Parser
 import           Ouroboros.Consensus.Storage.VolatileDB.Impl.Types
 import           Ouroboros.Consensus.Storage.VolatileDB.Impl.Util
-import           Ouroboros.Consensus.Util (whenJust, (.:))
+import           Ouroboros.Consensus.Util (whenJust)
 import           Ouroboros.Consensus.Util.IOLike
-import           Ouroboros.Consensus.Util.MonadSTM.RAWLock (RAWLock)
-import qualified Ouroboros.Consensus.Util.MonadSTM.RAWLock as RAWLock
 import           Ouroboros.Consensus.Util.ResourceRegistry (WithTempRegistry,
                      allocateTemp, modifyWithTempRegistry)
 import           Ouroboros.Network.Block (MaxSlotNo (..))
@@ -135,8 +135,7 @@ modifyOpenState appendOrWrite
     -- temporary registry.
     (acquire, release) = case appendOrWrite of
       Append ->
-        (atomically .  RAWLock.unsafeAcquireAppendAccess,
-         atomically .: RAWLock.unsafeReleaseAppendAccess)
+        (RAWLock.unsafeAcquireAppendAccess, RAWLock.unsafeReleaseAppendAccess)
       Write  ->
         (RAWLock.unsafeAcquireWriteAccess, RAWLock.unsafeReleaseWriteAccess)
 

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/IOLike.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/IOLike.hs
@@ -82,6 +82,7 @@ class ( MonadAsync              m
       , Alternative        (STM m)
       , MonadCatch         (STM m)
       , PrimMonad               m
+      , MonadLabelledSTM        m
       , forall a. NoThunks (m a)
       , forall a. NoThunks a => NoThunks (StrictTVar m a)
       , forall a. NoThunks a => NoThunks (StrictSVar m a)