module Hydra.Tx.Recover where

import Hydra.Prelude

import Hydra.Cardano.Api
import Hydra.Cardano.Api.Network (networkIdToNetwork)
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.Deposit qualified as Deposit
import Hydra.Ledger.Cardano.Builder (
  addInputs,
  addOutputs,
  emptyTxBody,
  setValidityLowerBound,
  unsafeBuildTransaction,
 )
import PlutusLedgerApi.V2 (CurrencySymbol, POSIXTime)

-- | Builds a recover transaction to recover locked funds from the v_deposit script.
recoverTx ::
  NetworkId ->
  CurrencySymbol ->
  -- | Deposit input
  TxIn ->
  -- | Already Deposited funds
  [Commit.Commit] ->
  -- | Recover deadline
  POSIXTime ->
  -- | Lower bound slot number
  SlotNo ->
  Tx
recoverTx :: NetworkId
-> CurrencySymbol -> TxIn -> [Commit] -> POSIXTime -> SlotNo -> Tx
recoverTx NetworkId
networkId CurrencySymbol
headId TxIn
depositTxIn [Commit]
depositted POSIXTime
deadline SlotNo
lowerBoundSlot =
  HasCallStack => TxBodyContent BuildTx -> Tx
TxBodyContent BuildTx -> Tx
unsafeBuildTransaction (TxBodyContent BuildTx -> Tx) -> TxBodyContent BuildTx -> Tx
forall a b. (a -> b) -> a -> b
$
    TxBodyContent BuildTx
emptyTxBody
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxIns BuildTx -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addInputs TxIns BuildTx
recoverInputs
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxOut CtxTx] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addOutputs [TxOut CtxTx]
depositOutputs
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& SlotNo -> TxBodyContent BuildTx -> TxBodyContent BuildTx
setValidityLowerBound SlotNo
lowerBoundSlot
 where
  recoverInputs :: TxIns BuildTx
recoverInputs = (,BuildTxWith BuildTx (Witness WitCtxTxIn)
depositWitness) (TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn)))
-> [TxIn] -> TxIns BuildTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxIn
depositTxIn]

  redeemer :: DepositRedeemer
redeemer = Integer -> DepositRedeemer
Deposit.Recover (Integer -> DepositRedeemer) -> Integer -> DepositRedeemer
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [TxOut CtxTx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut CtxTx]
depositOutputs

  depositWitness :: BuildTxWith BuildTx (Witness WitCtxTxIn)
depositWitness =
    Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
      ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
forall ctx. IsScriptWitnessInCtx ctx => ScriptWitnessInCtx ctx
scriptWitnessInCtx (ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn)
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall a b. (a -> b) -> a -> b
$
        PlutusScript PlutusScriptV2
-> ScriptDatum WitCtxTxIn
-> ScriptRedeemer
-> ScriptWitness WitCtxTxIn
forall ctx era lang.
(IsPlutusScriptLanguage lang, HasScriptLanguageInEra lang era) =>
PlutusScript lang
-> ScriptDatum ctx -> ScriptRedeemer -> ScriptWitness ctx era
mkScriptWitness PlutusScript PlutusScriptV2
depositScript ((CurrencySymbol, POSIXTime, [Commit]) -> ScriptDatum WitCtxTxIn
forall a. ToScriptData a => a -> ScriptDatum WitCtxTxIn
mkScriptDatum (CurrencySymbol, POSIXTime, [Commit])
constructedDatum) (DepositRedeemer -> ScriptRedeemer
forall a. ToScriptData a => a -> ScriptRedeemer
toScriptData DepositRedeemer
redeemer)

  constructedDatum :: (CurrencySymbol, POSIXTime, [Commit])
constructedDatum = (CurrencySymbol
headId, POSIXTime
deadline, [Commit]
depositted)

  depositOutputs :: [TxOut CtxTx]
depositOutputs = TxOut CtxUTxO Era -> TxOut CtxTx
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
forall {k} (f :: * -> k -> *) (era :: k).
ToTxContext f =>
f CtxUTxO era -> f CtxTx era
toTxContext (TxOut CtxUTxO Era -> TxOut CtxTx)
-> ((TxIn, TxOut CtxUTxO Era) -> TxOut CtxUTxO Era)
-> (TxIn, TxOut CtxUTxO Era)
-> TxOut CtxTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut CtxUTxO Era) -> TxOut CtxUTxO Era
forall a b. (a, b) -> b
snd ((TxIn, TxOut CtxUTxO Era) -> TxOut CtxTx)
-> [(TxIn, TxOut CtxUTxO Era)] -> [TxOut CtxTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Commit -> Maybe (TxIn, TxOut CtxUTxO Era))
-> [Commit] -> [(TxIn, TxOut CtxUTxO Era)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Network -> Commit -> Maybe (TxIn, TxOut CtxUTxO Era)
Commit.deserializeCommit (NetworkId -> Network
networkIdToNetwork NetworkId
networkId)) [Commit]
depositted

  depositScript :: PlutusScript PlutusScriptV2
depositScript = forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript @PlutusScriptV2 SerialisedScript
Deposit.validatorScript