Construct a TimeHandle using blockfrost

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

Author: v0d1ch

hydra-cardano-api/src/Cardano/Api/UTxO.hs

@@ -76,6 +76,9 @@ filter fn = UTxO . Map.filter fn . toMap
 inputSet :: UTxO' out -> Set TxIn
 inputSet = Map.keysSet . toMap
 
+squash :: [UTxO' out] -> UTxO' out
+squash = foldMap (<> mempty)
+
 -- | Get a human-readable pretty text representation of a UTxO.
 render :: (TxIn, TxOut ctx era) -> Text
 render (k, TxOut _ (txOutValueToValue -> v) _ _) =

hydra-node/hydra-node.cabal

@@ -58,6 +58,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

@@ -15,6 +15,7 @@ import Hydra.Cardano.Api (
 import Hydra.Chain.Blockfrost.Client (
   mkEraHistory,
   queryGenesis,
+  queryScriptRegistry,
   queryTip,
   queryUTxO,
   runBlockfrostM,
@@ -24,18 +25,40 @@ import Hydra.Chain.Blockfrost.Client (
 import Hydra.Chain.Direct.Handlers (
   DirectChainLog (..),
  )
-import Hydra.Chain.Direct.Wallet (
-  TinyWallet (..),
-  WalletInfoOnChain (..),
-  newTinyWallet,
- )
+import Hydra.Chain.Direct.State (ChainContext (..))
+import Hydra.Chain.Direct.Wallet (TinyWallet, WalletInfoOnChain (..), newTinyWallet)
 import Hydra.Logging (Tracer)
 import Hydra.Node.Util (
   readKeyPair,
  )
 import Hydra.Options (BlockfrostChainConfig (..))
+import Hydra.Tx (Party)
 import Ouroboros.Consensus.HardFork.History qualified as Consensus
 
+-- | Build the 'ChainContext' from a 'ChainConfig' and additional information.
+loadChainContext ::
+  BlockfrostChainConfig ->
+  -- | Hydra party of our hydra node.
+  Party ->
+  -- | The current running era we can use to query the node
+  IO ChainContext
+loadChainContext config party = do
+  (vk, _) <- readKeyPair cardanoSigningKey
+  (scriptRegistry, networkId) <- queryScriptRegistry projectPath hydraScriptsTxId
+  pure $
+    ChainContext
+      { networkId
+      , ownVerificationKey = vk
+      , ownParty = party
+      , scriptRegistry
+      }
+ where
+  BlockfrostChainConfig
+    { projectPath
+    , hydraScriptsTxId
+    , cardanoSigningKey
+    } = config
+
 mkTinyWallet ::
   Tracer IO DirectChainLog ->
   BlockfrostChainConfig ->

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

@@ -14,6 +14,7 @@ import Data.Time.Clock.POSIX
 import Hydra.Cardano.Api hiding (LedgerState, fromNetworkMagic)
 
 import Cardano.Api.UTxO qualified as UTxO
+import Cardano.Crypto.Hash (hashToTextAsHex)
 import Cardano.Ledger.Api.PParams
 import Cardano.Ledger.BaseTypes (EpochInterval (..), EpochSize (..), NonNegativeInterval, UnitInterval, boundRational, unsafeNonZero)
 import Cardano.Ledger.Binary.Version (mkVersion)
@@ -42,7 +43,7 @@ import Data.Text qualified as T
 import Hydra.Cardano.Api.Prelude (StakePoolKey, fromNetworkMagic)
 import Hydra.Chain.CardanoClient (QueryPoint (..))
 import Hydra.Chain.ScriptRegistry (buildScriptPublishingTxs)
-import Hydra.Tx (txId)
+import Hydra.Tx (ScriptRegistry, newScriptRegistry, txId)
 import Money qualified
 import Ouroboros.Consensus.Block (GenesisWindow (..))
 import Ouroboros.Consensus.HardFork.History (Bound (..), EraEnd (..), EraParams (..), EraSummary (..), SafeZone (..), Summary (..), mkInterpreter)
@@ -63,6 +64,34 @@ runBlockfrostM prj action = do
     Left err -> throwIO (BlockfrostError $ show err)
     Right val -> pure val
 
+-- | Query for 'TxIn's in the search for outputs containing all the reference
+-- scripts of the 'ScriptRegistry'.
+--
+-- This is implemented by repeated querying until we have all necessary
+-- reference scripts as we do only know the transaction id, not the indices.
+--
+-- Can throw at least 'NewScriptRegistryException' on failure.
+queryScriptRegistry ::
+  (MonadIO m, MonadThrow m) =>
+  FilePath ->
+  [TxId] ->
+  m (ScriptRegistry, NetworkId)
+queryScriptRegistry projectPath txIds = do
+  prj <- liftIO $ Blockfrost.projectFromFile projectPath
+  runBlockfrostM prj $ do
+    Blockfrost.Genesis
+      { _genesisNetworkMagic
+      , _genesisSystemStart
+      } <-
+      queryGenesis
+    let networkId = toCardanoNetworkId _genesisNetworkMagic
+    utxoList <- forM candidates $ \candidateTxIn -> queryUTxOByTxIn networkId candidateTxIn
+    case newScriptRegistry $ UTxO.squash utxoList of
+      Left e -> liftIO $ throwIO e
+      Right sr -> pure (sr, networkId)
+ where
+  candidates = map (\txid -> TxIn txid (TxIx 0)) txIds
+
 publishHydraScripts ::
   -- | The path where the Blockfrost project token hash is stored.
   FilePath ->
@@ -114,13 +143,13 @@ toCardanoUTxO :: [Blockfrost.AddressUtxo] -> AddressInEra -> UTxO' (TxOut CtxUTx
 toCardanoUTxO utxos addr = UTxO.fromPairs (toEntry <$> utxos)
  where
   toEntry :: Blockfrost.AddressUtxo -> (TxIn, TxOut CtxUTxO)
-  toEntry utxo = (toCardanoTxIn utxo, toCardanoTxOut utxo addr)
+  toEntry utxo = (toCardanoTxIn (Blockfrost._addressUtxoTxHash utxo) (Blockfrost._addressUtxoOutputIndex utxo), toCardanoTxOut utxo addr)
 
-toCardanoTxIn :: Blockfrost.AddressUtxo -> TxIn
-toCardanoTxIn Blockfrost.AddressUtxo{_addressUtxoTxHash = Blockfrost.TxHash{unTxHash}, _addressUtxoOutputIndex} =
+toCardanoTxIn :: Blockfrost.TxHash -> Integer -> TxIn
+toCardanoTxIn Blockfrost.TxHash{unTxHash} i =
   case deserialiseFromRawBytesHex AsTxId (encodeUtf8 unTxHash) of
     Left err -> error (show err)
-    Right txid -> TxIn txid (TxIx (fromIntegral _addressUtxoOutputIndex))
+    Right txid -> TxIn txid (TxIx (fromIntegral i))
 
 -- REVIEW! TxOutDatumNone and ReferenceScriptNone
 toCardanoTxOut :: Blockfrost.AddressUtxo -> AddressInEra -> TxOut CtxUTxO
@@ -361,6 +390,56 @@ mkEraHistory = do
 -- Wallet API --
 ----------------
 
+-- | Query the Blockfrost API to get the 'UTxO' for 'TxIn' and convert to cardano 'UTxO'.
+queryUTxOByTxIn :: NetworkId -> TxIn -> BlockfrostClientT IO UTxO
+queryUTxOByTxIn networkId txIn = do
+  bfUTxO <- Blockfrost.getTxUtxos (Blockfrost.TxHash $ hashToTextAsHex txHash)
+  fromBFUtxo bfUTxO
+ where
+  fromBFUtxo Blockfrost.TransactionUtxos{_transactionUtxosOutputs} = do
+    utxoList <- mapM toCardanoUTxO' _transactionUtxosOutputs
+    pure $ UTxO.squash utxoList
+
+  toCardanoUTxO' output@Blockfrost.UtxoOutput{_utxoOutputReferenceScriptHash} = do
+    case _utxoOutputReferenceScriptHash of
+      -- NOTE: We don't care about outputs without reference scripts
+      Nothing -> pure mempty
+      Just scriptHash -> do
+        Blockfrost.ScriptCBOR{_scriptCborCbor} <- Blockfrost.getScriptCBOR scriptHash
+        case _scriptCborCbor of
+          Nothing -> liftIO $ throwIO $ BlockfrostError "Failed to get script CBOR."
+          Just fullScriptCBOR -> do
+            case decodeBase16 fullScriptCBOR of
+              Left decodeErr -> liftIO $ throwIO . DecodeError $ "Bad Base16 PlutusScript CBOR: " <> decodeErr
+              Right bytes ->
+                case deserialiseFromCBOR (proxyToAsType (Proxy @PlutusScript)) bytes of
+                  Left err -> liftIO $ throwIO $ BlockfrostError $ "Failed to decode script: " <> T.pack (show err)
+                  Right plutusScript -> do
+                    let o = toCardanoTxOut' output plutusScript
+                    pure $ UTxO.singleton (txIn, o)
+
+  toCardanoTxOut' Blockfrost.UtxoOutput{_utxoOutputAddress, _utxoOutputAmount, _utxoOutputDataHash, _utxoOutputInlineDatum, _utxoOutputReferenceScriptHash} plutusScript =
+    let datum =
+          case _utxoOutputInlineDatum of
+            Nothing ->
+              case _utxoOutputDataHash of
+                Nothing -> TxOutDatumNone
+                Just datumHash -> TxOutDatumHash (fromString $ T.unpack $ Blockfrost.unDatumHash datumHash)
+            Just (Blockfrost.InlineDatum (Blockfrost.ScriptDatumCBOR cborDatum)) ->
+              case deserialiseFromCBOR (proxyToAsType (Proxy @HashableScriptData)) (encodeUtf8 cborDatum) of
+                Left _ -> TxOutDatumNone
+                Right hashableScriptData -> TxOutDatumInline hashableScriptData
+     in TxOut (scriptAddr plutusScript) (toCardanoValue _utxoOutputAmount) datum (mkScriptRef plutusScript)
+
+  scriptAddr script =
+    makeShelleyAddressInEra
+      shelleyBasedEra
+      networkId
+      (PaymentCredentialByScript $ hashScript $ PlutusScript script)
+      NoStakeAddress
+
+  TxIn (TxId txHash) _ = txIn
+
 -- | Query the Blockfrost API for address UTxO and convert to cardano 'UTxO'.
 queryUTxO :: SigningKey PaymentKey -> NetworkId -> BlockfrostClientT IO UTxO
 queryUTxO sk networkId = do

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

@@ -8,8 +8,7 @@ import Hydra.Prelude
 
 import Cardano.Api.UTxO (UTxO)
 import Cardano.Ledger.Address qualified as Ledger
-import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext, ContextError, EraPlutusContext)
-import Cardano.Crypto.Hash.Class
+import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusContext)
 import Cardano.Ledger.Alonzo.Scripts (
   AlonzoEraScript (..),
   AsIx (..),
@@ -101,8 +100,8 @@ import Hydra.Chain.CardanoClient (QueryPoint (..))
 import Hydra.Ledger.Cardano ()
 import Hydra.Logging (Tracer, traceWith)
 
-type Address = Ledger.Addr StandardCrypto
-type TxIn = Ledger.TxIn StandardCrypto
+type Address = Ledger.Addr
+type TxIn = Ledger.TxIn
 type TxOut = Ledger.TxOut LedgerEra
 
 -- | A 'TinyWallet' is a small abstraction of a wallet with basic UTXO
@@ -236,7 +235,7 @@ data ErrCoverFee
   | ErrUnknownInput {input :: TxIn}
   | ErrScriptExecutionFailed {redeemerPointer :: Text, scriptFailure :: Text}
   | ErrTranslationError (ContextError LedgerEra)
-  | ErrConwayUpgradeError (TxUpgradeError Conway)
+  | ErrConwayUpgradeError (TxUpgradeError ConwayEra)
   deriving stock (Show)
 
 data ChangeError = ChangeError {inputBalance :: Coin, outputBalance :: Coin}

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

@@ -407,6 +407,8 @@ data BlockfrostChainConfig = BlockfrostChainConfig
   -- ^ Path to the blockfrost project file
   , cardanoSigningKey :: FilePath
   -- ^ Path to the cardano signing key of the internal wallet.
+  , hydraScriptsTxId :: [TxId]
+  -- ^ Identifier of transaction holding the hydra scripts to use.
   }
   deriving stock (Eq, Show, Generic)