{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusLedgerApi.V1.Orphans.Tx () where

import Data.Coerce (coerce)
import PlutusLedgerApi.Orphans.Common (
  Blake2b256Hash (Blake2b256Hash),
 )
import PlutusLedgerApi.V1 qualified as PLA
import PlutusLedgerApi.V1.Orphans.Address ()
import PlutusLedgerApi.V1.Orphans.Value qualified as Value
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  CoArbitrary (coarbitrary),
  Function (function),
  NonNegative (NonNegative),
  functionMap,
  getNonNegative,
 )

{- | BLAKE2b-256 hash (32 bytes) of a transaction ID.

@since 1.0.0
-}
deriving via Blake2b256Hash instance Arbitrary PLA.TxId

-- | @since 1.0.0
deriving via Blake2b256Hash instance CoArbitrary PLA.TxId

-- | @since 1.0.0
instance Function PLA.TxId where
  {-# INLINEABLE function #-}
  function :: forall b. (TxId -> b) -> TxId :-> b
function = (TxId -> BuiltinByteString)
-> (BuiltinByteString -> TxId) -> (TxId -> b) -> TxId :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap TxId -> BuiltinByteString
forall a b. Coercible a b => a -> b
coerce BuiltinByteString -> TxId
PLA.TxId

-- | @since 1.0.2
instance Arbitrary PLA.TxOutRef where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen TxOutRef
arbitrary = TxId -> Integer -> TxOutRef
PLA.TxOutRef (TxId -> Integer -> TxOutRef)
-> Gen TxId -> Gen (Integer -> TxOutRef)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxId
forall a. Arbitrary a => Gen a
arbitrary Gen (Integer -> TxOutRef) -> Gen Integer -> Gen TxOutRef
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative (NonNegative Integer -> Integer)
-> Gen (NonNegative Integer) -> Gen Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary)
  {-# INLINEABLE shrink #-}
  shrink :: TxOutRef -> [TxOutRef]
shrink (PLA.TxOutRef TxId
tid Integer
ix) =
    TxId -> Integer -> TxOutRef
PLA.TxOutRef (TxId -> Integer -> TxOutRef) -> [TxId] -> [Integer -> TxOutRef]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TxId -> [TxId]
forall a. Arbitrary a => a -> [a]
shrink TxId
tid [Integer -> TxOutRef] -> [Integer] -> [TxOutRef]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ((NonNegative Integer -> Integer)
-> [NonNegative Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative ([NonNegative Integer] -> [Integer])
-> (Integer -> [NonNegative Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative Integer -> [NonNegative Integer]
forall a. Arbitrary a => a -> [a]
shrink (NonNegative Integer -> [NonNegative Integer])
-> (Integer -> NonNegative Integer)
-> Integer
-> [NonNegative Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NonNegative Integer
forall a. a -> NonNegative a
NonNegative (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer
ix)

-- | @since 1.0.2
instance CoArbitrary PLA.TxOutRef where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. TxOutRef -> Gen b -> Gen b
coarbitrary (PLA.TxOutRef TxId
tid Integer
ix) =
    TxId -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. TxId -> Gen b -> Gen b
coarbitrary TxId
tid (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
ix

-- | @since 1.0.2
instance Function PLA.TxOutRef where
  {-# INLINEABLE function #-}
  function :: forall b. (TxOutRef -> b) -> TxOutRef :-> b
function = (TxOutRef -> (TxId, Integer))
-> ((TxId, Integer) -> TxOutRef)
-> (TxOutRef -> b)
-> TxOutRef :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(PLA.TxOutRef TxId
tid Integer
ix) -> (TxId
tid, Integer
ix)) ((TxId -> Integer -> TxOutRef) -> (TxId, Integer) -> TxOutRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxId -> Integer -> TxOutRef
PLA.TxOutRef)

-- | @since 1.0.2
instance Arbitrary PLA.TxOut where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen TxOut
arbitrary =
    Address -> Value -> Maybe DatumHash -> TxOut
PLA.TxOut
      (Address -> Value -> Maybe DatumHash -> TxOut)
-> Gen Address -> Gen (Value -> Maybe DatumHash -> TxOut)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
forall a. Arbitrary a => Gen a
arbitrary -- address
      Gen (Value -> Maybe DatumHash -> TxOut)
-> Gen Value -> Gen (Maybe DatumHash -> TxOut)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (UTxOValue -> Value
Value.getUtxoValue (UTxOValue -> Value) -> Gen UTxOValue -> Gen Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTxOValue
forall a. Arbitrary a => Gen a
arbitrary) -- value
      Gen (Maybe DatumHash -> TxOut)
-> Gen (Maybe DatumHash) -> Gen TxOut
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Gen (Maybe DatumHash)
forall a. Arbitrary a => Gen a
arbitrary -- maybe datum hash
  {-# INLINEABLE shrink #-}
  shrink :: TxOut -> [TxOut]
shrink (PLA.TxOut Address
addr Value
val Maybe DatumHash
mdh) = do
    Address
addr' <- Address -> [Address]
forall a. Arbitrary a => a -> [a]
shrink Address
addr
    Value
val' <- UTxOValue -> Value
Value.getUtxoValue (UTxOValue -> Value) -> [UTxOValue] -> [Value]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOValue -> [UTxOValue]
forall a. Arbitrary a => a -> [a]
shrink (Value -> UTxOValue
Value.UTxOValue Value
val)
    Maybe DatumHash
mdh' <- Maybe DatumHash -> [Maybe DatumHash]
forall a. Arbitrary a => a -> [a]
shrink Maybe DatumHash
mdh
    TxOut -> [TxOut]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TxOut -> [TxOut])
-> (Maybe DatumHash -> TxOut) -> Maybe DatumHash -> [TxOut]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Value -> Maybe DatumHash -> TxOut
PLA.TxOut Address
addr' Value
val' (Maybe DatumHash -> [TxOut]) -> Maybe DatumHash -> [TxOut]
forall a b. (a -> b) -> a -> b
$ Maybe DatumHash
mdh'

-- | @since 1.0.2
instance CoArbitrary PLA.TxOut where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. TxOut -> Gen b -> Gen b
coarbitrary (PLA.TxOut Address
addr Value
val Maybe DatumHash
mdh) =
    Address -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Address -> Gen b -> Gen b
coarbitrary Address
addr (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Value -> Gen b -> Gen b
coarbitrary Value
val (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DatumHash -> Gen b -> Gen b
forall b. Maybe DatumHash -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Maybe DatumHash
mdh

-- | @since 1.0.2
instance Function PLA.TxOut where
  {-# INLINEABLE function #-}
  function :: forall b. (TxOut -> b) -> TxOut :-> b
function = (TxOut -> (Address, Value, Maybe DatumHash))
-> ((Address, Value, Maybe DatumHash) -> TxOut)
-> (TxOut -> b)
-> TxOut :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap TxOut -> (Address, Value, Maybe DatumHash)
into (Address, Value, Maybe DatumHash) -> TxOut
outOf
    where
      into :: PLA.TxOut -> (PLA.Address, PLA.Value, Maybe PLA.DatumHash)
      into :: TxOut -> (Address, Value, Maybe DatumHash)
into (PLA.TxOut Address
addr Value
val Maybe DatumHash
mdh) = (Address
addr, Value
val, Maybe DatumHash
mdh)
      outOf :: (PLA.Address, PLA.Value, Maybe PLA.DatumHash) -> PLA.TxOut
      outOf :: (Address, Value, Maybe DatumHash) -> TxOut
outOf (Address
addr, Value
val, Maybe DatumHash
mdh) = Address -> Value -> Maybe DatumHash -> TxOut
PLA.TxOut Address
addr Value
val Maybe DatumHash
mdh