{-# 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 (PlutusScriptV3))
import Hydra.Contract.Commit (Commit)
import Hydra.Contract.DepositError (
  DepositError (
    DepositDeadlineNotReached,
    DepositDeadlineSurpassed,
    DepositNoLowerBoundDefined,
    DepositNoUpperBoundDefined,
    IncorrectDepositHash,
    WrongHeadIdInDepositDatum
  ),
 )
import Hydra.Contract.Error (errorCode)
import Hydra.Contract.Head (hashPreSerializedCommits, hashTxOuts)
import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator)
import PlutusLedgerApi.V3 (
  CurrencySymbol,
  Datum (Datum),
  Extended (Finite),
  Interval (ivFrom),
  LowerBound (LowerBound),
  POSIXTime,
  Redeemer (Redeemer),
  ScriptContext (..),
  ScriptHash,
  SerialisedScript,
  UpperBound (..),
  ivTo,
  serialiseCompiledCode,
  txInfoOutputs,
  txInfoValidRange,
 )
import PlutusTx (CompiledCode, toBuiltinData)
import PlutusTx qualified

data DepositRedeemer
  = -- | Claims already deposited funds.
    -- FIXME: Make sure to change the spec and add head CS to the Claim redeemer.
    Claim CurrencySymbol
  | -- | 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 ->
--     * The deadline has not been reached.
--     * HeadId matches.
--
-- * 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
    Claim CurrencySymbol
headId' -> Bool
beforeDeadline Bool -> Bool -> Bool
&& CurrencySymbol -> Bool
checkHeadId CurrencySymbol
headId'
    Recover Integer
m ->
      Bool
afterDeadline
        Bool -> Bool -> Bool
&& Integer -> Bool
recoverOutputs Integer
m
 where
  DepositDatum (CurrencySymbol
headId, POSIXTime
dl, [Commit]
deposits) = DepositDatum
depositDatum

  checkHeadId :: CurrencySymbol -> Bool
checkHeadId CurrencySymbol
headId' =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode WrongHeadIdInDepositDatum) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      CurrencySymbol
headId' CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
headId

  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)

  beforeDeadline :: Bool
beforeDeadline =
    case Interval POSIXTime -> UpperBound POSIXTime
forall a. Interval a -> UpperBound a
ivTo (TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
txInfo) of
      UpperBound (Finite POSIXTime
t) Bool
_ ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode DepositDeadlineSurpassed) (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
      UpperBound POSIXTime
_ -> BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode DepositNoUpperBoundDefined)

  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.
(UnsafeFromData datum, UnsafeFromData redeemer) =>
(datum -> redeemer -> ScriptContext -> 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 PlutusScriptV3
-> SerialisedScript -> ScriptHash
forall lang.
PlutusScriptVersion lang -> SerialisedScript -> ScriptHash
scriptValidatorHash PlutusScriptVersion PlutusScriptV3
PlutusScriptV3 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)