module Hydra.Tx.Utils where

import Hydra.Cardano.Api
import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Data.Map.Strict qualified as Map
import Hydra.Contract.Util (hydraHeadV1)
import Hydra.Tx.OnChainId (OnChainId (..))
import PlutusLedgerApi.V2 (FromData, fromBuiltin, getPubKeyHash)
import Test.Cardano.Ledger.Babbage.Arbitrary ()

hydraHeadV1AssetName :: AssetName
hydraHeadV1AssetName :: AssetName
hydraHeadV1AssetName = ByteString -> AssetName
AssetName (BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin BuiltinByteString
hydraHeadV1)

-- | The metadata label used for identifying Hydra protocol transactions. As
-- suggested by a friendly large language model: The number most commonly
-- associated with "Hydra" is 5, as in the mythological creature Hydra, which
-- had multiple heads, and the number 5 often symbolizes multiplicity or
-- diversity. However, there is no specific numerical association for Hydra
-- smaller than 10000 beyond this mythological reference.
hydraMetadataLabel :: Word64
hydraMetadataLabel :: Word64
hydraMetadataLabel = Word64
55555

-- | Create a transaction metadata entry to identify Hydra transactions (for
-- informational purposes).
mkHydraHeadV1TxName :: Text -> TxMetadata
mkHydraHeadV1TxName :: Text -> TxMetadata
mkHydraHeadV1TxName Text
name =
  Map Word64 TxMetadataValue -> TxMetadata
TxMetadata (Map Word64 TxMetadataValue -> TxMetadata)
-> Map Word64 TxMetadataValue -> TxMetadata
forall a b. (a -> b) -> a -> b
$ [(Word64, TxMetadataValue)] -> Map Word64 TxMetadataValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64
hydraMetadataLabel, Text -> TxMetadataValue
TxMetaText (Text -> TxMetadataValue) -> Text -> TxMetadataValue
forall a b. (a -> b) -> a -> b
$ Text
"HydraV1/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)]

assetNameToOnChainId :: AssetName -> OnChainId
assetNameToOnChainId :: AssetName -> OnChainId
assetNameToOnChainId (AssetName ByteString
bs) = ByteString -> OnChainId
UnsafeOnChainId ByteString
bs

onChainIdToAssetName :: OnChainId -> AssetName
onChainIdToAssetName :: OnChainId -> AssetName
onChainIdToAssetName = ByteString -> AssetName
AssetName (ByteString -> AssetName)
-> (OnChainId -> ByteString) -> OnChainId -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnChainId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes

-- | Find first occurrence including a transformation.
findFirst :: Foldable t => (a -> Maybe b) -> t a -> Maybe b
findFirst :: forall (t :: * -> *) a b.
Foldable t =>
(a -> Maybe b) -> t a -> Maybe b
findFirst a -> Maybe b
fn = First b -> Maybe b
forall a. First a -> Maybe a
getFirst (First b -> Maybe b) -> (t a -> First b) -> t a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> First b) -> t a -> First b
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe b -> First b
forall a. Maybe a -> First a
First (Maybe b -> First b) -> (a -> Maybe b) -> a -> First b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
fn)

-- | Derive the 'OnChainId' from a Cardano 'PaymentKey'. The on-chain identifier
-- is the public key hash as it is also availble to plutus validators.
verificationKeyToOnChainId :: VerificationKey PaymentKey -> OnChainId
verificationKeyToOnChainId :: VerificationKey PaymentKey -> OnChainId
verificationKeyToOnChainId =
  ByteString -> OnChainId
UnsafeOnChainId (ByteString -> OnChainId)
-> (VerificationKey PaymentKey -> ByteString)
-> VerificationKey PaymentKey
-> OnChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> ByteString
BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin (BuiltinByteString -> ByteString)
-> (VerificationKey PaymentKey -> BuiltinByteString)
-> VerificationKey PaymentKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyHash -> BuiltinByteString
getPubKeyHash (PubKeyHash -> BuiltinByteString)
-> (VerificationKey PaymentKey -> PubKeyHash)
-> VerificationKey PaymentKey
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash PaymentKey -> PubKeyHash
toPlutusKeyHash (Hash PaymentKey -> PubKeyHash)
-> (VerificationKey PaymentKey -> Hash PaymentKey)
-> VerificationKey PaymentKey
-> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash

headTokensFromValue :: PlutusScript -> Value -> [(AssetName, Quantity)]
headTokensFromValue :: PlutusScript -> Value -> [(AssetName, Quantity)]
headTokensFromValue PlutusScript
headTokenScript Value
v =
  [ (AssetName
assetName, Quantity
q)
  | (AssetId PolicyId
pid AssetName
assetName, Quantity
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v
  , PolicyId
pid PolicyId -> PolicyId -> Bool
forall a. Eq a => a -> a -> Bool
== Script PlutusScriptV2 -> PolicyId
forall lang. Script lang -> PolicyId
scriptPolicyId (PlutusScript -> Script PlutusScriptV2
PlutusScript PlutusScript
headTokenScript)
  ]

-- | Split a given UTxO into two, such that the second UTxO is non-empty. This
-- is useful to pick a UTxO to decommit.
splitUTxO :: UTxO -> (UTxO, UTxO)
splitUTxO :: UTxO -> (UTxO, UTxO)
splitUTxO UTxO
utxo =
  case UTxO -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs UTxO
utxo of
    [] -> (UTxO
forall a. Monoid a => a
mempty, UTxO
forall a. Monoid a => a
mempty)
    ((TxIn, TxOut CtxUTxO Era)
u : [(TxIn, TxOut CtxUTxO Era)]
us) -> ([(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs [(TxIn, TxOut CtxUTxO Era)]
us, (TxIn, TxOut CtxUTxO Era) -> UTxO
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn, TxOut CtxUTxO Era)
u)

adaOnly :: TxOut CtxUTxO -> TxOut CtxUTxO
adaOnly :: TxOut CtxUTxO Era -> TxOut CtxUTxO Era
adaOnly = \case
  TxOut AddressInEra
addr Value
value TxOutDatum CtxUTxO
datum ReferenceScript
refScript ->
    AddressInEra
-> Value
-> TxOutDatum CtxUTxO
-> ReferenceScript
-> TxOut CtxUTxO Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
addr (Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Coin
selectLovelace Value
value) TxOutDatum CtxUTxO
datum ReferenceScript
refScript

-- | Extract the inline datum from a given 'TxOut'.
extractInlineDatumFromTxOut :: FromData a => TxOut CtxUTxO -> Maybe a
extractInlineDatumFromTxOut :: forall a. FromData a => TxOut CtxUTxO Era -> Maybe a
extractInlineDatumFromTxOut TxOut CtxUTxO Era
txout =
  let TxOut AddressInEra
_ Value
_ TxOutDatum CtxUTxO
dat ReferenceScript
_ = TxOut CtxUTxO Era
txout
   in case TxOutDatum CtxUTxO
dat of
        TxOutDatumInline HashableScriptData
d ->
          HashableScriptData -> Maybe a
forall a. FromScriptData a => HashableScriptData -> Maybe a
fromScriptData HashableScriptData
d
        TxOutDatum CtxUTxO
_ -> Maybe a
forall a. Maybe a
Nothing