Merge pull request #3285 from input-output-hk/mhuesch/CDEC-451-sq

[CDEC-451] Remove `Mockable`

Author: mhuesch

auxx/Main.hs

@@ -14,7 +14,6 @@ import           System.Wlog (LoggerName, logInfo)
 import qualified Pos.Client.CLI as CLI
 import           Pos.Context (NodeContext (..))
 import           Pos.Core (ConfigurationError, epochSlots)
-import           Pos.Core.Mockable (Production (..), runProduction)
 import           Pos.Crypto (ProtocolMagic)
 import           Pos.DB.DB (initNodeDBs)
 import           Pos.Infra.Diffusion.Types (Diffusion, hoistDiffusion)
@@ -43,12 +42,12 @@ loggerName = "auxx"
 
 -- 'NodeParams' obtained using 'CLI.getNodeParams' are not perfect for
 -- Auxx, so we need to adapt them slightly.
-correctNodeParams :: AuxxOptions -> NodeParams -> Production (NodeParams, Bool)
+correctNodeParams :: AuxxOptions -> NodeParams -> IO (NodeParams, Bool)
 correctNodeParams AuxxOptions {..} np = do
     (dbPath, isTempDbUsed) <- case npDbPathM np of
         Nothing -> do
-            tempDir <- liftIO $ Temp.getCanonicalTemporaryDirectory
-            dbPath <- liftIO $ Temp.createTempDirectory tempDir "nodedb"
+            tempDir <- Temp.getCanonicalTemporaryDirectory
+            dbPath <- Temp.createTempDirectory tempDir "nodedb"
             logInfo $ sformat ("Temporary db created: "%shown) dbPath
             return (dbPath, True)
         Just dbPath -> do
@@ -81,7 +80,7 @@ runNodeWithSinglePlugin ::
 runNodeWithSinglePlugin pm nr plugin =
     runNode pm nr [plugin]
 
-action :: HasCompileInfo => AuxxOptions -> Either WithCommandAction Text -> Production ()
+action :: HasCompileInfo => AuxxOptions -> Either WithCommandAction Text -> IO ()
 action opts@AuxxOptions {..} command = do
     let pa = either printAction (const putText) command
     case aoStartMode of
@@ -95,10 +94,10 @@ action opts@AuxxOptions {..} command = do
         _   -> withConfigurations Nothing conf (runWithConfig pa)
 
   where
-    runWithoutNode :: PrintAction Production -> Production ()
+    runWithoutNode :: PrintAction IO -> IO ()
     runWithoutNode printAction = printAction "Mode: light" >> rawExec Nothing Nothing opts Nothing command
 
-    runWithConfig :: HasConfigurations => PrintAction Production -> NtpConfiguration -> ProtocolMagic -> Production ()
+    runWithConfig :: HasConfigurations => PrintAction IO -> NtpConfiguration -> ProtocolMagic -> IO ()
     runWithConfig printAction ntpConfig pm = do
         printAction "Mode: with-config"
         CLI.printInfoOnStart aoCommonNodeArgs ntpConfig
@@ -117,7 +116,7 @@ action opts@AuxxOptions {..} command = do
                               (npUserSecret nodeParams ^. usVss)
             sscParams = CLI.gtSscParams cArgs vssSK (npBehaviorConfig nodeParams)
 
-        bracketNodeResources nodeParams sscParams (txpGlobalSettings pm) (initNodeDBs pm epochSlots) $ \nr -> Production $
+        bracketNodeResources nodeParams sscParams (txpGlobalSettings pm) (initNodeDBs pm epochSlots) $ \nr ->
             let NodeContext {..} = nrContext nr
                 modifier = if aoStartMode == WithNode
                            then runNodeWithSinglePlugin pm nr
@@ -146,7 +145,7 @@ main = withCompileInfo $ do
         loggingParams = disableConsoleLog $
             CLI.loggingParams loggerName (aoCommonNodeArgs opts)
     loggerBracket loggingParams . logException "auxx" $ do
-        let runAction a = runProduction $ action opts a
+        let runAction a = action opts a
         case aoAction opts of
             Repl    -> withAuxxRepl $ \c -> runAction (Left c)
             Cmd cmd -> runAction (Right cmd)

auxx/cardano-sl-auxx.cabal

@@ -88,6 +88,7 @@ library
                      , time-units
                      , transformers
                      , universum >= 0.1.11
+                     , unliftio
                      , unordered-containers
                      , validation
 

auxx/src/Command/Tx.hs

@@ -12,6 +12,7 @@ module Command.Tx
 
 import           Universum
 
+import qualified Control.Concurrent.MVar as Conc
 import           Control.Concurrent.STM.TQueue (newTQueue, tryReadTQueue,
                      writeTQueue)
 import           Control.Exception.Safe (Exception (..), try)
@@ -31,6 +32,7 @@ import           Formatting (build, int, sformat, shown, stext, (%))
 import           System.Environment (lookupEnv)
 import           System.IO (BufferMode (LineBuffering), hClose, hSetBuffering)
 import           System.Wlog (logError, logInfo)
+import           UnliftIO (MonadUnliftIO)
 
 import           Pos.Client.KeyStorage (getSecretKeysPlain)
 import           Pos.Client.Txp.Balances (getOwnUtxoForPk)
@@ -39,11 +41,10 @@ import           Pos.Client.Txp.Util (createTx)
 import           Pos.Core (BlockVersionData (bvdSlotDuration),
                      IsBootstrapEraAddr (..), Timestamp (..),
                      deriveFirstHDAddress, makePubKeyAddress, mkCoin)
+import           Pos.Core.Conc (concurrently, currentTime, delay,
+                     forConcurrently, modifySharedAtomic, newSharedAtomic)
 import           Pos.Core.Configuration (genesisBlockVersionData,
                      genesisSecretKeys)
-import           Pos.Core.Mockable (Mockable, SharedAtomic, SharedAtomicT,
-                     concurrently, currentTime, delay, forConcurrently,
-                     modifySharedAtomic, newSharedAtomic)
 import           Pos.Core.Txp (TxAux (..), TxIn (TxInUtxo), TxOut (..),
                      TxOutAux (..), txaF)
 import           Pos.Crypto (EncryptedSecretKey, ProtocolMagic, emptyPassphrase,
@@ -77,7 +78,7 @@ data TxCount = TxCount
       -- How many threads are still sending transactions.
     , _txcThreads   :: !Int }
 
-addTxSubmit :: Mockable SharedAtomic m => SharedAtomicT m TxCount -> m ()
+addTxSubmit :: MonadUnliftIO m => Conc.MVar TxCount -> m ()
 addTxSubmit =
     flip modifySharedAtomic
         (\(TxCount submitted sending) ->

auxx/src/Mode.hs

@@ -44,7 +44,6 @@ import           Pos.Core (Address, HasConfiguration, HasPrimaryKey (..),
                      largestPubKeyAddressBoot, largestPubKeyAddressSingleKey,
                      makePubKeyAddress, siEpoch)
 import           Pos.Core.JsonLog (CanJsonLog (..))
-import           Pos.Core.Mockable (Production)
 import           Pos.Core.Reporting (HasMisbehaviorMetrics (..),
                      MonadReporting (..))
 import           Pos.Core.Slotting (HasSlottingVar (..), MonadSlotsData)
@@ -70,7 +69,7 @@ import           Pos.Util.LoggerName (HasLoggerName' (..))
 import           Pos.Util.UserSecret (HasUserSecret (..))
 import           Pos.WorkMode (EmptyMempoolExt, RealMode, RealModeContext (..))
 
-type AuxxMode = ReaderT AuxxContext Production
+type AuxxMode = ReaderT AuxxContext IO
 
 class (m ~ AuxxMode, HasConfigurations, HasCompileInfo) => MonadAuxxMode m
 instance (HasConfigurations, HasCompileInfo) => MonadAuxxMode AuxxMode

auxx/src/Plugin.hs

@@ -21,7 +21,7 @@ import           Formatting (float, int, sformat, (%))
 import           System.IO (hFlush, stdout)
 import           System.Wlog (CanLog, HasLoggerName, logInfo)
 
-import           Pos.Core.Mockable (Delay, Mockable, delay)
+import           Pos.Core.Conc (delay)
 import           Pos.Crypto (AHash (..), ProtocolMagic, fullPublicKeyF,
                      hashHexF)
 import           Pos.Infra.Diffusion.Types (Diffusion)
@@ -40,7 +40,7 @@ import           Repl (PrintAction, WithCommandAction (..))
 {-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
 
 auxxPlugin ::
-       (MonadAuxxMode m, Mockable Delay m)
+       MonadAuxxMode m
     => ProtocolMagic
     -> AuxxOptions
     -> Either WithCommandAction Text
@@ -56,7 +56,6 @@ rawExec ::
        , MonadCatch m
        , CanLog m
        , HasLoggerName m
-       , Mockable Delay m
        )
     => Maybe ProtocolMagic
     -> Maybe (Dict (MonadAuxxMode m))
@@ -74,7 +73,6 @@ runWalletCmd ::
        ( MonadIO m
        , CanLog m
        , HasLoggerName m
-       , Mockable Delay m
        )
     => Maybe ProtocolMagic
     -> Maybe (Dict (MonadAuxxMode m))

block/src/Pos/Block/BListener.hs

@@ -16,7 +16,6 @@ import           Control.Monad.Trans (MonadTrans (..))
 
 import           Pos.Block.Types (Blund)
 import           Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..))
-import           Pos.Core.Mockable (SharedAtomicT)
 import           Pos.DB.BatchOp (SomeBatchOp)
 
 class Monad m => MonadBListener m where
@@ -29,8 +28,7 @@ class Monad m => MonadBListener m where
     onRollbackBlocks :: NewestFirst NE Blund -> m SomeBatchOp
 
 instance {-# OVERLAPPABLE #-}
-    ( MonadBListener m, Monad m, MonadTrans t, Monad (t m)
-    , SharedAtomicT m ~ SharedAtomicT (t m) ) =>
+    ( MonadBListener m, Monad m, MonadTrans t, Monad (t m)) =>
         MonadBListener (t m)
   where
     onApplyBlocks = lift . onApplyBlocks

block/src/Pos/Block/Logic/Internal.hs

@@ -43,7 +43,6 @@ import           Pos.Core (ComponentBlock (..), IsGenesisHeader, epochIndexL,
                      mainBlockUpdatePayload)
 import           Pos.Core.Block (Block, GenesisBlock, MainBlock)
 import           Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..))
-import           Pos.Core.Mockable (CurrentTime, Mockable)
 import           Pos.Core.Reporting (MonadReporting)
 import           Pos.Crypto (ProtocolMagic)
 import           Pos.DB (MonadDB, MonadDBRead, MonadGState, SomeBatchOp (..))
@@ -105,8 +104,6 @@ type MonadBlockApply ctx m
        , MonadMask m
        -- Needed to embed custom logic.
        , MonadBListener m
-       -- Needed for rollback
-       , Mockable CurrentTime m
        )
 
 type MonadMempoolNormalization ctx m
@@ -123,7 +120,6 @@ type MonadMempoolNormalization ctx m
       , MonadReporting m
       -- 'MonadRandom' for crypto.
       , Rand.MonadRandom m
-      , Mockable CurrentTime m
       , HasSscConfiguration
       )
 

block/src/Pos/Block/Lrc.hs

@@ -31,7 +31,7 @@ import           Pos.Core (Coin, EpochIndex, EpochOrSlot (..), SharedSeed,
                      StakeholderId, blkSecurityParam, crucialSlot, epochIndexL,
                      epochSlots, getEpochOrSlot)
 import           Pos.Core.Chrono (NE, NewestFirst (..), toOldestFirst)
-import           Pos.Core.Mockable (forConcurrently)
+import           Pos.Core.Conc (forConcurrently)
 import           Pos.Core.Reporting (HasMisbehaviorMetrics (..),
                      MisbehaviorMetrics (..))
 import           Pos.Core.Slotting (MonadSlots)

client/src/Pos/Client/Txp/History.hs

@@ -43,7 +43,6 @@ import           Pos.Core.Block (Block, MainBlock, mainBlockSlot,
                      mainBlockTxPayload)
 import           Pos.Core.Block.Constructors (genesisBlock0)
 import           Pos.Core.JsonLog (CanJsonLog (..))
-import           Pos.Core.Mockable (CurrentTime, Mockable)
 import           Pos.Crypto (ProtocolMagic, WithHash (..), withHash)
 import           Pos.DB (MonadDBRead, MonadGState)
 import           Pos.DB.Block (getBlock)
@@ -208,7 +207,6 @@ type TxHistoryEnv ctx m =
     , MonadTxpMem (MempoolExt m) ctx m
     , HasLens' ctx StateLock
     , HasLens' ctx (StateLockMetrics MemPoolModifyReason)
-    , Mockable CurrentTime m
     , HasNodeType ctx
     , CanJsonLog m
     )

client/src/Pos/Client/Txp/Network.hs

@@ -26,7 +26,6 @@ import           Pos.Communication.Message ()
 import           Pos.Communication.Types (InvOrDataTK)
 import           Pos.Core (Address, Coin, makeRedeemAddress, mkCoin,
                      unsafeAddCoin)
-import           Pos.Core.Mockable (MonadMockable)
 import           Pos.Core.Txp (TxAux (..), TxId, TxMsgContents (..), TxOut (..),
                      TxOutAux (..), txaF)
 import           Pos.Crypto (ProtocolMagic, RedeemSecretKey, SafeSigner, hash,
@@ -41,7 +40,6 @@ type TxMode m
     = ( MinWorkMode m
       , MonadBalances m
       , MonadTxHistory m
-      , MonadMockable m
       , MonadMask m
       , MonadThrow m
       , TxCreateMode m

core/cardano-sl-core.cabal

@@ -57,21 +57,9 @@ library
                        Pos.Core.JsonLog.JsonLogT
                        Pos.Core.JsonLog.LogEvents
 
-                       -- Mockable (moved from networking in
-                       -- the `sinbin` shuffle). All modules
-                       -- must be exposed so that `networking`
-                       -- can import & re-export them.
-                       Pos.Core.Mockable
-                       Pos.Core.Mockable.Channel
-                       Pos.Core.Mockable.Class
-                       Pos.Core.Mockable.Concurrent
-                       Pos.Core.Mockable.CurrentTime
-                       Pos.Core.Mockable.Instances
-                       Pos.Core.Mockable.Monad
-                       Pos.Core.Mockable.Production
-                       Pos.Core.Mockable.SharedAtomic
-                       Pos.Core.Mockable.SharedExclusive
-                       Pos.Core.Mockable.Metrics
+                       -- Concurrency operations, previously
+                       -- in `Mockable`.
+                       Pos.Core.Conc
 
                        Pos.Core.Reporting
 
@@ -262,6 +250,7 @@ library
                      , transformers-base
                      , transformers-lift
                      , universum
+                     , unliftio
                      , unliftio-core
                      , unordered-containers
                      , vector