Refactor

Author: Jimbo4350

cabal.project

@@ -35,8 +35,8 @@ packages:
 -- Needed when cross compiling
 extra-packages: alex
 
--- program-options
---   ghc-options: -Werror
+program-options
+  ghc-options: -Werror
 
 test-show-details: direct
 

cardano-testnet/cardano-testnet.cabal

@@ -100,7 +100,6 @@ library
                       , time
                       , transformers
                       , transformers-except
-                      , unliftio-core
                       , vector
                       , yaml
 
@@ -271,7 +270,6 @@ test-suite cardano-testnet-test
                       , mtl
                       , process
                       , regex-compat
-                      , resourcet
                       , rio
                       , tasty ^>= 1.5
                       , text

cardano-testnet/src/Parsers/Run.hs

@@ -11,8 +11,6 @@ module Parsers.Run
 
 import           Cardano.CLI.Environment
 import           Control.Monad
-import           Control.Monad.Trans.Class (lift)
-import           Control.Monad.Trans.Resource (getInternalState)
 
 import           Data.Default.Class (def)
 import           Data.Foldable
@@ -65,8 +63,7 @@ createEnvOptions CardanoTestnetCreateEnvOptions
   , createEnvCreateEnvOptions=ceOptions
   } =
     testnetRoutine (UserProvidedEnv outputDir) $ \conf -> do 
-      r <- lift $ lift getInternalState 
-      liftToIntegration r $
+      liftToIntegration $
         createTestnetEnv
           testnetOptions genesisOptions ceOptions
           -- Do not add hashes to the main config file, so that genesis files

cardano-testnet/src/Testnet/Runtime.hs

@@ -147,7 +147,6 @@ startNode tp node ipv4 port _testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
                              , "--port", show port
                              , "--host-addr", showIpv4Address ipv4
                              ]
-    -- error "startNode 1" -- works
     nodeProcess <- newExceptT . fmap (first ExecutableRelatedFailure) . try $ runRIO () $ procNode completeNodeCmd
 
     -- The port number if it is obtained using 'H.randomPort', it is firstly bound to and then closed. The closing
@@ -176,15 +175,15 @@ startNode tp node ipv4 port _testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
 
     -- We then log the pid in the temp dir structure.
     liftIO $ IO.writeFile nodePidFile $ show pid
-   -- error "pre eSprocketError " -- THIS FAILS DIAGNOSE THIS
+
     -- Wait for socket to be created
     eSprocketError <-
       liftIO $
         Ping.waitForSprocket
           60  -- timeout
           0.2 -- check interval
           sprocket
-    -- error $ "startNode 2:" <> show eSprocketError -- Works! after replacing bracket
+
     -- If we do have anything on stderr, fail.
     stdErrContents <- liftIO $ IO.readFile nodeStderrFile
     unless (null stdErrContents) $

cardano-testnet/src/Testnet/Start/Cardano.hs

@@ -25,7 +25,6 @@ module Testnet.Start.Cardano
   , retryOnAddressInUseError
     -- Move to my own module
   , liftToIntegration
-  , reconcileMaps
   ) where
 
 
@@ -44,17 +43,13 @@ import           Prelude hiding (lines)
 import           Control.Concurrent (threadDelay)
 import           Control.Exception (Exception (..))
 import           Control.Monad
-import           Control.Monad.Trans.Resource.Internal (ReleaseMap(..))
 import           Data.Aeson
 import qualified Data.Aeson.Encode.Pretty as A
 import qualified Data.Aeson.KeyMap as A
-import           Data.Acquire.Internal (ReleaseType)
 import qualified Data.ByteString.Lazy as LBS
 import           Data.Default.Class (def)
 import           Data.Either
 import           Data.Functor
-import           Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
 import           Data.MonoTraversable (Element, MonoFunctor, omap)
 import qualified Data.Text as Text
 import           Data.Time (diffUTCTime)
@@ -78,11 +73,10 @@ import qualified Hedgehog.Extras as H
 import qualified Hedgehog.Extras.Stock.IO.Network.Port as H
 
 
-import RIO (RIO(..),runRIO, IORef, readIORef, modifyIORef', throwM)
-import Control.Monad.Trans.Resource (ResourceT, getInternalState)
+import RIO (RIO(..),runRIO, throwM)
+import Control.Monad.Trans.Resource (getInternalState)
 import Testnet.Orphans ()
-import RIO.Orphans (HasResourceMap, withResourceMap)
-import Control.Monad.IO.Unlift
+import RIO.Orphans (ResourceMap)
 
 
 newtype MinimumConfigRequirementsError
@@ -101,100 +95,10 @@ testMinimumConfigurationRequirements options = withFrozenCallStack $ do
   when (cardanoNumPools options < 1) $ do
     throwM $ MinimumConfigRequirementsError "Need at least one SPO node to produce blocks, but got none."
 
-liftToIntegration :: IORef ReleaseMap -> RIO (IORef ReleaseMap) a -> H.Integration a 
-liftToIntegration m r = lift . lift $ updateRIOState m r
-
-
--- Why do we need to do this? What happens if an IO action fails
--- when running the RIO monad? We need to clean up everthing else.
--- TODO: Accomodate for the IntegrationState as well!
-updateRIOState
-  :: MonadUnliftIO m
-  => IORef ReleaseMap -- ^ External resource map
-  -> RIO (IORef ReleaseMap) a 
-  -> ResourceT m a
-updateRIOState externalResourceMap rioAction = 
-    withResourceMap 
-      (\rioActionResoureMap -> do 
-          liftIO $ appendResourceMap externalResourceMap rioActionResoureMap
-          updatedState <- getInternalState
-          runRIO updatedState rioAction
-      )
- where 
-  -- TODO: Figure out how to do this!
-  appendResourceMap :: IORef ReleaseMap -> IORef ReleaseMap -> IO ()
-  appendResourceMap externalMap internalMap = do
-    extMap <- readIORef externalMap 
-    intMap <- readIORef internalMap  
-    modifyIORef' internalMap $ const $ appendResourceMapPure extMap intMap  
-
-
-appendResourceMapPure :: ReleaseMap -> ReleaseMap -> ReleaseMap
-appendResourceMapPure (ReleaseMap _ rf1 m1) (ReleaseMap _ rf2 m2) = 
-    let finalMap = reconcileMaps m1 m2
-    in ReleaseMap (getNextKey finalMap) (rf1 + rf2) finalMap
-appendResourceMapPure _ _ = error "failed"
-
-{-
-createInternalState :: MonadIO m => m InternalState
-createInternalState = liftIO
-                    $ I.newIORef
-                    $ ReleaseMap maxBound (minBound + 1) IntMap.empty
-register' :: I.IORef ReleaseMap
-          -> IO ()
-          -> IO ReleaseKey
-register' istate rel = I.atomicModifyIORef istate $ \rm ->
-    case rm of
-        ReleaseMap key rf m ->
-            ( ReleaseMap (key - 1) rf (IntMap.insert key (const rel) m)
-            , ReleaseKey istate key
-            )
-        ReleaseMapClosed -> throw $ InvalidAccess "register'"
-
--}
-
-getNextKey :: IntMap (ReleaseType -> IO ()) -> Int
-getNextKey m = case IntMap.lookupMin m of 
-                Just (mini,_) -> mini - 1
-                Nothing -> maxBound
-
-reconcileMaps :: IntMap a-> IntMap a -> IntMap a
-reconcileMaps externalMap internalMap = 
-  let externalValues = IntMap.elems externalMap 
-      internalValues = IntMap.elems internalMap
-      finalValues = externalValues ++ internalValues
-  in IntMap.fromList $ zip (dec maxBound) finalValues
- where 
-   dec 0 = []
-   dec start = 
-     start : dec (start - 1)
-
--- TODO: Left off here
--- You are already decrementing the key. Therefore get the mod of each key
--- add them and then add the negative
--- The reference account appears to stay the same when registering actions
--- You need to generate the next key which is the negative of the sum of both keys plus 1 
--- You need to merge the maps. However you need to reassign the keys in the RIO internal map. 
--- You need to start from the most negative key in the external map and decrement it for each key in the internal 
--- RIO map. 
-
-
-{-
-register' :: I.IORef ReleaseMap
-          -> IO ()
-          -> IO ReleaseKey
-register' istate rel = I.atomicModifyIORef istate $ \rm ->
-    case rm of
-        ReleaseMap key rf m ->
-            -- First value in tuple is important 
-
-            ( ReleaseMap (key - 1) rf (IntMap.insert key (const rel) m)
-            , ReleaseKey istate key
-            )
-        ReleaseMapClosed -> throw $ InvalidAccess "register'"
-
--}
-
+liftToIntegration :: RIO ResourceMap a -> H.Integration a 
+liftToIntegration  r = do 
+   rMap <- lift $ lift getInternalState 
+   liftIO $ runRIO rMap r
 
 createTestnetEnv :: ()
   => HasCallStack
@@ -321,10 +225,9 @@ createTestnetEnv
 -- > ├── current-stake-pools.json
 -- > └── module
 cardanoTestnet :: HasCallStack
-  => HasResourceMap env
   => CardanoTestnetOptions -- ^ The options to use
   -> Conf -- ^ Path to the test sandbox
-  -> RIO env TestnetRuntime
+  -> RIO ResourceMap TestnetRuntime
 cardanoTestnet
   testnetOptions
   Conf
@@ -547,8 +450,7 @@ createAndRunTestnet :: ()
   -> Conf -- ^ Path to the test sandbox
   -> H.Integration TestnetRuntime
 createAndRunTestnet testnetOptions genesisOptions conf = do
-  r <- lift $ lift getInternalState 
-  liftToIntegration r $ do
+  liftToIntegration $ do
      -- works error "here"
      createTestnetEnv
        testnetOptions genesisOptions def

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs

@@ -22,6 +22,7 @@ import           Prelude
 
 import           Control.Monad
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.Aeson as J
 import           Data.Default.Class
 import           Data.Function
@@ -49,6 +50,7 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Extras.Test.TestWatchdog as H
+import Testnet.Start.Cardano (liftToIntegration)
 
 
 -- | Execute me with:
@@ -254,7 +256,7 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs
       , "--out-file", testSpoOperationalCertFp
       ]
 
-  jsonBS <- undefined -- Aeson.encodePretty . Aeson.Object <$> createConfigJson tempAbsPath sbe
+  jsonBS <- liftToIntegration $ Aeson.encodePretty . Aeson.Object <$> createConfigJson tempAbsPath sbe
   H.lbsWriteFile (unFile configurationFile) jsonBS
   newNodePortNumber <- H.randomPort testnetDefaultIpv4Address
   eRuntime <- runExceptT . retryOnAddressInUseError $

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs

@@ -22,7 +22,6 @@ import           Cardano.Testnet
 import           Prelude
 
 import           Control.Monad (void)
-import           Control.Monad.Trans.Resource (getInternalState)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encode.Pretty as Aeson
@@ -258,8 +257,7 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \
       , "--operational-certificate-issue-counter-file", testSpoOperationalCertFp
       , "--out-file", testSpoOperationalCertFp
       ]
-  r1 <- lift $ lift getInternalState 
-  jsonBS <- liftToIntegration r1 $
+  jsonBS <- liftToIntegration $
     Aeson.encodePretty . Aeson.Object <$> createConfigJson tempAbsPath sbe
   H.lbsWriteFile (unFile configurationFile) jsonBS
   newNodePort <- H.randomPort testnetDefaultIpv4Address

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/DumpConfig.hs

@@ -17,8 +17,6 @@ import           Cardano.Testnet.Test.Utils (nodesProduceBlocks)
 
 import           Prelude
 
-import           Control.Monad.Trans.Class (lift)
-import           Control.Monad.Trans.Resource (getInternalState)
 import           Data.Aeson.Encode.Pretty (encodePretty)
 import           Data.Default.Class (def)
 import qualified Data.Time.Clock as Time
@@ -48,8 +46,7 @@ hprop_dump_config = integrationRetryWorkspace 2 "dump-config-files" $ \tmpDir ->
   conf <- mkConf tmpDir
   -- TODO: Make this a standalone function for testing only
   -- see createAndRunTestnet
-  r1 <- lift $ lift getInternalState 
-  liftToIntegration r1 $ createTestnetEnv
+  liftToIntegration $ createTestnetEnv
     testnetOptions genesisOptions def
     -- Do not add hashes to the main config file, so that genesis files
     -- can be modified without having to recompute hashes every time.
@@ -75,7 +72,6 @@ hprop_dump_config = integrationRetryWorkspace 2 "dump-config-files" $ \tmpDir ->
   H.lbsWriteFile shelleyGenesisFile $ encodePretty shelleyGenesis
 
   -- Run testnet with generated config
-  r2 <- lift $ lift getInternalState 
-  runtime <- liftToIntegration r2 $ cardanoTestnet testnetOptions conf
+  runtime <- liftToIntegration $ cardanoTestnet testnetOptions conf
 
   nodesProduceBlocks tmpDir runtime

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs

@@ -21,7 +21,6 @@ import           Cardano.Testnet
 import           Prelude
 
 import           Control.Monad
-import           Control.Monad.Trans.Resource (getInternalState)
 import qualified Data.ByteString.Char8 as BSC
 import           Data.Default.Class
 import qualified Data.Map.Strict as Map
@@ -105,19 +104,17 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat
       committeeThreshold = unsafeBoundedRational 0.5
       committee = L.Committee (Map.fromList [(comKeyCred1, EpochNo 100)]) committeeThreshold
 
-  r1 <- lift $ lift getInternalState 
-  liftToIntegration r1 $ createTestnetEnv fastTestnetOptions genesisOptions def conf
+  liftToIntegration $ createTestnetEnv fastTestnetOptions genesisOptions def conf
 
   H.rewriteJsonFile (tempAbsBasePath' </> "conway-genesis.json") $
     \conwayGenesis -> conwayGenesis { L.cgCommittee = committee }
 
-  r2 <- lift $ lift getInternalState 
   TestnetRuntime
     { testnetMagic
     , testnetNodes
     , wallets=wallet0:_wallet1:_
     , configurationFile
-    } <- liftToIntegration r2 $ cardanoTestnet fastTestnetOptions conf
+    } <- liftToIntegration $ cardanoTestnet fastTestnetOptions conf
 
   poolNode1 <- H.headM testnetNodes
   poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/MainnetParams.hs

@@ -9,8 +9,6 @@ module Cardano.Testnet.Test.MainnetParams
 
 import           Cardano.Testnet
 
-import           Control.Monad.Trans.Class (lift)
-import           Control.Monad.Trans.Resource (getInternalState)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Lens as A
 import qualified Data.ByteString.Lazy.Char8 as B
@@ -41,16 +39,14 @@ hprop_mainnet_params = integrationRetryWorkspace 2 "mainnet-params" $ \tmpDir ->
 
   -- Generate the sandbox
   conf <- mkConf tmpDir
-  r <- lift $ lift getInternalState 
-  liftToIntegration r $ createTestnetEnv
+  liftToIntegration $ createTestnetEnv
     testnetOptions genesisOptions createEnvOptions conf
 
   -- Run testnet with mainnet on-chain params
-  r1 <- lift $ lift getInternalState 
   TestnetRuntime
     { testnetNodes
     , testnetMagic
-    } <- liftToIntegration r1 $ cardanoTestnet testnetOptions conf
+    } <- liftToIntegration $ cardanoTestnet testnetOptions conf
 
   -- Get a running node
   TestnetNode{nodeSprocket} <- H.headM testnetNodes