-- | This module exposes outputs as they can be defined in a
-- 'Cooked.Skeleton.TxSkel' with various utilities around them.
module Cooked.Skeleton.Output
  ( TxSkelOut (..),
    receives,
    txSkelOutValueL,
    txSkelOutDatumL,
    txSkelOutReferenceScriptL,
    txSkelOutStakingCredentialL,
    txSkelOutValue,
    txSkelOutValidator,
    IsTxSkelOutAllowedOwner (..),
    txSkelOutReferenceScript,
    txSkelOutReferenceScriptHash,
    OwnerConstrs,
    txSkelOutAddress,
    txSkelOutPKHash,
    txSkelOutTypedOwnerAT,
  )
where

import Cooked.Skeleton.Datum
import Cooked.Skeleton.Payable
import Cooked.Skeleton.ReferenceScript
import Cooked.Skeleton.Value
import Cooked.Wallet
import Data.Either.Combinators
import Data.Function
import Data.Typeable
import Optics.Core
import Optics.TH (makeLensesFor)
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import Plutus.Script.Utils.V1.Typed qualified as Script (TypedValidator (..))
import Plutus.Script.Utils.V3.Typed qualified as Script
import Plutus.Script.Utils.Value qualified as Script
import PlutusLedgerApi.V3 qualified as Api

-- | Depicts the entities that are allowed to own a 'TxSkelOut'
class IsTxSkelOutAllowedOwner a where
  toPKHOrValidator :: a -> Either Api.PubKeyHash (Script.Versioned Script.Validator)

instance IsTxSkelOutAllowedOwner Api.PubKeyHash where
  toPKHOrValidator :: PubKeyHash -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = PubKeyHash -> Either PubKeyHash (Versioned Validator)
forall a b. a -> Either a b
Left

instance IsTxSkelOutAllowedOwner Wallet where
  toPKHOrValidator :: Wallet -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = PubKeyHash -> Either PubKeyHash (Versioned Validator)
forall a b. a -> Either a b
Left (PubKeyHash -> Either PubKeyHash (Versioned Validator))
-> (Wallet -> PubKeyHash)
-> Wallet
-> Either PubKeyHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
Script.toPubKeyHash

instance IsTxSkelOutAllowedOwner (Script.Versioned Script.Validator) where
  toPKHOrValidator :: Versioned Validator -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = Versioned Validator -> Either PubKeyHash (Versioned Validator)
forall a b. b -> Either a b
Right

instance IsTxSkelOutAllowedOwner (Script.TypedValidator a) where
  toPKHOrValidator :: TypedValidator a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = Versioned Validator -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator (Versioned Validator -> Either PubKeyHash (Versioned Validator))
-> (TypedValidator a -> Versioned Validator)
-> TypedValidator a
-> Either PubKeyHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned @Script.Validator

instance IsTxSkelOutAllowedOwner (Either Api.PubKeyHash (Script.Versioned Script.Validator)) where
  toPKHOrValidator :: Either PubKeyHash (Versioned Validator)
-> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = Either PubKeyHash (Versioned Validator)
-> Either PubKeyHash (Versioned Validator)
forall a. a -> a
id

instance IsTxSkelOutAllowedOwner (Script.MultiPurposeScript a) where
  toPKHOrValidator :: MultiPurposeScript a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = Versioned Validator -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator (Versioned Validator -> Either PubKeyHash (Versioned Validator))
-> (MultiPurposeScript a -> Versioned Validator)
-> MultiPurposeScript a
-> Either PubKeyHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned @Script.Validator

-- | Type constraints over the owner of a 'TxSkelOut'
type OwnerConstrs owner =
  ( IsTxSkelOutAllowedOwner owner,
    Script.ToCredential owner,
    Typeable owner,
    Show owner
  )

-- | A rich output to be put into a 'Cooked.Skeleton.TxSkel'
data TxSkelOut where
  TxSkelOut ::
    (OwnerConstrs owner) =>
    { ()
tsoOwner :: owner,
      TxSkelOut -> Maybe StakingCredential
tsoSCred :: Maybe Api.StakingCredential,
      TxSkelOut -> TxSkelOutDatum
tsoDatum :: TxSkelOutDatum,
      TxSkelOut -> TxSkelOutValue
tsoValue :: TxSkelOutValue,
      TxSkelOut -> TxSkelOutReferenceScript
tsoRefSc :: TxSkelOutReferenceScript
    } ->
    TxSkelOut

deriving instance Show TxSkelOut

-- | Returns the address of this 'TxSkelOut'
txSkelOutAddress :: TxSkelOut -> Api.Address
txSkelOutAddress :: TxSkelOut -> Address
txSkelOutAddress (TxSkelOut owner
owner Maybe StakingCredential
stCred TxSkelOutDatum
_ TxSkelOutValue
_ TxSkelOutReferenceScript
_) =
  Credential -> Maybe StakingCredential -> Address
Api.Address
    (owner -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential owner
owner)
    (Maybe StakingCredential -> Maybe StakingCredential
forall a.
ToMaybeStakingCredential a =>
a -> Maybe StakingCredential
Script.toMaybeStakingCredential Maybe StakingCredential
stCred)

-- | A lens to get or set the 'TxSkelOutDatum' from a 'TxSkelOut'
makeLensesFor [("tsoDatum", "txSkelOutDatumL")] ''TxSkelOut

-- | A lens to get or set the 'TxSkelOutValue' from a 'TxSkelOut'
makeLensesFor [("tsoValue", "txSkelOutValueL")] ''TxSkelOut

-- | A lens to get or set the 'TxSkelOutReferenceScript' from a 'TxSkelOut'
makeLensesFor [("tsoRefSc", "txSkelOutReferenceScriptL")] ''TxSkelOut

-- | A lens to get or set the 'Maybe Api.StakingCredential' from a 'TxSkelOut'
makeLensesFor [("tsoSCred", "txSkelOutStakingCredentialL")] ''TxSkelOut

-- | Attempts to retrieve or set a typed owner from this 'TxSkelOut'
txSkelOutTypedOwnerAT :: (OwnerConstrs a) => AffineTraversal' TxSkelOut a
txSkelOutTypedOwnerAT :: forall a. OwnerConstrs a => AffineTraversal' TxSkelOut a
txSkelOutTypedOwnerAT =
  (TxSkelOut -> Either TxSkelOut a)
-> (TxSkelOut -> a -> TxSkelOut)
-> AffineTraversal TxSkelOut TxSkelOut a a
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\txSkelOut :: TxSkelOut
txSkelOut@(TxSkelOut {owner
tsoOwner :: ()
tsoOwner :: owner
tsoOwner}) -> Either TxSkelOut a
-> (a -> Either TxSkelOut a) -> Maybe a -> Either TxSkelOut a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TxSkelOut -> Either TxSkelOut a
forall a b. a -> Either a b
Left TxSkelOut
txSkelOut) a -> Either TxSkelOut a
forall a b. b -> Either a b
Right (owner -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast owner
tsoOwner))
    (\TxSkelOut
txSkelOut a
newOwner -> TxSkelOut
txSkelOut {tsoOwner = newOwner})

-- | Returns the value contained in a 'TxSkelOut'
txSkelOutValue :: TxSkelOut -> Api.Value
txSkelOutValue :: TxSkelOut -> Value
txSkelOutValue = (TxSkelOut -> Optic' A_Lens NoIx TxSkelOut Value -> Value
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. (Lens' TxSkelOut TxSkelOutValue
txSkelOutValueL Lens' TxSkelOut TxSkelOutValue
-> Optic A_Lens NoIx TxSkelOutValue TxSkelOutValue Value Value
-> Optic' A_Lens NoIx TxSkelOut Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxSkelOutValue TxSkelOutValue Value Value
txSkelOutValueContentL))

instance Eq TxSkelOut where
  TxSkelOut
txSkelOut == :: TxSkelOut -> TxSkelOut -> Bool
== TxSkelOut
txSkelOut' =
    TxSkelOut -> Address
txSkelOutAddress TxSkelOut
txSkelOut Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelOut -> Address
txSkelOutAddress TxSkelOut
txSkelOut'
      Bool -> Bool -> Bool
&& TxSkelOut -> TxSkelOutDatum
tsoDatum TxSkelOut
txSkelOut TxSkelOutDatum -> TxSkelOutDatum -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelOut -> TxSkelOutDatum
tsoDatum TxSkelOut
txSkelOut'
      Bool -> Bool -> Bool
&& TxSkelOut -> Value
txSkelOutValue TxSkelOut
txSkelOut Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelOut -> Value
txSkelOutValue TxSkelOut
txSkelOut'
      Bool -> Bool -> Bool
&& TxSkelOut -> Maybe ScriptHash
txSkelOutReferenceScriptHash TxSkelOut
txSkelOut Maybe ScriptHash -> Maybe ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelOut -> Maybe ScriptHash
txSkelOutReferenceScriptHash TxSkelOut
txSkelOut'

-- | Returns the optional private key owning a given 'TxSkelOut'
txSkelOutPKHash :: TxSkelOut -> Maybe Api.PubKeyHash
txSkelOutPKHash :: TxSkelOut -> Maybe PubKeyHash
txSkelOutPKHash (TxSkelOut {owner
tsoOwner :: ()
tsoOwner :: owner
tsoOwner}) = Either PubKeyHash (Versioned Validator) -> Maybe PubKeyHash
forall a b. Either a b -> Maybe a
leftToMaybe (Either PubKeyHash (Versioned Validator) -> Maybe PubKeyHash)
-> Either PubKeyHash (Versioned Validator) -> Maybe PubKeyHash
forall a b. (a -> b) -> a -> b
$ owner -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator owner
tsoOwner

-- | Returns the optional validator owning a given 'TxSkelOut'
txSkelOutValidator :: TxSkelOut -> Maybe (Script.Versioned Script.Validator)
txSkelOutValidator :: TxSkelOut -> Maybe (Versioned Validator)
txSkelOutValidator (TxSkelOut {owner
tsoOwner :: ()
tsoOwner :: owner
tsoOwner}) = Either PubKeyHash (Versioned Validator)
-> Maybe (Versioned Validator)
forall a b. Either a b -> Maybe b
rightToMaybe (Either PubKeyHash (Versioned Validator)
 -> Maybe (Versioned Validator))
-> Either PubKeyHash (Versioned Validator)
-> Maybe (Versioned Validator)
forall a b. (a -> b) -> a -> b
$ owner -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator owner
tsoOwner

-- | Returns the optional reference script in a 'TxSkelOut'
txSkelOutReferenceScript :: TxSkelOut -> Maybe (Script.Versioned Script.Script)
txSkelOutReferenceScript :: TxSkelOut -> Maybe (Versioned Script)
txSkelOutReferenceScript = TxSkelOutReferenceScript -> Maybe (Versioned Script)
txSkelOutRefScriptVersioned (TxSkelOutReferenceScript -> Maybe (Versioned Script))
-> (TxSkelOut -> TxSkelOutReferenceScript)
-> TxSkelOut
-> Maybe (Versioned Script)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxSkelOut TxSkelOutReferenceScript
-> TxSkelOut -> TxSkelOutReferenceScript
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' TxSkelOut TxSkelOutReferenceScript
txSkelOutReferenceScriptL

-- | Returns the optional reference script hash in a 'TxSkelOut'
txSkelOutReferenceScriptHash :: TxSkelOut -> Maybe Api.ScriptHash
txSkelOutReferenceScriptHash :: TxSkelOut -> Maybe ScriptHash
txSkelOutReferenceScriptHash = (Versioned Script -> ScriptHash)
-> Maybe (Versioned Script) -> Maybe ScriptHash
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioned Script -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash (Maybe (Versioned Script) -> Maybe ScriptHash)
-> (TxSkelOut -> Maybe (Versioned Script))
-> TxSkelOut
-> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> Maybe (Versioned Script)
txSkelOutReferenceScript

-- | Smart constructor to build a 'TxSkelOut' from an owner and payment. This
-- should be the main way of building outputs.
receives :: (OwnerConstrs owner) => owner -> Payable els -> TxSkelOut
receives :: forall owner (els :: [Symbol]).
OwnerConstrs owner =>
owner -> Payable els -> TxSkelOut
receives owner
owner =
  TxSkelOut -> Payable els -> TxSkelOut
forall (els :: [Symbol]). TxSkelOut -> Payable els -> TxSkelOut
go (TxSkelOut -> Payable els -> TxSkelOut)
-> TxSkelOut -> Payable els -> TxSkelOut
forall a b. (a -> b) -> a -> b
$
    owner
-> Maybe StakingCredential
-> TxSkelOutDatum
-> TxSkelOutValue
-> TxSkelOutReferenceScript
-> TxSkelOut
forall owner.
OwnerConstrs owner =>
owner
-> Maybe StakingCredential
-> TxSkelOutDatum
-> TxSkelOutValue
-> TxSkelOutReferenceScript
-> TxSkelOut
TxSkelOut
      owner
owner
      Maybe StakingCredential
forall a. Maybe a
Nothing -- No staking credential by default
      TxSkelOutDatum
defaultTxSkelDatum -- Default datum defined below
      (Value -> Bool -> TxSkelOutValue
TxSkelOutValue Value
forall a. Monoid a => a
mempty Bool
True) -- Empty value by default, adjustable to min ada
      TxSkelOutReferenceScript
TxSkelOutNoReferenceScript -- No reference script by default
  where
    go :: TxSkelOut -> Payable els -> TxSkelOut
    go :: forall (els :: [Symbol]). TxSkelOut -> Payable els -> TxSkelOut
go TxSkelOut
txSkelOut (VisibleHashedDatum a1
dat) = TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL Lens' TxSkelOut TxSkelOutDatum
-> TxSkelOutDatum -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ DatumContent -> DatumKind -> TxSkelOutDatum
TxSkelOutSomeDatum (a1 -> DatumContent
forall a. DatumConstrs a => a -> DatumContent
DatumContent a1
dat) (DatumResolved -> DatumKind
Hashed DatumResolved
Resolved)
    go TxSkelOut
txSkelOut (InlineDatum a1
dat) = TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL Lens' TxSkelOut TxSkelOutDatum
-> TxSkelOutDatum -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ DatumContent -> DatumKind -> TxSkelOutDatum
TxSkelOutSomeDatum (a1 -> DatumContent
forall a. DatumConstrs a => a -> DatumContent
DatumContent a1
dat) DatumKind
Inline
    go TxSkelOut
txSkelOut (HiddenHashedDatum a1
dat) = TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL Lens' TxSkelOut TxSkelOutDatum
-> TxSkelOutDatum -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ DatumContent -> DatumKind -> TxSkelOutDatum
TxSkelOutSomeDatum (a1 -> DatumContent
forall a. DatumConstrs a => a -> DatumContent
DatumContent a1
dat) (DatumResolved -> DatumKind
Hashed DatumResolved
NotResolved)
    go TxSkelOut
txSkelOut (FixedValue a1
v) = TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut TxSkelOutValue
txSkelOutValueL Lens' TxSkelOut TxSkelOutValue
-> TxSkelOutValue -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Value -> Bool -> TxSkelOutValue
TxSkelOutValue (a1 -> Value
forall a. ToValue a => a -> Value
Script.toValue a1
v) Bool
False
    go TxSkelOut
txSkelOut (Value a1
v) = TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut TxSkelOutValue
txSkelOutValueL Lens' TxSkelOut TxSkelOutValue
-> TxSkelOutValue -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Value -> Bool -> TxSkelOutValue
TxSkelOutValue (a1 -> Value
forall a. ToValue a => a -> Value
Script.toValue a1
v) Bool
True
    go TxSkelOut
txSkelOut (ReferenceScript s
script) = TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut TxSkelOutReferenceScript
txSkelOutReferenceScriptL Lens' TxSkelOut TxSkelOutReferenceScript
-> TxSkelOutReferenceScript -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ s -> TxSkelOutReferenceScript
forall a. ReferenceScriptConstrs a => a -> TxSkelOutReferenceScript
TxSkelOutSomeReferenceScript s
script
    go TxSkelOut
txSkelOut (StakingCredential cred
stCred) = TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut (Maybe StakingCredential)
txSkelOutStakingCredentialL Lens' TxSkelOut (Maybe StakingCredential)
-> Maybe StakingCredential -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ cred -> Maybe StakingCredential
forall a.
ToMaybeStakingCredential a =>
a -> Maybe StakingCredential
Script.toMaybeStakingCredential cred
stCred
    go TxSkelOut
txSkelOut (PayableAnd Payable els
p1 Payable els'
p2) = TxSkelOut -> Payable els' -> TxSkelOut
forall (els :: [Symbol]). TxSkelOut -> Payable els -> TxSkelOut
go (TxSkelOut -> Payable els -> TxSkelOut
forall (els :: [Symbol]). TxSkelOut -> Payable els -> TxSkelOut
go TxSkelOut
txSkelOut Payable els
p1) Payable els'
p2

    defaultTxSkelDatum :: TxSkelOutDatum
defaultTxSkelDatum = case owner -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator owner
owner of
      -- V1 and V2 script always need a datum, even if empty
      Right (Script.Versioned Validator
_ Language
v) | Language
v Language -> Language -> Bool
forall a. Ord a => a -> a -> Bool
<= Language
Script.PlutusV2 -> DatumContent -> DatumKind -> TxSkelOutDatum
TxSkelOutSomeDatum (() -> DatumContent
forall a. DatumConstrs a => a -> DatumContent
DatumContent ()) (DatumResolved -> DatumKind
Hashed DatumResolved
NotResolved)
      -- V3 script and PKH do not necessarily need a datum
      Either PubKeyHash (Versioned Validator)
_ -> TxSkelOutDatum
TxSkelOutNoDatum