-- | 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,
    txSkelOutValueAutoAdjustL,
    txSkelOutDatumL,
    txSkelOutReferenceScriptL,
    txSkelOutStakingCredentialL,
    txSkelOutValidatorAT,
    IsTxSkelOutAllowedOwner (..),
    OwnerConstrs,
    txSkelOutCredentialG,
    txSkelOutAddressG,
    txSkelOutPKHashAT,
    txSkelOutTypedOwnerAT,
    txSkelOutValidatorHashAF,
    valueAssetClassAmountL,
    lovelaceIntegerI,
    valueLovelaceL,
    valueAssetClassAmountP,
    valueLovelaceP,
    ownerCredentialG,
  )
where

import Cooked.Skeleton.Datum
import Cooked.Skeleton.Payable
import Cooked.Skeleton.ReferenceScript
import Cooked.Wallet
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.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.AssocMap qualified as PMap

-- * Requirements to be able to own a 'TxSkelOut'

-- | A 'TxSkelOut' can either be owned by a pubkeyhash or a versioned validator
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 (Script.Versioned Script.Script) where
  toPKHOrValidator :: Versioned Script -> 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))
-> (Versioned Script -> Versioned Validator)
-> Versioned Script
-> Either PubKeyHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Script -> Validator) -> Versioned Script -> Versioned Validator
forall a b. (a -> b) -> Versioned a -> Versioned b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script -> Validator
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

-- | Retrieves the credential of a 'TxSkelOut' allowed owner
ownerCredentialG :: (IsTxSkelOutAllowedOwner owner) => Getter owner Api.Credential
ownerCredentialG :: forall owner.
IsTxSkelOutAllowedOwner owner =>
Getter owner Credential
ownerCredentialG = (owner -> Credential) -> Getter owner Credential
forall s a. (s -> a) -> Getter s a
to ((owner -> Credential) -> Getter owner Credential)
-> (owner -> Credential) -> Getter owner Credential
forall a b. (a -> b) -> a -> b
$ (PubKeyHash -> Credential)
-> (Versioned Validator -> Credential)
-> Either PubKeyHash (Versioned Validator)
-> Credential
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PubKeyHash -> Credential
Api.PubKeyCredential (ScriptHash -> Credential
Api.ScriptCredential (ScriptHash -> Credential)
-> (Versioned Validator -> ScriptHash)
-> Versioned Validator
-> Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned Validator -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash) (Either PubKeyHash (Versioned Validator) -> Credential)
-> (owner -> Either PubKeyHash (Versioned Validator))
-> owner
-> Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. owner -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator

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

-- * Definition of 'Cooked.Skeleton.TxSkel' outputs with associated optics

-- | A rich output to be put into a 'Cooked.Skeleton.TxSkel'
data TxSkelOut where
  TxSkelOut ::
    (OwnerConstrs owner) =>
    { -- The target of this payment
      ()
txSkelOutOwner :: owner,
      -- What staking credential should be attached to this payment
      TxSkelOut -> Maybe StakingCredential
txSkelOutStakingCredential :: Maybe Api.StakingCredential,
      -- What datum should be placed in this payment
      TxSkelOut -> TxSkelOutDatum
txSkelOutDatum :: TxSkelOutDatum,
      -- What value should be paid
      TxSkelOut -> Value
txSkelOutValue :: Api.Value,
      -- Whether the paid value can be auto-adjusted for min ADA
      TxSkelOut -> Bool
txSkelOutValueAutoAdjust :: Bool,
      -- What reference script should be attached to this payment
      TxSkelOut -> TxSkelOutReferenceScript
txSkelOutReferenceScript :: TxSkelOutReferenceScript
    } ->
    TxSkelOut

deriving instance Show TxSkelOut

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

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

-- | A lens to get or set the 'Api.Value' from a 'TxSkelOut'
makeLensesFor [("txSkelOutValue", "txSkelOutValueL")] ''TxSkelOut

-- | A lens to get or set if the value can be auto-adjusted if needed
makeLensesFor [("txSkelOutValueAutoAdjust", "txSkelOutValueAutoAdjustL")] ''TxSkelOut

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

-- | Returns the credential of this 'TxSkelOut'
txSkelOutCredentialG :: Getter TxSkelOut Api.Credential
txSkelOutCredentialG :: Getter TxSkelOut Credential
txSkelOutCredentialG = (TxSkelOut -> Credential) -> Getter TxSkelOut Credential
forall s a. (s -> a) -> Getter s a
to ((TxSkelOut -> Credential) -> Getter TxSkelOut Credential)
-> (TxSkelOut -> Credential) -> Getter TxSkelOut Credential
forall a b. (a -> b) -> a -> b
$ \(TxSkelOut {owner
txSkelOutOwner :: ()
txSkelOutOwner :: owner
txSkelOutOwner}) -> Optic' A_Getter NoIx owner Credential -> owner -> Credential
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx owner Credential
forall owner.
IsTxSkelOutAllowedOwner owner =>
Getter owner Credential
ownerCredentialG owner
txSkelOutOwner

instance Script.ToCredential TxSkelOut where
  toCredential :: TxSkelOut -> Credential
toCredential = Getter TxSkelOut Credential -> TxSkelOut -> Credential
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter TxSkelOut Credential
txSkelOutCredentialG

-- | Returns the address of this 'TxSkelOut'
txSkelOutAddressG :: Getter TxSkelOut Api.Address
txSkelOutAddressG :: Getter TxSkelOut Address
txSkelOutAddressG = (TxSkelOut -> Address) -> Getter TxSkelOut Address
forall s a. (s -> a) -> Getter s a
to ((TxSkelOut -> Address) -> Getter TxSkelOut Address)
-> (TxSkelOut -> Address) -> Getter TxSkelOut Address
forall a b. (a -> b) -> a -> b
$ \TxSkelOut
txSkelOut ->
  Credential -> Maybe StakingCredential -> Address
Api.Address
    (Getter TxSkelOut Credential -> TxSkelOut -> Credential
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter TxSkelOut Credential
txSkelOutCredentialG TxSkelOut
txSkelOut)
    (Lens' TxSkelOut (Maybe StakingCredential)
-> TxSkelOut -> Maybe StakingCredential
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' TxSkelOut (Maybe StakingCredential)
txSkelOutStakingCredentialL TxSkelOut
txSkelOut)

instance Script.ToAddress TxSkelOut where
  toAddress :: TxSkelOut -> Address
toAddress = Getter TxSkelOut Address -> TxSkelOut -> Address
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter TxSkelOut Address
txSkelOutAddressG

-- | Attempts to retrieve or set a typed owner from this 'TxSkelOut'
txSkelOutTypedOwnerAT :: (OwnerConstrs a, OwnerConstrs b) => AffineTraversal TxSkelOut TxSkelOut a b
txSkelOutTypedOwnerAT :: forall a b.
(OwnerConstrs a, OwnerConstrs b) =>
AffineTraversal TxSkelOut TxSkelOut a b
txSkelOutTypedOwnerAT =
  (TxSkelOut -> Either TxSkelOut a)
-> (TxSkelOut -> b -> TxSkelOut)
-> AffineTraversal TxSkelOut TxSkelOut a b
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\txSkelOut :: TxSkelOut
txSkelOut@(TxSkelOut {owner
txSkelOutOwner :: ()
txSkelOutOwner :: owner
txSkelOutOwner}) -> 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
txSkelOutOwner))
    (\TxSkelOut
txSkelOut b
newOwner -> TxSkelOut
txSkelOut {txSkelOutOwner = newOwner})

instance Eq TxSkelOut where
  TxSkelOut
txSkelOut == :: TxSkelOut -> TxSkelOut -> Bool
== TxSkelOut
txSkelOut' =
    Getter TxSkelOut Address -> TxSkelOut -> Address
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter TxSkelOut Address
txSkelOutAddressG TxSkelOut
txSkelOut Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Getter TxSkelOut Address -> TxSkelOut -> Address
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter TxSkelOut Address
txSkelOutAddressG TxSkelOut
txSkelOut'
      Bool -> Bool -> Bool
&& TxSkelOut -> TxSkelOutDatum
txSkelOutDatum TxSkelOut
txSkelOut TxSkelOutDatum -> TxSkelOutDatum -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelOut -> TxSkelOutDatum
txSkelOutDatum 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
&& Optic' An_AffineFold NoIx TxSkelOut ScriptHash
-> TxSkelOut -> Maybe ScriptHash
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Lens' TxSkelOut TxSkelOutReferenceScript
txSkelOutReferenceScriptL Lens' TxSkelOut TxSkelOutReferenceScript
-> Optic
     An_AffineFold
     NoIx
     TxSkelOutReferenceScript
     TxSkelOutReferenceScript
     ScriptHash
     ScriptHash
-> Optic' An_AffineFold NoIx TxSkelOut ScriptHash
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
  An_AffineFold
  NoIx
  TxSkelOutReferenceScript
  TxSkelOutReferenceScript
  ScriptHash
  ScriptHash
txSkelOutReferenceScriptHashAF) TxSkelOut
txSkelOut
        Maybe ScriptHash -> Maybe ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== Optic' An_AffineFold NoIx TxSkelOut ScriptHash
-> TxSkelOut -> Maybe ScriptHash
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Lens' TxSkelOut TxSkelOutReferenceScript
txSkelOutReferenceScriptL Lens' TxSkelOut TxSkelOutReferenceScript
-> Optic
     An_AffineFold
     NoIx
     TxSkelOutReferenceScript
     TxSkelOutReferenceScript
     ScriptHash
     ScriptHash
-> Optic' An_AffineFold NoIx TxSkelOut ScriptHash
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
  An_AffineFold
  NoIx
  TxSkelOutReferenceScript
  TxSkelOutReferenceScript
  ScriptHash
  ScriptHash
txSkelOutReferenceScriptHashAF) TxSkelOut
txSkelOut'

-- | Returns the optional private key owning a given 'TxSkelOut'
txSkelOutPKHashAT :: AffineTraversal' TxSkelOut Api.PubKeyHash
txSkelOutPKHashAT :: AffineTraversal' TxSkelOut PubKeyHash
txSkelOutPKHashAT =
  (TxSkelOut -> Either TxSkelOut PubKeyHash)
-> (TxSkelOut -> PubKeyHash -> TxSkelOut)
-> AffineTraversal' TxSkelOut PubKeyHash
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\txSkelOut :: TxSkelOut
txSkelOut@(TxSkelOut {owner
txSkelOutOwner :: ()
txSkelOutOwner :: owner
txSkelOutOwner}) -> (PubKeyHash -> Either TxSkelOut PubKeyHash)
-> (Versioned Validator -> Either TxSkelOut PubKeyHash)
-> Either PubKeyHash (Versioned Validator)
-> Either TxSkelOut PubKeyHash
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PubKeyHash -> Either TxSkelOut PubKeyHash
forall a b. b -> Either a b
Right (Either TxSkelOut PubKeyHash
-> Versioned Validator -> Either TxSkelOut PubKeyHash
forall a b. a -> b -> a
const (TxSkelOut -> Either TxSkelOut PubKeyHash
forall a b. a -> Either a b
Left TxSkelOut
txSkelOut)) (Either PubKeyHash (Versioned Validator)
 -> Either TxSkelOut PubKeyHash)
-> Either PubKeyHash (Versioned Validator)
-> Either TxSkelOut PubKeyHash
forall a b. (a -> b) -> a -> b
$ owner -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator owner
txSkelOutOwner)
    (\TxSkelOut
txSkelOut PubKeyHash
pkh -> TxSkelOut
txSkelOut {txSkelOutOwner = pkh})

-- | Returns the optional validator owning a given 'TxSkelOut'
txSkelOutValidatorAT :: AffineTraversal' TxSkelOut (Script.Versioned Script.Validator)
txSkelOutValidatorAT :: AffineTraversal' TxSkelOut (Versioned Validator)
txSkelOutValidatorAT =
  (TxSkelOut -> Either TxSkelOut (Versioned Validator))
-> (TxSkelOut -> Versioned Validator -> TxSkelOut)
-> AffineTraversal' TxSkelOut (Versioned Validator)
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\txSkelOut :: TxSkelOut
txSkelOut@(TxSkelOut {owner
txSkelOutOwner :: ()
txSkelOutOwner :: owner
txSkelOutOwner}) -> (PubKeyHash -> Either TxSkelOut (Versioned Validator))
-> (Versioned Validator -> Either TxSkelOut (Versioned Validator))
-> Either PubKeyHash (Versioned Validator)
-> Either TxSkelOut (Versioned Validator)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TxSkelOut (Versioned Validator)
-> PubKeyHash -> Either TxSkelOut (Versioned Validator)
forall a b. a -> b -> a
const (Either TxSkelOut (Versioned Validator)
 -> PubKeyHash -> Either TxSkelOut (Versioned Validator))
-> Either TxSkelOut (Versioned Validator)
-> PubKeyHash
-> Either TxSkelOut (Versioned Validator)
forall a b. (a -> b) -> a -> b
$ TxSkelOut -> Either TxSkelOut (Versioned Validator)
forall a b. a -> Either a b
Left TxSkelOut
txSkelOut) Versioned Validator -> Either TxSkelOut (Versioned Validator)
forall a b. b -> Either a b
Right (Either PubKeyHash (Versioned Validator)
 -> Either TxSkelOut (Versioned Validator))
-> Either PubKeyHash (Versioned Validator)
-> Either TxSkelOut (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
txSkelOutOwner)
    (\TxSkelOut
txSkelOut Versioned Validator
val -> TxSkelOut
txSkelOut {txSkelOutOwner = val})

-- | Returns the optional validator hash owning a given 'TxSkelOut'
txSkelOutValidatorHashAF :: AffineFold TxSkelOut Script.ValidatorHash
txSkelOutValidatorHashAF :: AffineFold TxSkelOut ValidatorHash
txSkelOutValidatorHashAF = AffineTraversal' TxSkelOut (Versioned Validator)
txSkelOutValidatorAT AffineTraversal' TxSkelOut (Versioned Validator)
-> Optic
     A_Getter
     NoIx
     (Versioned Validator)
     (Versioned Validator)
     ValidatorHash
     ValidatorHash
-> AffineFold TxSkelOut ValidatorHash
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
% (Versioned Validator -> ValidatorHash)
-> Optic
     A_Getter
     NoIx
     (Versioned Validator)
     (Versioned Validator)
     ValidatorHash
     ValidatorHash
forall s a. (s -> a) -> Getter s a
to Versioned Validator -> ValidatorHash
forall a. ToValidatorHash a => a -> ValidatorHash
Script.toValidatorHash

-- * Additional optics revolving around 'Api.Value'

-- | A lens to get or set the amount of tokens of a certain 'Api.AssetClass'
-- from a given 'Api.Value'. This removes the entry if the new amount is 0.
valueAssetClassAmountL :: (Script.ToMintingPolicyHash mp) => mp -> Api.TokenName -> Lens' Api.Value Integer
valueAssetClassAmountL :: forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Lens' Value Integer
valueAssetClassAmountL (mp -> CurrencySymbol
forall script.
ToMintingPolicyHash script =>
script -> CurrencySymbol
Script.toCurrencySymbol -> CurrencySymbol
cs) TokenName
tk =
  (Value -> Integer)
-> (Value -> Integer -> Value) -> Lens' Value Integer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (Value -> AssetClass -> Integer
`Api.assetClassValueOf` CurrencySymbol -> TokenName -> AssetClass
Api.assetClass CurrencySymbol
cs TokenName
tk)
    ( \v :: Value
v@(Api.Value Map CurrencySymbol (Map TokenName Integer)
val) Integer
i -> case CurrencySymbol
-> Map CurrencySymbol (Map TokenName Integer)
-> Maybe (Map TokenName Integer)
forall k v. Eq k => k -> Map k v -> Maybe v
PMap.lookup CurrencySymbol
cs Map CurrencySymbol (Map TokenName Integer)
val of
        -- No previous cs entry and nothing to add.
        Maybe (Map TokenName Integer)
Nothing | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Value
v
        -- No previous cs entry, and something to add.
        Maybe (Map TokenName Integer)
Nothing -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map TokenName Integer
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert CurrencySymbol
cs (TokenName -> Integer -> Map TokenName Integer
forall k v. k -> v -> Map k v
PMap.singleton TokenName
tk Integer
i) Map CurrencySymbol (Map TokenName Integer)
val
        -- A previous cs and tk entry, which needs to be removed and the whole
        -- cs entry as well because it only containes this tk.
        Just (Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
PMap.toList -> [(TokenName
tk', Integer
_)]) | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0, TokenName
tk TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
tk' -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> Map k v -> Map k v
PMap.delete CurrencySymbol
cs Map CurrencySymbol (Map TokenName Integer)
val
        -- A previous cs and tk entry, which needs to be removed, but the whole
        -- cs entry has other tokens and thus is kept.
        Just Map TokenName Integer
tokenMap | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map TokenName Integer
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert CurrencySymbol
cs (TokenName -> Map TokenName Integer -> Map TokenName Integer
forall k v. Eq k => k -> Map k v -> Map k v
PMap.delete TokenName
tk Map TokenName Integer
tokenMap) Map CurrencySymbol (Map TokenName Integer)
val
        -- A previous cs entry, in which we insert the new tk (regarless of
        -- whether the tk was already present).
        Just Map TokenName Integer
tokenMap -> Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Map TokenName Integer
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert CurrencySymbol
cs (TokenName
-> Integer -> Map TokenName Integer -> Map TokenName Integer
forall k v. Eq k => k -> v -> Map k v -> Map k v
PMap.insert TokenName
tk Integer
i Map TokenName Integer
tokenMap) Map CurrencySymbol (Map TokenName Integer)
val
    )

-- | Isomorphism between 'Api.Lovelace' and integers
lovelaceIntegerI :: Iso' Api.Lovelace Integer
lovelaceIntegerI :: Iso' Lovelace Integer
lovelaceIntegerI = (Lovelace -> Integer)
-> (Integer -> Lovelace) -> Iso' Lovelace Integer
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Lovelace -> Integer
Api.getLovelace Integer -> Lovelace
Api.Lovelace

-- | Focus the Lovelace part in a value.
valueLovelaceL :: Lens' Api.Value Api.Lovelace
valueLovelaceL :: Lens' Value Lovelace
valueLovelaceL = CurrencySymbol -> TokenName -> Lens' Value Integer
forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Lens' Value Integer
valueAssetClassAmountL CurrencySymbol
Api.adaSymbol TokenName
Api.adaToken Lens' Value Integer
-> Optic An_Iso NoIx Integer Integer Lovelace Lovelace
-> Lens' Value Lovelace
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
% Iso' Lovelace Integer
-> Optic
     (ReversedOptic An_Iso) NoIx Integer Integer Lovelace Lovelace
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic An_Iso is s t a b -> Optic (ReversedOptic An_Iso) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Iso' Lovelace Integer
lovelaceIntegerI

-- | A prism to build a value from an asset class and amount, or retrieves the
-- amount from this asset class if it is not zero
valueAssetClassAmountP :: (Script.ToMintingPolicyHash mp) => mp -> Api.TokenName -> Prism' Api.Value Integer
valueAssetClassAmountP :: forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Prism' Value Integer
valueAssetClassAmountP (mp -> CurrencySymbol
forall script.
ToMintingPolicyHash script =>
script -> CurrencySymbol
Script.toCurrencySymbol -> CurrencySymbol
cs) TokenName
tk
  | AssetClass
ac <- CurrencySymbol -> TokenName -> AssetClass
Api.assetClass CurrencySymbol
cs TokenName
tk =
      (Integer -> Value)
-> (Value -> Either Value Integer) -> Prism' Value Integer
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
        ( \case
            Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Value
forall a. Monoid a => a
mempty
            Integer
i -> AssetClass -> Integer -> Value
Api.assetClassValue AssetClass
ac Integer
i
        )
        ( \Value
val -> case Value
val Value -> AssetClass -> Integer
`Api.assetClassValueOf` AssetClass
ac of
            Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Value -> Either Value Integer
forall a b. a -> Either a b
Left Value
val
            Integer
i -> Integer -> Either Value Integer
forall a b. b -> Either a b
Right Integer
i
        )

-- | An instance of 'valueAssetClassAmountP' for 'Api.Lovelace'
valueLovelaceP :: Prism' Api.Value Api.Lovelace
valueLovelaceP :: Prism' Value Lovelace
valueLovelaceP = CurrencySymbol -> TokenName -> Prism' Value Integer
forall mp.
ToMintingPolicyHash mp =>
mp -> TokenName -> Prism' Value Integer
valueAssetClassAmountP CurrencySymbol
Api.adaSymbol TokenName
Api.adaToken Prism' Value Integer
-> Optic An_Iso NoIx Integer Integer Lovelace Lovelace
-> Prism' Value Lovelace
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
% Iso' Lovelace Integer
-> Optic
     (ReversedOptic An_Iso) NoIx Integer Integer Lovelace Lovelace
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic An_Iso is s t a b -> Optic (ReversedOptic An_Iso) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Iso' Lovelace Integer
lovelaceIntegerI

-- * Smart constructor to build 'TxSkelOut's

-- | 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 =
  ( Payable els -> TxSkelOut -> TxSkelOut
forall (els :: [Symbol]). Payable els -> TxSkelOut -> TxSkelOut
`go`
      owner
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Bool
-> TxSkelOutReferenceScript
-> TxSkelOut
forall owner.
OwnerConstrs owner =>
owner
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Bool
-> TxSkelOutReferenceScript
-> TxSkelOut
TxSkelOut
        owner
owner
        Maybe StakingCredential
forall a. Maybe a
Nothing -- No staking credential by default
        TxSkelOutDatum
defaultTxSkelDatum -- Default datum defined below
        Value
forall a. Monoid a => a
mempty -- Empty value by default
        Bool
True -- the value is adjustable to min ADA by default
        TxSkelOutReferenceScript
NoTxSkelOutReferenceScript -- No reference script by default
  )
  where
    go :: Payable els -> TxSkelOut -> TxSkelOut
    go :: forall (els :: [Symbol]). Payable els -> TxSkelOut -> TxSkelOut
go (VisibleHashedDatum a1
dat) = 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
set Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL (a1 -> DatumKind -> TxSkelOutDatum
forall dat. DatumConstrs dat => dat -> DatumKind -> TxSkelOutDatum
SomeTxSkelOutDatum a1
dat (DatumResolved -> DatumKind
Hashed DatumResolved
Resolved))
    go (InlineDatum a1
dat) = 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
set Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL (a1 -> DatumKind -> TxSkelOutDatum
forall dat. DatumConstrs dat => dat -> DatumKind -> TxSkelOutDatum
SomeTxSkelOutDatum a1
dat DatumKind
Inline)
    go (HiddenHashedDatum a1
dat) = 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
set Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL (a1 -> DatumKind -> TxSkelOutDatum
forall dat. DatumConstrs dat => dat -> DatumKind -> TxSkelOutDatum
SomeTxSkelOutDatum a1
dat (DatumResolved -> DatumKind
Hashed DatumResolved
NotResolved))
    go (FixedValue a1
v) = Lens' TxSkelOut Value -> Value -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' TxSkelOut Value
txSkelOutValueL (a1 -> Value
forall a. ToValue a => a -> Value
Script.toValue a1
v) (TxSkelOut -> TxSkelOut)
-> (TxSkelOut -> TxSkelOut) -> TxSkelOut -> TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxSkelOut Bool -> Bool -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' TxSkelOut Bool
txSkelOutValueAutoAdjustL Bool
False
    go (Value a1
v) = Lens' TxSkelOut Value -> Value -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' TxSkelOut Value
txSkelOutValueL (a1 -> Value
forall a. ToValue a => a -> Value
Script.toValue a1
v) (TxSkelOut -> TxSkelOut)
-> (TxSkelOut -> TxSkelOut) -> TxSkelOut -> TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxSkelOut Bool -> Bool -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' TxSkelOut Bool
txSkelOutValueAutoAdjustL Bool
True
    go (ReferenceScript s
script) = 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
set Lens' TxSkelOut TxSkelOutReferenceScript
txSkelOutReferenceScriptL (s -> TxSkelOutReferenceScript
forall a. ReferenceScriptConstrs a => a -> TxSkelOutReferenceScript
SomeTxSkelOutReferenceScript s
script)
    go (StakingCredential cred
stCred) = 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
set Lens' TxSkelOut (Maybe StakingCredential)
txSkelOutStakingCredentialL (cred -> Maybe StakingCredential
forall a.
ToMaybeStakingCredential a =>
a -> Maybe StakingCredential
Script.toMaybeStakingCredential cred
stCred)
    go (PayableAnd Payable els
p1 Payable els'
p2) = Payable els' -> TxSkelOut -> TxSkelOut
forall (els :: [Symbol]). Payable els -> TxSkelOut -> TxSkelOut
go Payable els'
p2 (TxSkelOut -> TxSkelOut)
-> (TxSkelOut -> TxSkelOut) -> TxSkelOut -> TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Payable els -> TxSkelOut -> TxSkelOut
forall (els :: [Symbol]). Payable els -> TxSkelOut -> TxSkelOut
go Payable els
p1

    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 -> () -> DatumKind -> TxSkelOutDatum
forall dat. DatumConstrs dat => dat -> DatumKind -> TxSkelOutDatum
SomeTxSkelOutDatum () (DatumResolved -> DatumKind
Hashed DatumResolved
NotResolved)
      -- V3 script and PKH do not necessarily need a datum
      Either PubKeyHash (Versioned Validator)
_ -> TxSkelOutDatum
NoTxSkelOutDatum