{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.TxOut () where

import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.TxOut (
  BabbageTxOut (..),
  addrEitherBabbageTxOutL,
  babbageMinUTxOValue,
  dataBabbageTxOutL,
  dataHashBabbageTxOutL,
  datumBabbageTxOutL,
  getDatumBabbageTxOut,
  referenceScriptBabbageTxOutL,
  valueEitherBabbageTxOutL,
 )
import Cardano.Ledger.Conway.Era (ConwayEra)
import Cardano.Ledger.Conway.PParams ()
import Cardano.Ledger.Conway.Scripts ()
import Cardano.Ledger.Plutus.Data (Datum (..), translateDatum)
import Data.Maybe.Strict (StrictMaybe (..))
import Lens.Micro

instance EraTxOut ConwayEra where
  type TxOut ConwayEra = BabbageTxOut ConwayEra

  mkBasicTxOut :: HasCallStack => Addr -> Value ConwayEra -> TxOut ConwayEra
mkBasicTxOut Addr
addr Value ConwayEra
vl = Addr
-> Value ConwayEra
-> Datum ConwayEra
-> StrictMaybe (Script ConwayEra)
-> BabbageTxOut ConwayEra
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value ConwayEra
vl Datum ConwayEra
forall era. Datum era
NoDatum StrictMaybe (Script ConwayEra)
StrictMaybe (AlonzoScript ConwayEra)
forall a. StrictMaybe a
SNothing

  upgradeTxOut :: EraTxOut (PreviousEra ConwayEra) =>
TxOut (PreviousEra ConwayEra) -> TxOut ConwayEra
upgradeTxOut (BabbageTxOut Addr
addr Value BabbageEra
value Datum BabbageEra
d StrictMaybe (Script BabbageEra)
s) =
    Addr
-> Value ConwayEra
-> Datum ConwayEra
-> StrictMaybe (Script ConwayEra)
-> BabbageTxOut ConwayEra
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value BabbageEra
Value ConwayEra
value (Datum BabbageEra -> Datum ConwayEra
forall era1 era2. Datum era1 -> Datum era2
translateDatum Datum BabbageEra
d) (Script (PreviousEra ConwayEra) -> Script ConwayEra
Script (PreviousEra ConwayEra) -> AlonzoScript ConwayEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra ConwayEra) -> AlonzoScript ConwayEra)
-> StrictMaybe (Script (PreviousEra ConwayEra))
-> StrictMaybe (AlonzoScript ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (Script (PreviousEra ConwayEra))
StrictMaybe (Script BabbageEra)
s)

  addrEitherTxOutL :: Lens' (TxOut ConwayEra) (Either Addr CompactAddr)
addrEitherTxOutL = (Either Addr CompactAddr -> f (Either Addr CompactAddr))
-> TxOut ConwayEra -> f (TxOut ConwayEra)
(Either Addr CompactAddr -> f (Either Addr CompactAddr))
-> BabbageTxOut ConwayEra -> f (BabbageTxOut ConwayEra)
forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (Either Addr CompactAddr)
Lens' (BabbageTxOut ConwayEra) (Either Addr CompactAddr)
addrEitherBabbageTxOutL
  {-# INLINE addrEitherTxOutL #-}

  valueEitherTxOutL :: Lens'
  (TxOut ConwayEra)
  (Either (Value ConwayEra) (CompactForm (Value ConwayEra)))
valueEitherTxOutL = (Either (Value ConwayEra) (CompactForm (Value ConwayEra))
 -> f (Either (Value ConwayEra) (CompactForm (Value ConwayEra))))
-> TxOut ConwayEra -> f (TxOut ConwayEra)
(Either (Value ConwayEra) (CompactForm (Value ConwayEra))
 -> f (Either (Value ConwayEra) (CompactForm (Value ConwayEra))))
-> BabbageTxOut ConwayEra -> f (BabbageTxOut ConwayEra)
forall era.
EraTxOut era =>
Lens'
  (BabbageTxOut era) (Either (Value era) (CompactForm (Value era)))
Lens'
  (BabbageTxOut ConwayEra)
  (Either (Value ConwayEra) (CompactForm (Value ConwayEra)))
valueEitherBabbageTxOutL
  {-# INLINE valueEitherTxOutL #-}

  getMinCoinSizedTxOut :: PParams ConwayEra -> Sized (TxOut ConwayEra) -> Coin
getMinCoinSizedTxOut = PParams ConwayEra -> Sized (TxOut ConwayEra) -> Coin
PParams ConwayEra -> Sized (BabbageTxOut ConwayEra) -> Coin
forall era a.
BabbageEraPParams era =>
PParams era -> Sized a -> Coin
babbageMinUTxOValue

instance AlonzoEraTxOut ConwayEra where
  dataHashTxOutL :: Lens' (TxOut ConwayEra) (StrictMaybe DataHash)
dataHashTxOutL = (StrictMaybe DataHash -> f (StrictMaybe DataHash))
-> TxOut ConwayEra -> f (TxOut ConwayEra)
(StrictMaybe DataHash -> f (StrictMaybe DataHash))
-> BabbageTxOut ConwayEra -> f (BabbageTxOut ConwayEra)
forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe DataHash)
Lens' (BabbageTxOut ConwayEra) (StrictMaybe DataHash)
dataHashBabbageTxOutL
  {-# INLINE dataHashTxOutL #-}

  datumTxOutF :: SimpleGetter (TxOut ConwayEra) (Datum ConwayEra)
datumTxOutF = (BabbageTxOut ConwayEra -> Datum ConwayEra)
-> SimpleGetter (BabbageTxOut ConwayEra) (Datum ConwayEra)
forall s a. (s -> a) -> SimpleGetter s a
to BabbageTxOut ConwayEra -> Datum ConwayEra
forall era. BabbageTxOut era -> Datum era
getDatumBabbageTxOut
  {-# INLINE datumTxOutF #-}

instance BabbageEraTxOut ConwayEra where
  dataTxOutL :: Lens' (TxOut ConwayEra) (StrictMaybe (Data ConwayEra))
dataTxOutL = (StrictMaybe (Data ConwayEra) -> f (StrictMaybe (Data ConwayEra)))
-> TxOut ConwayEra -> f (TxOut ConwayEra)
(StrictMaybe (Data ConwayEra) -> f (StrictMaybe (Data ConwayEra)))
-> BabbageTxOut ConwayEra -> f (BabbageTxOut ConwayEra)
forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe (Data era))
Lens' (BabbageTxOut ConwayEra) (StrictMaybe (Data ConwayEra))
dataBabbageTxOutL
  {-# INLINE dataTxOutL #-}

  datumTxOutL :: Lens' (TxOut ConwayEra) (Datum ConwayEra)
datumTxOutL = (Datum ConwayEra -> f (Datum ConwayEra))
-> TxOut ConwayEra -> f (TxOut ConwayEra)
(Datum ConwayEra -> f (Datum ConwayEra))
-> BabbageTxOut ConwayEra -> f (BabbageTxOut ConwayEra)
forall era. EraTxOut era => Lens' (BabbageTxOut era) (Datum era)
Lens' (BabbageTxOut ConwayEra) (Datum ConwayEra)
datumBabbageTxOutL
  {-# INLINE datumTxOutL #-}

  referenceScriptTxOutL :: Lens' (TxOut ConwayEra) (StrictMaybe (Script ConwayEra))
referenceScriptTxOutL = (StrictMaybe (Script ConwayEra)
 -> f (StrictMaybe (Script ConwayEra)))
-> TxOut ConwayEra -> f (TxOut ConwayEra)
(StrictMaybe (Script ConwayEra)
 -> f (StrictMaybe (Script ConwayEra)))
-> BabbageTxOut ConwayEra -> f (BabbageTxOut ConwayEra)
forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe (Script era))
Lens' (BabbageTxOut ConwayEra) (StrictMaybe (Script ConwayEra))
referenceScriptBabbageTxOutL
  {-# INLINE referenceScriptTxOutL #-}