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 Cardano.Ledger.Keys 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.
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 StandardCrypto -> AddressInEra era
fromLedgerAddr :: forall era.
IsShelleyBasedEra era =>
Addr StandardCrypto -> AddressInEra era
fromLedgerAddr = ShelleyBasedEra era -> Addr StandardCrypto -> AddressInEra era
forall era.
ShelleyBasedEra era -> Addr StandardCrypto -> 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 StandardCrypto
toLedgerAddr :: forall era. AddressInEra era -> Addr StandardCrypto
toLedgerAddr = \case
  AddressInEra AddressTypeInEra addrtype era
ByronAddressInAnyEra (ByronAddress Address
addr) ->
    BootstrapAddress StandardCrypto -> Addr StandardCrypto
forall c. BootstrapAddress c -> Addr c
Ledger.AddrBootstrap (Address -> BootstrapAddress StandardCrypto
forall c. Address -> BootstrapAddress c
Ledger.BootstrapAddress Address
addr)
  AddressInEra (ShelleyAddressInEra ShelleyBasedEra era
_) (ShelleyAddress Network
ntwrk PaymentCredential StandardCrypto
creds StakeReference StandardCrypto
stake) ->
    Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Addr StandardCrypto
forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Ledger.Addr Network
ntwrk PaymentCredential StandardCrypto
creds StakeReference StandardCrypto
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 StandardCrypto -> AddressInEra era
forall era.
IsShelleyBasedEra era =>
Addr StandardCrypto -> AddressInEra era
fromLedgerAddr (Addr StandardCrypto -> AddressInEra era)
-> Addr StandardCrypto -> AddressInEra era
forall a b. (a -> b) -> a -> b
$
    case (Credential
addressCredential, Maybe StakingCredential
addressStakingCredential) of
      (Credential
cred, Just (StakingHash Credential
stakeCred)) ->
        Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Addr StandardCrypto
forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Ledger.Addr Network
network (Credential -> PaymentCredential StandardCrypto
forall {kr :: KeyRole}. Credential -> Credential kr StandardCrypto
unsafeCredential Credential
cred) (StakeReference StandardCrypto -> Addr StandardCrypto)
-> (StakeCredential StandardCrypto
    -> StakeReference StandardCrypto)
-> StakeCredential StandardCrypto
-> Addr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeCredential StandardCrypto -> StakeReference StandardCrypto
forall c. StakeCredential c -> StakeReference c
Ledger.StakeRefBase (StakeCredential StandardCrypto -> Addr StandardCrypto)
-> StakeCredential StandardCrypto -> Addr StandardCrypto
forall a b. (a -> b) -> a -> b
$ Credential -> StakeCredential StandardCrypto
forall {kr :: KeyRole}. Credential -> Credential kr StandardCrypto
unsafeCredential Credential
stakeCred
      (Credential
cred, Just (StakingPtr Integer
slot Integer
txix Integer
certix)) ->
        Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Addr StandardCrypto
forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Ledger.Addr Network
network (Credential -> PaymentCredential StandardCrypto
forall {kr :: KeyRole}. Credential -> Credential kr StandardCrypto
unsafeCredential Credential
cred) (StakeReference StandardCrypto -> Addr StandardCrypto)
-> (Ptr -> StakeReference StandardCrypto)
-> Ptr
-> Addr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr -> StakeReference StandardCrypto
forall c. Ptr -> StakeReference c
Ledger.StakeRefPtr (Ptr -> Addr StandardCrypto) -> Ptr -> Addr StandardCrypto
forall a b. (a -> b) -> a -> b
$
          SlotNo -> TxIx -> CertIx -> Ptr
Ledger.Ptr
            (Integer -> SlotNo
forall a. Num a => Integer -> a
fromInteger Integer
slot)
            (Word64 -> TxIx
Ledger.TxIx (Word64 -> TxIx) -> Word64 -> TxIx
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
txix)
            (Word64 -> CertIx
Ledger.CertIx (Word64 -> CertIx) -> Word64 -> CertIx
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
certix)
      (Credential
cred, Maybe StakingCredential
Nothing) ->
        Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Addr StandardCrypto
forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Ledger.Addr Network
network (Credential -> PaymentCredential StandardCrypto
forall {kr :: KeyRole}. Credential -> Credential kr StandardCrypto
unsafeCredential Credential
cred) StakeReference StandardCrypto
forall c. StakeReference c
Ledger.StakeRefNull
 where
  unsafeCredential :: Credential -> Credential kr StandardCrypto
unsafeCredential = \case
    PubKeyCredential (Plutus.PubKeyHash BuiltinByteString
h) ->
      KeyHash kr StandardCrypto -> Credential kr StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
Ledger.KeyHashObj (KeyHash kr StandardCrypto -> Credential kr StandardCrypto)
-> (ByteString -> KeyHash kr StandardCrypto)
-> ByteString
-> Credential kr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash kr StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Ledger.KeyHash (Hash
   (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
 -> KeyHash kr StandardCrypto)
-> (ByteString
    -> Hash
         (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto)))
-> ByteString
-> KeyHash kr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Hash
     (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
forall hash a.
(HasCallStack, HashAlgorithm hash) =>
ByteString -> Hash hash a
unsafeHashFromBytes (ByteString -> Credential kr StandardCrypto)
-> ByteString -> Credential kr StandardCrypto
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 StandardCrypto -> Credential kr StandardCrypto
forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
Ledger.ScriptHashObj (ScriptHash StandardCrypto -> Credential kr StandardCrypto)
-> (ByteString -> ScriptHash StandardCrypto)
-> ByteString
-> Credential kr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (ADDRHASH StandardCrypto) EraIndependentScript
-> ScriptHash StandardCrypto
forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
Ledger.ScriptHash (Hash (ADDRHASH StandardCrypto) EraIndependentScript
 -> ScriptHash StandardCrypto)
-> (ByteString
    -> Hash (ADDRHASH StandardCrypto) EraIndependentScript)
-> ByteString
-> ScriptHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash (ADDRHASH StandardCrypto) EraIndependentScript
forall hash a.
(HasCallStack, HashAlgorithm hash) =>
ByteString -> Hash hash a
unsafeHashFromBytes (ByteString -> Credential kr StandardCrypto)
-> ByteString -> Credential kr StandardCrypto
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