{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ledger.Address
    ( module Export
    , CardanoAddress
    , PaymentPrivateKey(..)
    , PaymentPubKey(..)
    , PaymentPubKeyHash(..)
    , StakePubKey(..)
    , StakePubKeyHash(..)
    , toPlutusAddress
    , toPlutusPubKeyHash
    , cardanoAddressCredential
    , cardanoPubKeyHash
    , cardanoStakingCredential
    , paymentPubKeyHash
    , pubKeyHashAddress
    , pubKeyAddress
    , scriptValidatorHashAddress
    , stakePubKeyHashCredential
    , stakeValidatorHashCredential
    , xprvToPaymentPubKey
    , xprvToPaymentPubKeyHash
    , xprvToStakingCredential
    , xprvToStakePubKey
    , xprvToStakePubKeyHash
    , mkValidatorCardanoAddress
    ) where

import Cardano.Api qualified as C
import Cardano.Api.Byron qualified as C
import Cardano.Api.Shelley qualified as C
import Cardano.Chain.Common (addrToBase58)
import Cardano.Crypto.Wallet qualified as Crypto
import Codec.Serialise (Serialise)
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Ledger.Address.Orphans as Export ()
import Ledger.Crypto (PubKey (PubKey), PubKeyHash (PubKeyHash), pubKeyHash, toPublicKey)
import Ledger.Orphans ()
import Ledger.Scripts (Language (..), StakeValidatorHash (..), Validator, ValidatorHash (..), Versioned (..))
import Plutus.Script.Utils.V1.Address qualified as PV1
import Plutus.Script.Utils.V2.Address qualified as PV2
import Plutus.V1.Ledger.Address as Export hiding (pubKeyHashAddress)
import Plutus.V1.Ledger.Credential (Credential (PubKeyCredential, ScriptCredential), StakingCredential (StakingHash))
import PlutusTx qualified
import PlutusTx.Lift (makeLift)
import PlutusTx.Prelude qualified as PlutusTx
import Prettyprinter (Pretty)

type CardanoAddress = C.AddressInEra C.BabbageEra

instance ToJSONKey (C.AddressInEra C.BabbageEra)
instance FromJSONKey (C.AddressInEra C.BabbageEra)

cardanoAddressCredential :: C.AddressInEra era -> Credential
cardanoAddressCredential :: AddressInEra era -> Credential
cardanoAddressCredential (C.AddressInEra AddressTypeInEra addrtype era
C.ByronAddressInAnyEra (C.ByronAddress Address
address))
  = PubKeyHash -> Credential
PubKeyCredential
  (PubKeyHash -> Credential) -> PubKeyHash -> Credential
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> PubKeyHash
PubKeyHash
  (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin
  (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Address -> ByteString
addrToBase58 Address
address
cardanoAddressCredential (C.AddressInEra AddressTypeInEra addrtype era
_ (C.ShelleyAddress Network
_ PaymentCredential StandardCrypto
paymentCredential StakeReference StandardCrypto
_))
  = case PaymentCredential StandardCrypto -> PaymentCredential
C.fromShelleyPaymentCredential PaymentCredential StandardCrypto
paymentCredential of
      C.PaymentCredentialByKey Hash PaymentKey
paymentKeyHash ->
          PubKeyHash -> Credential
PubKeyCredential
          (PubKeyHash -> Credential) -> PubKeyHash -> Credential
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> PubKeyHash
PubKeyHash
          (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin
          (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes Hash PaymentKey
paymentKeyHash
      C.PaymentCredentialByScript ScriptHash
scriptHash ->
          ValidatorHash -> Credential
ScriptCredential (ValidatorHash -> Credential) -> ValidatorHash -> Credential
forall a b. (a -> b) -> a -> b
$ ScriptHash -> ValidatorHash
scriptToValidatorHash ScriptHash
scriptHash

cardanoStakingCredential :: C.AddressInEra era -> Maybe StakingCredential
cardanoStakingCredential :: AddressInEra era -> Maybe StakingCredential
cardanoStakingCredential (C.AddressInEra AddressTypeInEra addrtype era
C.ByronAddressInAnyEra Address addrtype
_) = Maybe StakingCredential
forall a. Maybe a
Nothing
cardanoStakingCredential (C.AddressInEra AddressTypeInEra addrtype era
_ (C.ShelleyAddress Network
_ PaymentCredential StandardCrypto
_ StakeReference StandardCrypto
stakeAddressReference))
  = case StakeReference StandardCrypto -> StakeAddressReference
C.fromShelleyStakeReference StakeReference StandardCrypto
stakeAddressReference of
         StakeAddressReference
C.NoStakeAddress -> Maybe StakingCredential
forall a. Maybe a
Nothing
         (C.StakeAddressByValue StakeCredential
stakeCredential) ->
             StakingCredential -> Maybe StakingCredential
forall a. a -> Maybe a
Just (Credential -> StakingCredential
StakingHash (Credential -> StakingCredential)
-> Credential -> StakingCredential
forall a b. (a -> b) -> a -> b
$ StakeCredential -> Credential
fromCardanoStakeCredential StakeCredential
stakeCredential)
         C.StakeAddressByPointer{} -> Maybe StakingCredential
forall a. Maybe a
Nothing -- Not supported
  where
    fromCardanoStakeCredential :: C.StakeCredential -> Credential
    fromCardanoStakeCredential :: StakeCredential -> Credential
fromCardanoStakeCredential (C.StakeCredentialByKey Hash StakeKey
stakeKeyHash)
      = PubKeyHash -> Credential
PubKeyCredential
      (PubKeyHash -> Credential) -> PubKeyHash -> Credential
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> PubKeyHash
PubKeyHash
      (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin
      (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes Hash StakeKey
stakeKeyHash
    fromCardanoStakeCredential (C.StakeCredentialByScript ScriptHash
scriptHash) = ValidatorHash -> Credential
ScriptCredential (ScriptHash -> ValidatorHash
scriptToValidatorHash ScriptHash
scriptHash)

cardanoPubKeyHash :: C.AddressInEra era -> Maybe PubKeyHash
cardanoPubKeyHash :: AddressInEra era -> Maybe PubKeyHash
cardanoPubKeyHash AddressInEra era
addr = case AddressInEra era -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential AddressInEra era
addr of
  PubKeyCredential PubKeyHash
x -> PubKeyHash -> Maybe PubKeyHash
forall a. a -> Maybe a
Just PubKeyHash
x
  Credential
_                  -> Maybe PubKeyHash
forall a. Maybe a
Nothing

toPlutusAddress :: C.AddressInEra era -> Address
toPlutusAddress :: AddressInEra era -> Address
toPlutusAddress AddressInEra era
address = Credential -> Maybe StakingCredential -> Address
Address (AddressInEra era -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential AddressInEra era
address) (AddressInEra era -> Maybe StakingCredential
forall era. AddressInEra era -> Maybe StakingCredential
cardanoStakingCredential AddressInEra era
address)

toPlutusPubKeyHash :: C.Hash C.PaymentKey -> PubKeyHash
toPlutusPubKeyHash :: Hash PaymentKey -> PubKeyHash
toPlutusPubKeyHash Hash PaymentKey
paymentKeyHash = BuiltinByteString -> PubKeyHash
PubKeyHash (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes Hash PaymentKey
paymentKeyHash

scriptToValidatorHash :: C.ScriptHash -> ValidatorHash
scriptToValidatorHash :: ScriptHash -> ValidatorHash
scriptToValidatorHash = BuiltinByteString -> ValidatorHash
ValidatorHash (BuiltinByteString -> ValidatorHash)
-> (ScriptHash -> BuiltinByteString) -> ScriptHash -> ValidatorHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> (ScriptHash -> ByteString) -> ScriptHash -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes

newtype PaymentPrivateKey = PaymentPrivateKey { PaymentPrivateKey -> XPrv
unPaymentPrivateKey :: Crypto.XPrv }

newtype PaymentPubKey = PaymentPubKey { PaymentPubKey -> PubKey
unPaymentPubKey :: PubKey }
    deriving stock (PaymentPubKey -> PaymentPubKey -> Bool
(PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> Bool) -> Eq PaymentPubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaymentPubKey -> PaymentPubKey -> Bool
$c/= :: PaymentPubKey -> PaymentPubKey -> Bool
== :: PaymentPubKey -> PaymentPubKey -> Bool
$c== :: PaymentPubKey -> PaymentPubKey -> Bool
Eq, Eq PaymentPubKey
Eq PaymentPubKey
-> (PaymentPubKey -> PaymentPubKey -> Ordering)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> PaymentPubKey)
-> (PaymentPubKey -> PaymentPubKey -> PaymentPubKey)
-> Ord PaymentPubKey
PaymentPubKey -> PaymentPubKey -> Bool
PaymentPubKey -> PaymentPubKey -> Ordering
PaymentPubKey -> PaymentPubKey -> PaymentPubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
$cmin :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
max :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
$cmax :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
>= :: PaymentPubKey -> PaymentPubKey -> Bool
$c>= :: PaymentPubKey -> PaymentPubKey -> Bool
> :: PaymentPubKey -> PaymentPubKey -> Bool
$c> :: PaymentPubKey -> PaymentPubKey -> Bool
<= :: PaymentPubKey -> PaymentPubKey -> Bool
$c<= :: PaymentPubKey -> PaymentPubKey -> Bool
< :: PaymentPubKey -> PaymentPubKey -> Bool
$c< :: PaymentPubKey -> PaymentPubKey -> Bool
compare :: PaymentPubKey -> PaymentPubKey -> Ordering
$ccompare :: PaymentPubKey -> PaymentPubKey -> Ordering
$cp1Ord :: Eq PaymentPubKey
Ord, (forall x. PaymentPubKey -> Rep PaymentPubKey x)
-> (forall x. Rep PaymentPubKey x -> PaymentPubKey)
-> Generic PaymentPubKey
forall x. Rep PaymentPubKey x -> PaymentPubKey
forall x. PaymentPubKey -> Rep PaymentPubKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PaymentPubKey x -> PaymentPubKey
$cfrom :: forall x. PaymentPubKey -> Rep PaymentPubKey x
Generic)
    deriving anyclass ([PaymentPubKey] -> Encoding
[PaymentPubKey] -> Value
PaymentPubKey -> Encoding
PaymentPubKey -> Value
(PaymentPubKey -> Value)
-> (PaymentPubKey -> Encoding)
-> ([PaymentPubKey] -> Value)
-> ([PaymentPubKey] -> Encoding)
-> ToJSON PaymentPubKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PaymentPubKey] -> Encoding
$ctoEncodingList :: [PaymentPubKey] -> Encoding
toJSONList :: [PaymentPubKey] -> Value
$ctoJSONList :: [PaymentPubKey] -> Value
toEncoding :: PaymentPubKey -> Encoding
$ctoEncoding :: PaymentPubKey -> Encoding
toJSON :: PaymentPubKey -> Value
$ctoJSON :: PaymentPubKey -> Value
ToJSON, Value -> Parser [PaymentPubKey]
Value -> Parser PaymentPubKey
(Value -> Parser PaymentPubKey)
-> (Value -> Parser [PaymentPubKey]) -> FromJSON PaymentPubKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PaymentPubKey]
$cparseJSONList :: Value -> Parser [PaymentPubKey]
parseJSON :: Value -> Parser PaymentPubKey
$cparseJSON :: Value -> Parser PaymentPubKey
FromJSON, ToJSONKeyFunction [PaymentPubKey]
ToJSONKeyFunction PaymentPubKey
ToJSONKeyFunction PaymentPubKey
-> ToJSONKeyFunction [PaymentPubKey] -> ToJSONKey PaymentPubKey
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PaymentPubKey]
$ctoJSONKeyList :: ToJSONKeyFunction [PaymentPubKey]
toJSONKey :: ToJSONKeyFunction PaymentPubKey
$ctoJSONKey :: ToJSONKeyFunction PaymentPubKey
ToJSONKey, FromJSONKeyFunction [PaymentPubKey]
FromJSONKeyFunction PaymentPubKey
FromJSONKeyFunction PaymentPubKey
-> FromJSONKeyFunction [PaymentPubKey] -> FromJSONKey PaymentPubKey
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PaymentPubKey]
$cfromJSONKeyList :: FromJSONKeyFunction [PaymentPubKey]
fromJSONKey :: FromJSONKeyFunction PaymentPubKey
$cfromJSONKey :: FromJSONKeyFunction PaymentPubKey
FromJSONKey)
    deriving newtype (PaymentPubKey -> PaymentPubKey -> Bool
(PaymentPubKey -> PaymentPubKey -> Bool) -> Eq PaymentPubKey
forall a. (a -> a -> Bool) -> Eq a
== :: PaymentPubKey -> PaymentPubKey -> Bool
$c== :: PaymentPubKey -> PaymentPubKey -> Bool
PlutusTx.Eq, Eq PaymentPubKey
Eq PaymentPubKey
-> (PaymentPubKey -> PaymentPubKey -> Ordering)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> Bool)
-> (PaymentPubKey -> PaymentPubKey -> PaymentPubKey)
-> (PaymentPubKey -> PaymentPubKey -> PaymentPubKey)
-> Ord PaymentPubKey
PaymentPubKey -> PaymentPubKey -> Bool
PaymentPubKey -> PaymentPubKey -> Ordering
PaymentPubKey -> PaymentPubKey -> PaymentPubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
$cmin :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
max :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
$cmax :: PaymentPubKey -> PaymentPubKey -> PaymentPubKey
>= :: PaymentPubKey -> PaymentPubKey -> Bool
$c>= :: PaymentPubKey -> PaymentPubKey -> Bool
> :: PaymentPubKey -> PaymentPubKey -> Bool
$c> :: PaymentPubKey -> PaymentPubKey -> Bool
<= :: PaymentPubKey -> PaymentPubKey -> Bool
$c<= :: PaymentPubKey -> PaymentPubKey -> Bool
< :: PaymentPubKey -> PaymentPubKey -> Bool
$c< :: PaymentPubKey -> PaymentPubKey -> Bool
compare :: PaymentPubKey -> PaymentPubKey -> Ordering
$ccompare :: PaymentPubKey -> PaymentPubKey -> Ordering
$cp1Ord :: Eq PaymentPubKey
PlutusTx.Ord, Decoder s PaymentPubKey
Decoder s [PaymentPubKey]
[PaymentPubKey] -> Encoding
PaymentPubKey -> Encoding
(PaymentPubKey -> Encoding)
-> (forall s. Decoder s PaymentPubKey)
-> ([PaymentPubKey] -> Encoding)
-> (forall s. Decoder s [PaymentPubKey])
-> Serialise PaymentPubKey
forall s. Decoder s [PaymentPubKey]
forall s. Decoder s PaymentPubKey
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [PaymentPubKey]
$cdecodeList :: forall s. Decoder s [PaymentPubKey]
encodeList :: [PaymentPubKey] -> Encoding
$cencodeList :: [PaymentPubKey] -> Encoding
decode :: Decoder s PaymentPubKey
$cdecode :: forall s. Decoder s PaymentPubKey
encode :: PaymentPubKey -> Encoding
$cencode :: PaymentPubKey -> Encoding
Serialise, PaymentPubKey -> BuiltinData
(PaymentPubKey -> BuiltinData) -> ToData PaymentPubKey
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: PaymentPubKey -> BuiltinData
$ctoBuiltinData :: PaymentPubKey -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe PaymentPubKey
(BuiltinData -> Maybe PaymentPubKey) -> FromData PaymentPubKey
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe PaymentPubKey
$cfromBuiltinData :: BuiltinData -> Maybe PaymentPubKey
PlutusTx.FromData, BuiltinData -> PaymentPubKey
(BuiltinData -> PaymentPubKey) -> UnsafeFromData PaymentPubKey
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> PaymentPubKey
$cunsafeFromBuiltinData :: BuiltinData -> PaymentPubKey
PlutusTx.UnsafeFromData)
    deriving (Int -> PaymentPubKey -> ShowS
[PaymentPubKey] -> ShowS
PaymentPubKey -> String
(Int -> PaymentPubKey -> ShowS)
-> (PaymentPubKey -> String)
-> ([PaymentPubKey] -> ShowS)
-> Show PaymentPubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaymentPubKey] -> ShowS
$cshowList :: [PaymentPubKey] -> ShowS
show :: PaymentPubKey -> String
$cshow :: PaymentPubKey -> String
showsPrec :: Int -> PaymentPubKey -> ShowS
$cshowsPrec :: Int -> PaymentPubKey -> ShowS
Show, [PaymentPubKey] -> Doc ann
PaymentPubKey -> Doc ann
(forall ann. PaymentPubKey -> Doc ann)
-> (forall ann. [PaymentPubKey] -> Doc ann) -> Pretty PaymentPubKey
forall ann. [PaymentPubKey] -> Doc ann
forall ann. PaymentPubKey -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [PaymentPubKey] -> Doc ann
$cprettyList :: forall ann. [PaymentPubKey] -> Doc ann
pretty :: PaymentPubKey -> Doc ann
$cpretty :: forall ann. PaymentPubKey -> Doc ann
Pretty) via PubKey
makeLift ''PaymentPubKey

xprvToPaymentPubKey :: Crypto.XPrv -> PaymentPubKey
xprvToPaymentPubKey :: XPrv -> PaymentPubKey
xprvToPaymentPubKey = PubKey -> PaymentPubKey
PaymentPubKey (PubKey -> PaymentPubKey)
-> (XPrv -> PubKey) -> XPrv -> PaymentPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> PubKey
toPublicKey

newtype PaymentPubKeyHash = PaymentPubKeyHash { PaymentPubKeyHash -> PubKeyHash
unPaymentPubKeyHash :: PubKeyHash }
    deriving stock (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
(PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> Eq PaymentPubKeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c/= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
== :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c== :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
Eq, Eq PaymentPubKeyHash
Eq PaymentPubKeyHash
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash)
-> Ord PaymentPubKeyHash
PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering
PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
$cmin :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
max :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
$cmax :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
>= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c>= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
> :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c> :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
<= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c<= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
< :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c< :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
compare :: PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering
$ccompare :: PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering
$cp1Ord :: Eq PaymentPubKeyHash
Ord, (forall x. PaymentPubKeyHash -> Rep PaymentPubKeyHash x)
-> (forall x. Rep PaymentPubKeyHash x -> PaymentPubKeyHash)
-> Generic PaymentPubKeyHash
forall x. Rep PaymentPubKeyHash x -> PaymentPubKeyHash
forall x. PaymentPubKeyHash -> Rep PaymentPubKeyHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PaymentPubKeyHash x -> PaymentPubKeyHash
$cfrom :: forall x. PaymentPubKeyHash -> Rep PaymentPubKeyHash x
Generic)
    deriving anyclass ([PaymentPubKeyHash] -> Encoding
[PaymentPubKeyHash] -> Value
PaymentPubKeyHash -> Encoding
PaymentPubKeyHash -> Value
(PaymentPubKeyHash -> Value)
-> (PaymentPubKeyHash -> Encoding)
-> ([PaymentPubKeyHash] -> Value)
-> ([PaymentPubKeyHash] -> Encoding)
-> ToJSON PaymentPubKeyHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PaymentPubKeyHash] -> Encoding
$ctoEncodingList :: [PaymentPubKeyHash] -> Encoding
toJSONList :: [PaymentPubKeyHash] -> Value
$ctoJSONList :: [PaymentPubKeyHash] -> Value
toEncoding :: PaymentPubKeyHash -> Encoding
$ctoEncoding :: PaymentPubKeyHash -> Encoding
toJSON :: PaymentPubKeyHash -> Value
$ctoJSON :: PaymentPubKeyHash -> Value
ToJSON, Value -> Parser [PaymentPubKeyHash]
Value -> Parser PaymentPubKeyHash
(Value -> Parser PaymentPubKeyHash)
-> (Value -> Parser [PaymentPubKeyHash])
-> FromJSON PaymentPubKeyHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PaymentPubKeyHash]
$cparseJSONList :: Value -> Parser [PaymentPubKeyHash]
parseJSON :: Value -> Parser PaymentPubKeyHash
$cparseJSON :: Value -> Parser PaymentPubKeyHash
FromJSON, ToJSONKeyFunction [PaymentPubKeyHash]
ToJSONKeyFunction PaymentPubKeyHash
ToJSONKeyFunction PaymentPubKeyHash
-> ToJSONKeyFunction [PaymentPubKeyHash]
-> ToJSONKey PaymentPubKeyHash
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PaymentPubKeyHash]
$ctoJSONKeyList :: ToJSONKeyFunction [PaymentPubKeyHash]
toJSONKey :: ToJSONKeyFunction PaymentPubKeyHash
$ctoJSONKey :: ToJSONKeyFunction PaymentPubKeyHash
ToJSONKey, FromJSONKeyFunction [PaymentPubKeyHash]
FromJSONKeyFunction PaymentPubKeyHash
FromJSONKeyFunction PaymentPubKeyHash
-> FromJSONKeyFunction [PaymentPubKeyHash]
-> FromJSONKey PaymentPubKeyHash
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PaymentPubKeyHash]
$cfromJSONKeyList :: FromJSONKeyFunction [PaymentPubKeyHash]
fromJSONKey :: FromJSONKeyFunction PaymentPubKeyHash
$cfromJSONKey :: FromJSONKeyFunction PaymentPubKeyHash
FromJSONKey)
    deriving newtype (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
(PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> Eq PaymentPubKeyHash
forall a. (a -> a -> Bool) -> Eq a
== :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c== :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
PlutusTx.Eq, Eq PaymentPubKeyHash
Eq PaymentPubKeyHash
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> Bool)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash)
-> (PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash)
-> Ord PaymentPubKeyHash
PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering
PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
$cmin :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
max :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
$cmax :: PaymentPubKeyHash -> PaymentPubKeyHash -> PaymentPubKeyHash
>= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c>= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
> :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c> :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
<= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c<= :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
< :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
$c< :: PaymentPubKeyHash -> PaymentPubKeyHash -> Bool
compare :: PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering
$ccompare :: PaymentPubKeyHash -> PaymentPubKeyHash -> Ordering
$cp1Ord :: Eq PaymentPubKeyHash
PlutusTx.Ord, Decoder s PaymentPubKeyHash
Decoder s [PaymentPubKeyHash]
[PaymentPubKeyHash] -> Encoding
PaymentPubKeyHash -> Encoding
(PaymentPubKeyHash -> Encoding)
-> (forall s. Decoder s PaymentPubKeyHash)
-> ([PaymentPubKeyHash] -> Encoding)
-> (forall s. Decoder s [PaymentPubKeyHash])
-> Serialise PaymentPubKeyHash
forall s. Decoder s [PaymentPubKeyHash]
forall s. Decoder s PaymentPubKeyHash
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [PaymentPubKeyHash]
$cdecodeList :: forall s. Decoder s [PaymentPubKeyHash]
encodeList :: [PaymentPubKeyHash] -> Encoding
$cencodeList :: [PaymentPubKeyHash] -> Encoding
decode :: Decoder s PaymentPubKeyHash
$cdecode :: forall s. Decoder s PaymentPubKeyHash
encode :: PaymentPubKeyHash -> Encoding
$cencode :: PaymentPubKeyHash -> Encoding
Serialise, Int -> PaymentPubKeyHash -> Int
PaymentPubKeyHash -> Int
(Int -> PaymentPubKeyHash -> Int)
-> (PaymentPubKeyHash -> Int) -> Hashable PaymentPubKeyHash
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PaymentPubKeyHash -> Int
$chash :: PaymentPubKeyHash -> Int
hashWithSalt :: Int -> PaymentPubKeyHash -> Int
$chashWithSalt :: Int -> PaymentPubKeyHash -> Int
Hashable, PaymentPubKeyHash -> BuiltinData
(PaymentPubKeyHash -> BuiltinData) -> ToData PaymentPubKeyHash
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: PaymentPubKeyHash -> BuiltinData
$ctoBuiltinData :: PaymentPubKeyHash -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe PaymentPubKeyHash
(BuiltinData -> Maybe PaymentPubKeyHash)
-> FromData PaymentPubKeyHash
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe PaymentPubKeyHash
$cfromBuiltinData :: BuiltinData -> Maybe PaymentPubKeyHash
PlutusTx.FromData, BuiltinData -> PaymentPubKeyHash
(BuiltinData -> PaymentPubKeyHash)
-> UnsafeFromData PaymentPubKeyHash
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> PaymentPubKeyHash
$cunsafeFromBuiltinData :: BuiltinData -> PaymentPubKeyHash
PlutusTx.UnsafeFromData)
    deriving (Int -> PaymentPubKeyHash -> ShowS
[PaymentPubKeyHash] -> ShowS
PaymentPubKeyHash -> String
(Int -> PaymentPubKeyHash -> ShowS)
-> (PaymentPubKeyHash -> String)
-> ([PaymentPubKeyHash] -> ShowS)
-> Show PaymentPubKeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaymentPubKeyHash] -> ShowS
$cshowList :: [PaymentPubKeyHash] -> ShowS
show :: PaymentPubKeyHash -> String
$cshow :: PaymentPubKeyHash -> String
showsPrec :: Int -> PaymentPubKeyHash -> ShowS
$cshowsPrec :: Int -> PaymentPubKeyHash -> ShowS
Show, [PaymentPubKeyHash] -> Doc ann
PaymentPubKeyHash -> Doc ann
(forall ann. PaymentPubKeyHash -> Doc ann)
-> (forall ann. [PaymentPubKeyHash] -> Doc ann)
-> Pretty PaymentPubKeyHash
forall ann. [PaymentPubKeyHash] -> Doc ann
forall ann. PaymentPubKeyHash -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [PaymentPubKeyHash] -> Doc ann
$cprettyList :: forall ann. [PaymentPubKeyHash] -> Doc ann
pretty :: PaymentPubKeyHash -> Doc ann
$cpretty :: forall ann. PaymentPubKeyHash -> Doc ann
Pretty) via PubKeyHash
makeLift ''PaymentPubKeyHash

xprvToPaymentPubKeyHash :: Crypto.XPrv -> PaymentPubKeyHash
xprvToPaymentPubKeyHash :: XPrv -> PaymentPubKeyHash
xprvToPaymentPubKeyHash = PubKeyHash -> PaymentPubKeyHash
PaymentPubKeyHash (PubKeyHash -> PaymentPubKeyHash)
-> (XPrv -> PubKeyHash) -> XPrv -> PaymentPubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> PubKeyHash
pubKeyHash (PubKey -> PubKeyHash) -> (XPrv -> PubKey) -> XPrv -> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> PubKey
toPublicKey

newtype StakePubKey = StakePubKey { StakePubKey -> PubKey
unStakePubKey :: PubKey }
    deriving stock (StakePubKey -> StakePubKey -> Bool
(StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> Bool) -> Eq StakePubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePubKey -> StakePubKey -> Bool
$c/= :: StakePubKey -> StakePubKey -> Bool
== :: StakePubKey -> StakePubKey -> Bool
$c== :: StakePubKey -> StakePubKey -> Bool
Eq, Eq StakePubKey
Eq StakePubKey
-> (StakePubKey -> StakePubKey -> Ordering)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> StakePubKey)
-> (StakePubKey -> StakePubKey -> StakePubKey)
-> Ord StakePubKey
StakePubKey -> StakePubKey -> Bool
StakePubKey -> StakePubKey -> Ordering
StakePubKey -> StakePubKey -> StakePubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StakePubKey -> StakePubKey -> StakePubKey
$cmin :: StakePubKey -> StakePubKey -> StakePubKey
max :: StakePubKey -> StakePubKey -> StakePubKey
$cmax :: StakePubKey -> StakePubKey -> StakePubKey
>= :: StakePubKey -> StakePubKey -> Bool
$c>= :: StakePubKey -> StakePubKey -> Bool
> :: StakePubKey -> StakePubKey -> Bool
$c> :: StakePubKey -> StakePubKey -> Bool
<= :: StakePubKey -> StakePubKey -> Bool
$c<= :: StakePubKey -> StakePubKey -> Bool
< :: StakePubKey -> StakePubKey -> Bool
$c< :: StakePubKey -> StakePubKey -> Bool
compare :: StakePubKey -> StakePubKey -> Ordering
$ccompare :: StakePubKey -> StakePubKey -> Ordering
$cp1Ord :: Eq StakePubKey
Ord, (forall x. StakePubKey -> Rep StakePubKey x)
-> (forall x. Rep StakePubKey x -> StakePubKey)
-> Generic StakePubKey
forall x. Rep StakePubKey x -> StakePubKey
forall x. StakePubKey -> Rep StakePubKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StakePubKey x -> StakePubKey
$cfrom :: forall x. StakePubKey -> Rep StakePubKey x
Generic)
    deriving anyclass ([StakePubKey] -> Encoding
[StakePubKey] -> Value
StakePubKey -> Encoding
StakePubKey -> Value
(StakePubKey -> Value)
-> (StakePubKey -> Encoding)
-> ([StakePubKey] -> Value)
-> ([StakePubKey] -> Encoding)
-> ToJSON StakePubKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StakePubKey] -> Encoding
$ctoEncodingList :: [StakePubKey] -> Encoding
toJSONList :: [StakePubKey] -> Value
$ctoJSONList :: [StakePubKey] -> Value
toEncoding :: StakePubKey -> Encoding
$ctoEncoding :: StakePubKey -> Encoding
toJSON :: StakePubKey -> Value
$ctoJSON :: StakePubKey -> Value
ToJSON, Value -> Parser [StakePubKey]
Value -> Parser StakePubKey
(Value -> Parser StakePubKey)
-> (Value -> Parser [StakePubKey]) -> FromJSON StakePubKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StakePubKey]
$cparseJSONList :: Value -> Parser [StakePubKey]
parseJSON :: Value -> Parser StakePubKey
$cparseJSON :: Value -> Parser StakePubKey
FromJSON, ToJSONKeyFunction [StakePubKey]
ToJSONKeyFunction StakePubKey
ToJSONKeyFunction StakePubKey
-> ToJSONKeyFunction [StakePubKey] -> ToJSONKey StakePubKey
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [StakePubKey]
$ctoJSONKeyList :: ToJSONKeyFunction [StakePubKey]
toJSONKey :: ToJSONKeyFunction StakePubKey
$ctoJSONKey :: ToJSONKeyFunction StakePubKey
ToJSONKey, FromJSONKeyFunction [StakePubKey]
FromJSONKeyFunction StakePubKey
FromJSONKeyFunction StakePubKey
-> FromJSONKeyFunction [StakePubKey] -> FromJSONKey StakePubKey
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [StakePubKey]
$cfromJSONKeyList :: FromJSONKeyFunction [StakePubKey]
fromJSONKey :: FromJSONKeyFunction StakePubKey
$cfromJSONKey :: FromJSONKeyFunction StakePubKey
FromJSONKey)
    deriving newtype (StakePubKey -> StakePubKey -> Bool
(StakePubKey -> StakePubKey -> Bool) -> Eq StakePubKey
forall a. (a -> a -> Bool) -> Eq a
== :: StakePubKey -> StakePubKey -> Bool
$c== :: StakePubKey -> StakePubKey -> Bool
PlutusTx.Eq, Eq StakePubKey
Eq StakePubKey
-> (StakePubKey -> StakePubKey -> Ordering)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> Bool)
-> (StakePubKey -> StakePubKey -> StakePubKey)
-> (StakePubKey -> StakePubKey -> StakePubKey)
-> Ord StakePubKey
StakePubKey -> StakePubKey -> Bool
StakePubKey -> StakePubKey -> Ordering
StakePubKey -> StakePubKey -> StakePubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StakePubKey -> StakePubKey -> StakePubKey
$cmin :: StakePubKey -> StakePubKey -> StakePubKey
max :: StakePubKey -> StakePubKey -> StakePubKey
$cmax :: StakePubKey -> StakePubKey -> StakePubKey
>= :: StakePubKey -> StakePubKey -> Bool
$c>= :: StakePubKey -> StakePubKey -> Bool
> :: StakePubKey -> StakePubKey -> Bool
$c> :: StakePubKey -> StakePubKey -> Bool
<= :: StakePubKey -> StakePubKey -> Bool
$c<= :: StakePubKey -> StakePubKey -> Bool
< :: StakePubKey -> StakePubKey -> Bool
$c< :: StakePubKey -> StakePubKey -> Bool
compare :: StakePubKey -> StakePubKey -> Ordering
$ccompare :: StakePubKey -> StakePubKey -> Ordering
$cp1Ord :: Eq StakePubKey
PlutusTx.Ord, Decoder s StakePubKey
Decoder s [StakePubKey]
[StakePubKey] -> Encoding
StakePubKey -> Encoding
(StakePubKey -> Encoding)
-> (forall s. Decoder s StakePubKey)
-> ([StakePubKey] -> Encoding)
-> (forall s. Decoder s [StakePubKey])
-> Serialise StakePubKey
forall s. Decoder s [StakePubKey]
forall s. Decoder s StakePubKey
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [StakePubKey]
$cdecodeList :: forall s. Decoder s [StakePubKey]
encodeList :: [StakePubKey] -> Encoding
$cencodeList :: [StakePubKey] -> Encoding
decode :: Decoder s StakePubKey
$cdecode :: forall s. Decoder s StakePubKey
encode :: StakePubKey -> Encoding
$cencode :: StakePubKey -> Encoding
Serialise, StakePubKey -> BuiltinData
(StakePubKey -> BuiltinData) -> ToData StakePubKey
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: StakePubKey -> BuiltinData
$ctoBuiltinData :: StakePubKey -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe StakePubKey
(BuiltinData -> Maybe StakePubKey) -> FromData StakePubKey
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe StakePubKey
$cfromBuiltinData :: BuiltinData -> Maybe StakePubKey
PlutusTx.FromData, BuiltinData -> StakePubKey
(BuiltinData -> StakePubKey) -> UnsafeFromData StakePubKey
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> StakePubKey
$cunsafeFromBuiltinData :: BuiltinData -> StakePubKey
PlutusTx.UnsafeFromData)
    deriving (Int -> StakePubKey -> ShowS
[StakePubKey] -> ShowS
StakePubKey -> String
(Int -> StakePubKey -> ShowS)
-> (StakePubKey -> String)
-> ([StakePubKey] -> ShowS)
-> Show StakePubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePubKey] -> ShowS
$cshowList :: [StakePubKey] -> ShowS
show :: StakePubKey -> String
$cshow :: StakePubKey -> String
showsPrec :: Int -> StakePubKey -> ShowS
$cshowsPrec :: Int -> StakePubKey -> ShowS
Show, [StakePubKey] -> Doc ann
StakePubKey -> Doc ann
(forall ann. StakePubKey -> Doc ann)
-> (forall ann. [StakePubKey] -> Doc ann) -> Pretty StakePubKey
forall ann. [StakePubKey] -> Doc ann
forall ann. StakePubKey -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [StakePubKey] -> Doc ann
$cprettyList :: forall ann. [StakePubKey] -> Doc ann
pretty :: StakePubKey -> Doc ann
$cpretty :: forall ann. StakePubKey -> Doc ann
Pretty) via PubKey
makeLift ''StakePubKey

xprvToStakePubKey :: Crypto.XPrv -> StakePubKey
xprvToStakePubKey :: XPrv -> StakePubKey
xprvToStakePubKey = PubKey -> StakePubKey
StakePubKey (PubKey -> StakePubKey) -> (XPrv -> PubKey) -> XPrv -> StakePubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> PubKey
toPublicKey

newtype StakePubKeyHash = StakePubKeyHash { StakePubKeyHash -> PubKeyHash
unStakePubKeyHash :: PubKeyHash }
    deriving stock (StakePubKeyHash -> StakePubKeyHash -> Bool
(StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> Eq StakePubKeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c/= :: StakePubKeyHash -> StakePubKeyHash -> Bool
== :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c== :: StakePubKeyHash -> StakePubKeyHash -> Bool
Eq, Eq StakePubKeyHash
Eq StakePubKeyHash
-> (StakePubKeyHash -> StakePubKeyHash -> Ordering)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash)
-> (StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash)
-> Ord StakePubKeyHash
StakePubKeyHash -> StakePubKeyHash -> Bool
StakePubKeyHash -> StakePubKeyHash -> Ordering
StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
$cmin :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
max :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
$cmax :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
>= :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c>= :: StakePubKeyHash -> StakePubKeyHash -> Bool
> :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c> :: StakePubKeyHash -> StakePubKeyHash -> Bool
<= :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c<= :: StakePubKeyHash -> StakePubKeyHash -> Bool
< :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c< :: StakePubKeyHash -> StakePubKeyHash -> Bool
compare :: StakePubKeyHash -> StakePubKeyHash -> Ordering
$ccompare :: StakePubKeyHash -> StakePubKeyHash -> Ordering
$cp1Ord :: Eq StakePubKeyHash
Ord, (forall x. StakePubKeyHash -> Rep StakePubKeyHash x)
-> (forall x. Rep StakePubKeyHash x -> StakePubKeyHash)
-> Generic StakePubKeyHash
forall x. Rep StakePubKeyHash x -> StakePubKeyHash
forall x. StakePubKeyHash -> Rep StakePubKeyHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StakePubKeyHash x -> StakePubKeyHash
$cfrom :: forall x. StakePubKeyHash -> Rep StakePubKeyHash x
Generic)
    deriving anyclass ([StakePubKeyHash] -> Encoding
[StakePubKeyHash] -> Value
StakePubKeyHash -> Encoding
StakePubKeyHash -> Value
(StakePubKeyHash -> Value)
-> (StakePubKeyHash -> Encoding)
-> ([StakePubKeyHash] -> Value)
-> ([StakePubKeyHash] -> Encoding)
-> ToJSON StakePubKeyHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StakePubKeyHash] -> Encoding
$ctoEncodingList :: [StakePubKeyHash] -> Encoding
toJSONList :: [StakePubKeyHash] -> Value
$ctoJSONList :: [StakePubKeyHash] -> Value
toEncoding :: StakePubKeyHash -> Encoding
$ctoEncoding :: StakePubKeyHash -> Encoding
toJSON :: StakePubKeyHash -> Value
$ctoJSON :: StakePubKeyHash -> Value
ToJSON, Value -> Parser [StakePubKeyHash]
Value -> Parser StakePubKeyHash
(Value -> Parser StakePubKeyHash)
-> (Value -> Parser [StakePubKeyHash]) -> FromJSON StakePubKeyHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StakePubKeyHash]
$cparseJSONList :: Value -> Parser [StakePubKeyHash]
parseJSON :: Value -> Parser StakePubKeyHash
$cparseJSON :: Value -> Parser StakePubKeyHash
FromJSON, ToJSONKeyFunction [StakePubKeyHash]
ToJSONKeyFunction StakePubKeyHash
ToJSONKeyFunction StakePubKeyHash
-> ToJSONKeyFunction [StakePubKeyHash] -> ToJSONKey StakePubKeyHash
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [StakePubKeyHash]
$ctoJSONKeyList :: ToJSONKeyFunction [StakePubKeyHash]
toJSONKey :: ToJSONKeyFunction StakePubKeyHash
$ctoJSONKey :: ToJSONKeyFunction StakePubKeyHash
ToJSONKey, FromJSONKeyFunction [StakePubKeyHash]
FromJSONKeyFunction StakePubKeyHash
FromJSONKeyFunction StakePubKeyHash
-> FromJSONKeyFunction [StakePubKeyHash]
-> FromJSONKey StakePubKeyHash
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [StakePubKeyHash]
$cfromJSONKeyList :: FromJSONKeyFunction [StakePubKeyHash]
fromJSONKey :: FromJSONKeyFunction StakePubKeyHash
$cfromJSONKey :: FromJSONKeyFunction StakePubKeyHash
FromJSONKey)
    deriving newtype (StakePubKeyHash -> StakePubKeyHash -> Bool
(StakePubKeyHash -> StakePubKeyHash -> Bool) -> Eq StakePubKeyHash
forall a. (a -> a -> Bool) -> Eq a
== :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c== :: StakePubKeyHash -> StakePubKeyHash -> Bool
PlutusTx.Eq, Eq StakePubKeyHash
Eq StakePubKeyHash
-> (StakePubKeyHash -> StakePubKeyHash -> Ordering)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> Bool)
-> (StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash)
-> (StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash)
-> Ord StakePubKeyHash
StakePubKeyHash -> StakePubKeyHash -> Bool
StakePubKeyHash -> StakePubKeyHash -> Ordering
StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
$cmin :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
max :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
$cmax :: StakePubKeyHash -> StakePubKeyHash -> StakePubKeyHash
>= :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c>= :: StakePubKeyHash -> StakePubKeyHash -> Bool
> :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c> :: StakePubKeyHash -> StakePubKeyHash -> Bool
<= :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c<= :: StakePubKeyHash -> StakePubKeyHash -> Bool
< :: StakePubKeyHash -> StakePubKeyHash -> Bool
$c< :: StakePubKeyHash -> StakePubKeyHash -> Bool
compare :: StakePubKeyHash -> StakePubKeyHash -> Ordering
$ccompare :: StakePubKeyHash -> StakePubKeyHash -> Ordering
$cp1Ord :: Eq StakePubKeyHash
PlutusTx.Ord, Decoder s StakePubKeyHash
Decoder s [StakePubKeyHash]
[StakePubKeyHash] -> Encoding
StakePubKeyHash -> Encoding
(StakePubKeyHash -> Encoding)
-> (forall s. Decoder s StakePubKeyHash)
-> ([StakePubKeyHash] -> Encoding)
-> (forall s. Decoder s [StakePubKeyHash])
-> Serialise StakePubKeyHash
forall s. Decoder s [StakePubKeyHash]
forall s. Decoder s StakePubKeyHash
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [StakePubKeyHash]
$cdecodeList :: forall s. Decoder s [StakePubKeyHash]
encodeList :: [StakePubKeyHash] -> Encoding
$cencodeList :: [StakePubKeyHash] -> Encoding
decode :: Decoder s StakePubKeyHash
$cdecode :: forall s. Decoder s StakePubKeyHash
encode :: StakePubKeyHash -> Encoding
$cencode :: StakePubKeyHash -> Encoding
Serialise, Int -> StakePubKeyHash -> Int
StakePubKeyHash -> Int
(Int -> StakePubKeyHash -> Int)
-> (StakePubKeyHash -> Int) -> Hashable StakePubKeyHash
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StakePubKeyHash -> Int
$chash :: StakePubKeyHash -> Int
hashWithSalt :: Int -> StakePubKeyHash -> Int
$chashWithSalt :: Int -> StakePubKeyHash -> Int
Hashable, StakePubKeyHash -> BuiltinData
(StakePubKeyHash -> BuiltinData) -> ToData StakePubKeyHash
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: StakePubKeyHash -> BuiltinData
$ctoBuiltinData :: StakePubKeyHash -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe StakePubKeyHash
(BuiltinData -> Maybe StakePubKeyHash) -> FromData StakePubKeyHash
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe StakePubKeyHash
$cfromBuiltinData :: BuiltinData -> Maybe StakePubKeyHash
PlutusTx.FromData, BuiltinData -> StakePubKeyHash
(BuiltinData -> StakePubKeyHash) -> UnsafeFromData StakePubKeyHash
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> StakePubKeyHash
$cunsafeFromBuiltinData :: BuiltinData -> StakePubKeyHash
PlutusTx.UnsafeFromData)
    deriving (Int -> StakePubKeyHash -> ShowS
[StakePubKeyHash] -> ShowS
StakePubKeyHash -> String
(Int -> StakePubKeyHash -> ShowS)
-> (StakePubKeyHash -> String)
-> ([StakePubKeyHash] -> ShowS)
-> Show StakePubKeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePubKeyHash] -> ShowS
$cshowList :: [StakePubKeyHash] -> ShowS
show :: StakePubKeyHash -> String
$cshow :: StakePubKeyHash -> String
showsPrec :: Int -> StakePubKeyHash -> ShowS
$cshowsPrec :: Int -> StakePubKeyHash -> ShowS
Show, [StakePubKeyHash] -> Doc ann
StakePubKeyHash -> Doc ann
(forall ann. StakePubKeyHash -> Doc ann)
-> (forall ann. [StakePubKeyHash] -> Doc ann)
-> Pretty StakePubKeyHash
forall ann. [StakePubKeyHash] -> Doc ann
forall ann. StakePubKeyHash -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [StakePubKeyHash] -> Doc ann
$cprettyList :: forall ann. [StakePubKeyHash] -> Doc ann
pretty :: StakePubKeyHash -> Doc ann
$cpretty :: forall ann. StakePubKeyHash -> Doc ann
Pretty) via PubKeyHash
makeLift ''StakePubKeyHash

xprvToStakePubKeyHash :: Crypto.XPrv -> StakePubKeyHash
xprvToStakePubKeyHash :: XPrv -> StakePubKeyHash
xprvToStakePubKeyHash = PubKeyHash -> StakePubKeyHash
StakePubKeyHash (PubKeyHash -> StakePubKeyHash)
-> (XPrv -> PubKeyHash) -> XPrv -> StakePubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> PubKeyHash
pubKeyHash (PubKey -> PubKeyHash) -> (XPrv -> PubKey) -> XPrv -> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> PubKey
toPublicKey

xprvToStakingCredential :: Crypto.XPrv -> StakingCredential
xprvToStakingCredential :: XPrv -> StakingCredential
xprvToStakingCredential = StakePubKeyHash -> StakingCredential
stakePubKeyHashCredential (StakePubKeyHash -> StakingCredential)
-> (XPrv -> StakePubKeyHash) -> XPrv -> StakingCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> StakePubKeyHash
xprvToStakePubKeyHash

{-# INLINABLE paymentPubKeyHash #-}
paymentPubKeyHash :: PaymentPubKey -> PaymentPubKeyHash
paymentPubKeyHash :: PaymentPubKey -> PaymentPubKeyHash
paymentPubKeyHash (PaymentPubKey PubKey
pk) = PubKeyHash -> PaymentPubKeyHash
PaymentPubKeyHash (PubKey -> PubKeyHash
pubKeyHash PubKey
pk)

{-# INLINABLE pubKeyHashAddress #-}
-- | The address that should be targeted by a transaction output locked by the
-- given public payment key (with its staking credentials).
pubKeyHashAddress :: PaymentPubKeyHash -> Maybe StakingCredential -> Address
pubKeyHashAddress :: PaymentPubKeyHash -> Maybe StakingCredential -> Address
pubKeyHashAddress (PaymentPubKeyHash PubKeyHash
pkh) = Credential -> Maybe StakingCredential -> Address
Address (PubKeyHash -> Credential
PubKeyCredential PubKeyHash
pkh)

{-# INLINABLE pubKeyAddress #-}
-- | The address that should be targeted by a transaction output locked by the given public key.
-- (with its staking credentials).
pubKeyAddress :: PaymentPubKey -> Maybe StakingCredential -> Address
pubKeyAddress :: PaymentPubKey -> Maybe StakingCredential -> Address
pubKeyAddress (PaymentPubKey PubKey
pk) = Credential -> Maybe StakingCredential -> Address
Address (PubKeyHash -> Credential
PubKeyCredential (PubKey -> PubKeyHash
pubKeyHash PubKey
pk))

{-# INLINABLE scriptValidatorHashAddress #-}
-- | The address that should be used by a transaction output locked by the given validator script
-- (with its staking credentials).
scriptValidatorHashAddress :: ValidatorHash -> Maybe StakingCredential -> Address
scriptValidatorHashAddress :: ValidatorHash -> Maybe StakingCredential -> Address
scriptValidatorHashAddress ValidatorHash
vh = Credential -> Maybe StakingCredential -> Address
Address (ValidatorHash -> Credential
ScriptCredential ValidatorHash
vh)

{-# INLINABLE stakePubKeyHashCredential #-}
-- | Construct a `StakingCredential` from a public key hash.
stakePubKeyHashCredential :: StakePubKeyHash -> StakingCredential
stakePubKeyHashCredential :: StakePubKeyHash -> StakingCredential
stakePubKeyHashCredential = Credential -> StakingCredential
StakingHash (Credential -> StakingCredential)
-> (StakePubKeyHash -> Credential)
-> StakePubKeyHash
-> StakingCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyHash -> Credential
PubKeyCredential (PubKeyHash -> Credential)
-> (StakePubKeyHash -> PubKeyHash) -> StakePubKeyHash -> Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePubKeyHash -> PubKeyHash
unStakePubKeyHash

{-# INLINEABLE stakeValidatorHashCredential #-}
-- | Construct a `StakingCredential` from a validator script hash.
stakeValidatorHashCredential :: StakeValidatorHash -> StakingCredential
stakeValidatorHashCredential :: StakeValidatorHash -> StakingCredential
stakeValidatorHashCredential (StakeValidatorHash BuiltinByteString
h) = Credential -> StakingCredential
StakingHash (Credential -> StakingCredential)
-> (BuiltinByteString -> Credential)
-> BuiltinByteString
-> StakingCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatorHash -> Credential
ScriptCredential (ValidatorHash -> Credential)
-> (BuiltinByteString -> ValidatorHash)
-> BuiltinByteString
-> Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> ValidatorHash
ValidatorHash (BuiltinByteString -> StakingCredential)
-> BuiltinByteString -> StakingCredential
forall a b. (a -> b) -> a -> b
$ BuiltinByteString
h

-- | Cardano address of a versioned 'Validator' script.
mkValidatorCardanoAddress :: C.NetworkId -> Versioned Validator -> C.AddressInEra C.BabbageEra
mkValidatorCardanoAddress :: NetworkId -> Versioned Validator -> AddressInEra BabbageEra
mkValidatorCardanoAddress NetworkId
networkId (Versioned Validator
val Language
PlutusV1) = NetworkId -> Validator -> AddressInEra BabbageEra
PV1.mkValidatorCardanoAddress NetworkId
networkId Validator
val
mkValidatorCardanoAddress NetworkId
networkId (Versioned Validator
val Language
PlutusV2) = NetworkId -> Validator -> AddressInEra BabbageEra
PV2.mkValidatorCardanoAddress NetworkId
networkId Validator
val