{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Cardano.Api.TxIn where

import Hydra.Cardano.Api.Prelude

import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Binary qualified as Ledger
import Cardano.Ledger.Plutus (transSafeHash)
import Cardano.Ledger.TxIn qualified as Ledger
import Data.ByteString qualified as BS
import Data.Set qualified as Set
import PlutusLedgerApi.V3 qualified as Plutus
import Test.QuickCheck (choose, vectorOf)

-- * Extras

-- | Create a 'TxIn' (a.k.a UTXO) from a transaction and output index.
mkTxIn :: Tx era -> Word -> TxIn
mkTxIn :: forall era. Tx era -> Word -> TxIn
mkTxIn (TxBody era -> TxId
forall era. TxBody era -> TxId
getTxId (TxBody era -> TxId) -> (Tx era -> TxBody era) -> Tx era -> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody -> TxId
txId) Word
index =
  TxId -> TxIx -> TxIn
TxIn TxId
txId (Word -> TxIx
TxIx Word
index)

-- | Attach some verification-key witness to a 'TxIn'.
withWitness :: TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn Era))
withWitness :: TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn Era))
withWitness TxIn
txIn =
  (TxIn
txIn, Witness WitCtxTxIn Era
-> BuildTxWith BuildTx (Witness WitCtxTxIn Era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn Era
 -> BuildTxWith BuildTx (Witness WitCtxTxIn Era))
-> Witness WitCtxTxIn Era
-> BuildTxWith BuildTx (Witness WitCtxTxIn Era)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn Era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending)

-- | Access inputs of a transaction, as an ordered list.
txIns' :: Tx era -> [TxIn]
txIns' :: forall era. Tx era -> [TxIn]
txIns' (Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody -> TxBody era
txBody) =
  let TxBody TxBodyContent{TxIns ViewTx era
txIns :: TxIns ViewTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns} = TxBody era
txBody
   in (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era)) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era)) -> TxIn)
-> TxIns ViewTx era -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIns ViewTx era
txIns

-- | Access inputs of a transaction, as an ordered set.
txInputSet :: Tx era -> Set TxIn
txInputSet :: forall era. Tx era -> Set TxIn
txInputSet = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList ([TxIn] -> Set TxIn) -> (Tx era -> [TxIn]) -> Tx era -> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> [TxIn]
forall era. Tx era -> [TxIn]
txIns'

-- * Type Conversions

-- | Convert a cardano-ledger 'TxIn' into a cardano-api 'TxIn'
fromLedgerTxIn :: Ledger.TxIn StandardCrypto -> TxIn
fromLedgerTxIn :: TxIn StandardCrypto -> TxIn
fromLedgerTxIn = TxIn StandardCrypto -> TxIn
fromShelleyTxIn

-- | Convert a cardano-api 'TxIn' into a cardano-ledger 'TxIn'
toLedgerTxIn :: TxIn -> Ledger.TxIn StandardCrypto
toLedgerTxIn :: TxIn -> TxIn StandardCrypto
toLedgerTxIn = TxIn -> TxIn StandardCrypto
toShelleyTxIn

-- | Convert a plutus' 'TxOutRef' into a cardano-api 'TxIn'
fromPlutusTxOutRef :: Plutus.TxOutRef -> TxIn
fromPlutusTxOutRef :: TxOutRef -> TxIn
fromPlutusTxOutRef (Plutus.TxOutRef (Plutus.TxId BuiltinByteString
bytes) Integer
ix) =
  TxId -> TxIx -> TxIn
TxIn
    (Hash StandardCrypto EraIndependentTxBody -> TxId
TxId (Hash StandardCrypto EraIndependentTxBody -> TxId)
-> Hash StandardCrypto EraIndependentTxBody -> TxId
forall a b. (a -> b) -> a -> b
$ ByteString -> Hash StandardCrypto EraIndependentTxBody
forall hash a.
(HasCallStack, HashAlgorithm hash) =>
ByteString -> Hash hash a
unsafeHashFromBytes (ByteString -> Hash StandardCrypto EraIndependentTxBody)
-> ByteString -> Hash StandardCrypto EraIndependentTxBody
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
Plutus.fromBuiltin BuiltinByteString
bytes)
    (Word -> TxIx
TxIx (Word -> TxIx) -> Word -> TxIx
forall a b. (a -> b) -> a -> b
$ Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ix)

-- | Convert a cardano-api 'TxIn' into a plutus 'TxOutRef'.
toPlutusTxOutRef :: TxIn -> Plutus.TxOutRef
toPlutusTxOutRef :: TxIn -> TxOutRef
toPlutusTxOutRef TxIn
txIn =
  -- XXX: The upstream 'transTxIn' works only with the the PlutusV1 type, so we
  -- needed to vendor its definition here.
  let (Ledger.TxIn (Ledger.TxId SafeHash StandardCrypto EraIndependentTxBody
safe) TxIx
txIx) = TxIn -> TxIn StandardCrypto
toLedgerTxIn TxIn
txIn
   in TxId -> Integer -> TxOutRef
Plutus.TxOutRef (BuiltinByteString -> TxId
Plutus.TxId (BuiltinByteString -> TxId) -> BuiltinByteString -> TxId
forall a b. (a -> b) -> a -> b
$ SafeHash StandardCrypto EraIndependentTxBody -> BuiltinByteString
forall c i. SafeHash c i -> BuiltinByteString
transSafeHash SafeHash StandardCrypto EraIndependentTxBody
safe) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ TxIx -> Int
Ledger.txIxToInt TxIx
txIx)

-- * Arbitrary values

-- | A more random generator than the 'Arbitrary TxIn' from cardano-ledger.
-- NOTE: This is using the Cardano ledger's deserialization framework using the
-- latest protocol version via 'maxBound'.
genTxIn :: Gen TxIn
genTxIn :: Gen TxIn
genTxIn =
  (TxIn StandardCrypto -> TxIn)
-> (TxIx -> TxIn StandardCrypto) -> TxIx -> TxIn
forall a b. (a -> b) -> (TxIx -> a) -> TxIx -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxIn StandardCrypto -> TxIn
fromLedgerTxIn ((TxIx -> TxIn StandardCrypto) -> TxIx -> TxIn)
-> (TxId StandardCrypto -> TxIx -> TxIn StandardCrypto)
-> TxId StandardCrypto
-> TxIx
-> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId StandardCrypto -> TxIx -> TxIn StandardCrypto
forall c. TxId c -> TxIx -> TxIn c
Ledger.TxIn
    -- NOTE: [88, 32] is a CBOR prefix for a bytestring of 32 bytes.
    (TxId StandardCrypto -> TxIx -> TxIn)
-> Gen (TxId StandardCrypto) -> Gen (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Word8] -> TxId StandardCrypto)
-> Gen [Word8] -> Gen (TxId StandardCrypto)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> ByteString -> TxId StandardCrypto
forall a. DecCBOR a => Version -> ByteString -> a
Ledger.unsafeDeserialize' Version
forall a. Bounded a => a
maxBound (ByteString -> TxId StandardCrypto)
-> ([Word8] -> ByteString) -> [Word8] -> TxId StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> ([Word8] -> [Word8]) -> [Word8] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8
88, Word8
32] <>)) (Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary)
    Gen (TxIx -> TxIn) -> Gen TxIx -> Gen TxIn
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TxIx) -> Gen Word64 -> Gen TxIx
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> TxIx
Ledger.TxIx ((Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
99))

instance Arbitrary TxIn where
  arbitrary :: Gen TxIn
arbitrary = Gen TxIn
genTxIn