Fix compilation after renaming.

ouroboros-consensus-cardano/src/tools/Cardano/Tools/DBAnalyser/Run.hs

@@ -52,7 +52,7 @@ analyse ::
   -> IO (Maybe AnalysisResult)
 analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbose} args =
     withRegistry $ \registry -> do
-      lock           <- newMVar ()
+      lock           <- newSVar ()
       chainDBTracer  <- mkTracer lock verbose
       analysisTracer <- mkTracer lock True
       ProtocolInfo { pInfoInitLedger = genesisLedger, pInfoConfig = cfg } <-
@@ -128,7 +128,7 @@ analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbo
         hPutStrLn stderr $ concat ["[", show diff, "] ", show ev]
         hFlush stderr
       where
-        withLock = bracket_ (takeMVar lock) (putMVar lock ())
+        withLock = bracket_ (takeSVar lock) (putSVar lock ())
 
     immValidationPolicy = case (analysis, validation) of
       (_, Just ValidateAllBlocks)      -> ImmutableDB.ValidateAllChunks

ouroboros-consensus-cardano/src/tools/Cardano/Tools/DBTruncater/Run.hs

@@ -103,15 +103,15 @@ findNewTip target iter =
         IteratorResult item -> do
           if acceptable item then go (Just item) else pure acc
 
-mkLock :: MonadSTM m => m (StrictMVar m ())
-mkLock = newMVar ()
+mkLock :: MonadSTM m => m (StrictSVar m ())
+mkLock = newSVar ()
 
-mkTracer :: Show a => StrictMVar IO () -> Bool -> IO (Tracer IO a)
+mkTracer :: Show a => StrictSVar IO () -> Bool -> IO (Tracer IO a)
 mkTracer _ False = pure mempty
 mkTracer lock True = do
   startTime <- getMonotonicTime
   pure $ Tracer $ \ev -> do
-    bracket_ (takeMVar lock) (putMVar lock ()) $ do
+    bracket_ (takeSVar lock) (putSVar lock ()) $ do
       traceTime <- getMonotonicTime
       let diff = diffTime traceTime startTime
       hPutStrLn stderr $ concat ["[", show diff, "] ", show ev]

ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Ledger/HotKey.hs

@@ -173,13 +173,13 @@ mkHotKey ::
   -> Word64              -- ^ Max KES evolutions
   -> m (HotKey c m)
 mkHotKey initKey startPeriod@(Absolute.KESPeriod start) maxKESEvolutions = do
-    varKESState <- newMVar initKESState
+    varKESState <- newSVar initKESState
     return HotKey {
         evolve     = evolveKey varKESState
-      , getInfo    = kesStateInfo <$> readMVar varKESState
-      , isPoisoned = kesKeyIsPoisoned . kesStateKey <$> readMVar varKESState
+      , getInfo    = kesStateInfo <$> readSVar varKESState
+      , isPoisoned = kesKeyIsPoisoned . kesStateKey <$> readSVar varKESState
       , sign_      = \toSign -> do
-          KESState { kesStateInfo, kesStateKey } <- readMVar varKESState
+          KESState { kesStateInfo, kesStateKey } <- readSVar varKESState
           case kesStateKey of
             KESKeyPoisoned -> error "trying to sign with a poisoned key"
             KESKey key     -> do
@@ -217,8 +217,8 @@ mkHotKey initKey startPeriod@(Absolute.KESPeriod start) maxKESEvolutions = do
 -- When the key is poisoned, we always return 'UpdateFailed'.
 evolveKey ::
      forall m c. (Crypto c, IOLike m)
-  => StrictMVar m (KESState c) -> Absolute.KESPeriod -> m KESEvolutionInfo
-evolveKey varKESState targetPeriod = modifyMVar varKESState $ \kesState -> do
+  => StrictSVar m (KESState c) -> Absolute.KESPeriod -> m KESEvolutionInfo
+evolveKey varKESState targetPeriod = modifySVar varKESState $ \kesState -> do
     let info = kesStateInfo kesState
     -- We mask the evolution process because if we got interrupted after
     -- calling 'forgetSignKeyKES', which destructively updates the current

ouroboros-consensus/src/consensus-testlib/Test/Util/LogicalClock.hs

@@ -152,7 +152,7 @@ newWithDelay :: (IOLike m, HasCallStack)
              -> m (LogicalClock m)
 newWithDelay registry (NumTicks numTicks) tickLen = do
     current <- newTVarIO 0
-    done    <- newEmptyMVar ()
+    done    <- newEmptySVar ()
     _thread <- forkThread registry "ticker" $ do
                  -- Tick 0 is the first tick, so increment @numTicks - 1@ times
                  replicateM_ (fromIntegral numTicks - 1) $ do
@@ -163,11 +163,11 @@ newWithDelay registry (NumTicks numTicks) tickLen = do
                  -- Give tests that need to do some final processing on the last
                  -- tick a chance to do that before we indicate completion.
                  threadDelay (nominalDelay tickLen)
-                 putMVar done ()
+                 putSVar done ()
 
     return LogicalClock {
         getCurrentTick = Tick <$> readTVar current
-      , waitUntilDone  = readMVar done
+      , waitUntilDone  = readSVar done
       , mockSystemTime = BTime.SystemTime {
             BTime.systemTimeCurrent = do
               tick <- atomically $ readTVar current

ouroboros-consensus/src/consensus-testlib/Test/Util/Orphans/NoThunks.hs

@@ -11,8 +11,8 @@ import           Data.Proxy
 import           NoThunks.Class (NoThunks (..))
 import           Ouroboros.Consensus.Util.MonadSTM.NormalForm
 
-instance NoThunks a => NoThunks (StrictMVar (IOSim s) a) where
-  showTypeOf _ = "StrictMVar IOSim"
-  wNoThunks ctxt StrictMVar { tvar } = do
+instance NoThunks a => NoThunks (StrictSVar (IOSim s) a) where
+  showTypeOf _ = "StrictSVar IOSim"
+  wNoThunks ctxt StrictSVar { tvar } = do
       a <- unsafeSTToIO $ lazyToStrictST $ inspectTVar (Proxy :: Proxy (IOSim s)) tvar
       noThunks ctxt a

ouroboros-consensus/src/mock-block/Ouroboros/Consensus/Mock/Node/Praos.hs

@@ -96,16 +96,16 @@ praosBlockForging ::
   -> HotKey PraosMockCrypto
   -> m (BlockForging m MockPraosBlock)
 praosBlockForging cid initHotKey = do
-    varHotKey <- newMVar initHotKey
+    varHotKey <- newSVar initHotKey
     return $ BlockForging {
         forgeLabel       = "praosBlockForging"
       , canBeLeader      = cid
-      , updateForgeState = \_ sno _ -> updateMVar varHotKey $
+      , updateForgeState = \_ sno _ -> updateSVar varHotKey $
                                  second forgeStateUpdateInfoFromUpdateInfo
                                . evolveKey sno
       , checkCanForge    = \_ _ _ _ _ -> return ()
       , forgeBlock       = \cfg bno sno tickedLedgerSt txs isLeader -> do
-                               hotKey <- readMVar varHotKey
+                               hotKey <- readSVar varHotKey
                                return $
                                  forgeSimple
                                    (forgePraosExt hotKey)

ouroboros-consensus/src/mock-block/Ouroboros/Consensus/Mock/Protocol/Praos.hs

@@ -213,7 +213,7 @@ deriving instance PraosCrypto c => Show (HotKey c)
 newtype HotKeyEvolutionError = HotKeyEvolutionError Period
   deriving (Show)
 
--- | To be used in conjunction with, e.g., 'updateMVar'.
+-- | To be used in conjunction with, e.g., 'updateSVar'.
 --
 -- NOTE: when the key's period is after the target period, we shouldn't use
 -- it, but we currently do. In real TPraos we check this in

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs

@@ -56,7 +56,8 @@ import qualified Ouroboros.Consensus.Mempool.TxSeq as TxSeq
 import           Ouroboros.Consensus.Storage.ChainDB (ChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
 import           Ouroboros.Consensus.Util (repeatedly)
-import           Ouroboros.Consensus.Util.IOLike hiding (newEmptyMVar, newMVar)
+import           Ouroboros.Consensus.Util.IOLike
+
 {-------------------------------------------------------------------------------
   Internal State
 -------------------------------------------------------------------------------}

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs

@@ -170,7 +170,7 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
       varFollowers       <- newTVarIO Map.empty
       varNextIteratorKey <- newTVarIO (IteratorKey 0)
       varNextFollowerKey <- newTVarIO (FollowerKey   0)
-      varCopyLock        <- newMVar  ()
+      varCopyLock        <- newSVar  ()
       varKillBgThreads   <- newTVarIO $ return ()
       blocksToAdd        <- newBlocksToAdd (Args.cdbBlocksToAddSize args)
 

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs

@@ -197,8 +197,8 @@ copyToImmutableDB CDB{..} = withCopyLock $ do
 
     withCopyLock :: forall a. HasCallStack => m a -> m a
     withCopyLock = bracket_
-      (fmap mustBeUnlocked $ tryTakeMVar cdbCopyLock)
-      (putMVar  cdbCopyLock ())
+      (fmap mustBeUnlocked $ tryTakeSVar cdbCopyLock)
+      (putSVar  cdbCopyLock ())
 
     mustBeUnlocked :: forall b. HasCallStack => Maybe b -> b
     mustBeUnlocked = fromMaybe

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs

@@ -225,7 +225,7 @@ data ChainDbEnv m blk = CDB
     -- not when hashes are garbage-collected from the map.
   , cdbNextIteratorKey :: !(StrictTVar m IteratorKey)
   , cdbNextFollowerKey :: !(StrictTVar m FollowerKey)
-  , cdbCopyLock        :: !(StrictMVar m ())
+  , cdbCopyLock        :: !(StrictSVar m ())
     -- ^ Lock used to ensure that 'copyToImmutableDB' is not executed more than
     -- once concurrently.
     --

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ImmutableDB/Impl.hs

@@ -257,7 +257,7 @@ openDBInternal ImmutableDbArgs { immHasFS = SomeHasFS hasFS, .. } cont = cont $
           }
     ost <- validateAndReopen validateEnv immRegistry immValidationPolicy
 
-    stVar <- lift $ newMVar (DbOpen ost)
+    stVar <- lift $ newSVar (DbOpen ost)
 
     let dbEnv = ImmutableDBEnv {
             hasFS            = hasFS
@@ -286,16 +286,16 @@ closeDBImpl ::
   => ImmutableDBEnv m blk
   -> m ()
 closeDBImpl ImmutableDBEnv { hasFS, tracer, varInternalState } = do
-    internalState <- takeMVar varInternalState
+    internalState <- takeSVar varInternalState
     case internalState of
       -- Already closed
       DbClosed -> do
-        putMVar varInternalState internalState
+        putSVar varInternalState internalState
         traceWith tracer $ DBAlreadyClosed
       DbOpen openState -> do
         -- Close the database before doing the file-system operations so that
         -- in case these fail, we don't leave the database open.
-        putMVar varInternalState DbClosed
+        putSVar varInternalState DbClosed
         cleanUp hasFS openState
         traceWith tracer DBClosed
 

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Cache.hs

@@ -356,9 +356,9 @@ data CacheEnv m blk h = CacheEnv
   { hasFS       :: HasFS m h
   , registry    :: ResourceRegistry m
   , tracer      :: Tracer m TraceCacheEvent
-  , cacheVar    :: StrictMVar m (Cached blk)
+  , cacheVar    :: StrictSVar m (Cached blk)
   , cacheConfig :: CacheConfig
-  , bgThreadVar :: StrictMVar m (Maybe (Thread m Void))
+  , bgThreadVar :: StrictSVar m (Maybe (Thread m Void))
     -- ^ Nothing if no thread running
   , chunkInfo   :: ChunkInfo
   }
@@ -386,10 +386,10 @@ newEnv hasFS registry tracer cacheConfig chunkInfo chunk = do
       error "pastChunksToCache must be > 0"
 
     currentChunkInfo <- loadCurrentChunkInfo hasFS chunkInfo chunk
-    cacheVar <- newMVarWithInvariants $ emptyCached chunk currentChunkInfo
-    bgThreadVar <- newMVar Nothing
+    cacheVar <- newSVarWithInvariants $ emptyCached chunk currentChunkInfo
+    bgThreadVar <- newSVar Nothing
     let cacheEnv = CacheEnv {..}
-    mask_ $ modifyMVar_ bgThreadVar $ \_mustBeNothing -> do
+    mask_ $ modifySVar_ bgThreadVar $ \_mustBeNothing -> do
       !bgThread <- forkLinkedThread registry "ImmutableDB.expireUnusedChunks" $
         expireUnusedChunks cacheEnv
       return $ Just bgThread
@@ -399,8 +399,8 @@ newEnv hasFS registry tracer cacheConfig chunkInfo chunk = do
 
     -- When checking invariants, check both our invariants and for thunks.
     -- Note that this is only done when the corresponding flag is enabled.
-    newMVarWithInvariants =
-      Strict.newMVarWithInvariant $ \cached ->
+    newSVarWithInvariants =
+      Strict.newSVarWithInvariant $ \cached ->
         checkInvariants pastChunksToCache cached
         `mplus`
         (show <$> unsafeNoThunks cached)
@@ -420,7 +420,7 @@ expireUnusedChunks
 expireUnusedChunks CacheEnv { cacheVar, cacheConfig, tracer } =
     forever $ do
       now <- getMonotonicTime
-      mbTraceMsg <- updateMVar cacheVar $ garbageCollect now
+      mbTraceMsg <- updateSVar cacheVar $ garbageCollect now
       mapM_ (traceWith tracer) mbTraceMsg
       threadDelay expireUnusedAfter
   where
@@ -578,25 +578,25 @@ getChunkInfo
   -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
 getChunkInfo cacheEnv chunk = do
     lastUsed <- LastUsed <$> getMonotonicTime
-    -- Make sure we don't leave an empty MVar in case of an exception.
-    mbCacheHit <- bracketOnError (takeMVar cacheVar) (tryPutMVar cacheVar) $
+    -- Make sure we don't leave an empty SVar in case of an exception.
+    mbCacheHit <- bracketOnError (takeSVar cacheVar) (tryPutSVar cacheVar) $
       \cached@Cached { currentChunk, currentChunkInfo, nbPastChunks } -> if
         | chunk == currentChunk -> do
           -- Cache hit for the current chunk
-          putMVar cacheVar cached
+          putSVar cacheVar cached
           traceWith tracer $ TraceCurrentChunkHit chunk nbPastChunks
           return $ Just $ Left currentChunkInfo
         | Just (pastChunkInfo, cached') <- lookupPastChunkInfo chunk lastUsed cached -> do
           -- Cache hit for an chunk in the past
-          putMVar cacheVar cached'
+          putSVar cacheVar cached'
           traceWith tracer $ TracePastChunkHit chunk nbPastChunks
           return $ Just $ Right pastChunkInfo
         | otherwise -> do
           -- Cache miss for an chunk in the past. We don't want to hold on to
-          -- the 'cacheVar' MVar, blocking all other access to the cace, while
+          -- the 'cacheVar' SVar, blocking all other access to the cace, while
           -- we're reading things from disk, so put it back now and update the
           -- cache afterwards.
-          putMVar cacheVar cached
+          putSVar cacheVar cached
           traceWith tracer $ TracePastChunkMiss chunk nbPastChunks
           return Nothing
     case mbCacheHit of
@@ -607,7 +607,7 @@ getChunkInfo cacheEnv chunk = do
         -- Loading the chunk might have taken some time, so obtain the time
         -- again.
         lastUsed' <- LastUsed <$> getMonotonicTime
-        mbEvicted <- updateMVar cacheVar $
+        mbEvicted <- updateSVar cacheVar $
           evictIfNecessary pastChunksToCache .
           addPastChunkInfo chunk lastUsed' pastChunkInfo
         whenJust mbEvicted $ \evicted ->
@@ -627,7 +627,7 @@ getChunkInfo cacheEnv chunk = do
 -- This operation is idempotent.
 close :: IOLike m => CacheEnv m blk h -> m ()
 close CacheEnv { bgThreadVar } =
-    mask_ $ modifyMVar_ bgThreadVar $ \mbBgThread -> do
+    mask_ $ modifySVar_ bgThreadVar $ \mbBgThread -> do
       mapM_ cancelThread mbBgThread
       return Nothing
 
@@ -643,8 +643,8 @@ restart
   -> m ()
 restart cacheEnv chunk = do
     currentChunkInfo <- loadCurrentChunkInfo hasFS chunkInfo chunk
-    void $ swapMVar cacheVar $ emptyCached chunk currentChunkInfo
-    mask_ $ modifyMVar_ bgThreadVar $ \mbBgThread ->
+    void $ swapSVar cacheVar $ emptyCached chunk currentChunkInfo
+    mask_ $ modifySVar_ bgThreadVar $ \mbBgThread ->
       case mbBgThread of
         Just _  -> throwIO $ userError "background thread still running"
         Nothing -> do
@@ -747,7 +747,7 @@ openPrimaryIndex cacheEnv chunk allowExisting = do
       newCurrentChunkInfo <- case allowExisting of
         MustBeNew     -> return $ emptyCurrentChunkInfo chunk
         AllowExisting -> loadCurrentChunkInfo hasFS chunkInfo chunk
-      mbEvicted <- updateMVar cacheVar $
+      mbEvicted <- updateSVar cacheVar $
         evictIfNecessary pastChunksToCache .
         openChunk chunk lastUsed newCurrentChunkInfo
       whenJust mbEvicted $ \evicted ->
@@ -767,7 +767,7 @@ appendOffsets
   -> m ()
 appendOffsets CacheEnv { hasFS, cacheVar } pHnd offsets = do
     Primary.appendOffsets hasFS pHnd offsets
-    updateMVar_ cacheVar addCurrentChunkOffsets
+    updateSVar_ cacheVar addCurrentChunkOffsets
   where
     -- Lenses would be nice here
     addCurrentChunkOffsets :: Cached blk -> Cached blk
@@ -861,7 +861,7 @@ appendEntry
   -> m Word64
 appendEntry CacheEnv { hasFS, cacheVar } chunk sHnd entry = do
     nbBytes <- Secondary.appendEntry hasFS sHnd (withoutBlockSize entry)
-    updateMVar_ cacheVar addCurrentChunkEntry
+    updateSVar_ cacheVar addCurrentChunkEntry
     return nbBytes
   where
     -- Lenses would be nice here