Light Mode: eraByEpoch fails explicitly for the testnet

cardano-foundation · Apr 4, 2022 · e965f80 · e965f80
1 parent 926a4eb
commit e965f80
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 12 deletions.
diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs
@@ -66,5 +66,5 @@ withNetworkLayer tr blockchainSrc net netParams tol =
             in Node.withNetworkLayer tr' net netParams nodeConn ver tol
         BlockfrostSource project ->
             let tr' = BlockfrostNetworkLog >$< tr
-            in Blockfrost.withNetworkLayer tr' project
+            in Blockfrost.withNetworkLayer tr' net project
 
diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs
@@ -38,7 +38,7 @@ import qualified Cardano.Api.Shelley as Node
 import qualified Data.Sequence as Seq
 
 import Cardano.Api
-    ( AnyCardanoEra )
+    ( AnyCardanoEra, NetworkId (Mainnet, Testnet) )
 import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Tracer
@@ -145,10 +145,11 @@ instance HasSeverityAnnotation Log where
 
 withNetworkLayer
     :: Tracer IO Log
+    -> NetworkId
     -> BF.Project
     -> (NetworkLayer IO (CardanoBlock StandardCrypto) -> IO a)
     -> IO a
-withNetworkLayer tr project k = k NetworkLayer
+withNetworkLayer tr net project k = k NetworkLayer
     { chainSync = \_tr _chainFollower -> pure ()
     , lightSync = Nothing
     , currentNodeTip
@@ -184,7 +185,7 @@ withNetworkLayer tr project k = k NetworkLayer
     currentNodeEra = handleBlockfrostError $ do
         BF.EpochInfo {_epochInfoEpoch} <- liftBlockfrost BF.getLatestEpoch
         epoch <- fromBlockfrostM _epochInfoEpoch
-        eraByEpoch epoch
+        liftEither $ eraByEpoch net epoch
 
     handleBlockfrostError :: ExceptT BlockfrostError IO a -> IO a
     handleBlockfrostError =
@@ -384,7 +385,11 @@ instance FromBlockfrost BF.Epoch EpochNo where
     fromBlockfrost = pure . fromIntegral
 
 
-{-
+{- Epoch-to-Era translation is not available in the Blockfrost API.
+
+For the Mainnet we're hardcoding the following history
+in order to work around this limiation:
+
 ┌───────┬───────┬─────────┐
 │ Epoch │ Major │   Era   │
 ├───────┼───────┼─────────┤
@@ -411,11 +416,16 @@ instance FromBlockfrost BF.Epoch EpochNo where
 │  ...  │   1   │  Byron  │
 └───────┴───────┴─────────┘
 -}
-eraByEpoch :: MonadError BlockfrostError m => EpochNo -> m AnyCardanoEra
-eraByEpoch epoch =
-    case dropWhile ((> epoch) . snd) (reverse eraBoundaries) of
-        (era, _) : _ -> pure era
-        _ -> throwError $ UnknownEraForEpoch epoch
+eraByEpoch :: NetworkId -> EpochNo -> Either BlockfrostError AnyCardanoEra
+eraByEpoch = \case
+    Mainnet -> \epoch ->
+        case dropWhile ((> epoch) . snd) (reverse eraBoundaries) of
+            (era, _) : _ -> Right era
+            _ -> Left $ UnknownEraForEpoch epoch
+    Testnet _ -> \_ -> error
+        "In light-mode era to epoch conversions are only available for the \
+        \mainnet (translation uses a hard-coded history of hard forks). \
+        \It doesn't seem viable to hardcode eras for other networks yet."
 
 eraBoundaries :: [(Node.AnyCardanoEra, EpochNo)]
 eraBoundaries = [minBound .. maxBound] <&> \era -> (era, epochEraStartsAt era)

diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/Network/BlockfrostSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/Network/BlockfrostSpec.hs
@@ -3,7 +3,7 @@ module Cardano.Wallet.Shelley.Network.BlockfrostSpec (spec) where
 import Prelude
 
 import Cardano.Api
-    ( AnyCardanoEra (..), CardanoEra (..) )
+    ( AnyCardanoEra (..), CardanoEra (..), NetworkId (Mainnet) )
 import Cardano.Wallet.Primitive.Types
     ( EpochNo )
 import Cardano.Wallet.Shelley.Network.Blockfrost
@@ -17,7 +17,7 @@ spec :: Spec
 spec = describe "Blockfrost Network" $ do
     it "determines era by epoch" $ do
         for_ epochEras $ \(epoch, era) ->
-            eraByEpoch epoch `shouldBe` Right era
+            eraByEpoch Mainnet epoch `shouldBe` Right era
   where
     epochEras :: [(EpochNo, AnyCardanoEra)]
     epochEras =