{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Functionality related to 'Address' data type and related types.
module Cardano.Chain.Common.Address (
  Address (..),
  Address' (..),

  -- * Formatting
  addressF,
  addressDetailedF,
  decCBORTextAddress,

  -- * Spending data checks
  checkAddrSpendingData,
  checkVerKeyAddress,
  checkRedeemAddress,

  -- * Encoding/Decoding
  addrToBase58,
  encCBORAddr,
  encCBORAddrCRC32,
  decodeAddressBase58,
  encodeAddressBase58,

  -- * Utilities
  addrAttributesUnwrapped,
  addrNetworkMagic,

  -- * Pattern-matching helpers
  isRedeemAddress,

  -- * Construction
  makeAddress,
  makeVerKeyAddress,
  makeVerKeyHdwAddress,
  makeRedeemAddress,
)
where

import Cardano.Chain.Common.AddrAttributes (
  AddrAttributes (..),
  HDAddressPayload,
 )
import Cardano.Chain.Common.AddrSpendingData (
  AddrSpendingData (..),
  AddrType (..),
  addrSpendingDataToType,
 )
import Cardano.Chain.Common.AddressHash (AddressHash, addressHash)
import Cardano.Chain.Common.Attributes (Attributes (..), mkAttributes)
import Cardano.Chain.Common.CBOR (
  decodeCrcProtected,
  encodeCrcProtected,
  encodedCrcProtectedSizeExpr,
 )
import Cardano.Chain.Common.NetworkMagic (NetworkMagic (..))
import Cardano.Crypto.Hashing (hashHexF)
import Cardano.Crypto.Signing (
  RedeemVerificationKey,
  VerificationKey,
 )
import Cardano.HeapWords (HeapWords (..), heapWords3)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecoderError (..),
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  ToCBOR (..),
  byronProtVer,
  decodeFull',
  decodeListLenCanonical,
  fromByronCBOR,
  matchSize,
  serialize',
  toByronCBOR,
 )
import Cardano.Prelude
import qualified Data.Aeson as Aeson
import Data.ByteString.Base58 (
  Alphabet (..),
  bitcoinAlphabet,
  decodeBase58,
  encodeBase58,
 )
import Data.Text.Encoding (decodeLatin1)
import Data.Text.Internal.Builder (Builder)
import Formatting (
  Format,
  bprint,
  build,
  builder,
  formatToString,
  later,
 )
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (
  FromJSON (..),
  FromObjectKey (..),
  JSValue (..),
  ToJSON (..),
  ToObjectKey (..),
  toJSString,
 )

-- | Hash of this data is stored in 'Address'. This type exists mostly
--   for internal usage.
newtype Address' = Address'
  { Address' -> (AddrType, AddrSpendingData, Attributes AddrAttributes)
unAddress' :: (AddrType, AddrSpendingData, Attributes AddrAttributes)
  }
  deriving (Address' -> Address' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address' -> Address' -> Bool
$c/= :: Address' -> Address' -> Bool
== :: Address' -> Address' -> Bool
$c== :: Address' -> Address' -> Bool
Eq, Int -> Address' -> ShowS
[Address'] -> ShowS
Address' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Address'] -> ShowS
$cshowList :: [Address'] -> ShowS
show :: Address' -> String
$cshow :: Address' -> String
showsPrec :: Int -> Address' -> ShowS
$cshowsPrec :: Int -> Address' -> ShowS
Show, forall x. Rep Address' x -> Address'
forall x. Address' -> Rep Address' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Address' x -> Address'
$cfrom :: forall x. Address' -> Rep Address' x
Generic)
  deriving newtype (Typeable Address'
Address' -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Address'] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy Address' -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Address'] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Address'] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Address' -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Address' -> Size
encCBOR :: Address' -> Encoding
$cencCBOR :: Address' -> Encoding
EncCBOR)

instance ToCBOR Address' where
  toCBOR :: Address' -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Address' where
  fromCBOR :: forall s. Decoder s Address'
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- We need to use canonical encodings for @Address'@ so that all implementations
-- agree on the `AddressHash`. The components of the @Address'@ also have
-- canonical encodings enforced.
instance DecCBOR Address' where
  decCBOR :: forall s. Decoder s Address'
decCBOR = do
    Int
len <- forall s. Decoder s Int
decodeListLenCanonical
    forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"Address'" Int
3 Int
len
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddrType, AddrSpendingData, Attributes AddrAttributes) -> Address'
Address' forall a b. (a -> b) -> a -> b
$ (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | 'Address' is where you can send Lovelace
data Address = Address
  { Address -> AddressHash Address'
addrRoot :: !(AddressHash Address')
  -- ^ Root of imaginary pseudo Merkle tree stored in this address.
  , Address -> Attributes AddrAttributes
addrAttributes :: !(Attributes AddrAttributes)
  -- ^ Attributes associated with this address.
  , Address -> AddrType
addrType :: !AddrType
  -- ^ The type of this address. Should correspond to
  -- 'AddrSpendingData', but it can't be checked statically, because
  -- spending data is hashed.
  }
  deriving (Address -> Address -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c== :: Address -> Address -> Bool
Eq, Eq Address
Address -> Address -> Bool
Address -> Address -> Ordering
Address -> Address -> Address
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 :: Address -> Address -> Address
$cmin :: Address -> Address -> Address
max :: Address -> Address -> Address
$cmax :: Address -> Address -> Address
>= :: Address -> Address -> Bool
$c>= :: Address -> Address -> Bool
> :: Address -> Address -> Bool
$c> :: Address -> Address -> Bool
<= :: Address -> Address -> Bool
$c<= :: Address -> Address -> Bool
< :: Address -> Address -> Bool
$c< :: Address -> Address -> Bool
compare :: Address -> Address -> Ordering
$ccompare :: Address -> Address -> Ordering
Ord, forall x. Rep Address x -> Address
forall x. Address -> Rep Address x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Address x -> Address
$cfrom :: forall x. Address -> Rep Address x
Generic, Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Address] -> ShowS
$cshowList :: [Address] -> ShowS
show :: Address -> String
$cshow :: Address -> String
showsPrec :: Int -> Address -> ShowS
$cshowsPrec :: Int -> Address -> ShowS
Show)
  deriving anyclass (Address -> ()
forall a. (a -> ()) -> NFData a
rnf :: Address -> ()
$crnf :: Address -> ()
NFData, Context -> Address -> IO (Maybe ThunkInfo)
Proxy Address -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Address -> String
$cshowTypeOf :: Proxy Address -> String
wNoThunks :: Context -> Address -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Address -> IO (Maybe ThunkInfo)
noThunks :: Context -> Address -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Address -> IO (Maybe ThunkInfo)
NoThunks)

-- Used for debugging purposes only
instance Aeson.ToJSON Address

instance ToCBOR Address where
  toCBOR :: Address -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Address where
  fromCBOR :: forall s. Decoder s Address
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR Address where
  encCBOR :: Address -> Encoding
encCBOR Address
addr =
    forall a. EncCBOR a => a -> Encoding
encodeCrcProtected (Address -> AddressHash Address'
addrRoot Address
addr, Address -> Attributes AddrAttributes
addrAttributes Address
addr, Address -> AddrType
addrType Address
addr)

  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Address -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy Address
pxy =
    forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedCrcProtectedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size
      forall a b. (a -> b) -> a -> b
$ (,,)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> AddressHash Address'
addrRoot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Address
pxy)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Address -> Attributes AddrAttributes
addrAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Address
pxy)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Address -> AddrType
addrType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Address
pxy)

instance DecCBOR Address where
  decCBOR :: forall s. Decoder s Address
decCBOR = do
    (AddressHash Address'
root, Attributes AddrAttributes
attributes, AddrType
addrType') <- forall s a. DecCBOR a => Decoder s a
decodeCrcProtected
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      forall a b. (a -> b) -> a -> b
$ Address
        { addrRoot :: AddressHash Address'
addrRoot = AddressHash Address'
root
        , addrAttributes :: Attributes AddrAttributes
addrAttributes = Attributes AddrAttributes
attributes
        , addrType :: AddrType
addrType = AddrType
addrType'
        }

instance B.Buildable [Address] where
  build :: [Address] -> Builder
build = forall a. Format Builder a -> a
bprint forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson

instance Monad m => ToObjectKey m Address where
  toObjectKey :: Address -> m JSString
toObjectKey = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> JSString
toJSString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format String a -> a
formatToString forall r. Format r (Address -> r)
addressF

instance MonadError SchemaError m => FromObjectKey m Address where
  fromObjectKey :: JSString -> m (Maybe Address)
fromObjectKey = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString Text -> Either DecoderError Address
decCBORTextAddress forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSString -> JSValue
JSString

instance Monad m => ToJSON m Address where
  toJSON :: Address -> m JSValue
toJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JSString -> JSValue
JSString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. ToObjectKey m a => a -> m JSString
toObjectKey

instance MonadError SchemaError m => FromJSON m Address where
  fromJSON :: JSValue -> m Address
fromJSON = forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString Text -> Either DecoderError Address
decCBORTextAddress

instance HeapWords Address where
  heapWords :: Address -> Int
heapWords (Address AddressHash Address'
root Attributes AddrAttributes
attrs AddrType
typ) = forall a2 a1 a.
(HeapWords a2, HeapWords a1, HeapWords a) =>
a -> a1 -> a2 -> Int
heapWords3 AddressHash Address'
root Attributes AddrAttributes
attrs AddrType
typ

--------------------------------------------------------------------------------
-- Formatting, pretty-printing
--------------------------------------------------------------------------------

-- | A formatter showing guts of an 'Address'
addressDetailedF :: Format r (Address -> r)
addressDetailedF :: forall r. Format r (Address -> r)
addressDetailedF = forall a r. (a -> Builder) -> Format r (a -> r)
later forall a b. (a -> b) -> a -> b
$ \Address
addr ->
  forall a. Format Builder a -> a
bprint
    (forall r. Format r (Builder -> r)
builder forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
" address with root " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Attributes AddrAttributes -> Builder)
  (Attributes AddrAttributes -> Builder)
", attributes: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build)
    (AddrType -> Builder
formattedType forall a b. (a -> b) -> a -> b
$ Address -> AddrType
addrType Address
addr)
    (Address -> AddressHash Address'
addrRoot Address
addr)
    (Address -> Attributes AddrAttributes
addrAttributes Address
addr)
  where
    formattedType :: AddrType -> Builder
    formattedType :: AddrType -> Builder
formattedType = \case
      AddrType
ATVerKey -> Builder
"VerKey"
      AddrType
ATRedeem -> Builder
"Redeem"

-- | Currently we use Bitcoin alphabet for representing addresses in base58
addrAlphabet :: Alphabet
addrAlphabet :: Alphabet
addrAlphabet = Alphabet
bitcoinAlphabet

addrToBase58 :: Address -> ByteString
addrToBase58 :: Address -> ByteString
addrToBase58 = Alphabet -> ByteString -> ByteString
encodeBase58 Alphabet
addrAlphabet forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer

instance B.Buildable Address where
  build :: Address -> Builder
build = forall p. Buildable p => p -> Builder
B.build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
decodeLatin1 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> ByteString
addrToBase58

-- | Specialized formatter for 'Address'
addressF :: Format r (Address -> r)
addressF :: forall r. Format r (Address -> r)
addressF = forall a r. Buildable a => Format r (a -> r)
build

-- | A function which decodes base58-encoded 'Address'
{-# DEPRECATED decCBORTextAddress "Use decodeAddressBase58 instead" #-}
decCBORTextAddress :: Text -> Either DecoderError Address
decCBORTextAddress :: Text -> Either DecoderError Address
decCBORTextAddress = ByteString -> Either DecoderError Address
decCBORAddress forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
encodeUtf8
  where
    decCBORAddress :: ByteString -> Either DecoderError Address
    decCBORAddress :: ByteString -> Either DecoderError Address
decCBORAddress ByteString
bs = do
      let base58Err :: DecoderError
base58Err =
            Text -> Text -> DecoderError
DecoderErrorCustom
              Text
"Address"
              Text
"Invalid base58 representation of address"
      ByteString
dbs <- forall l r. l -> Maybe r -> Either l r
maybeToRight DecoderError
base58Err forall a b. (a -> b) -> a -> b
$ Alphabet -> ByteString -> Maybe ByteString
decodeBase58 Alphabet
addrAlphabet ByteString
bs
      forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
byronProtVer ByteString
dbs

-- | Decode an address from Base58 encoded Text.
decodeAddressBase58 :: Text -> Either DecoderError Address
decodeAddressBase58 :: Text -> Either DecoderError Address
decodeAddressBase58 = Text -> Either DecoderError Address
decCBORTextAddress

-- | Encode an address to Text.
-- `decodeAddressBase58 (encodeAddressBase58 x) === Right x`
encodeAddressBase58 :: Address -> Text
encodeAddressBase58 :: Address -> Text
encodeAddressBase58 = ByteString -> Text
decodeLatin1 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> ByteString
addrToBase58

--------------------------------------------------------------------------------
-- Constructors
--------------------------------------------------------------------------------

-- | Make an 'Address' from spending data and attributes.
makeAddress :: AddrSpendingData -> AddrAttributes -> Address
makeAddress :: AddrSpendingData -> AddrAttributes -> Address
makeAddress AddrSpendingData
spendingData AddrAttributes
attributesUnwrapped =
  Address
    { addrRoot :: AddressHash Address'
addrRoot = forall a. EncCBOR a => a -> AddressHash a
addressHash Address'
address'
    , addrAttributes :: Attributes AddrAttributes
addrAttributes = Attributes AddrAttributes
attributes
    , addrType :: AddrType
addrType = AddrType
addrType'
    }
  where
    addrType' :: AddrType
addrType' = AddrSpendingData -> AddrType
addrSpendingDataToType AddrSpendingData
spendingData
    attributes :: Attributes AddrAttributes
attributes = forall h. h -> Attributes h
mkAttributes AddrAttributes
attributesUnwrapped
    address' :: Address'
address' = (AddrType, AddrSpendingData, Attributes AddrAttributes) -> Address'
Address' (AddrType
addrType', AddrSpendingData
spendingData, Attributes AddrAttributes
attributes)

-- | A function for making an address from 'VerificationKey'
makeVerKeyAddress :: NetworkMagic -> VerificationKey -> Address
makeVerKeyAddress :: NetworkMagic -> VerificationKey -> Address
makeVerKeyAddress NetworkMagic
nm = NetworkMagic
-> Maybe HDAddressPayload -> VerificationKey -> Address
makeVerKeyAddressImpl NetworkMagic
nm forall a. Maybe a
Nothing

-- | A function for making an HDW address
makeVerKeyHdwAddress ::
  NetworkMagic ->
  -- | Derivation path
  HDAddressPayload ->
  VerificationKey ->
  Address
makeVerKeyHdwAddress :: NetworkMagic -> HDAddressPayload -> VerificationKey -> Address
makeVerKeyHdwAddress NetworkMagic
nm HDAddressPayload
path = NetworkMagic
-> Maybe HDAddressPayload -> VerificationKey -> Address
makeVerKeyAddressImpl NetworkMagic
nm (forall a. a -> Maybe a
Just HDAddressPayload
path)

makeVerKeyAddressImpl :: NetworkMagic -> Maybe HDAddressPayload -> VerificationKey -> Address
makeVerKeyAddressImpl :: NetworkMagic
-> Maybe HDAddressPayload -> VerificationKey -> Address
makeVerKeyAddressImpl NetworkMagic
nm Maybe HDAddressPayload
path VerificationKey
key = AddrSpendingData -> AddrAttributes -> Address
makeAddress AddrSpendingData
spendingData AddrAttributes
attrs
  where
    spendingData :: AddrSpendingData
spendingData = VerificationKey -> AddrSpendingData
VerKeyASD VerificationKey
key
    attrs :: AddrAttributes
attrs =
      AddrAttributes
        { aaVKDerivationPath :: Maybe HDAddressPayload
aaVKDerivationPath = Maybe HDAddressPayload
path
        , aaNetworkMagic :: NetworkMagic
aaNetworkMagic = NetworkMagic
nm
        }

-- | A function for making an address from 'RedeemVerificationKey'
makeRedeemAddress :: NetworkMagic -> RedeemVerificationKey -> Address
makeRedeemAddress :: NetworkMagic -> RedeemVerificationKey -> Address
makeRedeemAddress NetworkMagic
nm RedeemVerificationKey
key = AddrSpendingData -> AddrAttributes -> Address
makeAddress AddrSpendingData
spendingData AddrAttributes
attrs
  where
    spendingData :: AddrSpendingData
spendingData = RedeemVerificationKey -> AddrSpendingData
RedeemASD RedeemVerificationKey
key
    attrs :: AddrAttributes
attrs =
      AddrAttributes
        { aaVKDerivationPath :: Maybe HDAddressPayload
aaVKDerivationPath = forall a. Maybe a
Nothing
        , aaNetworkMagic :: NetworkMagic
aaNetworkMagic = NetworkMagic
nm
        }

--------------------------------------------------------------------------------
-- Checks
--------------------------------------------------------------------------------

-- | Check whether given 'AddrSpendingData' corresponds to given 'Address'
checkAddrSpendingData :: AddrSpendingData -> Address -> Bool
checkAddrSpendingData :: AddrSpendingData -> Address -> Bool
checkAddrSpendingData AddrSpendingData
asd Address
addr =
  Address -> AddressHash Address'
addrRoot Address
addr
    forall a. Eq a => a -> a -> Bool
== forall a. EncCBOR a => a -> AddressHash a
addressHash Address'
address'
    Bool -> Bool -> Bool
&& Address -> AddrType
addrType Address
addr
    forall a. Eq a => a -> a -> Bool
== AddrSpendingData -> AddrType
addrSpendingDataToType AddrSpendingData
asd
  where
    address' :: Address'
address' = (AddrType, AddrSpendingData, Attributes AddrAttributes) -> Address'
Address' (Address -> AddrType
addrType Address
addr, AddrSpendingData
asd, Address -> Attributes AddrAttributes
addrAttributes Address
addr)

-- | Check if given 'Address' is created from given 'VerificationKey'
checkVerKeyAddress :: VerificationKey -> Address -> Bool
checkVerKeyAddress :: VerificationKey -> Address -> Bool
checkVerKeyAddress VerificationKey
vk = AddrSpendingData -> Address -> Bool
checkAddrSpendingData (VerificationKey -> AddrSpendingData
VerKeyASD VerificationKey
vk)

-- | Check if given 'Address' is created from given 'RedeemVerificationKey'
checkRedeemAddress :: RedeemVerificationKey -> Address -> Bool
checkRedeemAddress :: RedeemVerificationKey -> Address -> Bool
checkRedeemAddress RedeemVerificationKey
rvk = AddrSpendingData -> Address -> Bool
checkAddrSpendingData (RedeemVerificationKey -> AddrSpendingData
RedeemASD RedeemVerificationKey
rvk)

--------------------------------------------------------------------------------
-- Utils
--------------------------------------------------------------------------------

-- | Get 'AddrAttributes' from 'Address'
addrAttributesUnwrapped :: Address -> AddrAttributes
addrAttributesUnwrapped :: Address -> AddrAttributes
addrAttributesUnwrapped = forall h. Attributes h -> h
attrData forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> Attributes AddrAttributes
addrAttributes

-- | Get 'NetworkMagic' from 'Address'
addrNetworkMagic :: Address -> NetworkMagic
addrNetworkMagic :: Address -> NetworkMagic
addrNetworkMagic = AddrAttributes -> NetworkMagic
aaNetworkMagic forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> AddrAttributes
addrAttributesUnwrapped

--------------------------------------------------------------------------------
-- Pattern-matching helpers
--------------------------------------------------------------------------------

-- | Check whether an 'Address' is redeem address
isRedeemAddress :: Address -> Bool
isRedeemAddress :: Address -> Bool
isRedeemAddress Address
addr = case Address -> AddrType
addrType Address
addr of
  AddrType
ATRedeem -> Bool
True
  AddrType
_ -> Bool
False

-- Encodes the `Address` __without__ the CRC32.
-- It's important to keep this function separated from the `encCBOR`
-- definition to avoid that `encCBOR` would call `crc32` and
-- the latter invoke `crc32Update`, which would then try to call `encCBOR`
-- indirectly once again, in an infinite loop.
encCBORAddr :: Address -> Encoding
encCBORAddr :: Address -> Encoding
encCBORAddr Address
addr =
  forall a. EncCBOR a => a -> Encoding
encCBOR (Address -> AddressHash Address'
addrRoot Address
addr)
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Address -> Attributes AddrAttributes
addrAttributes Address
addr)
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR
      (Address -> AddrType
addrType Address
addr)

encCBORAddrCRC32 :: Address -> Encoding
encCBORAddrCRC32 :: Address -> Encoding
encCBORAddrCRC32 Address
addr =
  forall a. EncCBOR a => a -> Encoding
encodeCrcProtected (Address -> AddressHash Address'
addrRoot Address
addr, Address -> Attributes AddrAttributes
addrAttributes Address
addr, Address -> AddrType
addrType Address
addr)