{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.Chain.Cardano where

import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Shelley.API qualified as Ledger
import Hydra.Cardano.Api (
  Tx,
  shelleyBasedEra,
  toLedgerEpochInfo,
  unLedgerEpochInfo,
 )
import Hydra.Chain (ChainComponent, ChainStateHistory)
import Hydra.Chain.Backend (ChainBackend (..))
import Hydra.Chain.Blockfrost (BlockfrostBackend, newBlockfrostEnv, runBlockfrostBackendWith, withBlockfrostChain)
import Hydra.Chain.CardanoClient (
  QueryPoint (..),
 )
import Hydra.Chain.Direct (DirectBackend, runDirectBackend, withDirectChain)
import Hydra.Chain.Direct.Handlers (CardanoChainLog (..))
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 (CardanoChainConfig (..), ChainBackendOptions (..))
import Hydra.Tx (Party)

withCardanoChain ::
  forall a.
  Tracer IO CardanoChainLog ->
  CardanoChainConfig ->
  Party ->
  -- | Chain state loaded from persistence.
  ChainStateHistory Tx ->
  ChainComponent Tx IO a
withCardanoChain :: forall a.
Tracer IO CardanoChainLog
-> CardanoChainConfig
-> Party
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
withCardanoChain Tracer IO CardanoChainLog
tracer CardanoChainConfig
cfg Party
party ChainStateHistory Tx
chainStateHistory ChainCallback Tx IO
callback Chain Tx IO -> IO a
action =
  case ChainBackendOptions
chainBackendOptions of
    Direct DirectOptions
directOptions -> do
      TinyWallet IO
wallet <- forall (m :: * -> *).
(ChainBackend m, Monad m) =>
(forall b. m b -> IO b)
-> Tracer IO CardanoChainLog
-> CardanoChainConfig
-> IO (TinyWallet IO)
mkTinyWallet @DirectBackend (DirectOptions -> DirectBackend b -> IO b
forall a. DirectOptions -> DirectBackend a -> IO a
runDirectBackend DirectOptions
directOptions) Tracer IO CardanoChainLog
tracer CardanoChainConfig
cfg
      ChainContext
ctx <- DirectOptions -> DirectBackend ChainContext -> IO ChainContext
forall a. DirectOptions -> DirectBackend a -> IO a
runDirectBackend DirectOptions
directOptions (DirectBackend ChainContext -> IO ChainContext)
-> DirectBackend ChainContext -> IO ChainContext
forall a b. (a -> b) -> a -> b
$ CardanoChainConfig -> Party -> DirectBackend ChainContext
forall (m :: * -> *).
(ChainBackend m, MonadIO m) =>
CardanoChainConfig -> Party -> m ChainContext
loadChainContext CardanoChainConfig
cfg Party
party
      DirectOptions
-> Tracer IO CardanoChainLog
-> CardanoChainConfig
-> ChainContext
-> TinyWallet IO
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
forall a.
DirectOptions
-> Tracer IO CardanoChainLog
-> CardanoChainConfig
-> ChainContext
-> TinyWallet IO
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
withDirectChain DirectOptions
directOptions Tracer IO CardanoChainLog
tracer CardanoChainConfig
cfg ChainContext
ctx TinyWallet IO
wallet ChainStateHistory Tx
chainStateHistory ChainCallback Tx IO
callback Chain Tx IO -> IO a
action
    Blockfrost BlockfrostOptions
blockfrostOptions -> do
      BlockfrostEnv
env <- BlockfrostOptions -> IO BlockfrostEnv
newBlockfrostEnv BlockfrostOptions
blockfrostOptions
      TinyWallet IO
wallet <- forall (m :: * -> *).
(ChainBackend m, Monad m) =>
(forall b. m b -> IO b)
-> Tracer IO CardanoChainLog
-> CardanoChainConfig
-> IO (TinyWallet IO)
mkTinyWallet @BlockfrostBackend (BlockfrostEnv -> BlockfrostBackend b -> IO b
forall a. BlockfrostEnv -> BlockfrostBackend a -> IO a
runBlockfrostBackendWith BlockfrostEnv
env) Tracer IO CardanoChainLog
tracer CardanoChainConfig
cfg
      ChainContext
ctx <- BlockfrostEnv -> BlockfrostBackend ChainContext -> IO ChainContext
forall a. BlockfrostEnv -> BlockfrostBackend a -> IO a
runBlockfrostBackendWith BlockfrostEnv
env (BlockfrostBackend ChainContext -> IO ChainContext)
-> BlockfrostBackend ChainContext -> IO ChainContext
forall a b. (a -> b) -> a -> b
$ CardanoChainConfig -> Party -> BlockfrostBackend ChainContext
forall (m :: * -> *).
(ChainBackend m, MonadIO m) =>
CardanoChainConfig -> Party -> m ChainContext
loadChainContext CardanoChainConfig
cfg Party
party
      BlockfrostEnv
-> Tracer IO CardanoChainLog
-> CardanoChainConfig
-> ChainContext
-> TinyWallet IO
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
forall a.
BlockfrostEnv
-> Tracer IO CardanoChainLog
-> CardanoChainConfig
-> ChainContext
-> TinyWallet IO
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
withBlockfrostChain BlockfrostEnv
env Tracer IO CardanoChainLog
tracer CardanoChainConfig
cfg ChainContext
ctx TinyWallet IO
wallet ChainStateHistory Tx
chainStateHistory ChainCallback Tx IO
callback Chain Tx IO -> IO a
action
 where
  CardanoChainConfig{ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
$sel:chainBackendOptions:CardanoChainConfig :: CardanoChainConfig -> ChainBackendOptions
chainBackendOptions} = CardanoChainConfig
cfg

-- | Build the 'ChainContext' from a 'ChainConfig' and additional information.
loadChainContext ::
  forall m.
  (ChainBackend m, MonadIO m) =>
  CardanoChainConfig ->
  -- | Hydra party of our hydra node.
  Party ->
  m ChainContext
loadChainContext :: forall (m :: * -> *).
(ChainBackend m, MonadIO m) =>
CardanoChainConfig -> Party -> m ChainContext
loadChainContext CardanoChainConfig
config Party
party = do
  (VerificationKey PaymentKey
vk, Secret CardanoSigningKey
_) <- IO (VerificationKey PaymentKey, Secret CardanoSigningKey)
-> m (VerificationKey PaymentKey, Secret CardanoSigningKey)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (VerificationKey PaymentKey, Secret CardanoSigningKey)
 -> m (VerificationKey PaymentKey, Secret CardanoSigningKey))
-> IO (VerificationKey PaymentKey, Secret CardanoSigningKey)
-> m (VerificationKey PaymentKey, Secret CardanoSigningKey)
forall a b. (a -> b) -> a -> b
$ FilePath
-> IO (VerificationKey PaymentKey, Secret CardanoSigningKey)
readKeyPair FilePath
cardanoSigningKey
  ScriptRegistry
scriptRegistry <- [TxId] -> m ScriptRegistry
forall (m :: * -> *). ChainBackend m => [TxId] -> m ScriptRegistry
queryScriptRegistry [TxId]
hydraScriptsTxId
  NetworkId
networkId <- m NetworkId
forall (m :: * -> *). ChainBackend m => m NetworkId
queryNetworkId
  ChainContext -> m ChainContext
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainContext -> m ChainContext) -> ChainContext -> m ChainContext
forall a b. (a -> b) -> a -> b
$
    ChainContext
      { NetworkId
networkId :: NetworkId
$sel:networkId:ChainContext :: NetworkId
networkId
      , $sel:ownVerificationKey:ChainContext :: VerificationKey PaymentKey
ownVerificationKey = VerificationKey PaymentKey
vk
      , $sel:ownParty:ChainContext :: Party
ownParty = Party
party
      , ScriptRegistry
scriptRegistry :: ScriptRegistry
$sel:scriptRegistry:ChainContext :: ScriptRegistry
scriptRegistry
      }
 where
  CardanoChainConfig
    { [TxId]
hydraScriptsTxId :: [TxId]
$sel:hydraScriptsTxId:CardanoChainConfig :: CardanoChainConfig -> [TxId]
hydraScriptsTxId
    , FilePath
cardanoSigningKey :: FilePath
$sel:cardanoSigningKey:CardanoChainConfig :: CardanoChainConfig -> FilePath
cardanoSigningKey
    } = CardanoChainConfig
config

mkTinyWallet ::
  forall m.
  (ChainBackend m, Monad m) =>
  (forall b. m b -> IO b) ->
  Tracer IO CardanoChainLog ->
  CardanoChainConfig ->
  IO (TinyWallet IO)
mkTinyWallet :: forall (m :: * -> *).
(ChainBackend m, Monad m) =>
(forall b. m b -> IO b)
-> Tracer IO CardanoChainLog
-> CardanoChainConfig
-> IO (TinyWallet IO)
mkTinyWallet forall b. m b -> IO b
runM Tracer IO CardanoChainLog
tracer CardanoChainConfig
config = do
  (VerificationKey PaymentKey, Secret CardanoSigningKey)
keyPair <- FilePath
-> IO (VerificationKey PaymentKey, Secret CardanoSigningKey)
readKeyPair FilePath
cardanoSigningKey
  NetworkId
networkId <- m NetworkId -> IO NetworkId
forall b. m b -> IO b
runM m NetworkId
forall (m :: * -> *). ChainBackend m => m NetworkId
queryNetworkId
  Tracer IO TinyWalletLog
-> NetworkId
-> (VerificationKey PaymentKey, Secret CardanoSigningKey)
-> ChainQuery IO
-> IO (EpochInfo (Either Text))
-> IO (PParams ConwayEra)
-> IO (TinyWallet IO)
newTinyWallet ((TinyWalletLog -> CardanoChainLog)
-> Tracer IO CardanoChainLog -> Tracer IO TinyWalletLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap TinyWalletLog -> CardanoChainLog
Wallet Tracer IO CardanoChainLog
tracer) NetworkId
networkId (VerificationKey PaymentKey, Secret CardanoSigningKey)
keyPair ChainQuery IO
queryWalletInfo IO (EpochInfo (Either Text))
queryEpochInfo IO (PParams ConwayEra)
querySomePParams
 where
  CardanoChainConfig{FilePath
$sel:cardanoSigningKey:CardanoChainConfig :: CardanoChainConfig -> FilePath
cardanoSigningKey :: FilePath
cardanoSigningKey} = CardanoChainConfig
config

  queryEpochInfo :: IO (EpochInfo (Either Text))
queryEpochInfo = m (EpochInfo (Either Text)) -> IO (EpochInfo (Either Text))
forall b. m b -> IO b
runM (m (EpochInfo (Either Text)) -> IO (EpochInfo (Either Text)))
-> m (EpochInfo (Either Text)) -> IO (EpochInfo (Either Text))
forall a b. (a -> b) -> a -> b
$ LedgerEpochInfo -> EpochInfo (Either Text)
unLedgerEpochInfo (LedgerEpochInfo -> EpochInfo (Either Text))
-> (EraHistory -> LedgerEpochInfo)
-> EraHistory
-> EpochInfo (Either Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraHistory -> LedgerEpochInfo
toLedgerEpochInfo (EraHistory -> EpochInfo (Either Text))
-> m EraHistory -> m (EpochInfo (Either Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryPoint -> m EraHistory
forall (m :: * -> *). ChainBackend m => QueryPoint -> m EraHistory
queryEraHistory QueryPoint
QueryTip

  querySomePParams :: IO (PParams ConwayEra)
querySomePParams = m (PParams ConwayEra) -> IO (PParams ConwayEra)
forall b. m b -> IO b
runM (m (PParams ConwayEra) -> IO (PParams ConwayEra))
-> m (PParams ConwayEra) -> IO (PParams ConwayEra)
forall a b. (a -> b) -> a -> b
$ QueryPoint -> m (PParams LedgerEra)
forall (m :: * -> *).
ChainBackend m =>
QueryPoint -> m (PParams LedgerEra)
queryProtocolParameters QueryPoint
QueryTip

  queryWalletInfo :: ChainQuery IO
queryWalletInfo QueryPoint
queryPoint Address ShelleyAddr
address = m WalletInfoOnChain -> IO WalletInfoOnChain
forall b. m b -> IO b
runM (m WalletInfoOnChain -> IO WalletInfoOnChain)
-> m WalletInfoOnChain -> IO WalletInfoOnChain
forall a b. (a -> b) -> a -> b
$ do
    ChainPoint
point <- case QueryPoint
queryPoint of
      QueryAt ChainPoint
point -> ChainPoint -> m ChainPoint
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainPoint
point
      QueryPoint
QueryTip -> m ChainPoint
forall (m :: * -> *). ChainBackend m => m ChainPoint
queryTip
    Map TxIn (TxOut ConwayEra)
walletUTxO <- UTxO ConwayEra -> Map TxIn (TxOut ConwayEra)
forall era. UTxO era -> Map TxIn (TxOut era)
Ledger.unUTxO (UTxO ConwayEra -> Map TxIn (TxOut ConwayEra))
-> (UTxO Era -> UTxO ConwayEra)
-> UTxO Era
-> Map TxIn (TxOut ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra Era -> UTxO Era -> UTxO LedgerEra
forall era.
HasCallStack =>
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
UTxO.toShelleyUTxO ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra (UTxO Era -> Map TxIn (TxOut ConwayEra))
-> m (UTxO Era) -> m (Map TxIn (TxOut ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Address ShelleyAddr] -> m (UTxO Era)
forall (m :: * -> *).
ChainBackend m =>
[Address ShelleyAddr] -> m (UTxO Era)
queryUTxO [Address ShelleyAddr
address]
    SystemStart
systemStart <- QueryPoint -> m SystemStart
forall (m :: * -> *). ChainBackend m => QueryPoint -> m SystemStart
querySystemStart QueryPoint
QueryTip
    WalletInfoOnChain -> m WalletInfoOnChain
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletInfoOnChain -> m WalletInfoOnChain)
-> WalletInfoOnChain -> m WalletInfoOnChain
forall a b. (a -> b) -> a -> b
$ WalletInfoOnChain{Map TxIn (TxOut ConwayEra)
Map TxIn TxOut
walletUTxO :: Map TxIn (TxOut ConwayEra)
$sel:walletUTxO:WalletInfoOnChain :: Map TxIn TxOut
walletUTxO, SystemStart
systemStart :: SystemStart
$sel:systemStart:WalletInfoOnChain :: SystemStart
systemStart, $sel:tip:WalletInfoOnChain :: ChainPoint
tip = ChainPoint
point}