{-# 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.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 = forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value ConwayEra
vl forall era. Datum era
NoDatum 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) =
    forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut (Addr -> Addr
addrPtrNormalize Addr
addr) Value BabbageEra
value (forall era1 era2. Datum era1 -> Datum era2
translateDatum Datum BabbageEra
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)
s)

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

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

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

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

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

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

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

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