Use hackage rawlock

IntersectMBO · Oct 23, 2024 · 9913ef5 · 9913ef5
1 parent 43e04df
commit 9913ef5
Show file tree

Hide file tree

Showing 9 changed files with 17 additions and 778 deletions.
diff --git a/cabal.project b/cabal.project
@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- update either of these.
 index-state:
   -- Bump this if you need newer packages from Hackage
-  , hackage.haskell.org 2024-09-16T12:20:25Z
+  , hackage.haskell.org 2024-10-22T14:26:27Z
   -- Bump this if you need newer packages from CHaP
   , cardano-haskell-packages 2024-10-21T06:28:35Z
 
@@ -44,3 +44,6 @@ package ouroboros-network
 if(os(windows))
   constraints:
     bitvec -simd
+
+-- https://github.com/ulidtko/cabal-doctest/issues/85
+constraints: Cabal < 3.13
diff --git a/flake.lock b/flake.lock
diff --git a/ouroboros-consensus/changelog.d/js-rawlock.md b/ouroboros-consensus/changelog.d/js-rawlock.md
@@ -0,0 +1,3 @@
+## Breaking
+
+* Use [`rawlock`](https://hackage.haskell.org/package/rawlock) instead of the in-tree implementation.
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)