{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableSuperClasses #-}

-- | This module is used for building and inspecting transaction outputs.
--
-- You'll find some examples below.
--
-- Let's start by defining the GHC extensions and imports.
--
-- >>> :set -XTypeApplications
-- >>> import Cardano.Ledger.Api.Era (BabbageEra)
-- >>> import Lens.Micro
-- >>> import Test.Cardano.Ledger.Babbage.Arbitrary() -- Needed for doctests only
-- >>> import Test.QuickCheck -- Needed for doctests only
--
-- Here's an example on how to build a very basic Babbage era transaction output with a random
-- address and value, and without any datum or reference script.
--
-- >>> :{
-- quickCheck $ \addr val ->
--     let
--         -- Defining a Babbage era transaction output with some random address and value.
--         txOut = mkBasicTxOut @BabbageEra addr val
--      in
--         -- We verify that the transaction output contains our random address and value.
--         txOut ^. addrTxOutL == addr && txOut ^. valueTxOutL == val
-- :}
-- +++ OK, passed 100 tests.
module Cardano.Ledger.Api.Tx.Out (
  module Cardano.Ledger.Api.Tx.Address,
  EraTxOut (TxOut),
  mkBasicTxOut,
  upgradeTxOut,

  -- * Any Era
  AnyEraTxOut (..),

  -- ** Value
  valueTxOutL,
  coinTxOutL,
  isAdaOnlyTxOutF,

  -- ** Address
  addrTxOutL,
  bootAddrTxOutF,

  -- ** Size
  getMinCoinTxOut,
  setMinCoinTxOut,
  getMinCoinSizedTxOut,
  setMinCoinSizedTxOut,
  ensureMinCoinTxOut,
  ensureMinCoinSizedTxOut,

  -- * Shelley, Allegra and Mary Era

  -- * Alonzo Era
  AlonzoEraTxOut,
  dataHashTxOutL,
  DataHash,
  datumTxOutF,

  -- * Babbage Era
  BabbageEraTxOut,
  dataTxOutL,
  Data (..),
  datumTxOutL,
  Datum (..),
  referenceScriptTxOutL,
) where

import Cardano.Ledger.Alonzo.Core (AlonzoEraTxOut (..))
import Cardano.Ledger.Api.Era
import Cardano.Ledger.Api.Scripts (AnyEraScript, Script)
import Cardano.Ledger.Api.Scripts.Data (Data (..), DataHash, Datum (..))
import Cardano.Ledger.Api.Tx.Address
import Cardano.Ledger.Babbage.Core (BabbageEraTxOut (..))
import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin
import Cardano.Ledger.Core (
  EraTxOut (..),
  PParams,
  bootAddrTxOutF,
  coinTxOutL,
  isAdaOnlyTxOutF,
 )
import Cardano.Ledger.Tools (ensureMinCoinTxOut, setMinCoinTxOut)
import Lens.Micro

class (EraTxOut era, AnyEraScript era) => AnyEraTxOut era where
  datumTxOutG :: SimpleGetter (TxOut era) (Maybe (Datum era))
  default datumTxOutG ::
    AlonzoEraTxOut era =>
    SimpleGetter (TxOut era) (Maybe (Datum era))
  datumTxOutG = Getting r (TxOut era) (Datum era)
forall era.
AlonzoEraTxOut era =>
SimpleGetter (TxOut era) (Datum era)
SimpleGetter (TxOut era) (Datum era)
datumTxOutF Getting r (TxOut era) (Datum era)
-> ((Maybe (Datum era) -> Const r (Maybe (Datum era)))
    -> Datum era -> Const r (Datum era))
-> (Maybe (Datum era) -> Const r (Maybe (Datum era)))
-> TxOut era
-> Const r (TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Datum era -> Maybe (Datum era))
-> SimpleGetter (Datum era) (Maybe (Datum era))
forall s a. (s -> a) -> SimpleGetter s a
to Datum era -> Maybe (Datum era)
forall a. a -> Maybe a
Just

  referenceScriptTxOutG :: SimpleGetter (TxOut era) (Maybe (Maybe (Script era)))
  default referenceScriptTxOutG ::
    BabbageEraTxOut era =>
    SimpleGetter (TxOut era) (Maybe (Maybe (Script era)))
  referenceScriptTxOutG = (StrictMaybe (Script era) -> Const r (StrictMaybe (Script era)))
-> TxOut era -> Const r (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Const r (StrictMaybe (Script era)))
 -> TxOut era -> Const r (TxOut era))
-> ((Maybe (Maybe (Script era))
     -> Const r (Maybe (Maybe (Script era))))
    -> StrictMaybe (Script era) -> Const r (StrictMaybe (Script era)))
-> (Maybe (Maybe (Script era))
    -> Const r (Maybe (Maybe (Script era))))
-> TxOut era
-> Const r (TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Script era) -> Maybe (Maybe (Script era)))
-> SimpleGetter
     (StrictMaybe (Script era)) (Maybe (Maybe (Script era)))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Script era) -> Maybe (Maybe (Script era))
forall a. a -> Maybe a
Just (Maybe (Script era) -> Maybe (Maybe (Script era)))
-> (StrictMaybe (Script era) -> Maybe (Script era))
-> StrictMaybe (Script era)
-> Maybe (Maybe (Script era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe (Script era) -> Maybe (Script era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe)

instance AnyEraTxOut ShelleyEra where
  datumTxOutG :: SimpleGetter (TxOut ShelleyEra) (Maybe (Datum ShelleyEra))
datumTxOutG = (ShelleyTxOut ShelleyEra -> Maybe (Datum ShelleyEra))
-> SimpleGetter
     (ShelleyTxOut ShelleyEra) (Maybe (Datum ShelleyEra))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Datum ShelleyEra)
-> ShelleyTxOut ShelleyEra -> Maybe (Datum ShelleyEra)
forall a b. a -> b -> a
const Maybe (Datum ShelleyEra)
forall a. Maybe a
Nothing)
  referenceScriptTxOutG :: SimpleGetter (TxOut ShelleyEra) (Maybe (Maybe (Script ShelleyEra)))
referenceScriptTxOutG = (ShelleyTxOut ShelleyEra -> Maybe (Maybe (MultiSig ShelleyEra)))
-> SimpleGetter
     (ShelleyTxOut ShelleyEra) (Maybe (Maybe (MultiSig ShelleyEra)))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Maybe (MultiSig ShelleyEra))
-> ShelleyTxOut ShelleyEra -> Maybe (Maybe (MultiSig ShelleyEra))
forall a b. a -> b -> a
const Maybe (Maybe (MultiSig ShelleyEra))
forall a. Maybe a
Nothing)

instance AnyEraTxOut AllegraEra where
  datumTxOutG :: SimpleGetter (TxOut AllegraEra) (Maybe (Datum AllegraEra))
datumTxOutG = (ShelleyTxOut AllegraEra -> Maybe (Datum AllegraEra))
-> SimpleGetter
     (ShelleyTxOut AllegraEra) (Maybe (Datum AllegraEra))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Datum AllegraEra)
-> ShelleyTxOut AllegraEra -> Maybe (Datum AllegraEra)
forall a b. a -> b -> a
const Maybe (Datum AllegraEra)
forall a. Maybe a
Nothing)
  referenceScriptTxOutG :: SimpleGetter (TxOut AllegraEra) (Maybe (Maybe (Script AllegraEra)))
referenceScriptTxOutG = (ShelleyTxOut AllegraEra -> Maybe (Maybe (Timelock AllegraEra)))
-> SimpleGetter
     (ShelleyTxOut AllegraEra) (Maybe (Maybe (Timelock AllegraEra)))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Maybe (Timelock AllegraEra))
-> ShelleyTxOut AllegraEra -> Maybe (Maybe (Timelock AllegraEra))
forall a b. a -> b -> a
const Maybe (Maybe (Timelock AllegraEra))
forall a. Maybe a
Nothing)

instance AnyEraTxOut MaryEra where
  datumTxOutG :: SimpleGetter (TxOut MaryEra) (Maybe (Datum MaryEra))
datumTxOutG = (ShelleyTxOut MaryEra -> Maybe (Datum MaryEra))
-> SimpleGetter (ShelleyTxOut MaryEra) (Maybe (Datum MaryEra))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Datum MaryEra)
-> ShelleyTxOut MaryEra -> Maybe (Datum MaryEra)
forall a b. a -> b -> a
const Maybe (Datum MaryEra)
forall a. Maybe a
Nothing)
  referenceScriptTxOutG :: SimpleGetter (TxOut MaryEra) (Maybe (Maybe (Script MaryEra)))
referenceScriptTxOutG = (ShelleyTxOut MaryEra -> Maybe (Maybe (Timelock MaryEra)))
-> SimpleGetter
     (ShelleyTxOut MaryEra) (Maybe (Maybe (Timelock MaryEra)))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Maybe (Timelock MaryEra))
-> ShelleyTxOut MaryEra -> Maybe (Maybe (Timelock MaryEra))
forall a b. a -> b -> a
const Maybe (Maybe (Timelock MaryEra))
forall a. Maybe a
Nothing)

instance AnyEraTxOut AlonzoEra where
  referenceScriptTxOutG :: SimpleGetter (TxOut AlonzoEra) (Maybe (Maybe (Script AlonzoEra)))
referenceScriptTxOutG = (AlonzoTxOut AlonzoEra -> Maybe (Maybe (AlonzoScript AlonzoEra)))
-> SimpleGetter
     (AlonzoTxOut AlonzoEra) (Maybe (Maybe (AlonzoScript AlonzoEra)))
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe (Maybe (AlonzoScript AlonzoEra))
-> AlonzoTxOut AlonzoEra -> Maybe (Maybe (AlonzoScript AlonzoEra))
forall a b. a -> b -> a
const Maybe (Maybe (AlonzoScript AlonzoEra))
forall a. Maybe a
Nothing)

instance AnyEraTxOut BabbageEra

instance AnyEraTxOut ConwayEra

instance AnyEraTxOut DijkstraEra

setMinCoinSizedTxOutInternal ::
  forall era.
  EraTxOut era =>
  (Coin -> Coin -> Bool) ->
  PParams era ->
  Sized (TxOut era) ->
  Sized (TxOut era)
setMinCoinSizedTxOutInternal :: forall era.
EraTxOut era =>
(Coin -> Coin -> Bool)
-> PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOutInternal Coin -> Coin -> Bool
f PParams era
pp = Sized (TxOut era) -> Sized (TxOut era)
go
  where
    version :: Version
version = forall era. Era era => Version
eraProtVerLow @era
    go :: Sized (TxOut era) -> Sized (TxOut era)
go !Sized (TxOut era)
txOut =
      let curMinCoin :: Coin
curMinCoin = PParams era -> Sized (TxOut era) -> Coin
forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Coin
getMinCoinSizedTxOut PParams era
pp Sized (TxOut era)
txOut
          curCoin :: Coin
curCoin = Sized (TxOut era)
txOut Sized (TxOut era) -> Getting Coin (Sized (TxOut era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Version -> Lens' (TxOut era) Coin -> Lens' (Sized (TxOut era)) Coin
forall s a. EncCBOR s => Version -> Lens' s a -> Lens' (Sized s) a
toSizedL Version
version (Coin -> f Coin) -> TxOut era -> f (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL
       in if Coin
curCoin Coin -> Coin -> Bool
`f` Coin
curMinCoin
            then Sized (TxOut era)
txOut
            else Sized (TxOut era) -> Sized (TxOut era)
go (Sized (TxOut era)
txOut Sized (TxOut era)
-> (Sized (TxOut era) -> Sized (TxOut era)) -> Sized (TxOut era)
forall a b. a -> (a -> b) -> b
& Version -> Lens' (TxOut era) Coin -> Lens' (Sized (TxOut era)) Coin
forall s a. EncCBOR s => Version -> Lens' s a -> Lens' (Sized s) a
toSizedL Version
version (Coin -> f Coin) -> TxOut era -> f (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin)
 -> Sized (TxOut era) -> Identity (Sized (TxOut era)))
-> Coin -> Sized (TxOut era) -> Sized (TxOut era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
curMinCoin)

-- | This function will adjust the output's `Coin` value to the smallest amount
-- allowed by the UTXO rule. Initial amount is not important.
setMinCoinSizedTxOut ::
  forall era.
  EraTxOut era =>
  PParams era ->
  Sized (TxOut era) ->
  Sized (TxOut era)
setMinCoinSizedTxOut :: forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOut = (Coin -> Coin -> Bool)
-> PParams era -> Sized (TxOut era) -> Sized (TxOut era)
forall era.
EraTxOut era =>
(Coin -> Coin -> Bool)
-> PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOutInternal Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Similar to `setMinCoinSizedTxOut` it will guarantee that the minimum requirement for the
-- output amount is satisified, however it makes it possible to set a higher amount than
-- the minimaly required.
--
-- `ensureMinCoinSizedTxOut` relates to `setMinCoinSizedTxOut` in the same way that
-- `ensureMinCoinTxOut` relates to `setMinCoinTxOut`.
ensureMinCoinSizedTxOut ::
  forall era.
  EraTxOut era =>
  PParams era ->
  Sized (TxOut era) ->
  Sized (TxOut era)
ensureMinCoinSizedTxOut :: forall era.
EraTxOut era =>
PParams era -> Sized (TxOut era) -> Sized (TxOut era)
ensureMinCoinSizedTxOut = (Coin -> Coin -> Bool)
-> PParams era -> Sized (TxOut era) -> Sized (TxOut era)
forall era.
EraTxOut era =>
(Coin -> Coin -> Bool)
-> PParams era -> Sized (TxOut era) -> Sized (TxOut era)
setMinCoinSizedTxOutInternal Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
(>=)