[WIP] Further extend BlockchainParameters with slotsPerEpoch

exe/wallet/http-bridge/Main.hs

@@ -65,13 +65,7 @@ import Cardano.Wallet.DaedalusIPC
 import Cardano.Wallet.DB
     ( DBLayer )
 import Cardano.Wallet.HttpBridge.Compatibility
-    ( HttpBridge
-    , Network (..)
-    , byronBlock0Date
-    , byronFeePolicy
-    , byronSlotLength
-    , byronTxMaxSize
-    )
+    ( HttpBridge, Network (..), byronBlockchainParameters )
 import Cardano.Wallet.HttpBridge.Environment
     ( KnownNetwork (..) )
 import Cardano.Wallet.Network
@@ -119,7 +113,6 @@ import qualified Cardano.BM.Configuration.Model as CM
 import qualified Cardano.Wallet as Wallet
 import qualified Cardano.Wallet.Api.Server as Server
 import qualified Cardano.Wallet.DB.Sqlite as Sqlite
-import qualified Cardano.Wallet.HttpBridge.Compatibility as HttpBridge
 import qualified Cardano.Wallet.HttpBridge.Network as HttpBridge
 import qualified Cardano.Wallet.HttpBridge.Transaction as HttpBridge
 import qualified Data.Text as T
@@ -288,14 +281,7 @@ cmdServe = command "serve" $ info (helper <*> cmd) $ mempty
             nl <- HttpBridge.newNetworkLayer @n (getPort nodePort)
             waitForService "http-bridge" (sb, tracer) nodePort $
                 waitForConnection nl defaultRetryPolicy
-            let bp = BlockchainParameters
-                    { getGenesisBlock = HttpBridge.block0
-                    , getGenesisBlockDate = byronBlock0Date
-                    , getFeePolicy = byronFeePolicy
-                    , getSlotLength = byronSlotLength
-                    , getTxMaxSize = byronTxMaxSize
-                    }
-            return (nl, bp)
+            return (nl, byronBlockchainParameters)
 
         withDBLayer
             :: CM.Configuration

lib/core/src/Cardano/Wallet.hs

@@ -176,7 +176,7 @@ import Data.Time.Clock
     , getCurrentTime
     )
 import Data.Word
-    ( Word16 )
+    ( Word16, Word32 )
 import Fmt
     ( Buildable, blockListF, pretty, (+|), (+||), (|+), (||+) )
 
@@ -382,6 +382,7 @@ data BlockchainParameters t = BlockchainParameters
         -- ^ Policy regarding transcation fee
     , getSlotLength :: SlotLength
         -- ^ Length, in seconds, of a slot
+    , getSlotsPerEpoch :: Quantity "slot/epoch" Word32
     , getTxMaxSize :: Quantity "byte" Word16
         -- ^ Maximum size of a transaction (soft or hard limit)
     }
@@ -419,7 +420,12 @@ newWalletLayer tracer bp db nw tl = do
         }
   where
     BlockchainParameters
-        block0 block0Date feePolicy (SlotLength slotLength) txMaxSize = bp
+        block0
+        block0Date
+        feePolicy
+        (SlotLength slotLength)
+        (Quantity slotsPerEpoch)
+        txMaxSize = bp
 
     logDebugT :: MonadIO m => Text -> m ()
     logDebugT = liftIO . logDebug tracer
@@ -603,7 +609,7 @@ newWalletLayer tracer bp db nw tl = do
                     splitAt (length blocks - 1) blocks
             liftIO $ logDebug t $ pretty (h ++ q)
             let (txs, cp') = applyBlocks @s @t (h ++ q) cp
-            let progress = slotRatio sup tip
+            let progress = slotRatio (fromIntegral slotsPerEpoch) sup tip
             let status' = if progress == maxBound
                     then Ready
                     else Restoring progress
@@ -738,9 +744,12 @@ newWalletLayer tracer bp db nw tl = do
     _slotIdTime slN =
         addUTCTime (convert $ slotLength * slots) block0Date
       where
-        slots = fromIntegral . fromEnum $ (flatSlot slN) - (flatSlot sl0)
+        slots = fromIntegral . fromEnum $ (flatSlot' slN) - (flatSlot' sl0)
         sl0 = block0 ^. #header ^. #slotId
 
+
+        flatSlot' = flatSlot (fromIntegral slotsPerEpoch)
+
         convert :: DiffTime -> NominalDiffTime
         convert = toEnum . fromEnum
 

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

@@ -35,8 +35,6 @@ import Cardano.Wallet.Primitive.Types
     , TxStatus (..)
     , WalletId (..)
     , WalletState (..)
-    , flatSlot
-    , fromFlatSlot
     , isValidCoin
     )
 import Control.Monad
@@ -226,8 +224,8 @@ instance PersistFieldSql SlotId where
     sqlType _ = sqlType (Proxy @Word64)
 
 instance PersistField SlotId where
-    toPersistValue = toPersistValue . flatSlot
-    fromPersistValue = fmap fromFlatSlot . fromPersistValue
+    toPersistValue = error "TODO"
+    fromPersistValue = error "TODO"
 
 instance ToJSON SlotId where
     toJSON = genericToJSON defaultOptions

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

@@ -678,35 +678,33 @@ instance Buildable SlotId where
 -- approximation for a few reasons, one of them being that we hard code the
 -- epoch length as a static number whereas it may vary in practice.
 slotRatio
-    :: SlotId
+    :: Word64
+    -> SlotId
         -- ^ Numerator
     -> SlotId
         -- ^ Denominator
     -> Quantity "percent" Percentage
-slotRatio a b =
+slotRatio epochLength a b =
     let
-        n0 = flatSlot a
-        n1 = flatSlot b
+        n0 = flatSlot epochLength a
+        n1 = flatSlot epochLength b
         tolerance = 5
     in if distance n0 n1 < tolerance || n0 >= n1 then
         maxBound
     else
         Quantity $ toEnum $ fromIntegral $ (100 * n0) `div` n1
 
 -- | Convert a 'SlotId' to the number of slots since genesis.
-flatSlot :: SlotId -> Word64
-flatSlot (SlotId e s) = epochLength * e + fromIntegral s
+flatSlot :: Word64 -> SlotId -> Word64
+flatSlot epochLength (SlotId e s) = epochLength * e + fromIntegral s
 
 -- | Convert a 'flatSlot' index to 'SlotId'.
-fromFlatSlot :: Word64 -> SlotId
-fromFlatSlot n = SlotId e (fromIntegral s)
+fromFlatSlot :: Word64 -> Word64 -> SlotId
+fromFlatSlot epochLength n = SlotId e (fromIntegral s)
   where
     e = n `div` epochLength
     s = n `mod` epochLength
 
-epochLength :: Integral a => a
-epochLength = 500
-
 newtype SlotLength = SlotLength DiffTime
     deriving (Show, Eq)
 

lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs

@@ -121,14 +121,15 @@ spec = do
             let txMeta = TxMeta Invalidated Incoming (SlotId 0 42) (Quantity 0)
             "+0.000000 invalidated since 0.42" === pretty @_ @Text txMeta
 
+    let slotsPerEpoch = 21600
     describe "slotRatio" $ do
         it "works for any two slots" $ property $ \sl0 sl1 ->
-            slotRatio sl0 sl1 `deepseq` ()
+            slotRatio slotsPerEpoch sl0 sl1 `deepseq` ()
     describe "flatSlot" $ do
         it "flatSlot . fromFlatSlot == id" $ property $ \sl ->
-            fromFlatSlot (flatSlot sl) === sl
+            fromFlatSlot slotsPerEpoch (flatSlot slotsPerEpoch sl) === sl
         it "fromFlatSlot . flatSlot == id" $ property $ \n ->
-            flatSlot (fromFlatSlot n) === n
+            flatSlot slotsPerEpoch (fromFlatSlot slotsPerEpoch n) === n
 
     describe "Negative cases for types decoding" $ do
         it "fail fromText @AddressState \"unusedused\"" $ do

lib/core/test/unit/Cardano/WalletSpec.hs

@@ -108,6 +108,8 @@ import Data.Quantity
     ( Quantity (..) )
 import Data.Time.Clock
     ( secondsToDiffTime )
+import Data.Time.Clock.POSIX
+    ( posixSecondsToUTCTime )
 import Data.Word
     ( Word16, Word32 )
 import GHC.Generics
@@ -372,7 +374,8 @@ setupFixture (wid, wname, wstate) = do
     db <- newDBLayer
     let nl = error "NetworkLayer"
     let tl = dummyTransactionLayer
-    let bp = BlockchainParameters block0 block0Date policy slotLength txMaxSize
+    let bp = BlockchainParameters
+            block0 block0Date policy slotLength slotsPerEpoch txMaxSize
     wl <- newWalletLayer @_ @DummyTarget nullTracer bp db nl tl
     res <- runExceptT $ createWallet wl wid wname wstate
     let wal = case res of
@@ -389,6 +392,11 @@ setupFixture (wid, wname, wstate) = do
     txMaxSize :: Quantity "byte" Word16
     txMaxSize = Quantity 8192
 
+    slotsPerEpoch :: Quantity "slot/epoch" Word32
+    slotsPerEpoch = Quantity 21600
+
+    block0Date = posixSecondsToUTCTime 0
+
 -- | A dummy transaction layer to see the effect of a root private key. It
 -- implements a fake signer that still produces sort of witnesses
 dummyTransactionLayer :: TransactionLayer DummyTarget

lib/http-bridge/src/Cardano/Wallet/HttpBridge/Compatibility.hs

@@ -22,12 +22,15 @@ module Cardano.Wallet.HttpBridge.Compatibility
     , byronFeePolicy
     , byronSlotLength
     , byronTxMaxSize
+    , byronBlockchainParameters
     ) where
 
 import Prelude
 
 import Cardano.Crypto.Wallet
     ( XPub (..) )
+import Cardano.Wallet
+    ( BlockchainParameters (..) )
 import Cardano.Wallet.DB.Sqlite
     ( PersistTx (..) )
 import Cardano.Wallet.HttpBridge.Binary
@@ -180,3 +183,14 @@ byronSlotLength = SlotLength $ secondsToDiffTime 20
 -- | Hard-coded max transaction size
 byronTxMaxSize :: Quantity "byte" Word16
 byronTxMaxSize = Quantity 8192
+
+byronBlockchainParameters :: BlockchainParameters (HttpBridge n)
+byronBlockchainParameters = BlockchainParameters
+                    { getGenesisBlock = block0
+                    , getGenesisBlockDate = byronBlock0Date
+                    , getFeePolicy = byronFeePolicy
+                    , getSlotLength = byronSlotLength
+                    , getTxMaxSize = byronTxMaxSize
+                    , getSlotsPerEpoch = Quantity 21600
+                    }
+

lib/http-bridge/test/bench/Main.hs

@@ -20,7 +20,7 @@ import Cardano.Wallet
 import Cardano.Wallet.DB.Sqlite
     ( PersistState )
 import Cardano.Wallet.HttpBridge.Compatibility
-    ( HttpBridge, block0, byronFeePolicy, byronSlotLength, byronTxMaxSize )
+    ( HttpBridge, byronBlockchainParameters )
 import Cardano.Wallet.HttpBridge.Environment
     ( KnownNetwork (..), Network (..) )
 import Cardano.Wallet.HttpBridge.Network
@@ -212,12 +212,7 @@ bench_restoration _ (wid, wname, s) = withHttpBridge network $ \port -> do
     let tl = newTransactionLayer
     BlockHeader sl _ <- unsafeRunExceptT $ networkTip nw
     sayErr . fmt $ network ||+ " tip is at " +|| sl ||+ ""
-    let bp = BlockchainParameters
-            { getGenesisBlock = block0
-            , getFeePolicy = byronFeePolicy
-            , getSlotLength = byronSlotLength
-            , getTxMaxSize = byronTxMaxSize
-            }
+    let bp = byronBlockchainParameters
     w <- newWalletLayer @_ @t nullTracer bp db nw tl
     wallet <- unsafeRunExceptT $ createWallet w wid wname s
     unsafeRunExceptT $ restoreWallet w wallet

lib/http-bridge/test/integration/Main.hs

@@ -26,13 +26,7 @@ import Cardano.Wallet.Api.Server
 import Cardano.Wallet.DB.Sqlite
     ( SqliteContext )
 import Cardano.Wallet.HttpBridge.Compatibility
-    ( HttpBridge
-    , block0
-    , block0Date
-    , byronFeePolicy
-    , byronSlotLength
-    , byronTxMaxSize
-    )
+    ( HttpBridge, byronBlockchainParameters )
 import Cardano.Wallet.HttpBridge.Environment
     ( Network (..) )
 import Cardano.Wallet.Network
@@ -270,13 +264,7 @@ main = do
         mvar <- newEmptyMVar
         thread <- forkIO $ do
             let tl = HttpBridge.newTransactionLayer
-            let bp = BlockchainParameters
-                    { getGenesisBlock = block0
-                    , getGenesisBlockDate = block0Date
-                    , getFeePolicy = byronFeePolicy
-                    , getSlotLength = byronSlotLength
-                    , getTxMaxSize = byronTxMaxSize
-                    }
+            let bp = byronBlockchainParameters
             wallet <- newWalletLayer nullTracer bp db nl tl
             let listen = fromMaybe (ListenOnPort defaultPort) mlisten
             Server.withListeningSocket listen $ \(port, socket) -> do

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs

@@ -272,12 +272,20 @@ mkJormungandrLayer mgr baseUrl = JormungandrLayer
                     _ -> Nothing
 
 
-        case (mpolicy, mduration, mblock0Date) of
-            ([policy],[duration],[block0Date]) ->
+        let mslotsPerEpoch = mapMaybe getEpochLength params
+              where
+                getEpochLength = \case
+                    SlotsPerEpoch x -> Just x
+                    _ -> Nothing
+
+
+        case (mpolicy, mduration, mblock0Date, mslotsPerEpoch) of
+            ([policy],[duration],[block0Date], [slotsPerEpoch]) ->
                 return $ BlockchainParameters
                     { getGenesisBlock = coerceBlock jblock
                     , getGenesisBlockDate = block0Date
                     , getFeePolicy = policy
+                    , getSlotsPerEpoch = slotsPerEpoch
                     , getSlotLength = SlotLength duration
                     , getTxMaxSize = softTxMaxSize
                     }