module Hydra.Cardano.Api.AddressInEra where

import Hydra.Cardano.Api.Prelude

import Cardano.Ledger.Address qualified as Ledger
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Credential qualified as Ledger
import Cardano.Ledger.Hashes qualified as Ledger
import Hydra.Cardano.Api.Network (Network)
import PlutusLedgerApi.V3 (
  Address (..),
  Credential (..),
  StakingCredential (StakingHash, StakingPtr),
  fromBuiltin,
 )
import PlutusLedgerApi.V3 qualified as Plutus

-- * Extras

-- | Construct a Shelley-style address from a verification key. This address has
-- no stake rights.
--
-- TODO: 'NetworkId' here is an annoying API because it requires a network magic
-- for testnet addresses. Nevertheless, the network magic is only needed for
-- Byron addresses; Shelley addresses use a different kind of network
-- discriminant which is currently fully captured as 'Mainnet | Testnet'.
--
-- So, it would be a slightly better DX to use Mainnet | Testnet as an interface
-- here since we are only constructing Shelley addresses.
mkVkAddress ::
  IsShelleyBasedEra era =>
  NetworkId ->
  VerificationKey PaymentKey ->
  AddressInEra era
mkVkAddress :: forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk =
  ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra
    ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra
    NetworkId
networkId
    (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (Hash PaymentKey -> PaymentCredential)
-> Hash PaymentKey -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk)
    StakeAddressReference
NoStakeAddress

-- | Construct a Shelley-style address from a Plutus script. This address has
-- no stake rights.
mkScriptAddress ::
  forall lang era.
  (IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
  NetworkId ->
  PlutusScript lang ->
  AddressInEra era
mkScriptAddress :: forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript lang
script =
  ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra
    ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra
    NetworkId
networkId
    (ScriptHash -> PaymentCredential
PaymentCredentialByScript (ScriptHash -> PaymentCredential)
-> ScriptHash -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script lang -> ScriptHash) -> Script lang -> ScriptHash
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
version PlutusScript lang
script)
    StakeAddressReference
NoStakeAddress
 where
  version :: PlutusScriptVersion lang
version = forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
plutusScriptVersion @lang

-- * Type Conversions

-- | From a ledger 'Addr' to an api 'AddressInEra'
fromLedgerAddr :: IsShelleyBasedEra era => Ledger.Addr -> AddressInEra era
fromLedgerAddr :: forall era. IsShelleyBasedEra era => Addr -> AddressInEra era
fromLedgerAddr = ShelleyBasedEra era -> Addr -> AddressInEra era
forall era. ShelleyBasedEra era -> Addr -> AddressInEra era
fromShelleyAddrIsSbe ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra

-- | From an api 'AddressInEra' to a ledger 'Addr'
toLedgerAddr :: AddressInEra era -> Ledger.Addr
toLedgerAddr :: forall era. AddressInEra era -> Addr
toLedgerAddr = \case
  AddressInEra AddressTypeInEra addrtype era
ByronAddressInAnyEra (ByronAddress Address
addr) ->
    BootstrapAddress -> Addr
Ledger.AddrBootstrap (Address -> BootstrapAddress
Ledger.BootstrapAddress Address
addr)
  AddressInEra (ShelleyAddressInEra ShelleyBasedEra era
_) (ShelleyAddress Network
ntwrk PaymentCredential
creds StakeReference
stake) ->
    Network -> PaymentCredential -> StakeReference -> Addr
Ledger.Addr Network
ntwrk PaymentCredential
creds StakeReference
stake

-- | Convert a plutus 'Address' to an api 'AddressInEra'.
-- NOTE: Requires the 'Network' discriminator (Testnet or Mainnet) because
-- Plutus addresses are stripped off it.
fromPlutusAddress :: IsShelleyBasedEra era => Network -> Plutus.Address -> AddressInEra era
fromPlutusAddress :: forall era.
IsShelleyBasedEra era =>
Network -> Address -> AddressInEra era
fromPlutusAddress Network
network Address
plutusAddress =
  Addr -> AddressInEra era
forall era. IsShelleyBasedEra era => Addr -> AddressInEra era
fromLedgerAddr (Addr -> AddressInEra era) -> Addr -> AddressInEra era
forall a b. (a -> b) -> a -> b
$
    case (Credential
addressCredential, Maybe StakingCredential
addressStakingCredential) of
      (Credential
cred, Just (StakingHash Credential
stakeCred)) ->
        Network -> PaymentCredential -> StakeReference -> Addr
Ledger.Addr Network
network (Credential -> PaymentCredential
forall {kr :: KeyRole}. Credential -> Credential kr
unsafeCredential Credential
cred) (StakeReference -> Addr)
-> (StakeCredential -> StakeReference) -> StakeCredential -> Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeCredential -> StakeReference
Ledger.StakeRefBase (StakeCredential -> Addr) -> StakeCredential -> Addr
forall a b. (a -> b) -> a -> b
$ Credential -> StakeCredential
forall {kr :: KeyRole}. Credential -> Credential kr
unsafeCredential Credential
stakeCred
      (Credential
cred, Just (StakingPtr Integer
slot Integer
txix Integer
certix)) ->
        Network -> PaymentCredential -> StakeReference -> Addr
Ledger.Addr Network
network (Credential -> PaymentCredential
forall {kr :: KeyRole}. Credential -> Credential kr
unsafeCredential Credential
cred) (StakeReference -> Addr) -> (Ptr -> StakeReference) -> Ptr -> Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr -> StakeReference
Ledger.StakeRefPtr (Ptr -> Addr) -> Ptr -> Addr
forall a b. (a -> b) -> a -> b
$
          SlotNo32 -> TxIx -> CertIx -> Ptr
Ledger.Ptr
            (Integer -> SlotNo32
forall a. Num a => Integer -> a
fromInteger Integer
slot)
            (Word16 -> TxIx
Ledger.TxIx (Word16 -> TxIx) -> Word16 -> TxIx
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a. Num a => Integer -> a
fromInteger Integer
txix)
            (Word16 -> CertIx
Ledger.CertIx (Word16 -> CertIx) -> Word16 -> CertIx
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a. Num a => Integer -> a
fromInteger Integer
certix)
      (Credential
cred, Maybe StakingCredential
Nothing) ->
        Network -> PaymentCredential -> StakeReference -> Addr
Ledger.Addr Network
network (Credential -> PaymentCredential
forall {kr :: KeyRole}. Credential -> Credential kr
unsafeCredential Credential
cred) StakeReference
Ledger.StakeRefNull
 where
  unsafeCredential :: Credential -> Credential kr
unsafeCredential = \case
    PubKeyCredential (Plutus.PubKeyHash BuiltinByteString
h) ->
      KeyHash kr -> Credential kr
forall (kr :: KeyRole). KeyHash kr -> Credential kr
Ledger.KeyHashObj (KeyHash kr -> Credential kr)
-> (ByteString -> KeyHash kr) -> ByteString -> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash kr
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
Ledger.KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash kr)
-> (ByteString -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> ByteString
-> KeyHash kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall hash a.
(HasCallStack, HashAlgorithm hash) =>
ByteString -> Hash hash a
unsafeHashFromBytes (ByteString -> Credential kr) -> ByteString -> Credential kr
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin BuiltinByteString
h
    ScriptCredential (Plutus.ScriptHash BuiltinByteString
h) ->
      ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
Ledger.ScriptHashObj (ScriptHash -> Credential kr)
-> (ByteString -> ScriptHash) -> ByteString -> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
Ledger.ScriptHash (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> (ByteString -> Hash ADDRHASH EraIndependentScript)
-> ByteString
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash ADDRHASH EraIndependentScript
forall hash a.
(HasCallStack, HashAlgorithm hash) =>
ByteString -> Hash hash a
unsafeHashFromBytes (ByteString -> Credential kr) -> ByteString -> Credential kr
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin BuiltinByteString
h

  Plutus.Address{Credential
addressCredential :: Credential
addressCredential :: Address -> Credential
addressCredential, Maybe StakingCredential
addressStakingCredential :: Maybe StakingCredential
addressStakingCredential :: Address -> Maybe StakingCredential
addressStakingCredential} = Address
plutusAddress