{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-specialize #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:conservative-optimisation #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-}
-- Plutus core version to compile to. In babbage era, that is Cardano protocol
-- version 7 and 8, only plutus-core version 1.0.0 is available.
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}

-- | The validator used to deposit and recover locked funds
module Hydra.Contract.Deposit where

import PlutusTx.Prelude

import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV2))
import Hydra.Contract.Commit (Commit)
import Hydra.Contract.DepositError (
  DepositError (
    DepositDeadlineNotReached,
    DepositNoLowerBoundDefined,
    IncorrectDepositHash
  ),
 )
import Hydra.Contract.Error (errorCode)
import Hydra.Contract.Head (hashPreSerializedCommits, hashTxOuts)
import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator)
import PlutusLedgerApi.V2 (
  CurrencySymbol,
  Datum (Datum),
  Extended (Finite),
  Interval (ivFrom),
  LowerBound (LowerBound),
  POSIXTime,
  Redeemer (Redeemer),
  ScriptContext (..),
  ScriptHash,
  SerialisedScript,
  serialiseCompiledCode,
  txInfoOutputs,
  txInfoValidRange,
 )
import PlutusTx (CompiledCode, toBuiltinData)
import PlutusTx qualified

data DepositRedeemer
  = -- | Claims already deposited funds.
    Claim
  | -- | Recovers m number of deposited outputs.
    Recover Integer

PlutusTx.unstableMakeIsData ''DepositRedeemer

-- | Deposit datum containing HeadId, deadline and a list of deposits.
newtype DepositDatum
  = DepositDatum (CurrencySymbol, POSIXTime, [Commit])

PlutusTx.unstableMakeIsData ''DepositDatum

-- | v_deposit validator checks
--
-- * Claim redeemer -> more checks will be added
--
-- * Recover redeemer
--     * The deadline has been reached.
--     * The hash of recovered outputs are matching the deposited outputs.
validator :: DepositDatum -> DepositRedeemer -> ScriptContext -> Bool
validator :: DepositDatum -> DepositRedeemer -> ScriptContext -> Bool
validator DepositDatum
depositDatum DepositRedeemer
r ScriptContext
ctx =
  case DepositRedeemer
r of
    DepositRedeemer
Claim -> Bool
False
    Recover Integer
m ->
      Bool
afterDeadline
        Bool -> Bool -> Bool
&& Integer -> Bool
recoverOutputs Integer
m
 where
  DepositDatum (CurrencySymbol
_headId, POSIXTime
dl, [Commit]
deposits) = DepositDatum
depositDatum
  recoverOutputs :: Integer -> Bool
recoverOutputs Integer
m =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode IncorrectDepositHash) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Integer -> BuiltinByteString
hashOfOutputs Integer
m BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Commit] -> BuiltinByteString
hashPreSerializedCommits [Commit]
deposits

  hashOfOutputs :: Integer -> BuiltinByteString
hashOfOutputs Integer
m =
    [TxOut] -> BuiltinByteString
hashTxOuts ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
take Integer
m (TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo)

  afterDeadline :: Bool
afterDeadline =
    case Interval POSIXTime -> LowerBound POSIXTime
forall a. Interval a -> LowerBound a
ivFrom (TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
txInfo) of
      LowerBound (Finite POSIXTime
t) Bool
_ ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode DepositDeadlineNotReached) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          POSIXTime
t POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
dl
      LowerBound POSIXTime
_ -> BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode DepositNoLowerBoundDefined)

  ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} = ScriptContext
ctx

compiledValidator :: CompiledCode ValidatorType
compiledValidator :: CompiledCode ValidatorType
compiledValidator =
  $$(PlutusTx.compile [||wrap validator||])
 where
  wrap :: (DepositDatum -> DepositRedeemer -> ScriptContext -> Bool)
-> ValidatorType
wrap = forall datum redeemer context.
(UnsafeFromData datum, UnsafeFromData redeemer,
 UnsafeFromData context) =>
(datum -> redeemer -> context -> Bool) -> ValidatorType
wrapValidator @DepositDatum @DepositRedeemer

validatorScript :: SerialisedScript
validatorScript :: SerialisedScript
validatorScript = CompiledCode ValidatorType -> SerialisedScript
forall a. CompiledCode a -> SerialisedScript
serialiseCompiledCode CompiledCode ValidatorType
compiledValidator

validatorHash :: ScriptHash
validatorHash :: ScriptHash
validatorHash = PlutusScriptVersion PlutusScriptV2
-> SerialisedScript -> ScriptHash
forall lang.
PlutusScriptVersion lang -> SerialisedScript -> ScriptHash
scriptValidatorHash PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 SerialisedScript
validatorScript

datum :: DepositDatum -> Datum
datum :: DepositDatum -> Datum
datum DepositDatum
a = BuiltinData -> Datum
Datum (DepositDatum -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData DepositDatum
a)

redeemer :: DepositRedeemer -> Redeemer
redeemer :: DepositRedeemer -> Redeemer
redeemer DepositRedeemer
a = BuiltinData -> Redeemer
Redeemer (DepositRedeemer -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData DepositRedeemer
a)