-- | Things related to the Hydra smart contracts / script validators.
module Hydra.Contract where

import Hydra.Prelude

import Data.ByteString qualified as BS
import Hydra.Cardano.Api (
  ScriptHash,
  hashScript,
  serialiseToRawBytes,
  pattern PlutusScript,
 )
import Hydra.Contract.Head qualified as Head
import Hydra.Contract.HeadTokens qualified as HeadTokens
import Hydra.Plutus (commitValidatorScript, depositValidatorScript, initialValidatorScript)
import PlutusLedgerApi.V3 (TxId (..), TxOutRef (..), toBuiltin)

-- | Information about relevant Hydra scripts.
data ScriptInfo = ScriptInfo
  { ScriptInfo -> ScriptHash
mintingScriptHash :: ScriptHash
  -- ^ Hash of the μHead minting script given some default parameters.
  , ScriptInfo -> Int
mintingScriptSize :: Int
  -- ^ Size of the μHead minting script given some default parameters.
  , ScriptInfo -> ScriptHash
initialScriptHash :: ScriptHash
  , ScriptInfo -> Int
initialScriptSize :: Int
  , ScriptInfo -> ScriptHash
commitScriptHash :: ScriptHash
  , ScriptInfo -> Int
commitScriptSize :: Int
  , ScriptInfo -> ScriptHash
headScriptHash :: ScriptHash
  , ScriptInfo -> Int
headScriptSize :: Int
  , ScriptInfo -> ScriptHash
depositScriptHash :: ScriptHash
  , ScriptInfo -> Int
depositScriptSize :: Int
  }
  deriving stock (ScriptInfo -> ScriptInfo -> Bool
(ScriptInfo -> ScriptInfo -> Bool)
-> (ScriptInfo -> ScriptInfo -> Bool) -> Eq ScriptInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptInfo -> ScriptInfo -> Bool
== :: ScriptInfo -> ScriptInfo -> Bool
$c/= :: ScriptInfo -> ScriptInfo -> Bool
/= :: ScriptInfo -> ScriptInfo -> Bool
Eq, Int -> ScriptInfo -> ShowS
[ScriptInfo] -> ShowS
ScriptInfo -> String
(Int -> ScriptInfo -> ShowS)
-> (ScriptInfo -> String)
-> ([ScriptInfo] -> ShowS)
-> Show ScriptInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptInfo -> ShowS
showsPrec :: Int -> ScriptInfo -> ShowS
$cshow :: ScriptInfo -> String
show :: ScriptInfo -> String
$cshowList :: [ScriptInfo] -> ShowS
showList :: [ScriptInfo] -> ShowS
Show, (forall x. ScriptInfo -> Rep ScriptInfo x)
-> (forall x. Rep ScriptInfo x -> ScriptInfo) -> Generic ScriptInfo
forall x. Rep ScriptInfo x -> ScriptInfo
forall x. ScriptInfo -> Rep ScriptInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptInfo -> Rep ScriptInfo x
from :: forall x. ScriptInfo -> Rep ScriptInfo x
$cto :: forall x. Rep ScriptInfo x -> ScriptInfo
to :: forall x. Rep ScriptInfo x -> ScriptInfo
Generic)
  deriving anyclass ([ScriptInfo] -> Value
[ScriptInfo] -> Encoding
ScriptInfo -> Bool
ScriptInfo -> Value
ScriptInfo -> Encoding
(ScriptInfo -> Value)
-> (ScriptInfo -> Encoding)
-> ([ScriptInfo] -> Value)
-> ([ScriptInfo] -> Encoding)
-> (ScriptInfo -> Bool)
-> ToJSON ScriptInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ScriptInfo -> Value
toJSON :: ScriptInfo -> Value
$ctoEncoding :: ScriptInfo -> Encoding
toEncoding :: ScriptInfo -> Encoding
$ctoJSONList :: [ScriptInfo] -> Value
toJSONList :: [ScriptInfo] -> Value
$ctoEncodingList :: [ScriptInfo] -> Encoding
toEncodingList :: [ScriptInfo] -> Encoding
$comitField :: ScriptInfo -> Bool
omitField :: ScriptInfo -> Bool
ToJSON)

-- | Gather 'ScriptInfo' from the current Hydra scripts. This is useful to
-- determine changes in between version of 'hydra-plutus'.
scriptInfo :: ScriptInfo
scriptInfo :: ScriptInfo
scriptInfo =
  ScriptInfo
    { mintingScriptHash :: ScriptHash
mintingScriptHash = PlutusScript -> ScriptHash
scriptHash (PlutusScript -> ScriptHash) -> PlutusScript -> ScriptHash
forall a b. (a -> b) -> a -> b
$ TxOutRef -> PlutusScript
HeadTokens.mintingPolicyScript TxOutRef
defaultOutRef
    , mintingScriptSize :: Int
mintingScriptSize = PlutusScript -> Int
scriptSize (PlutusScript -> Int) -> PlutusScript -> Int
forall a b. (a -> b) -> a -> b
$ TxOutRef -> PlutusScript
HeadTokens.mintingPolicyScript TxOutRef
defaultOutRef
    , initialScriptHash :: ScriptHash
initialScriptHash = PlutusScript -> ScriptHash
scriptHash PlutusScript
initialValidatorScript
    , initialScriptSize :: Int
initialScriptSize = PlutusScript -> Int
scriptSize PlutusScript
initialValidatorScript
    , commitScriptHash :: ScriptHash
commitScriptHash = PlutusScript -> ScriptHash
scriptHash PlutusScript
commitValidatorScript
    , commitScriptSize :: Int
commitScriptSize = PlutusScript -> Int
scriptSize PlutusScript
commitValidatorScript
    , headScriptHash :: ScriptHash
headScriptHash = PlutusScript -> ScriptHash
scriptHash PlutusScript
Head.validatorScript
    , headScriptSize :: Int
headScriptSize = PlutusScript -> Int
scriptSize PlutusScript
Head.validatorScript
    , depositScriptHash :: ScriptHash
depositScriptHash = PlutusScript -> ScriptHash
scriptHash PlutusScript
depositValidatorScript
    , depositScriptSize :: Int
depositScriptSize = PlutusScript -> Int
scriptSize PlutusScript
depositValidatorScript
    }
 where
  scriptHash :: PlutusScript -> ScriptHash
scriptHash = Script PlutusScriptV3 -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script PlutusScriptV3 -> ScriptHash)
-> (PlutusScript -> Script PlutusScriptV3)
-> PlutusScript
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript -> Script PlutusScriptV3
PlutusScript

  scriptSize :: PlutusScript -> Int
scriptSize = ByteString -> Int
BS.length (ByteString -> Int)
-> (PlutusScript -> ByteString) -> PlutusScript -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes

  defaultOutRef :: TxOutRef
defaultOutRef =
    TxOutRef
      { txOutRefId :: TxId
txOutRefId = BuiltinByteString -> TxId
TxId (ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> ([Word8] -> ByteString) -> [Word8] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> BuiltinByteString) -> [Word8] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
32 Word8
0)
      , txOutRefIdx :: Integer
txOutRefIdx = Integer
0
      }