{-# 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,
    fromCBORTextAddress,

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

    -- * Encoding/Decoding
    addrToBase58,
    toCBORAddr,
    toCBORAddrCRC32,
    decodeAddressBase58,
    encodeAddressBase58,

    -- * Utilities
    addrAttributesUnwrapped,
    addrNetworkMagic,

    -- * Pattern-matching helpers
    isRedeemAddress,

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

import Cardano.Binary
  ( DecoderError (..),
    Encoding,
    FromCBOR (..),
    ToCBOR (..),
    decodeFull',
    decodeListLenCanonical,
    matchSize,
    serialize',
  )
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.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
(Address' -> Address' -> Bool)
-> (Address' -> Address' -> Bool) -> Eq Address'
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
(Int -> Address' -> ShowS)
-> (Address' -> String) -> ([Address'] -> ShowS) -> Show Address'
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. Address' -> Rep Address' x)
-> (forall x. Rep Address' x -> Address') -> Generic Address'
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'
Typeable Address'
-> (Address' -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy Address' -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Address'] -> Size)
-> ToCBOR Address'
Address' -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Address'] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Address' -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Address'] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Address'] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Address' -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Address' -> Size
toCBOR :: Address' -> Encoding
$ctoCBOR :: Address' -> Encoding
$cp1ToCBOR :: Typeable Address'
ToCBOR)

-- 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 FromCBOR Address' where
  fromCBOR :: Decoder s Address'
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLenCanonical
    Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"Address'" Int
3 Int
len
    ((AddrType, AddrSpendingData, Attributes AddrAttributes)
 -> Address')
-> Decoder
     s (AddrType, AddrSpendingData, Attributes AddrAttributes)
-> Decoder s Address'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddrType, AddrSpendingData, Attributes AddrAttributes) -> Address'
Address' (Decoder s (AddrType, AddrSpendingData, Attributes AddrAttributes)
 -> Decoder s Address')
-> Decoder
     s (AddrType, AddrSpendingData, Attributes AddrAttributes)
-> Decoder s Address'
forall a b. (a -> b) -> a -> b
$ (,,) (AddrType
 -> AddrSpendingData
 -> Attributes AddrAttributes
 -> (AddrType, AddrSpendingData, Attributes AddrAttributes))
-> Decoder s AddrType
-> Decoder
     s
     (AddrSpendingData
      -> Attributes AddrAttributes
      -> (AddrType, AddrSpendingData, Attributes AddrAttributes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s AddrType
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder
  s
  (AddrSpendingData
   -> Attributes AddrAttributes
   -> (AddrType, AddrSpendingData, Attributes AddrAttributes))
-> Decoder s AddrSpendingData
-> Decoder
     s
     (Attributes AddrAttributes
      -> (AddrType, AddrSpendingData, Attributes AddrAttributes))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s AddrSpendingData
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder
  s
  (Attributes AddrAttributes
   -> (AddrType, AddrSpendingData, Attributes AddrAttributes))
-> Decoder s (Attributes AddrAttributes)
-> Decoder
     s (AddrType, AddrSpendingData, Attributes AddrAttributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Attributes AddrAttributes)
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- | 'Address' is where you can send Lovelace
data Address = Address
  { -- | Root of imaginary pseudo Merkle tree stored in this address.
    Address -> AddressHash Address'
addrRoot :: !(AddressHash Address'),
    -- | Attributes associated with this address.
    Address -> Attributes AddrAttributes
addrAttributes :: !(Attributes AddrAttributes),
    -- | The type of this address. Should correspond to
    -- 'AddrSpendingData', but it can't be checked statically, because
    -- spending data is hashed.
    Address -> AddrType
addrType :: !AddrType
  }
  deriving (Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
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
Eq Address
-> (Address -> Address -> Ordering)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Address)
-> (Address -> Address -> Address)
-> Ord 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
$cp1Ord :: Eq Address
Ord, (forall x. Address -> Rep Address x)
-> (forall x. Rep Address x -> Address) -> Generic Address
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
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
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 -> ()
(Address -> ()) -> NFData Address
forall a. (a -> ()) -> NFData a
rnf :: Address -> ()
$crnf :: Address -> ()
NFData, Context -> Address -> IO (Maybe ThunkInfo)
Proxy Address -> String
(Context -> Address -> IO (Maybe ThunkInfo))
-> (Context -> Address -> IO (Maybe ThunkInfo))
-> (Proxy Address -> String)
-> NoThunks Address
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 Address
addr =
    (AddressHash Address', Attributes AddrAttributes, AddrType)
-> Encoding
forall a. ToCBOR a => a -> Encoding
encodeCrcProtected (Address -> AddressHash Address'
addrRoot Address
addr, Address -> Attributes AddrAttributes
addrAttributes Address
addr, Address -> AddrType
addrType Address
addr)

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

instance FromCBOR Address where
  fromCBOR :: Decoder s Address
fromCBOR = do
    (AddressHash Address'
root, Attributes AddrAttributes
attributes, AddrType
addrType') <- Decoder
  s (AddressHash Address', Attributes AddrAttributes, AddrType)
forall s a. FromCBOR a => Decoder s a
decodeCrcProtected
    Address -> Decoder s Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Decoder s Address) -> Address -> Decoder s Address
forall a b. (a -> b) -> a -> b
$
      Address :: AddressHash Address'
-> Attributes AddrAttributes -> AddrType -> Address
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 = Format Builder ([Address] -> Builder) -> [Address] -> Builder
forall a. Format Builder a -> a
bprint Format Builder ([Address] -> Builder)
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 = JSString -> m JSString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSString -> m JSString)
-> (Address -> JSString) -> Address -> m JSString
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 (String -> JSString) -> (Address -> String) -> Address -> JSString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format String (Address -> String) -> Address -> String
forall a. Format String a -> a
formatToString Format String (Address -> String)
forall r. Format r (Address -> r)
addressF

instance MonadError SchemaError m => FromObjectKey m Address where
  fromObjectKey :: JSString -> m (Maybe Address)
fromObjectKey = (Address -> Maybe Address) -> m Address -> m (Maybe Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Address -> Maybe Address
forall a. a -> Maybe a
Just (m Address -> m (Maybe Address))
-> (JSString -> m Address) -> JSString -> m (Maybe Address)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Either DecoderError Address) -> JSValue -> m Address
forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString Text -> Either DecoderError Address
fromCBORTextAddress (JSValue -> m Address)
-> (JSString -> JSValue) -> JSString -> m Address
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 = (JSString -> JSValue) -> m JSString -> m JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JSString -> JSValue
JSString (m JSString -> m JSValue)
-> (Address -> m JSString) -> Address -> m JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> m JSString
forall (m :: * -> *) a. ToObjectKey m a => a -> m JSString
toObjectKey

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

instance HeapWords Address where
  heapWords :: Address -> Int
heapWords (Address AddressHash Address'
root Attributes AddrAttributes
attrs AddrType
typ) = AddressHash Address'
-> Attributes AddrAttributes -> AddrType -> Int
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 :: Format r (Address -> r)
addressDetailedF = (Address -> Builder) -> Format r (Address -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((Address -> Builder) -> Format r (Address -> r))
-> (Address -> Builder) -> Format r (Address -> r)
forall a b. (a -> b) -> a -> b
$ \Address
addr ->
  Format
  Builder
  (Builder
   -> AddressHash Address' -> Attributes AddrAttributes -> Builder)
-> Builder
-> AddressHash Address'
-> Attributes AddrAttributes
-> Builder
forall a. Format Builder a -> a
bprint
    (Format
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
  (Builder
   -> AddressHash Address' -> Attributes AddrAttributes -> Builder)
forall r. Format r (Builder -> r)
builder Format
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
  (Builder
   -> AddressHash Address' -> Attributes AddrAttributes -> Builder)
-> Format
     Builder
     (AddressHash Address' -> Attributes AddrAttributes -> Builder)
-> Format
     Builder
     (Builder
      -> AddressHash Address' -> Attributes AddrAttributes -> 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 " Format
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
-> Format
     Builder
     (AddressHash Address' -> Attributes AddrAttributes -> Builder)
-> Format
     Builder
     (AddressHash Address' -> Attributes AddrAttributes -> Builder)
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)
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF Format
  (Attributes AddrAttributes -> Builder)
  (AddressHash Address' -> Attributes AddrAttributes -> Builder)
-> Format Builder (Attributes AddrAttributes -> Builder)
-> Format
     Builder
     (AddressHash Address' -> Attributes AddrAttributes -> Builder)
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: " Format
  (Attributes AddrAttributes -> Builder)
  (Attributes AddrAttributes -> Builder)
-> Format Builder (Attributes AddrAttributes -> Builder)
-> Format Builder (Attributes AddrAttributes -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Attributes AddrAttributes -> Builder)
forall a r. Buildable a => Format r (a -> r)
build)
    (AddrType -> Builder
formattedType (AddrType -> Builder) -> AddrType -> Builder
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 (ByteString -> ByteString)
-> (Address -> ByteString) -> Address -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Address -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'

instance B.Buildable Address where
  build :: Address -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
B.build (Text -> Builder) -> (Address -> Text) -> Address -> Builder
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 (ByteString -> Text) -> (Address -> ByteString) -> Address -> Text
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 :: Format r (Address -> r)
addressF = Format r (Address -> r)
forall a r. Buildable a => Format r (a -> r)
build

-- | A function which decodes base58-encoded 'Address'
{-# DEPRECATED fromCBORTextAddress "Use decodeAddressBase58 instead" #-}
fromCBORTextAddress :: Text -> Either DecoderError Address
fromCBORTextAddress :: Text -> Either DecoderError Address
fromCBORTextAddress = ByteString -> Either DecoderError Address
fromCBORAddress (ByteString -> Either DecoderError Address)
-> (Text -> ByteString) -> Text -> Either DecoderError Address
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
    fromCBORAddress :: ByteString -> Either DecoderError Address
    fromCBORAddress :: ByteString -> Either DecoderError Address
fromCBORAddress ByteString
bs = do
      let base58Err :: DecoderError
base58Err =
            Text -> Text -> DecoderError
DecoderErrorCustom
              Text
"Address"
              Text
"Invalid base58 representation of address"
      ByteString
dbs <- DecoderError -> Maybe ByteString -> Either DecoderError ByteString
forall l r. l -> Maybe r -> Either l r
maybeToRight DecoderError
base58Err (Maybe ByteString -> Either DecoderError ByteString)
-> Maybe ByteString -> Either DecoderError ByteString
forall a b. (a -> b) -> a -> b
$ Alphabet -> ByteString -> Maybe ByteString
decodeBase58 Alphabet
addrAlphabet ByteString
bs
      ByteString -> Either DecoderError Address
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' ByteString
dbs

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

-- | Encode an address to Text.
-- `decodeAddressBase58 (encodeAddressBase58 x) === Right x`
encodeAddressBase58 :: Address -> Text
encodeAddressBase58 :: Address -> Text
encodeAddressBase58 = ByteString -> Text
decodeLatin1 (ByteString -> Text) -> (Address -> ByteString) -> Address -> Text
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 :: AddressHash Address'
-> Attributes AddrAttributes -> AddrType -> Address
Address
    { addrRoot :: AddressHash Address'
addrRoot = Address' -> AddressHash Address'
forall a. ToCBOR 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 = AddrAttributes -> Attributes AddrAttributes
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 Maybe HDAddressPayload
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 (HDAddressPayload -> Maybe HDAddressPayload
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 :: Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes
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 :: Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes
AddrAttributes
        { aaVKDerivationPath :: Maybe HDAddressPayload
aaVKDerivationPath = Maybe HDAddressPayload
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
    AddressHash Address' -> AddressHash Address' -> Bool
forall a. Eq a => a -> a -> Bool
== Address' -> AddressHash Address'
forall a. ToCBOR a => a -> AddressHash a
addressHash Address'
address'
    Bool -> Bool -> Bool
&& Address -> AddrType
addrType Address
addr
    AddrType -> AddrType -> Bool
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 = Attributes AddrAttributes -> AddrAttributes
forall h. Attributes h -> h
attrData (Attributes AddrAttributes -> AddrAttributes)
-> (Address -> Attributes AddrAttributes)
-> Address
-> AddrAttributes
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 (AddrAttributes -> NetworkMagic)
-> (Address -> AddrAttributes) -> Address -> NetworkMagic
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 `toCBOR`
-- definition to avoid that `toCBOR` would call `crc32` and
-- the latter invoke `crc32Update`, which would then try to call `toCBOR`
-- indirectly once again, in an infinite loop.
toCBORAddr :: Address -> Encoding
toCBORAddr :: Address -> Encoding
toCBORAddr Address
addr =
  AddressHash Address' -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Address -> AddressHash Address'
addrRoot Address
addr) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Attributes AddrAttributes -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Address -> Attributes AddrAttributes
addrAttributes Address
addr)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AddrType -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
      (Address -> AddrType
addrType Address
addr)

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