Use io-sim-1.0.0.0

IntersectMBO · Apr 25, 2023 · 4c9bd28 · 4c9bd28
1 parent e4a222f
commit 4c9bd28
Show file tree

Hide file tree

Showing 137 changed files with 545 additions and 368 deletions.
diff --git a/cabal.project b/cabal.project
@@ -16,9 +16,9 @@ repository cardano-haskell-packages
 index-state: 2023-03-29T00:00:00Z
 index-state:
   -- Bump this if you need newer packages from Hackage
-  , hackage.haskell.org 2023-03-29T00:00:00Z
+  , hackage.haskell.org 2023-04-18T18:49:22Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2023-04-05T21:25:44Z
+  , cardano-haskell-packages 2023-04-25T08:35:30Z
 
 packages: ./cardano-ping
           ./ouroboros-network-testing

diff --git a/cardano-ping/cardano-ping.cabal b/cardano-ping/cardano-ping.cabal
@@ -27,9 +27,12 @@ library
                         cborg                         >=0.2.8    && <0.3,
                         bytestring                    >=0.10     && <0.12,
                         contra-tracer                 >=0.1      && <0.2,
-                        io-classes                    >=0.3      && <0.4,
+
+                        io-classes                   ^>=1.0,
+                        si-timers,
+                        strict-stm,
+
                         network-mux                   >=0.3      && <0.4,
-                        strict-stm                    >=0.2      && <0.3,
                         tdigest                       >=0.2.1.1  && <0.3,
                         text                          >=1.2.4    && <2.1,
 

diff --git a/cardano-ping/src/Cardano/Network/Ping.hs b/cardano-ping/src/Cardano/Network/Ping.hs
@@ -22,7 +22,7 @@ module Cardano.Network.Ping
 import           Control.Exception (bracket)
 import           Control.Monad (replicateM, unless, when)
 import           Control.Concurrent.Class.MonadSTM.Strict ( MonadSTM(atomically), takeTMVar, StrictTMVar )
-import           Control.Monad.Class.MonadTime (UTCTime, diffTime, MonadMonotonicTime(getMonotonicTime), MonadTime(getCurrentTime), Time)
+import           Control.Monad.Class.MonadTime.SI (UTCTime, diffTime, MonadMonotonicTime(getMonotonicTime), MonadTime(getCurrentTime), Time)
 import           Control.Tracer (Tracer (..), nullTracer, traceWith)
 import           Data.Aeson (Value, ToJSON(toJSON), object, encode, KeyValue((.=)))
 import           Data.Bits (clearBit, setBit, testBit)

diff --git a/monoidal-synchronisation/test/Test/Data/Monoid/Synchronisation.hs b/monoidal-synchronisation/test/Test/Data/Monoid/Synchronisation.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Test.Data.Monoid.Synchronisation where
 
+import           Control.Monad (MonadPlus)
 import           Control.Concurrent.Class.MonadSTM
 import           Control.Monad.Class.MonadFork
 
@@ -23,6 +25,7 @@ tests =
 lastToFinishExperiment
     :: forall m.
        ( MonadFork  m
+       , MonadPlus (STM m)
        , MonadSTM   m
        )
     => Bool -> m Bool

diff --git a/network-mux/network-mux.cabal b/network-mux/network-mux.cabal
@@ -45,8 +45,9 @@ common demo-deps
 
 library
   build-depends:       base            >=4.14 && <4.17,
-                       io-classes     ^>=0.3,
-                       strict-stm     ^>=0.2,
+                       io-classes     ^>=1.0,
+                       strict-stm,
+                       si-timers,
                        contra-tracer   >=0.1 && <0.2,
                        monoidal-synchronisation
                                        >=0.1 && <0.2,
@@ -125,8 +126,9 @@ test-suite test
   default-language:    Haskell2010
   build-depends:       base >=4.14 && <4.17,
                        io-classes,
+                       si-timers,
                        strict-stm,
-                       io-sim            >=0.3 && < 0.4,
+                       io-sim           ^>=1.0,
                        contra-tracer,
                        network-mux,
                        Win32-network,

diff --git a/network-mux/src/Network/Mux.hs b/network-mux/src/Network/Mux.hs
@@ -58,8 +58,8 @@ import           Control.Monad
 import           Control.Monad.Class.MonadAsync
 import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer hiding (timeout)
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI hiding (timeout)
 import           Control.Tracer
 
 import           Network.Mux.Bearer
@@ -202,6 +202,7 @@ runMux :: forall m mode.
           ( MonadAsync m
           , MonadFork m
           , MonadLabelledSTM m
+          , Alternative (STM m)
           , MonadThrow (STM m)
           , MonadTime  m
           , MonadTimer m
@@ -348,6 +349,7 @@ newtype MonitorCtx m mode = MonitorCtx {
 monitor :: forall mode m.
            ( MonadAsync m
            , MonadMask m
+           , Alternative (STM m)
            , MonadThrow (STM m)
            )
         => Tracer m MuxTrace
@@ -624,7 +626,8 @@ traceMuxBearerState tracer state =
 -- irrespective of the 'StartOnDemandOrEagerly' value.
 --
 runMiniProtocol :: forall mode m a.
-                   ( MonadSTM   m
+                   ( Alternative (STM m)
+                   , MonadSTM   m
                    , MonadThrow m
                    , MonadThrow (STM m)
                    )

diff --git a/network-mux/src/Network/Mux/Bearer.hs b/network-mux/src/Network/Mux/Bearer.hs
@@ -20,7 +20,7 @@ module Network.Mux.Bearer
 
 import           Control.Monad.Class.MonadSTM
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
+import           Control.Monad.Class.MonadTime.SI
 import           Control.Tracer (Tracer)
 
 import           Network.Socket (Socket)
@@ -66,7 +66,7 @@ makePipeChannelBearer = MakeBearer $ pureBearer (\_ -> pipeAsMuxBearer size)
     size = SDUSize 32_768
 
 makeQueueChannelBearer :: ( MonadSTM   m
-                          , MonadTime  m
+                          , MonadMonotonicTime m
                           , MonadThrow m
                           )
                        => MakeBearer m (QueueChannel m)

diff --git a/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs b/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs
@@ -21,8 +21,8 @@ import           Prelude hiding (read)
 import           Control.Concurrent.Class.MonadSTM.Strict
 import           Control.Monad (when)
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI
 import           Control.Tracer (Tracer, traceWith)
 
 import           GHC.IO.Exception
@@ -156,7 +156,7 @@ data Attenuation = Attenuation {
 -- | Make a 'AttenuatedChannel' from a 'QueueChannel'.
 --
 newAttenuatedChannel :: forall m.
-                        ( MonadTime       m
+                        ( MonadDelay      m
                         , MonadTimer      m
                         , MonadThrow      m
                         , MonadThrow (STM m)
@@ -232,8 +232,8 @@ newAttenuatedChannel tr Attenuation { aReadAttenuation,
 --
 newConnectedAttenuatedChannelPair
     :: forall m.
-       ( MonadLabelledSTM m
-       , MonadTime        m
+       ( MonadDelay       m
+       , MonadLabelledSTM m
        , MonadTimer       m
        , MonadThrow       m
        , MonadThrow  (STM m)

diff --git a/network-mux/src/Network/Mux/Bearer/NamedPipe.hs b/network-mux/src/Network/Mux/Bearer/NamedPipe.hs
@@ -10,8 +10,8 @@ import           Data.Foldable (traverse_)
 import           Data.Int (Int64)
 
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI
 import           Control.Tracer
 
 import qualified Network.Mux.Codec as Mx

diff --git a/network-mux/src/Network/Mux/Bearer/Pipe.hs b/network-mux/src/Network/Mux/Bearer/Pipe.hs
@@ -16,7 +16,7 @@ module Network.Mux.Bearer.Pipe (
   ) where
 
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
+import           Control.Monad.Class.MonadTime.SI
 import           Control.Tracer
 import qualified Data.ByteString.Lazy as BL
 import           System.IO (Handle, hFlush)

diff --git a/network-mux/src/Network/Mux/Bearer/Queues.hs b/network-mux/src/Network/Mux/Bearer/Queues.hs
@@ -12,7 +12,7 @@ import qualified Data.ByteString.Lazy as BL
 
 import           Control.Concurrent.Class.MonadSTM.Strict
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
+import           Control.Monad.Class.MonadTime.SI
 import           Control.Tracer
 
 import qualified Network.Mux.Codec as Mx
@@ -31,7 +31,7 @@ data QueueChannel m = QueueChannel {
 queueChannelAsMuxBearer
   :: forall m.
      ( MonadSTM   m
-     , MonadTime  m
+     , MonadMonotonicTime m
      , MonadThrow m
      )
   => Mx.SDUSize

diff --git a/network-mux/src/Network/Mux/Bearer/Socket.hs b/network-mux/src/Network/Mux/Bearer/Socket.hs
@@ -12,8 +12,8 @@ import qualified Data.ByteString.Lazy as BL
 import           Data.Int
 
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer hiding (timeout)
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI hiding (timeout)
 
 import qualified Network.Socket as Socket
 #if !defined(mingw32_HOST_OS)

diff --git a/network-mux/src/Network/Mux/Channel.hs b/network-mux/src/Network/Mux/Channel.hs
@@ -30,7 +30,7 @@ import qualified System.Process as IO (createPipe)
 
 import           Control.Concurrent.Class.MonadSTM
 import           Control.Monad.Class.MonadSay
-import           Control.Monad.Class.MonadTimer
+import           Control.Monad.Class.MonadTimer.SI
 
 
 data Channel m = Channel {
@@ -209,8 +209,7 @@ channelEffect beforeSend afterRecv Channel{send, recv} =
 -- This is intended for testing, as a crude approximation of network delays.
 -- More accurate models along these lines are of course possible.
 --
-delayChannel :: ( MonadTimer m
-                )
+delayChannel :: MonadDelay m
              => DiffTime
              -> Channel m
              -> Channel m

diff --git a/network-mux/src/Network/Mux/Compat.hs b/network-mux/src/Network/Mux/Compat.hs
@@ -36,14 +36,13 @@ module Network.Mux.Compat
 import qualified Data.ByteString.Lazy as BL
 import           Data.Void (Void)
 
-import           Control.Applicative ((<|>))
+import           Control.Applicative (Alternative (..), (<|>))
 import           Control.Concurrent.Class.MonadSTM.Strict
 import           Control.Monad
 import           Control.Monad.Class.MonadAsync
-import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI
 import           Control.Tracer
 
 import           Network.Mux (StartOnDemandOrEagerly (..), newMux,
@@ -92,6 +91,7 @@ muxStart
        ( MonadAsync m
        , MonadFork m
        , MonadLabelledSTM m
+       , Alternative (STM m)
        , MonadThrow (STM m)
        , MonadTime  m
        , MonadTimer m

diff --git a/network-mux/src/Network/Mux/DeltaQ/TraceStats.hs b/network-mux/src/Network/Mux/DeltaQ/TraceStats.hs
@@ -11,7 +11,7 @@ import qualified Data.IntMap.Strict as IM
 import           Data.Maybe
 import           Data.Word (Word32)
 
-import           Control.Monad.Class.MonadTime
+import           Control.Monad.Class.MonadTime.SI
 import           Network.Mux.DeltaQ.TraceStatsSupport
 import           Network.Mux.DeltaQ.TraceTypes
 import           Network.Mux.Types

diff --git a/network-mux/src/Network/Mux/Egress.hs b/network-mux/src/Network/Mux/Egress.hs
@@ -18,10 +18,9 @@ import qualified Data.ByteString.Lazy as BL
 
 import           Control.Concurrent.Class.MonadSTM.Strict
 import           Control.Monad.Class.MonadAsync
-import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer hiding (timeout)
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI hiding (timeout)
 
 import           Network.Mux.Timeout
 import           Network.Mux.Types

diff --git a/network-mux/src/Network/Mux/Ingress.hs b/network-mux/src/Network/Mux/Ingress.hs
@@ -19,10 +19,9 @@ import           Text.Printf
 import           Control.Concurrent.Class.MonadSTM.Strict
 import           Control.Monad
 import           Control.Monad.Class.MonadAsync
-import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer hiding (timeout)
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI hiding (timeout)
 
 import           Network.Mux.Timeout
 import           Network.Mux.Trace

diff --git a/network-mux/src/Network/Mux/Time.hs b/network-mux/src/Network/Mux/Time.hs
@@ -8,7 +8,7 @@ module Network.Mux.Time
   , timestampMicrosecondsLow32Bits
   ) where
 
-import           Control.Monad.Class.MonadTime (Time (..))
+import           Control.Monad.Class.MonadTime.SI (Time (..))
 import           Data.Time.Clock (DiffTime, diffTimeToPicoseconds,
                      picosecondsToDiffTime)
 import           Data.Word (Word32)

diff --git a/network-mux/src/Network/Mux/Timeout.hs b/network-mux/src/Network/Mux/Timeout.hs
@@ -29,9 +29,9 @@ import           Control.Monad
 import           Control.Monad.Class.MonadAsync
 import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
-import           Control.Monad.Class.MonadTimer (MonadTimer, registerDelay)
-import qualified Control.Monad.Class.MonadTimer as MonadTimer
+import           Control.Monad.Class.MonadTime.SI
+import           Control.Monad.Class.MonadTimer.SI (MonadTimer, registerDelay)
+import qualified Control.Monad.Class.MonadTimer.SI as MonadTimer
 
 
 -- | The type of the 'System.Timeout.timeout' function.
@@ -305,8 +305,8 @@ timeout monitorState delay action =
 
 
 monitoringThread :: (MonadFork m, MonadSTM m,
-                     MonadMonotonicTime m, MonadTimer m,
-                     MonadThrow (STM m))
+                     MonadMonotonicTime m,
+                     MonadTimer m, MonadThrow (STM m))
                  => MonitorState m -> m ()
 monitoringThread monitorState@MonitorState{deadlineResetVar} = do
   threadId <- myThreadId

diff --git a/network-mux/src/Network/Mux/Trace.hs b/network-mux/src/Network/Mux/Trace.hs
@@ -23,7 +23,7 @@ import           Text.Printf
 
 import           Control.Exception hiding (throwIO)
 import           Control.Monad.Class.MonadThrow
-import           Control.Monad.Class.MonadTime
+import           Control.Monad.Class.MonadTime.SI
 import           Data.Bifunctor (Bifunctor (..))
 import           Data.Word
 import           GHC.Generics (Generic (..))

diff --git a/network-mux/src/Network/Mux/Types.hs b/network-mux/src/Network/Mux/Types.hs
@@ -52,7 +52,7 @@ import           Quiet
 import           GHC.Generics (Generic)
 
 import           Control.Concurrent.Class.MonadSTM.Strict (StrictTVar)
-import           Control.Monad.Class.MonadTime
+import           Control.Monad.Class.MonadTime.SI
 
 import           Network.Mux.Channel (Channel (..))
 import           Network.Mux.Timeout (TimeoutFn)