{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK prune #-}
module Cardano.Address
(
Address
, PaymentAddress (..)
, StakeAddress (..)
, DelegationAddress (..)
, PointerAddress (..)
, ChainPointer (..)
, unsafeMkAddress
, unAddress
, base58
, fromBase58
, bech32
, bech32With
, fromBech32
, HasNetworkDiscriminant (..)
, AddressDiscrimination (..)
, NetworkTag (..)
, invariantSize
, invariantNetworkTag
) where
import Prelude
import Cardano.Address.Derivation
( Depth (..), XPub )
import Cardano.Codec.Cbor
( decodeAddress, deserialiseCbor )
import Codec.Binary.Bech32
( HumanReadablePart )
import Codec.Binary.Encoding
( AbstractEncoding (..), encode )
import Control.DeepSeq
( NFData )
import Control.Monad
( (<=<) )
import Data.Aeson
( ToJSON (..), Value (..), object, (.=) )
import Data.Bits
( Bits (testBit) )
import Data.ByteString
( ByteString )
import Data.Either.Extra
( eitherToMaybe )
import Data.Kind
( Type )
import Data.Text
( Text )
import Data.Word
( Word32, Word8 )
import GHC.Generics
( Generic )
import GHC.Stack
( HasCallStack )
import Numeric.Natural
( Natural )
import qualified Cardano.Codec.Bech32.Prefixes as CIP5
import qualified Codec.Binary.Encoding as E
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as T
newtype Address = Address
{ Address -> ByteString
unAddress :: ByteString
} deriving stock ((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, 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)
instance NFData Address
unsafeMkAddress :: ByteString -> Address
unsafeMkAddress :: ByteString -> Address
unsafeMkAddress = ByteString -> Address
Address
base58 :: Address -> Text
base58 :: Address -> Text
base58 = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Address -> ByteString) -> Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase58 (ByteString -> ByteString)
-> (Address -> ByteString) -> Address -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> ByteString
unAddress
fromBase58 :: Text -> Maybe Address
fromBase58 :: Text -> Maybe Address
fromBase58 =
(Either DeserialiseFailure Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Either DeserialiseFailure Address -> Maybe Address)
-> (ByteString -> Either DeserialiseFailure Address)
-> ByteString
-> Maybe Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s. Decoder s Address)
-> ByteString -> Either DeserialiseFailure Address
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure a
deserialiseCbor (ByteString -> Address
unsafeMkAddress (ByteString -> Address)
-> Decoder s ByteString -> Decoder s Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
decodeAddress)
(ByteString -> Maybe Address)
-> (Text -> Maybe ByteString) -> Text -> Maybe Address
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String ByteString -> Maybe ByteString)
-> (Text -> Either String ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
E.fromBase58 (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8))
bech32 :: Address -> Text
bech32 :: Address -> Text
bech32 Address
addr = HumanReadablePart -> Address -> Text
bech32With (Address -> HumanReadablePart
addressHrp Address
addr) Address
addr
bech32With :: HumanReadablePart -> Address -> Text
bech32With :: HumanReadablePart -> Address -> Text
bech32With HumanReadablePart
hrp = ByteString -> Text
T.decodeLatin1 (ByteString -> Text) -> (Address -> ByteString) -> Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
hrp) (ByteString -> ByteString)
-> (Address -> ByteString) -> Address -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> ByteString
unAddress
fromBech32 :: Text -> Maybe Address
fromBech32 :: Text -> Maybe Address
fromBech32 = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe
(Either String Address -> Maybe Address)
-> (Text -> Either String Address) -> Text -> Maybe Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HumanReadablePart, ByteString) -> Address)
-> Either String (HumanReadablePart, ByteString)
-> Either String Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Address
unsafeMkAddress (ByteString -> Address)
-> ((HumanReadablePart, ByteString) -> ByteString)
-> (HumanReadablePart, ByteString)
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HumanReadablePart, ByteString) -> ByteString
forall a b. (a, b) -> b
snd)
(Either String (HumanReadablePart, ByteString)
-> Either String Address)
-> (Text -> Either String (HumanReadablePart, ByteString))
-> Text
-> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> ShowS)
-> ByteString -> Either String (HumanReadablePart, ByteString)
E.fromBech32 (ShowS -> [Int] -> ShowS
forall a b. a -> b -> a
const ShowS
forall a. a -> a
id)
(ByteString -> Either String (HumanReadablePart, ByteString))
-> (Text -> ByteString)
-> Text
-> Either String (HumanReadablePart, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
addressHrp :: Address -> HumanReadablePart
addressHrp :: Address -> HumanReadablePart
addressHrp (Address ByteString
bs) = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Just (Word8
w8, ByteString
_) | Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
w8 Int
0 -> HumanReadablePart
CIP5.addr
Maybe (Word8, ByteString)
_ -> HumanReadablePart
CIP5.addr_test
class HasNetworkDiscriminant key => StakeAddress key where
stakeAddress :: NetworkDiscriminant key -> key 'DelegationK XPub -> Address
class HasNetworkDiscriminant key => PaymentAddress key where
paymentAddress :: NetworkDiscriminant key -> key 'PaymentK XPub -> Address
class PaymentAddress key
=> DelegationAddress key where
delegationAddress
:: NetworkDiscriminant key
-> key 'PaymentK XPub
-> key 'DelegationK XPub
-> Address
data ChainPointer = ChainPointer
{ ChainPointer -> Natural
slotNum :: Natural
, ChainPointer -> Natural
transactionIndex :: Natural
, ChainPointer -> Natural
outputIndex :: Natural
} deriving stock ((forall x. ChainPointer -> Rep ChainPointer x)
-> (forall x. Rep ChainPointer x -> ChainPointer)
-> Generic ChainPointer
forall x. Rep ChainPointer x -> ChainPointer
forall x. ChainPointer -> Rep ChainPointer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainPointer x -> ChainPointer
$cfrom :: forall x. ChainPointer -> Rep ChainPointer x
Generic, Int -> ChainPointer -> ShowS
[ChainPointer] -> ShowS
ChainPointer -> String
(Int -> ChainPointer -> ShowS)
-> (ChainPointer -> String)
-> ([ChainPointer] -> ShowS)
-> Show ChainPointer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainPointer] -> ShowS
$cshowList :: [ChainPointer] -> ShowS
show :: ChainPointer -> String
$cshow :: ChainPointer -> String
showsPrec :: Int -> ChainPointer -> ShowS
$cshowsPrec :: Int -> ChainPointer -> ShowS
Show, ChainPointer -> ChainPointer -> Bool
(ChainPointer -> ChainPointer -> Bool)
-> (ChainPointer -> ChainPointer -> Bool) -> Eq ChainPointer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainPointer -> ChainPointer -> Bool
$c/= :: ChainPointer -> ChainPointer -> Bool
== :: ChainPointer -> ChainPointer -> Bool
$c== :: ChainPointer -> ChainPointer -> Bool
Eq, Eq ChainPointer
Eq ChainPointer
-> (ChainPointer -> ChainPointer -> Ordering)
-> (ChainPointer -> ChainPointer -> Bool)
-> (ChainPointer -> ChainPointer -> Bool)
-> (ChainPointer -> ChainPointer -> Bool)
-> (ChainPointer -> ChainPointer -> Bool)
-> (ChainPointer -> ChainPointer -> ChainPointer)
-> (ChainPointer -> ChainPointer -> ChainPointer)
-> Ord ChainPointer
ChainPointer -> ChainPointer -> Bool
ChainPointer -> ChainPointer -> Ordering
ChainPointer -> ChainPointer -> ChainPointer
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 :: ChainPointer -> ChainPointer -> ChainPointer
$cmin :: ChainPointer -> ChainPointer -> ChainPointer
max :: ChainPointer -> ChainPointer -> ChainPointer
$cmax :: ChainPointer -> ChainPointer -> ChainPointer
>= :: ChainPointer -> ChainPointer -> Bool
$c>= :: ChainPointer -> ChainPointer -> Bool
> :: ChainPointer -> ChainPointer -> Bool
$c> :: ChainPointer -> ChainPointer -> Bool
<= :: ChainPointer -> ChainPointer -> Bool
$c<= :: ChainPointer -> ChainPointer -> Bool
< :: ChainPointer -> ChainPointer -> Bool
$c< :: ChainPointer -> ChainPointer -> Bool
compare :: ChainPointer -> ChainPointer -> Ordering
$ccompare :: ChainPointer -> ChainPointer -> Ordering
$cp1Ord :: Eq ChainPointer
Ord)
instance NFData ChainPointer
instance ToJSON ChainPointer where
toJSON :: ChainPointer -> Value
toJSON ChainPointer{Natural
outputIndex :: Natural
transactionIndex :: Natural
slotNum :: Natural
outputIndex :: ChainPointer -> Natural
transactionIndex :: ChainPointer -> Natural
slotNum :: ChainPointer -> Natural
..} = [Pair] -> Value
object
[ Text
"slot_num" Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
slotNum
, Text
"transaction_index" Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
transactionIndex
, Text
"output_index" Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
outputIndex
]
class PaymentAddress key
=> PointerAddress key where
pointerAddress
:: NetworkDiscriminant key
-> key 'PaymentK XPub
-> ChainPointer
-> Address
class HasNetworkDiscriminant (key :: Depth -> Type -> Type) where
type NetworkDiscriminant key :: Type
addressDiscrimination :: NetworkDiscriminant key -> AddressDiscrimination
networkTag :: NetworkDiscriminant key -> NetworkTag
newtype NetworkTag
= NetworkTag { NetworkTag -> Word32
unNetworkTag :: Word32 }
deriving ((forall x. NetworkTag -> Rep NetworkTag x)
-> (forall x. Rep NetworkTag x -> NetworkTag) -> Generic NetworkTag
forall x. Rep NetworkTag x -> NetworkTag
forall x. NetworkTag -> Rep NetworkTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkTag x -> NetworkTag
$cfrom :: forall x. NetworkTag -> Rep NetworkTag x
Generic, Int -> NetworkTag -> ShowS
[NetworkTag] -> ShowS
NetworkTag -> String
(Int -> NetworkTag -> ShowS)
-> (NetworkTag -> String)
-> ([NetworkTag] -> ShowS)
-> Show NetworkTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkTag] -> ShowS
$cshowList :: [NetworkTag] -> ShowS
show :: NetworkTag -> String
$cshow :: NetworkTag -> String
showsPrec :: Int -> NetworkTag -> ShowS
$cshowsPrec :: Int -> NetworkTag -> ShowS
Show, NetworkTag -> NetworkTag -> Bool
(NetworkTag -> NetworkTag -> Bool)
-> (NetworkTag -> NetworkTag -> Bool) -> Eq NetworkTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkTag -> NetworkTag -> Bool
$c/= :: NetworkTag -> NetworkTag -> Bool
== :: NetworkTag -> NetworkTag -> Bool
$c== :: NetworkTag -> NetworkTag -> Bool
Eq)
instance NFData NetworkTag
instance ToJSON NetworkTag where
toJSON :: NetworkTag -> Value
toJSON (NetworkTag Word32
net) = Scientific -> Value
Number (Word32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
net)
data AddressDiscrimination
= RequiresNetworkTag
| RequiresNoTag
deriving ((forall x. AddressDiscrimination -> Rep AddressDiscrimination x)
-> (forall x. Rep AddressDiscrimination x -> AddressDiscrimination)
-> Generic AddressDiscrimination
forall x. Rep AddressDiscrimination x -> AddressDiscrimination
forall x. AddressDiscrimination -> Rep AddressDiscrimination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddressDiscrimination x -> AddressDiscrimination
$cfrom :: forall x. AddressDiscrimination -> Rep AddressDiscrimination x
Generic, Int -> AddressDiscrimination -> ShowS
[AddressDiscrimination] -> ShowS
AddressDiscrimination -> String
(Int -> AddressDiscrimination -> ShowS)
-> (AddressDiscrimination -> String)
-> ([AddressDiscrimination] -> ShowS)
-> Show AddressDiscrimination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressDiscrimination] -> ShowS
$cshowList :: [AddressDiscrimination] -> ShowS
show :: AddressDiscrimination -> String
$cshow :: AddressDiscrimination -> String
showsPrec :: Int -> AddressDiscrimination -> ShowS
$cshowsPrec :: Int -> AddressDiscrimination -> ShowS
Show, AddressDiscrimination -> AddressDiscrimination -> Bool
(AddressDiscrimination -> AddressDiscrimination -> Bool)
-> (AddressDiscrimination -> AddressDiscrimination -> Bool)
-> Eq AddressDiscrimination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressDiscrimination -> AddressDiscrimination -> Bool
$c/= :: AddressDiscrimination -> AddressDiscrimination -> Bool
== :: AddressDiscrimination -> AddressDiscrimination -> Bool
$c== :: AddressDiscrimination -> AddressDiscrimination -> Bool
Eq)
instance NFData AddressDiscrimination
invariantSize :: HasCallStack => Int -> ByteString -> ByteString
invariantSize :: Int -> ByteString -> ByteString
invariantSize Int
expectedLength ByteString
bytes
| ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedLength = ByteString
bytes
| Bool
otherwise = String -> ByteString
forall a. HasCallStack => String -> a
error
(String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"length was "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bytes)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but expected to be "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
expectedLength)
invariantNetworkTag :: HasCallStack => Word32 -> NetworkTag -> Word8
invariantNetworkTag :: Word32 -> NetworkTag -> Word8
invariantNetworkTag Word32
limit (NetworkTag Word32
num)
| Word32
num Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
limit = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
num
| Bool
otherwise = String -> Word8
forall a. HasCallStack => String -> a
error
(String -> Word8) -> String -> Word8
forall a b. (a -> b) -> a -> b
$ String
"network tag was "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
num
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but expected to be less than "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
limit