{-# 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.Address (addrPtrNormalize)
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.Crypto
import Cardano.Ledger.Plutus.Data (Datum (..), translateDatum)
import Data.Maybe.Strict (StrictMaybe (..))
import Lens.Micro

instance Crypto c => EraTxOut (ConwayEra c) where
  {-# SPECIALIZE instance EraTxOut (ConwayEra StandardCrypto) #-}

  type TxOut (ConwayEra c) = BabbageTxOut (ConwayEra c)

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

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

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

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

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

instance Crypto c => AlonzoEraTxOut (ConwayEra c) where
  {-# SPECIALIZE instance AlonzoEraTxOut (ConwayEra StandardCrypto) #-}

  dataHashTxOutL :: Lens'
  (TxOut (ConwayEra c))
  (StrictMaybe (DataHash (EraCrypto (ConwayEra c))))
dataHashTxOutL = forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe (DataHash (EraCrypto era)))
dataHashBabbageTxOutL
  {-# INLINE dataHashTxOutL #-}

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

instance Crypto c => BabbageEraTxOut (ConwayEra c) where
  {-# SPECIALIZE instance BabbageEraTxOut (ConwayEra StandardCrypto) #-}

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

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

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