module Tezos.Address
( Address (..)
, mkKeyAddress
, mkContractAddressRaw
, formatAddress
, mformatAddress
, parseAddress
, unsafeParseAddress
) where
import Data.Aeson (FromJSON(..), FromJSONKey, ToJSON(..), ToJSONKey)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson
import qualified Data.Aeson.Types as AesonTypes
import qualified Data.ByteString as BS
import Fmt (fmt, hexF, pretty)
import qualified Formatting.Buildable as Buildable
import Test.QuickCheck (Arbitrary(..), oneof, vector)
import Michelson.Text
import Tezos.Crypto
data Address
= KeyAddress !KeyHash
| ContractAddress !ByteString
deriving (Show, Eq, Ord)
mkKeyAddress :: PublicKey -> Address
mkKeyAddress = KeyAddress . hashKey
mkContractAddressRaw :: ByteString -> Address
mkContractAddressRaw = ContractAddress . blake2b160 . blake2b160
formatAddress :: Address -> Text
formatAddress =
\case
KeyAddress h -> formatKeyHash h
ContractAddress bs -> encodeBase58Check (contractAddressPrefix <> bs)
mformatAddress :: Address -> MText
mformatAddress = mkMTextUnsafe . formatAddress
instance Buildable.Buildable Address where
build = Buildable.build . formatAddress
data ParseAddressError
= ParseAddressWrongBase58Check
| ParseAddressBothFailed !CryptoParseError !ParseContractAddressError
deriving (Show, Eq)
instance Buildable.Buildable ParseAddressError where
build =
\case
ParseAddressWrongBase58Check -> "Wrong base58check format"
ParseAddressBothFailed pkErr contractErr ->
mconcat
[ "Address is neither `KeyAddress` ("
, Buildable.build pkErr
, "), nor `ContractAddress` ("
, Buildable.build contractErr
, ")"
]
parseAddress :: Text -> Either ParseAddressError Address
parseAddress addressText =
case parseKeyHash addressText of
Left CryptoParseWrongBase58Check -> Left ParseAddressWrongBase58Check
Left keyAddrErr -> first (ParseAddressBothFailed keyAddrErr) $
parseContractAddress addressText
Right keyHash -> Right (KeyAddress keyHash)
unsafeParseAddress :: HasCallStack => Text -> Address
unsafeParseAddress = either (error . pretty) id . parseAddress
data ParseContractAddressError
= ParseContractAddressWrongBase58Check
| ParseContractAddressWrongTag !ByteString
| ParseContractAddressWrongSize !Int
deriving (Show, Eq)
instance Buildable.Buildable ParseContractAddressError where
build =
\case
ParseContractAddressWrongBase58Check ->
"Wrong base58check format"
ParseContractAddressWrongTag tag ->
"Wrong tag for a contract address: " <> fmt (hexF tag)
ParseContractAddressWrongSize s ->
"Wrong size for a contract address: " <> Buildable.build s
parseContractAddress :: Text -> Either ParseContractAddressError Address
parseContractAddress text =
case decodeBase58CheckWithPrefix contractAddressPrefix text of
Left (B58CheckWithPrefixWrongPrefix prefix) ->
Left (ParseContractAddressWrongTag prefix)
Left B58CheckWithPrefixWrongEncoding ->
Left ParseContractAddressWrongBase58Check
Right bs | length bs == 20 -> Right (ContractAddress bs)
| otherwise -> Left $ ParseContractAddressWrongSize (length bs)
contractAddressPrefix :: ByteString
contractAddressPrefix = "\2\90\121"
instance ToJSON Address where
toJSON = Aeson.String . formatAddress
toEncoding = Aeson.text . formatAddress
instance ToJSONKey Address where
toJSONKey = AesonTypes.toJSONKeyText formatAddress
instance FromJSON Address where
parseJSON =
Aeson.withText "Address" $
either (fail . pretty) pure . parseAddress
instance FromJSONKey Address where
fromJSONKey =
AesonTypes.FromJSONKeyTextParser
(either (fail . pretty) pure . parseAddress)
instance Arbitrary Address where
arbitrary = oneof [genKeyAddress, genContractAddress]
where
genKeyAddress = KeyAddress <$> arbitrary
genContractAddress = ContractAddress . BS.pack <$> vector 20