module Hydra.Cardano.Api.Value where

import Hydra.Cardano.Api.Prelude hiding (toLedgerValue)

import Cardano.Api.Ledger (Coin (..), PParams)
import Cardano.Ledger.Alonzo.Plutus.TxInfo qualified as Ledger
import Cardano.Ledger.Core (getMinCoinTxOut)
import Cardano.Ledger.Mary.Value qualified as Ledger
import Data.Word (Word64)
import GHC.IsList (IsList (..))
import Hydra.Cardano.Api.CtxUTxO (ToUTxOContext (..))
import Hydra.Cardano.Api.PolicyId (fromPlutusCurrencySymbol)
import PlutusLedgerApi.V1.Value (flattenValue)
import PlutusLedgerApi.V3 (adaSymbol, adaToken, fromBuiltin, unTokenName)
import PlutusLedgerApi.V3 qualified as Plutus

-- * Extras

-- | Calculate minimum ada as 'Value' for a 'TxOut'.
minUTxOValue ::
  PParams LedgerEra ->
  TxOut CtxTx Era ->
  Value
minUTxOValue :: PParams (ShelleyLedgerEra Era) -> TxOut CtxTx Era -> Value
minUTxOValue PParams (ShelleyLedgerEra Era)
pparams (TxOut AddressInEra Era
addr TxOutValue Era
val TxOutDatum CtxTx Era
dat ReferenceScript Era
ref) =
  Lovelace -> Value
lovelaceToValue (Lovelace -> Value) -> Lovelace -> Value
forall a b. (a -> b) -> a -> b
$
    PParams StandardConway -> TxOut StandardConway -> Lovelace
forall era. EraTxOut era => PParams era -> TxOut era -> Lovelace
getMinCoinTxOut
      PParams (ShelleyLedgerEra Era)
PParams StandardConway
pparams
      (ShelleyBasedEra Era -> TxOut CtxUTxO Era -> TxOut StandardConway
forall era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut ledgerera
toShelleyTxOut ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra (TxOut CtxTx Era -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext TxOut CtxTx Era
out'))
 where
  out' :: TxOut CtxTx Era
out' =
    AddressInEra Era
-> TxOutValue Era
-> TxOutDatum CtxTx Era
-> ReferenceScript Era
-> TxOut CtxTx Era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut
      AddressInEra Era
addr
      ( ShelleyBasedEra Era
-> Value (ShelleyLedgerEra Era) -> TxOutValue Era
forall era.
(Eq (Value (ShelleyLedgerEra era)),
 Show (Value (ShelleyLedgerEra era))) =>
ShelleyBasedEra era
-> Value (ShelleyLedgerEra era) -> TxOutValue era
TxOutValueShelleyBased
          (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @Era)
          (Value -> MaryValue StandardCrypto
toLedgerValue (TxOutValue Era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue Era
val Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
defaultHighEnoughValue))
      )
      TxOutDatum CtxTx Era
dat
      ReferenceScript Era
ref

  -- NOTE: We don't expect the caller to have set any particular value on the
  -- output, so most likely it is equal to '0' and thus, the minimum calculation
  -- will be slightly off because once set, the size of the output will change
  -- and increase the minimum required! So, we evaluate the minimum with an
  -- already large enough lovelace to acknowledge for the increase in size to
  -- come.
  defaultHighEnoughValue :: Value
defaultHighEnoughValue =
    Lovelace -> Value
lovelaceToValue (Lovelace -> Value) -> Lovelace -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Lovelace
Coin (Integer -> Lovelace) -> Integer -> Lovelace
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
maxBound @Word64

-- | Count number of assets in a 'Value'.
valueSize :: Value -> Int
valueSize :: Value -> Int
valueSize = [(AssetId, Quantity)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(AssetId, Quantity)] -> Int)
-> (Value -> [(AssetId, Quantity)]) -> Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(AssetId, Quantity)]
Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList

-- | Access minted assets of a transaction, as an ordered association list.
txMintAssets :: Tx era -> [(AssetId, Quantity)]
txMintAssets :: forall era. Tx era -> [(AssetId, Quantity)]
txMintAssets =
  TxMintValue ViewTx era -> [(AssetId, Quantity)]
forall {build} {era}.
TxMintValue build era -> [(AssetId, Quantity)]
asList (TxMintValue ViewTx era -> [(AssetId, Quantity)])
-> (Tx era -> TxMintValue ViewTx era)
-> Tx era
-> [(AssetId, Quantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyContent ViewTx era -> TxMintValue ViewTx era
forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue (TxBodyContent ViewTx era -> TxMintValue ViewTx era)
-> (Tx era -> TxBodyContent ViewTx era)
-> Tx era
-> TxMintValue ViewTx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> TxBodyContent ViewTx era
forall era. TxBody era -> TxBodyContent ViewTx era
getTxBodyContent (TxBody era -> TxBodyContent ViewTx era)
-> (Tx era -> TxBody era) -> Tx era -> TxBodyContent ViewTx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody
 where
  asList :: TxMintValue build era -> [(AssetId, Quantity)]
asList = \case
    TxMintValue build era
TxMintNone -> []
    TxMintValue MaryEraOnwards era
_ Value
val BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
_ -> Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList Value
val

-- * Type Conversions

-- | Convert a cardano-ledger 'Value' into a cardano-api 'Value'.
fromLedgerValue :: Ledger.MaryValue StandardCrypto -> Value
fromLedgerValue :: MaryValue StandardCrypto -> Value
fromLedgerValue =
  MaryValue StandardCrypto -> Value
fromMaryValue

-- | Convert a cardano-ledger 'MultiAsset' into a cardano-api 'Value'. The
-- cardano-api currently does not have an asset-only type. So this conversion
-- will construct a 'Value' with no 'AdaAssetId' entry in it.
fromLedgerMultiAsset :: Ledger.MultiAsset StandardCrypto -> Value
fromLedgerMultiAsset :: MultiAsset StandardCrypto -> Value
fromLedgerMultiAsset =
  MaryValue StandardCrypto -> Value
fromMaryValue (MaryValue StandardCrypto -> Value)
-> (MultiAsset StandardCrypto -> MaryValue StandardCrypto)
-> MultiAsset StandardCrypto
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> MultiAsset StandardCrypto -> MaryValue StandardCrypto
forall c. Lovelace -> MultiAsset c -> MaryValue c
Ledger.MaryValue (Integer -> Lovelace
Coin Integer
0)

-- | Convert a cardano-api 'Value' into a cardano-ledger 'Value'.
toLedgerValue :: Value -> Ledger.MaryValue StandardCrypto
toLedgerValue :: Value -> MaryValue StandardCrypto
toLedgerValue =
  Value -> MaryValue StandardCrypto
toMaryValue

-- | Convert a plutus 'Value' into a cardano-api 'Value'.
fromPlutusValue :: Plutus.Value -> Maybe Value
fromPlutusValue :: Value -> Maybe Value
fromPlutusValue Value
plutusValue = do
  ([(AssetId, Quantity)] -> Value)
-> Maybe [(AssetId, Quantity)] -> Maybe Value
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(AssetId, Quantity)] -> Value
[Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList (Maybe [(AssetId, Quantity)] -> Maybe Value)
-> ([(CurrencySymbol, TokenName, Integer)]
    -> Maybe [(AssetId, Quantity)])
-> [(CurrencySymbol, TokenName, Integer)]
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, TokenName, Integer) -> Maybe (AssetId, Quantity))
-> [(CurrencySymbol, TokenName, Integer)]
-> Maybe [(AssetId, Quantity)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CurrencySymbol, TokenName, Integer) -> Maybe (AssetId, Quantity)
forall {f :: * -> *}.
MonadFail f =>
(CurrencySymbol, TokenName, Integer) -> f (AssetId, Quantity)
convertAsset ([(CurrencySymbol, TokenName, Integer)] -> Maybe Value)
-> [(CurrencySymbol, TokenName, Integer)] -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Value -> [(CurrencySymbol, TokenName, Integer)]
flattenValue Value
plutusValue
 where
  convertAsset :: (CurrencySymbol, TokenName, Integer) -> f (AssetId, Quantity)
convertAsset (CurrencySymbol
cs, TokenName
tk, Integer
i)
    | CurrencySymbol
cs CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
adaSymbol Bool -> Bool -> Bool
&& TokenName
tk TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
adaToken =
        (AssetId, Quantity) -> f (AssetId, Quantity)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssetId
AdaAssetId, Integer -> Quantity
Quantity Integer
i)
    | Bool
otherwise = do
        PolicyId
pid <- CurrencySymbol -> f PolicyId
forall (m :: * -> *). MonadFail m => CurrencySymbol -> m PolicyId
fromPlutusCurrencySymbol CurrencySymbol
cs
        (AssetId, Quantity) -> f (AssetId, Quantity)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyId -> AssetName -> AssetId
AssetId PolicyId
pid (TokenName -> AssetName
toAssetName TokenName
tk), Integer -> Quantity
Quantity Integer
i)

  toAssetName :: Plutus.TokenName -> AssetName
  toAssetName :: TokenName -> AssetName
toAssetName = ByteString -> AssetName
AssetName (ByteString -> AssetName)
-> (TokenName -> ByteString) -> TokenName -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> ByteString
BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin (BuiltinByteString -> ByteString)
-> (TokenName -> BuiltinByteString) -> TokenName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenName -> BuiltinByteString
unTokenName

-- | Convert a cardano-api 'Value' into a plutus 'Value'
toPlutusValue :: Value -> Plutus.Value
toPlutusValue :: Value -> Value
toPlutusValue =
  MaryValue StandardCrypto -> Value
forall c. MaryValue c -> Value
Ledger.transValue (MaryValue StandardCrypto -> Value)
-> (Value -> MaryValue StandardCrypto) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> MaryValue StandardCrypto
toLedgerValue