diff --git a/lib/cardano-sl.cabal b/lib/cardano-sl.cabal index bf962ee59f1..5a506513636 100644 --- a/lib/cardano-sl.cabal +++ b/lib/cardano-sl.cabal @@ -277,6 +277,7 @@ test-suite cardano-test Test.Pos.ConstantsSpec Test.Pos.Diffusion.BlockSpec Test.Pos.Genesis.CanonicalSpec + Test.Pos.Launcher.ConfigurationSpec Test.Pos.MerkleSpec Test.Pos.Infra.Slotting.TypesSpec Test.Pos.Types.Identity.SafeCopySpec @@ -326,6 +327,7 @@ test-suite cardano-test , generic-arbitrary , hspec , lens + , log-warper , mtl , network-transport , network-transport-inmemory @@ -339,6 +341,7 @@ test-suite cardano-test , tagged , text , text-format + , time , time-units , universum >= 0.1.11 , unordered-containers diff --git a/lib/src/Pos/Launcher/Configuration.hs b/lib/src/Pos/Launcher/Configuration.hs index c7b940919b8..375be424aea 100644 --- a/lib/src/Pos/Launcher/Configuration.hs +++ b/lib/src/Pos/Launcher/Configuration.hs @@ -16,6 +16,7 @@ module Pos.Launcher.Configuration -- Exposed mostly for testing. , readAssetLockedSrcAddrs + , withConfigurationsM ) where import Universum @@ -30,7 +31,8 @@ import Data.Time.Units (fromMicroseconds) import Serokell.Aeson.Options (defaultOptions) import System.FilePath (takeDirectory) -import System.Wlog (WithLogger, logInfo) +import System.Wlog (LoggerName, WithLogger, askLoggerName, logInfo, + usingLoggerName) -- FIXME consistency on the locus of the JSON instances for configuration. -- Core keeps them separate, infra update and ssc define them on-site. @@ -111,14 +113,15 @@ instance Default ConfigurationOptions where -- | Parse some big yaml file to 'MultiConfiguration' and then use the -- configuration at a given key. -withConfigurations - :: (WithLogger m, MonadThrow m, MonadIO m) - => Maybe AssetLockPath +withConfigurationsM + :: forall m r. (MonadThrow m, MonadIO m) + => LoggerName + -> Maybe AssetLockPath -> ConfigurationOptions -> (HasConfigurations => NtpConfiguration -> ProtocolMagic -> m r) -> m r -withConfigurations mAssetLockPath cfo act = do - logInfo ("using configurations: " <> show cfo) +withConfigurationsM logName mAssetLockPath cfo act = do + logInfo' ("using configurations: " <> show cfo) cfg <- parseYamlConfig (cfoFilePath cfo) (cfoKey cfo) assetLock <- case mAssetLockPath of Nothing -> pure mempty @@ -132,6 +135,20 @@ withConfigurations mAssetLockPath cfo act = do withBlockConfiguration (ccBlock cfg) $ withNodeConfiguration (ccNode cfg) $ act (ccNtp cfg) + where + logInfo' :: Text -> m () + logInfo' = liftIO . usingLoggerName logName . logInfo + +withConfigurations + :: (WithLogger m, MonadThrow m, MonadIO m) + => Maybe AssetLockPath + -> ConfigurationOptions + -> (HasConfigurations => NtpConfiguration -> ProtocolMagic -> m r) + -> m r +withConfigurations mAssetLockPath cfo act = do + loggerName <- askLoggerName + withConfigurationsM loggerName mAssetLockPath cfo act + addAssetLock :: Set Address -> TxpConfiguration -> TxpConfiguration addAssetLock bset tcfg = tcfg { tcAssetLockedSrcAddrs = Set.union (tcAssetLockedSrcAddrs tcfg) bset } diff --git a/lib/test/Test/Pos/Launcher/ConfigurationSpec.hs b/lib/test/Test/Pos/Launcher/ConfigurationSpec.hs new file mode 100644 index 00000000000..a34babbd725 --- /dev/null +++ b/lib/test/Test/Pos/Launcher/ConfigurationSpec.hs @@ -0,0 +1,31 @@ +module Test.Pos.Launcher.ConfigurationSpec + ( spec + ) where + +import Universum + +import Data.Time.Clock.POSIX (getPOSIXTime) +import System.Wlog (LoggerName (..)) +import Test.Hspec (Spec, describe, it, shouldSatisfy) + +import Pos.Core.Slotting (Timestamp (..)) +import Pos.Launcher.Configuration (ConfigurationOptions (..), + defaultConfigurationOptions, withConfigurationsM) +import Pos.Util.Config (ConfigurationException) + +spec :: Spec +spec = describe "Pos.Launcher.Configuration" $ do + describe "withConfigurationsM" $ do + it "should parse `lib/configuration.yaml` file" $ do + startTime <- Timestamp . round . (* 1000000) <$> liftIO getPOSIXTime + let cfo = defaultConfigurationOptions + { cfoFilePath = "./configuration.yaml" + , cfoSystemStart = Just startTime + } + let catchFn :: ConfigurationException -> IO (Maybe ConfigurationException) + catchFn e = return $ Just e + res <- liftIO $ catch + (withConfigurationsM (LoggerName "test") Nothing cfo (\_ _ -> return Nothing)) + catchFn + res `shouldSatisfy` isNothing + diff --git a/pkgs/default.nix b/pkgs/default.nix index 6239cf5854c..15cd530fac1 100644 --- a/pkgs/default.nix +++ b/pkgs/default.nix @@ -14919,6 +14919,7 @@ formatting generic-arbitrary hspec lens +log-warper mtl network-transport network-transport-inmemory @@ -14933,6 +14934,7 @@ stm tagged text text-format +time time-units universum unordered-containers