more wip

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -1668,8 +1668,8 @@ getNetworkParameters
 getNetworkParameters (_block0, np, _st) nl = do
     pp <- liftIO $ NW.getProtocolParameters nl
     sp <- liftIO $ NW.getSlottingParametersForTip nl
-    let (apiNetworkParams, epochNoM) =
-            toApiNetworkParameters np { protocol = pp, slotting = sp }
+    let (apiNetworkParams, epochNoM) = toApiNetworkParameters np
+            { protocolParameters = pp, slottingParameters = sp }
     case epochNoM of
         Just epochNo -> do
             epochStartTime <-
@@ -1944,7 +1944,7 @@ registerWorker
 registerWorker ctx coworker wid =
     void $ Registry.register @_ @ctx re ctx wid config
   where
-    (_, NetworkParameters gp _, _) = ctx ^. genesisData
+    (_, NetworkParameters gp _ _, _) = ctx ^. genesisData
     re = ctx ^. workerRegistry
     df = ctx ^. dbFactory
     config = MkWorker

lib/core/src/Cardano/Wallet/DB/Sqlite.hs

@@ -157,7 +157,7 @@ import Data.Text.Class
 import Data.Typeable
     ( Typeable )
 import Data.Word
-    ( Word16, Word32, Word64 )
+    ( Word16, Word32 )
 import Database.Persist.Class
     ( toPersistValue )
 import Database.Persist.Sql

lib/core/src/Cardano/Wallet/Network.hs

@@ -47,7 +47,8 @@ import Cardano.BM.Data.Tracer
 import Cardano.Wallet.Primitive.Slotting
     ( TimeInterpreter, queryEpochLength, querySlotLength )
 import Cardano.Wallet.Primitive.Types
-    ( BlockHeader (..)
+    ( ActiveSlotCoefficient (..)
+    , BlockHeader (..)
     , ChimericAccount (..)
     , Hash (..)
     , ProtocolParameters
@@ -76,8 +77,6 @@ import Control.Tracer
     ( Tracer, traceWith )
 import Data.Functor
     ( ($>) )
-import Data.Generics.Internal.VL.Lens
-    ( view )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Quantity
@@ -99,7 +98,6 @@ import UnliftIO.Exception
 
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
-import qualified Ouroboros.Consensus.HardFork.History as HF
 
 data NetworkLayer m target block = NetworkLayer
     { nextBlocks
@@ -258,13 +256,13 @@ getSlottingParametersForTip
     => NetworkLayer m target block
     -> m SlottingParameters
 getSlottingParametersForTip nl = do
-    tip <- either 0 (view #slotNo) <$> runExceptT (currentNodeTip nl)
-    let ti = timeInterpreter nl
-    let getActiveSlotCoeff = pure (error "getActiveSlotCoeff")
+    tip <- either (const 0) slotNo <$> runExceptT (currentNodeTip nl)
+    -- fixme: where to get it from?
+    let getActiveSlotCoeff = pure (ActiveSlotCoefficient 1.0)
     -- fixme: handle any errors from ti
     SlottingParameters
-        <$> ti (querySlotLength tip)
-        <*> ti (queryEpochLength tip)
+        <$> timeInterpreter nl (querySlotLength tip)
+        <*> timeInterpreter nl (queryEpochLength tip)
         <*> getActiveSlotCoeff
 
 {-------------------------------------------------------------------------------

lib/core/src/Cardano/Wallet/Primitive/Slotting.hs

@@ -248,9 +248,12 @@ slotAtTimeDetailed t = do
         Nothing -> return Nothing
 
 querySlotLength :: SlotNo -> Qry SlotLength
-querySlotLength = fmap toSlotLength . HardForkQry . HF.qryFromExpr . HF.ESlotLength . HF.ELit
-  where
-    toSlotLength = SlotLength . Cardano.getSlotLength
+querySlotLength sl =
+    fmap (SlotLength . Cardano.getSlotLength) $
+    HardForkQry $
+    HF.qryFromExpr $
+    HF.ESlotLength $
+    HF.ELit sl
 
 queryEpochLength :: SlotNo -> Qry EpochLength
 queryEpochLength sl = fmap toEpochLength $ HardForkQry $ do
@@ -365,10 +368,10 @@ data SlotParameters = SlotParameters
 
 slotParams :: NetworkParameters -> SlotParameters
 slotParams np = SlotParameters
-    (np ^. #slotting . #getEpochLength)
-    (np ^. #slotting . #getSlotLength)
-    (np ^. #genesis . #getGenesisBlockDate)
-    (np ^. #slotting . #getActiveSlotCoefficient)
+    (np ^. #slottingParameters . #getEpochLength)
+    (np ^. #slottingParameters . #getSlotLength)
+    (np ^. #genesisParameters . #getGenesisBlockDate)
+    (np ^. #slottingParameters . #getActiveSlotCoefficient)
 
 -- | Calculate the time at which an epoch begins.
 epochStartTime :: SlotParameters -> EpochNo -> UTCTime

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -1418,11 +1418,11 @@ computeStatistics getCoins btype utxos =
 --   that are relevant to the wallet.
 --
 data NetworkParameters = NetworkParameters
-    { genesis :: GenesisParameters
+    { genesisParameters :: GenesisParameters
        -- ^ See 'GenesisParameters'.
-    , slotting :: SlottingParameters
+    , slottingParameters :: SlottingParameters
        -- ^ See 'SlottingParameters'.
-    , protocol :: ProtocolParameters
+    , protocolParameters :: ProtocolParameters
        -- ^ See 'ProtocolParameters'.
     } deriving (Generic, Show, Eq)
 

lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs

@@ -152,20 +152,21 @@ type NodeVersionData =
 --
 -- Chain Parameters
 
-
 mainnetNetworkParameters :: W.NetworkParameters
 mainnetNetworkParameters = W.NetworkParameters
     { genesisParameters = W.GenesisParameters
         { getGenesisBlockHash = W.Hash $ unsafeFromHex
             "5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb"
         , getGenesisBlockDate =
             W.StartTime $ posixSecondsToUTCTime 1506203091
-        , getSlotLength =
+        , getEpochStability =
+            Quantity 2160
+        }
+    , slottingParameters = W.SlottingParameters
+        { getSlotLength =
             W.SlotLength 20
         , getEpochLength =
             W.EpochLength 21600
-        , getEpochStability =
-            Quantity 2160
         , getActiveSlotCoefficient =
             W.ActiveSlotCoefficient 1.0
         }
@@ -316,8 +317,8 @@ toGenTx =
     . BL.fromStrict
     . W.getSealedTx
 
-byronCodecConfig :: W.GenesisParameters -> CodecConfig ByronBlock
-byronCodecConfig W.GenesisParameters{getEpochLength} =
+byronCodecConfig :: W.SlottingParameters -> CodecConfig ByronBlock
+byronCodecConfig W.SlottingParameters{getEpochLength} =
     ByronCodecConfig (toEpochSlots getEpochLength)
 
 fromByronBlock :: W.GenesisParameters -> ByronBlock -> W.Block
@@ -489,12 +490,14 @@ fromGenesisData (genesisData, genesisHash) =
                 W.Hash . CC.hashToBytes . unGenesisHash $ genesisHash
             , getGenesisBlockDate =
                 W.StartTime . gdStartTime $ genesisData
-            , getSlotLength =
+            , getEpochStability =
+                Quantity . fromIntegral . unBlockCount . gdK $ genesisData
+            }
+        , slottingParameters = W.SlottingParameters
+            { getSlotLength =
                 fromSlotDuration . ppSlotDuration . gdProtocolParameters $ genesisData
             , getEpochLength =
                 fromBlockCount . gdK $ genesisData
-            , getEpochStability =
-                Quantity . fromIntegral . unBlockCount . gdK $ genesisData
             , getActiveSlotCoefficient =
                 W.ActiveSlotCoefficient 1.0
             }

lib/shelley/src/Cardano/Wallet/Shelley.hs

@@ -106,10 +106,10 @@ import Cardano.Wallet.Primitive.Types
     ( Address
     , Block
     , ChimericAccount
-    , GenesisParameters (..)
     , NetworkParameters (..)
     , ProtocolParameters (..)
     , Settings (..)
+    , SlottingParameters (..)
     , WalletId
     )
 import Cardano.Wallet.Registry
@@ -283,7 +283,6 @@ serveWallet
     serveApp socket = withIOManager $ \io -> do
         withNetworkLayer networkTracer np socketPath vData $ \nl -> do
             withWalletNtpClient io ntpClientTracer $ \ntpClient -> do
-                let gp = genesisParameters np
                 let net = networkIdVal proxy
                 randomApi <- apiLayer (newTransactionLayer net) nl
                     Server.idleWorker
@@ -292,7 +291,7 @@ serveWallet
                 shelleyApi <- apiLayer (newTransactionLayer net) nl
                     (Server.manageRewardBalance proxy)
 
-                withPoolsMonitoring databaseDir gp nl $ \spl -> do
+                withPoolsMonitoring databaseDir np nl $ \spl -> do
                     startServer
                         proxy
                         socket
@@ -338,11 +337,11 @@ serveWallet
 
     withPoolsMonitoring
         :: Maybe FilePath
-        -> GenesisParameters
+        -> NetworkParameters
         -> NetworkLayer IO t (CardanoBlock StandardCrypto)
         -> (StakePoolLayer -> IO a)
         -> IO a
-    withPoolsMonitoring dir gp nl action =
+    withPoolsMonitoring dir (NetworkParameters gp sp _) nl action =
         Pool.withDecoratedDBLayer
                 poolDatabaseDecorator
                 poolsDbTracer
@@ -352,7 +351,7 @@ serveWallet
 
             forM_ settings $ atomically . putSettings
             void $ forkFinally (monitorStakePools tr gp nl db) onExit
-            spl <- newStakePoolLayer nl db $ forkFinally (monitorMetadata tr gp db) onExit
+            spl <- newStakePoolLayer nl db $ forkFinally (monitorMetadata tr sp db) onExit
             action spl
       where
         tr = contramap (MsgFromWorker mempty) poolsEngineTracer
@@ -376,20 +375,20 @@ serveWallet
             walletDbTracer
             (DefaultFieldValues
                 { defaultActiveSlotCoefficient =
-                    getActiveSlotCoefficient gp
+                    getActiveSlotCoefficient sp
                 , defaultDesiredNumberOfPool =
-                    desiredNumberOfStakePools (protocolParameters np)
+                    desiredNumberOfStakePools pp
                 , defaultMinimumUTxOValue =
-                    minimumUTxOvalue (protocolParameters np)
+                    minimumUTxOvalue pp
                 , defaultHardforkEpoch =
-                    hardforkEpochNo (protocolParameters np)
+                    hardforkEpochNo pp
                 }
             )
             (timeInterpreter nl)
             databaseDir
         Server.newApiLayer walletEngineTracer params nl' tl db coworker
       where
-        gp = genesisParameters np
+        NetworkParameters gp sp pp = np
         nl' = fromCardanoBlock gp <$> nl
 
     -- FIXME: reduce duplication (see Cardano.Wallet.Jormungandr)

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -566,12 +566,14 @@ fromGenesisData g initialFunds =
             { getGenesisBlockHash = dummyGenesisHash
             , getGenesisBlockDate =
                 W.StartTime . sgSystemStart $ g
-            , getSlotLength =
+            , getEpochStability =
+                Quantity . fromIntegral . sgSecurityParam $ g
+            }
+        , slottingParameters = W.SlottingParameters
+            { getSlotLength =
                 W.SlotLength $ sgSlotLength g
             , getEpochLength =
                 W.EpochLength . fromIntegral . unEpochSize . sgEpochLength $ g
-            , getEpochStability =
-                Quantity . fromIntegral . sgSecurityParam $ g
             , getActiveSlotCoefficient =
                 W.ActiveSlotCoefficient . fromRational . sgActiveSlotsCoeff $ g
             }

lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs

@@ -97,11 +97,11 @@ import Cardano.Wallet.Primitive.Types
     , Coin (..)
     , EpochLength (..)
     , EpochNo (..)
-    , GenesisParameters (..)
     , NetworkParameters (..)
     , PoolId (..)
     , ProtocolMagic (..)
     , SlotLength (..)
+    , SlottingParameters (..)
     , TxOut
     )
 import Cardano.Wallet.Shelley
@@ -524,7 +524,8 @@ withCluster tr severity poolConfigs dir logFile onByron onFork onClusterStart =
 
             traceWith tr MsgWaitingForFork
             updateVersion tr dir
-            waitForHardFork bftSocket (fst params) 1 *> onFork runningBftNode
+            let sp = slottingParameters $ fst params
+            waitForHardFork bftSocket sp 1 *> onFork runningBftNode
 
             setEnv "CARDANO_NODE_SOCKET_PATH" bftSocket
             (rawTx, faucetPrv) <- prepareKeyRegistration tr dir
@@ -582,13 +583,13 @@ withCluster tr severity poolConfigs dir logFile onByron onFork onClusterStart =
     rotate :: Ord a => [a] -> [(a, [a])]
     rotate = nub . fmap (\(x:xs) -> (x, sort xs)) . permutations
 
-waitForHardFork :: FilePath -> NetworkParameters -> Int -> IO ()
-waitForHardFork _socket np epoch = threadDelay (ceiling (1e6 * delay))
+waitForHardFork :: FilePath -> SlottingParameters -> Int -> IO ()
+waitForHardFork _socket sp epoch = threadDelay (ceiling (1e6 * delay))
   where
     delay :: NominalDiffTime
     delay = slotDur * fromIntegral epLen * fromIntegral epoch + fuzz
-    EpochLength epLen = getEpochLength (genesisParameters np)
-    SlotLength slotDur = getSlotLength (genesisParameters np)
+    EpochLength epLen = getEpochLength sp
+    SlotLength slotDur = getSlotLength sp
     -- add two seconds just to make sure.
     fuzz = 2
 

lib/shelley/src/Cardano/Wallet/Shelley/Network.hs

@@ -335,7 +335,8 @@ withNetworkLayer tr np addrInfo versionData action = do
         { getGenesisBlockHash
         , getGenesisBlockDate
         } = W.genesisParameters np
-    cfg = codecConfig gp
+    sp = W.slottingParameters np
+    cfg = codecConfig sp
 
     -- Put if empty, replace if not empty.
     repsertTMVar var x = do
@@ -381,7 +382,7 @@ withNetworkLayer tr np addrInfo versionData action = do
     _initCursor :: HasCallStack => [W.BlockHeader] -> IO (Cursor (IO Shelley))
     _initCursor headers = do
         chainSyncQ <- atomically newTQueue
-        client <- mkWalletClient (contramap MsgChainSyncCmd tr) gp chainSyncQ
+        client <- mkWalletClient (contramap MsgChainSyncCmd tr) cfg gp chainSyncQ
         let handlers = failOnConnectionLost tr
         thread <- async (connectClient tr handlers client versionData addrInfo)
         link thread
@@ -528,12 +529,13 @@ type NetworkClient m = OuroborosApplication
 mkWalletClient
     :: (MonadThrow m, MonadST m, MonadTimer m, MonadAsync m)
     => Tracer m (ChainSyncLog Text Text)
+    -> CodecConfig (CardanoBlock StandardCrypto)
     -> W.GenesisParameters
         -- ^ Static blockchain parameters
     -> TQueue m (ChainSyncCmd (CardanoBlock StandardCrypto) m)
         -- ^ Communication channel with the ChainSync client
     -> m (NetworkClient m)
-mkWalletClient tr gp chainSyncQ = do
+mkWalletClient tr cfg gp chainSyncQ = do
     stash <- atomically newTQueue
     pure $ nodeToClientProtocols (const $ return $ NodeToClientProtocols
         { localChainSyncProtocol =
@@ -561,7 +563,6 @@ mkWalletClient tr gp chainSyncQ = do
             , pretty $ fromCardanoHash $ Point.blockPointHash blk
             , ")"
             ]
-    cfg = codecConfig gp
 
 -- | Construct a network client with the given communication channel, for the
 -- purposes of querying delegations and rewards.
@@ -604,8 +605,8 @@ codecVersion :: BlockNodeToClientVersion (CardanoBlock StandardCrypto)
 codecVersion = verMap ! nodeToClientVersion
     where verMap = supportedNodeToClientVersions (Proxy @(CardanoBlock StandardCrypto))
 
-codecConfig :: W.GenesisParameters -> CodecConfig (CardanoBlock c)
-codecConfig gp = CardanoCodecConfig (byronCodecConfig gp) ShelleyCodecConfig
+codecConfig :: W.SlottingParameters -> CodecConfig (CardanoBlock c)
+codecConfig sp = CardanoCodecConfig (byronCodecConfig sp) ShelleyCodecConfig
 
 -- | A group of codecs which will deserialise block data.
 codecs
@@ -714,10 +715,10 @@ mkTipSyncClient tr np localTxSubmissionQ onTipUpdate onPParamsUpdate onInterpret
                     traceWith tr $ MsgInterpreter interpreter
                     onInterpreterUpdate interpreter
 
-        gp@W.GenesisParameters
+        W.GenesisParameters
              { getGenesisBlockHash
              } = W.genesisParameters np
-        cfg = codecConfig gp
+        cfg = codecConfig (W.slottingParameters np)
 
     onTipUpdate' <- debounce @(Tip (CardanoBlock StandardCrypto)) @m $ \tip' -> do
         let tip = castTip tip'