Move epochInfo creation to TimeInterpreter module

To create the 'EpochInfo' needed to evaluate scripts, I had to expose the constructor of `TimeInterpreter`, making the abstraction leaky. That's not good, especially when it is quite easy to keep the abstraction boundary closed by providing ways of doing the conversions from the module itself.
cardano-foundation · Oct 14, 2021 · ad80829 · ad80829
1 parent 1530e19
commit ad80829
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 12 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE Rank2Types #-}
@@ -37,18 +38,26 @@ module Cardano.Wallet.Primitive.Slotting
     , fromRelativeTime
     , addRelTime
 
+      -- ** Blockchain-absolute times
+    , SystemStart
+    , getSystemStart
+
       -- ** What's the time?
     , currentRelativeTime
     , getCurrentTimeRelativeFromStart
 
       -- ** Running queries
-    , TimeInterpreter (..)
+    , TimeInterpreter
     , mkSingleEraInterpreter
     , mkTimeInterpreter
     , PastHorizonException (..)
     , interpretQuery
     , TimeInterpreterLog (..)
 
+      -- ** EpochInfo
+    , EpochInfo
+    , toEpochInfo
+
       -- ** Combinators for running queries
     , unsafeExtendSafeZone
     , neverFails
@@ -62,6 +71,8 @@ import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
     ( HasSeverityAnnotation (..) )
+import Cardano.Slotting.EpochInfo.API
+    ( EpochInfo )
 import Cardano.Wallet.Orphans
     ()
 import Cardano.Wallet.Primitive.Types
@@ -108,7 +119,9 @@ import Fmt
 import GHC.Stack
     ( CallStack, HasCallStack, getCallStack, prettySrcLoc )
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types
-    ( RelativeTime (..), SystemStart (..), addRelTime )
+    ( RelativeTime (..), SystemStart (SystemStart), addRelTime )
+import Ouroboros.Consensus.HardFork.History.EpochInfo
+    ( interpreterToEpochInfo )
 import Ouroboros.Consensus.HardFork.History.Qry
     ( Expr (..)
     , Interpreter
@@ -376,6 +389,17 @@ data TimeInterpreter m = forall eras. TimeInterpreter
     , handleResult :: forall a. Either PastHorizonException a -> m a
     }
 
+toEpochInfo
+    :: forall m. (Applicative m)
+    => TimeInterpreter m
+    -> m (EpochInfo (ExceptT PastHorizonException Identity))
+toEpochInfo TimeInterpreter{interpreter} =
+    interpreterToEpochInfo <$> interpreter
+
+getSystemStart :: TimeInterpreter m -> SystemStart
+getSystemStart TimeInterpreter{blockchainStartTime} =
+    let (StartTime t) = blockchainStartTime in SystemStart t
+
 data TimeInterpreterLog
     = MsgInterpreterPastHorizon
         (Maybe String) -- ^ Reason for why the failure should be impossible

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs
@@ -92,7 +92,7 @@ import Cardano.Wallet.Primitive.CoinSelection
 import Cardano.Wallet.Primitive.CoinSelection.Balance
     ( SelectionLimitOf (..), SelectionSkeleton (..) )
 import Cardano.Wallet.Primitive.Slotting
-    ( PastHorizonException, TimeInterpreter (..) )
+    ( PastHorizonException, TimeInterpreter, getSystemStart, toEpochInfo )
 import Cardano.Wallet.Primitive.Types
     ( ExecutionUnitPrices (..)
     , ExecutionUnits (..)
@@ -148,7 +148,6 @@ import Cardano.Wallet.Shelley.Compatibility
     , toStakeKeyDeregCert
     , toStakeKeyRegCert
     , toStakePoolDlgCert
-    , toSystemStart
     )
 import Cardano.Wallet.Shelley.Compatibility.Ledger
     ( computeMinimumAdaQuantity, toAlonzoTxOut )
@@ -202,8 +201,6 @@ import Data.Word
     ( Word16, Word64, Word8 )
 import GHC.Generics
     ( Generic )
-import Ouroboros.Consensus.HardFork.History.EpochInfo
-    ( interpreterToEpochInfo )
 import Ouroboros.Network.Block
     ( SlotNo )
 import Shelley.Spec.Ledger.API
@@ -937,14 +934,11 @@ _assignScriptRedeemers ntwrk (toAlonzoPParams -> pparams) ti resolveInput redeem
     evaluateExecutionUnits indexedRedeemers alonzoTx = withExceptT ErrAssignRedeemersPastHorizon $ do
         let utxo = utxoFromAlonzoTx alonzoTx
         let costs = toCostModelsAsArray (Alonzo._costmdls pparams)
+        let systemStart = getSystemStart ti
 
-        (systemStart, epochInfo) <- case ti of
-            TimeInterpreter{interpreter,blockchainStartTime} -> do
-                let systemStart = toSystemStart blockchainStartTime
-                epochInfo <- interpreterToEpochInfo <$> interpreter
-                pure (systemStart, epochInfo)
+        epochInfo <- toEpochInfo ti
 
-        mapExceptT (pure . hoistScriptFailure . runIdentity) $
+        mapExceptT (pure . hoistScriptFailure . runIdentity) $ do
             evaluateTransactionExecutionUnits
                 pparams
                 alonzoTx