Construct a TimeHandle using blockfrost

Signed-off-by: Sasha Bogicevic <[email protected]>

Author: v0d1ch

hydra-node/hydra-node.cabal

@@ -57,6 +57,7 @@ library
     Hydra.Chain
     Hydra.Chain.Blockfrost
     Hydra.Chain.Blockfrost.Client
+    Hydra.Chain.Blockfrost.TimeHandle
     Hydra.Chain.CardanoClient
     Hydra.Chain.Direct
     Hydra.Chain.Direct.Handlers

hydra-node/src/Hydra/Chain/Blockfrost.hs

@@ -43,19 +43,21 @@ mkTinyWallet ::
 mkTinyWallet tracer config = do
   keyPair@(_, sk) <- readKeyPair cardanoSigningKey
   prj <- Blockfrost.projectFromFile projectPath
-  genesis@Blockfrost.Genesis{_genesisSystemStart, _genesisNetworkMagic} <- runBlockfrostM prj queryGenesis
-  let networkId = toCardanoNetworkId _genesisNetworkMagic
-  let queryEpochInfo = pure $ toEpochInfo $ mkEraHistory genesis
-  -- NOTE: we don't need to provide address here since it is derived from the
-  -- keypair but we still want to keep the same wallet api.
-  let queryWalletInfo queryPoint _address = runBlockfrostM prj $ do
-        point <- queryTip queryPoint
-        utxo <- queryUTxO sk networkId
-        let walletUTxO = Ledger.unUTxO $ toLedgerUTxO utxo
-        let systemStart = SystemStart $ posixSecondsToUTCTime _genesisSystemStart
-        pure $ WalletInfoOnChain{walletUTxO, systemStart, tip = point}
-  let querySomePParams = runBlockfrostM prj toCardanoPParams
-  newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo querySomePParams
+  runBlockfrostM prj $ do
+    Blockfrost.Genesis{_genesisSystemStart, _genesisNetworkMagic} <- queryGenesis
+    let networkId = toCardanoNetworkId _genesisNetworkMagic
+    eraHistory <- mkEraHistory
+    let queryEpochInfo = pure $ toEpochInfo eraHistory
+    -- NOTE: we don't need to provide address here since it is derived from the
+    -- keypair but we still want to keep the same wallet api.
+    let queryWalletInfo queryPoint _address = runBlockfrostM prj $ do
+          point <- queryTip queryPoint
+          utxo <- queryUTxO sk networkId
+          let walletUTxO = Ledger.unUTxO $ toLedgerUTxO utxo
+          let systemStart = SystemStart $ posixSecondsToUTCTime _genesisSystemStart
+          pure $ WalletInfoOnChain{walletUTxO, systemStart, tip = point}
+    let querySomePParams = runBlockfrostM prj toCardanoPParams
+    liftIO $ newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo querySomePParams
  where
   BlockfrostChainConfig{projectPath, cardanoSigningKey} = config
 

hydra-node/src/Hydra/Chain/Blockfrost/TimeHandle.hs

@@ -0,0 +1,34 @@
+-- | Module to deal with time in Blockfrost cardano chain layer. Defines the
+-- means to 'queryTimeHandle'.
+module Hydra.Chain.Blockfrost.TimeHandle where
+
+import Hydra.Prelude
+
+import Blockfrost.Client qualified as Blockfrost
+import Cardano.Slotting.Slot (SlotNo (SlotNo))
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Hydra.Cardano.Api (
+  SystemStart (..),
+ )
+import Hydra.Cardano.Api.Prelude (ChainPoint (ChainPoint, ChainPointAtGenesis))
+import Hydra.Chain.Blockfrost.Client (mkEraHistory, queryGenesis, queryTip, runBlockfrostM)
+import Hydra.Chain.CardanoClient (
+  QueryPoint (QueryTip),
+ )
+import Hydra.Chain.Direct.TimeHandle (TimeHandle, mkTimeHandle)
+
+-- | Query node for system start and era history before constructing a
+-- 'TimeHandle' using the slot at the tip of the network.
+queryTimeHandle :: Blockfrost.Project -> IO TimeHandle
+queryTimeHandle prj = runBlockfrostM prj $ do
+  tip <- queryTip QueryTip
+
+  Blockfrost.Genesis{_genesisSystemStart} <- queryGenesis
+  let systemStart = SystemStart $ posixSecondsToUTCTime _genesisSystemStart
+  eraHistory <- mkEraHistory
+  currentTipSlot <-
+    case tip of
+      ChainPointAtGenesis -> pure $ SlotNo 0
+      ChainPoint slotNo _ -> pure slotNo
+
+  pure $ mkTimeHandle currentTipSlot systemStart eraHistory

hydra-node/src/Hydra/Chain/Blockfrost/Wallet.hs

@@ -80,9 +80,6 @@ import Hydra.Chain.Direct.State (
   ChainStateAt (..),
  )
 import Hydra.Chain.Direct.TimeHandle (queryTimeHandle)
-import Hydra.Chain.Direct.Util (
-  readKeyPair,
- )
 import Hydra.Chain.Direct.Wallet (
   TinyWallet (..),
   WalletInfoOnChain (..),

hydra-node/src/Hydra/Chain/Direct.hs

@@ -11,9 +11,10 @@ roots = [
  , "spy$"
  , "spy'$"
  , "redeemer$"
- # toCardanoGenesisParameters and mkTinyWallet will be needed for full blockfrost integration
+ # toCardanoGenesisParameters, mkTinyWallet, queryTimeHandle will be needed for full blockfrost integration
  , "toCardanoGenesisParameters"
  , "mkTinyWallet"
+ , "queryTimeHandle"
  ]
 root-instances = [
  # Stock instances are treated as roots.