{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-missing-local-signatures #-}

-- | Representation of a UTxO when committed / deposited into the Hydra Head protocol.
-- TODO: Rename/move this to Deposit
module Hydra.Contract.Commit where

import PlutusTx.Prelude

import Codec.Serialise (deserialiseOrFail, serialise)
import Data.ByteString.Lazy (fromStrict, toStrict)
import Hydra.Cardano.Api (CtxUTxO, Network, fromPlutusTxOut, fromPlutusTxOutRef, toPlutusTxOut, toPlutusTxOutRef)
import Hydra.Cardano.Api qualified as OffChain
import PlutusLedgerApi.V3 (TxOutRef)
import PlutusTx (fromData, toData)
import PlutusTx qualified
import Prelude qualified as Haskell

-- | A data type representing committed outputs on-chain. Besides recording the
-- original 'TxOutRef', it also stores a binary representation compatible
-- between on- and off-chain code to be hashed in the validators.
data Commit = Commit
  { Commit -> TxOutRef
input :: TxOutRef
  , Commit -> BuiltinByteString
preSerializedOutput :: BuiltinByteString
  }
  deriving stock (Commit -> Commit -> Bool
(Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool) -> Eq Commit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Commit -> Commit -> Bool
== :: Commit -> Commit -> Bool
$c/= :: Commit -> Commit -> Bool
/= :: Commit -> Commit -> Bool
Haskell.Eq, Int -> Commit -> ShowS
[Commit] -> ShowS
Commit -> String
(Int -> Commit -> ShowS)
-> (Commit -> String) -> ([Commit] -> ShowS) -> Show Commit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Commit -> ShowS
showsPrec :: Int -> Commit -> ShowS
$cshow :: Commit -> String
show :: Commit -> String
$cshowList :: [Commit] -> ShowS
showList :: [Commit] -> ShowS
Haskell.Show, Eq Commit
Eq Commit =>
(Commit -> Commit -> Ordering)
-> (Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool)
-> (Commit -> Commit -> Commit)
-> (Commit -> Commit -> Commit)
-> Ord Commit
Commit -> Commit -> Bool
Commit -> Commit -> Ordering
Commit -> Commit -> Commit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Commit -> Commit -> Ordering
compare :: Commit -> Commit -> Ordering
$c< :: Commit -> Commit -> Bool
< :: Commit -> Commit -> Bool
$c<= :: Commit -> Commit -> Bool
<= :: Commit -> Commit -> Bool
$c> :: Commit -> Commit -> Bool
> :: Commit -> Commit -> Bool
$c>= :: Commit -> Commit -> Bool
>= :: Commit -> Commit -> Bool
$cmax :: Commit -> Commit -> Commit
max :: Commit -> Commit -> Commit
$cmin :: Commit -> Commit -> Commit
min :: Commit -> Commit -> Commit
Haskell.Ord)

instance Eq Commit where
  (Commit TxOutRef
i BuiltinByteString
o) == :: Commit -> Commit -> Bool
== (Commit TxOutRef
i' BuiltinByteString
o') =
    TxOutRef
i TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef
i' Bool -> Bool -> Bool
&& BuiltinByteString
o BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
o'

PlutusTx.unstableMakeIsData ''Commit

-- | Record an off-chain 'TxOut' as a 'Commit' on-chain.
-- NOTE: Depends on the 'Serialise' instance for Plutus' 'Data'.
-- NOTE: Reference scripts on the 'TxOut' are NOT preserved. The Plutus 'TxOut'
-- representation used for serialization has no reference script field, so any
-- inline reference script is silently dropped. Address, value and datum are
-- preserved faithfully.
serializeCommit :: (OffChain.TxIn, OffChain.TxOut CtxUTxO) -> Maybe Commit
serializeCommit :: (TxIn, TxOut CtxUTxO) -> Maybe Commit
serializeCommit (TxIn
i, TxOut CtxUTxO
o) = do
  BuiltinByteString
preSerializedOutput <- ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (TxOut -> ByteString) -> TxOut -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (TxOut -> ByteString) -> TxOut -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Data -> ByteString) -> (TxOut -> Data) -> TxOut -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Data
forall a. ToData a => a -> Data
toData (TxOut -> BuiltinByteString)
-> Maybe TxOut -> Maybe BuiltinByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => TxOut CtxUTxO -> Maybe TxOut
TxOut CtxUTxO -> Maybe TxOut
toPlutusTxOut TxOut CtxUTxO
o
  Commit -> Maybe Commit
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Commit
      { input :: TxOutRef
input = TxIn -> TxOutRef
toPlutusTxOutRef TxIn
i
      , BuiltinByteString
preSerializedOutput :: BuiltinByteString
preSerializedOutput :: BuiltinByteString
preSerializedOutput
      }

-- | Decode an on-chain 'SerializedTxOut' back into an off-chain 'TxOut'.
-- NOTE: Depends on the 'Serialise' instance for Plutus' 'Data'.
deserializeCommit :: Network -> Commit -> Maybe (OffChain.TxIn, OffChain.TxOut CtxUTxO)
deserializeCommit :: Network -> Commit -> Maybe (TxIn, TxOut CtxUTxO)
deserializeCommit Network
network Commit{TxOutRef
input :: Commit -> TxOutRef
input :: TxOutRef
input, BuiltinByteString
preSerializedOutput :: Commit -> BuiltinByteString
preSerializedOutput :: BuiltinByteString
preSerializedOutput} =
  case ByteString -> Either DeserialiseFailure Data
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail (ByteString -> Either DeserialiseFailure Data)
-> (ByteString -> ByteString)
-> ByteString
-> Either DeserialiseFailure Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> Either DeserialiseFailure Data)
-> ByteString -> Either DeserialiseFailure Data
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin BuiltinByteString
preSerializedOutput of
    Left{} -> Maybe (TxIn, TxOut CtxUTxO)
forall a. Maybe a
Nothing
    Right Data
dat -> do
      TxOut CtxUTxO
txOut <- Network -> TxOut -> Maybe (TxOut CtxUTxO)
forall era.
IsBabbageBasedEra era =>
Network -> TxOut -> Maybe (TxOut CtxUTxO era)
fromPlutusTxOut Network
network (TxOut -> Maybe (TxOut CtxUTxO))
-> Maybe TxOut -> Maybe (TxOut CtxUTxO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Data -> Maybe TxOut
forall a. FromData a => Data -> Maybe a
fromData Data
dat
      (TxIn, TxOut CtxUTxO) -> Maybe (TxIn, TxOut CtxUTxO)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutRef -> TxIn
fromPlutusTxOutRef TxOutRef
input, TxOut CtxUTxO
txOut)