Add TimeInterpreter to NetworkEnv

cardano-foundation · Oct 22, 2024 · 99bd214 · 99bd214
1 parent 1239608
commit 99bd214
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 2 deletions.
diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal
@@ -60,6 +60,7 @@ library
     , cardano-strict-containers
     , cardano-wallet
     , cardano-wallet-network-layer
+    , cardano-wallet-primitive
     , cardano-wallet-read           ==0.2024.8.27
     , containers
     , contra-tracer
@@ -71,6 +72,7 @@ library
     , mtl
     , OddWord
     , text
+    , time
 
   reexported-modules: Cardano.Wallet.Address.BIP32
   exposed-modules:

diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs
@@ -87,4 +87,6 @@ newNetworkEnvMock = do
             -- brief delay to account for asynchronous chain followers
             threadDelay 100
             pure $ Right ()
+        , getTimeInterpreter =
+            pure Write.mockTimeInterpreter
         }
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Type.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Type.hs
@@ -15,6 +15,9 @@ import Cardano.Wallet.Network
 import Control.Tracer
     ( Tracer
     )
+import Data.Functor.Identity
+    ( Identity
+    )
 import Data.List.NonEmpty
     ( NonEmpty
     )
@@ -46,17 +49,19 @@ data NetworkEnv m block = NetworkEnv
         :: Write.Tx -> m (Either ErrPostTx ())
         -- ^ Post a transaction to the Cardano network.
 
+    , getTimeInterpreter
+        :: m (Write.TimeInterpreter Identity)
+        -- ^ Get the current 'TimeInterpreter' from the Cardano node.
     }
 
 mapBlock
     :: Functor m
     => (block1 -> block2)
     -> NetworkEnv m block1
     -> NetworkEnv m block2
-mapBlock f NetworkEnv{chainSync,postTx} = NetworkEnv
+mapBlock f env@NetworkEnv{chainSync} = env
     { chainSync = \tr follower ->
         chainSync tr (mapChainFollower id id id (fmap f) follower)
-    , postTx = postTx
     }
 
 {-------------------------------------------------------------------------------

diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NumericUnderscores #-}
 -- | Indirection module that re-exports types
 -- used for writing transactions to the blockchain,
 -- in the most recent and the next future eras.
@@ -34,6 +35,11 @@ module Cardano.Wallet.Deposit.Write
 
     -- ** Time interpreter
     , Write.TimeTranslation
+    , TimeInterpreter
+    , PastHorizonException
+    , toTimeTranslation
+    , mockTimeInterpreter
+
     -- * Helper functions
     , mkAda
     , mkTxOut
@@ -53,23 +59,47 @@ import Cardano.Wallet.Deposit.Read
     , TxOut
     , Value
     )
+import Cardano.Wallet.Primitive.Slotting
+    ( PastHorizonException
+    , StartTime (..)
+    , TimeInterpreter
+    , mkSingleEraInterpreter
+    )
+import Cardano.Wallet.Primitive.Slotting.TimeTranslation
+    ( toTimeTranslation
+    )
+import Cardano.Wallet.Primitive.Types.SlottingParameters
+    ( ActiveSlotCoefficient (..)
+    , EpochLength (..)
+    , SlotLength (..)
+    , SlottingParameters (..)
+    )
 import Cardano.Wallet.Read.Tx
     ( toConwayOutput
     )
+import Data.Functor.Identity
+    ( Identity (..)
+    )
 import Data.Map
     ( Map
     )
 import Data.Maybe.Strict
     ( StrictMaybe
     , maybeToStrictMaybe
     )
+import Data.Quantity
+    ( Quantity (..)
+    )
 import Data.Sequence.Strict
     ( StrictSeq
     , fromList
     )
 import Data.Set
     ( Set
     )
+import Data.Time.Clock
+    ( UTCTime (..)
+    )
 import Lens.Micro
     ( (&)
     , (.~)
@@ -83,6 +113,23 @@ import qualified Cardano.Write.Tx as Write
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
+{-----------------------------------------------------------------------------
+    Time
+------------------------------------------------------------------------------}
+mockTimeInterpreter :: TimeInterpreter Identity
+mockTimeInterpreter =
+    mkSingleEraInterpreter
+        (StartTime $ UTCTime (toEnum 0) 0)
+        mockSlottingParameters
+
+mockSlottingParameters :: SlottingParameters
+mockSlottingParameters = SlottingParameters
+    { getSlotLength = SlotLength 1
+    , getEpochLength = EpochLength 21_600
+    , getActiveSlotCoefficient = ActiveSlotCoefficient 1
+    , getSecurityParameter = Quantity 2_160
+    }
+
 {-----------------------------------------------------------------------------
     Convenience TxBody
 ------------------------------------------------------------------------------}