[CDEC-405]

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

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 }

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
+

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