-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Address in Tezos.

module Tezos.Address
  ( ContractHash (..)
  , Address (..)
  , mkKeyAddress
  , detGenKeyAddress

  , OperationHash (..)
  , OriginationIndex (..)
  , GlobalCounter(..)
  , mkContractAddress
  , mkContractHashHack

  -- * Formatting
  , ParseAddressError (..)
  , ParseAddressRawError (..)
  , ParseContractAddressError (..)
  , formatAddress
  , mformatAddress
  , parseAddressRaw
  , parseContractHash
  , parseAddress
  , unsafeParseAddressRaw
  , unsafeParseAddress
  , unsafeParseContractHash
  ) 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 Data.Binary.Put (putInt32be, putWord64be, runPut)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Fmt (Buildable(build), hexF, pretty)

import Michelson.Text
import Tezos.Crypto
import Util.CLI

-- TODO: we should probably have a `Hash` type.
-- | Hash of origination command for some contract.
newtype ContractHash = ContractHash ByteString
  deriving stock (Int -> ContractHash -> ShowS
[ContractHash] -> ShowS
ContractHash -> String
(Int -> ContractHash -> ShowS)
-> (ContractHash -> String)
-> ([ContractHash] -> ShowS)
-> Show ContractHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContractHash] -> ShowS
$cshowList :: [ContractHash] -> ShowS
show :: ContractHash -> String
$cshow :: ContractHash -> String
showsPrec :: Int -> ContractHash -> ShowS
$cshowsPrec :: Int -> ContractHash -> ShowS
Show, ContractHash -> ContractHash -> Bool
(ContractHash -> ContractHash -> Bool)
-> (ContractHash -> ContractHash -> Bool) -> Eq ContractHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractHash -> ContractHash -> Bool
$c/= :: ContractHash -> ContractHash -> Bool
== :: ContractHash -> ContractHash -> Bool
$c== :: ContractHash -> ContractHash -> Bool
Eq, Eq ContractHash
Eq ContractHash =>
(ContractHash -> ContractHash -> Ordering)
-> (ContractHash -> ContractHash -> Bool)
-> (ContractHash -> ContractHash -> Bool)
-> (ContractHash -> ContractHash -> Bool)
-> (ContractHash -> ContractHash -> Bool)
-> (ContractHash -> ContractHash -> ContractHash)
-> (ContractHash -> ContractHash -> ContractHash)
-> Ord ContractHash
ContractHash -> ContractHash -> Bool
ContractHash -> ContractHash -> Ordering
ContractHash -> ContractHash -> ContractHash
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 :: ContractHash -> ContractHash -> ContractHash
$cmin :: ContractHash -> ContractHash -> ContractHash
max :: ContractHash -> ContractHash -> ContractHash
$cmax :: ContractHash -> ContractHash -> ContractHash
>= :: ContractHash -> ContractHash -> Bool
$c>= :: ContractHash -> ContractHash -> Bool
> :: ContractHash -> ContractHash -> Bool
$c> :: ContractHash -> ContractHash -> Bool
<= :: ContractHash -> ContractHash -> Bool
$c<= :: ContractHash -> ContractHash -> Bool
< :: ContractHash -> ContractHash -> Bool
$c< :: ContractHash -> ContractHash -> Bool
compare :: ContractHash -> ContractHash -> Ordering
$ccompare :: ContractHash -> ContractHash -> Ordering
$cp1Ord :: Eq ContractHash
Ord, (forall x. ContractHash -> Rep ContractHash x)
-> (forall x. Rep ContractHash x -> ContractHash)
-> Generic ContractHash
forall x. Rep ContractHash x -> ContractHash
forall x. ContractHash -> Rep ContractHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContractHash x -> ContractHash
$cfrom :: forall x. ContractHash -> Rep ContractHash x
Generic)

instance NFData ContractHash

-- We know that the length must be 20.
-- Currently it's hardcoded here, later we'll probably have a `Hash` type.
-- | Length of contract hash in bytes (only hash itself, no tags, checksums
-- or anything).
contractHashLengthBytes :: Integral n => n
contractHashLengthBytes :: n
contractHashLengthBytes = 20

-- | Data type corresponding to address structure in Tezos.
data Address
  = KeyAddress KeyHash
  -- ^ `tz` address which is a hash of a public key.
  | ContractAddress ContractHash
  -- ^ `KT` address which corresponds to a callable contract.
  deriving stock (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, (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)

instance NFData Address

-- | Smart constructor for 'KeyAddress'.
mkKeyAddress :: PublicKey -> Address
mkKeyAddress :: PublicKey -> Address
mkKeyAddress = KeyHash -> Address
KeyAddress (KeyHash -> Address)
-> (PublicKey -> KeyHash) -> PublicKey -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> KeyHash
hashKey

-- | Deterministically generate a random 'KeyAddress' and discard its
-- secret key.
detGenKeyAddress :: ByteString -> Address
detGenKeyAddress :: ByteString -> Address
detGenKeyAddress = PublicKey -> Address
mkKeyAddress (PublicKey -> Address)
-> (ByteString -> PublicKey) -> ByteString -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey)
-> (ByteString -> SecretKey) -> ByteString -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> SecretKey
ByteString -> SecretKey
detSecretKey

newtype OperationHash = OperationHash
  { OperationHash -> ByteString
unOperationHash :: ByteString
  }
  deriving stock (Int -> OperationHash -> ShowS
[OperationHash] -> ShowS
OperationHash -> String
(Int -> OperationHash -> ShowS)
-> (OperationHash -> String)
-> ([OperationHash] -> ShowS)
-> Show OperationHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationHash] -> ShowS
$cshowList :: [OperationHash] -> ShowS
show :: OperationHash -> String
$cshow :: OperationHash -> String
showsPrec :: Int -> OperationHash -> ShowS
$cshowsPrec :: Int -> OperationHash -> ShowS
Show, OperationHash -> OperationHash -> Bool
(OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool) -> Eq OperationHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationHash -> OperationHash -> Bool
$c/= :: OperationHash -> OperationHash -> Bool
== :: OperationHash -> OperationHash -> Bool
$c== :: OperationHash -> OperationHash -> Bool
Eq, Eq OperationHash
Eq OperationHash =>
(OperationHash -> OperationHash -> Ordering)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> OperationHash)
-> (OperationHash -> OperationHash -> OperationHash)
-> Ord OperationHash
OperationHash -> OperationHash -> Bool
OperationHash -> OperationHash -> Ordering
OperationHash -> OperationHash -> OperationHash
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 :: OperationHash -> OperationHash -> OperationHash
$cmin :: OperationHash -> OperationHash -> OperationHash
max :: OperationHash -> OperationHash -> OperationHash
$cmax :: OperationHash -> OperationHash -> OperationHash
>= :: OperationHash -> OperationHash -> Bool
$c>= :: OperationHash -> OperationHash -> Bool
> :: OperationHash -> OperationHash -> Bool
$c> :: OperationHash -> OperationHash -> Bool
<= :: OperationHash -> OperationHash -> Bool
$c<= :: OperationHash -> OperationHash -> Bool
< :: OperationHash -> OperationHash -> Bool
$c< :: OperationHash -> OperationHash -> Bool
compare :: OperationHash -> OperationHash -> Ordering
$ccompare :: OperationHash -> OperationHash -> Ordering
$cp1Ord :: Eq OperationHash
Ord, (forall x. OperationHash -> Rep OperationHash x)
-> (forall x. Rep OperationHash x -> OperationHash)
-> Generic OperationHash
forall x. Rep OperationHash x -> OperationHash
forall x. OperationHash -> Rep OperationHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OperationHash x -> OperationHash
$cfrom :: forall x. OperationHash -> Rep OperationHash x
Generic)
  deriving anyclass (OperationHash -> ()
(OperationHash -> ()) -> NFData OperationHash
forall a. (a -> ()) -> NFData a
rnf :: OperationHash -> ()
$crnf :: OperationHash -> ()
NFData)

-- | Represents the network's global counter.
--
-- When a new contract is created (either via a "global" origination operation or
-- via a @CREATE_CONTRACT@ instruction), this counter is used to create a new address for it
-- (see 'mkContractAddress').
--
-- The counter is incremented after every operation, and thus ensures that these
-- addresses are unique (i.e. origination of identical contracts with identical metadata will
-- result in different addresses.)
--
-- In Tezos each operation has a special field called @counter@, see here:
-- https://gitlab.com/tezos/tezos/-/blob/397dd233a10cc6df0df959e2a624c7947997dd0c/src/proto_006_PsCARTHA/lib_protocol/operation_repr.ml#L113-120
--
-- This counter seems to be a part of global state of Tezos network. In fact, it may be observed
-- in raw JSON representation of the operation in the network explorer.
--
-- Our counter is represented as 'Word64', while in Tezos it is unbounded. We believe that
-- for our interpreter it should not matter.
newtype GlobalCounter = GlobalCounter { GlobalCounter -> Word64
unGlobalCounter :: Word64 }
  deriving stock (Int -> GlobalCounter -> ShowS
[GlobalCounter] -> ShowS
GlobalCounter -> String
(Int -> GlobalCounter -> ShowS)
-> (GlobalCounter -> String)
-> ([GlobalCounter] -> ShowS)
-> Show GlobalCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalCounter] -> ShowS
$cshowList :: [GlobalCounter] -> ShowS
show :: GlobalCounter -> String
$cshow :: GlobalCounter -> String
showsPrec :: Int -> GlobalCounter -> ShowS
$cshowsPrec :: Int -> GlobalCounter -> ShowS
Show, GlobalCounter -> GlobalCounter -> Bool
(GlobalCounter -> GlobalCounter -> Bool)
-> (GlobalCounter -> GlobalCounter -> Bool) -> Eq GlobalCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalCounter -> GlobalCounter -> Bool
$c/= :: GlobalCounter -> GlobalCounter -> Bool
== :: GlobalCounter -> GlobalCounter -> Bool
$c== :: GlobalCounter -> GlobalCounter -> Bool
Eq, (forall x. GlobalCounter -> Rep GlobalCounter x)
-> (forall x. Rep GlobalCounter x -> GlobalCounter)
-> Generic GlobalCounter
forall x. Rep GlobalCounter x -> GlobalCounter
forall x. GlobalCounter -> Rep GlobalCounter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalCounter x -> GlobalCounter
$cfrom :: forall x. GlobalCounter -> Rep GlobalCounter x
Generic)
  deriving anyclass (GlobalCounter -> ()
(GlobalCounter -> ()) -> NFData GlobalCounter
forall a. (a -> ()) -> NFData a
rnf :: GlobalCounter -> ()
$crnf :: GlobalCounter -> ()
NFData)
  deriving newtype ([GlobalCounter] -> Encoding
[GlobalCounter] -> Value
GlobalCounter -> Encoding
GlobalCounter -> Value
(GlobalCounter -> Value)
-> (GlobalCounter -> Encoding)
-> ([GlobalCounter] -> Value)
-> ([GlobalCounter] -> Encoding)
-> ToJSON GlobalCounter
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GlobalCounter] -> Encoding
$ctoEncodingList :: [GlobalCounter] -> Encoding
toJSONList :: [GlobalCounter] -> Value
$ctoJSONList :: [GlobalCounter] -> Value
toEncoding :: GlobalCounter -> Encoding
$ctoEncoding :: GlobalCounter -> Encoding
toJSON :: GlobalCounter -> Value
$ctoJSON :: GlobalCounter -> Value
ToJSON, Value -> Parser [GlobalCounter]
Value -> Parser GlobalCounter
(Value -> Parser GlobalCounter)
-> (Value -> Parser [GlobalCounter]) -> FromJSON GlobalCounter
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GlobalCounter]
$cparseJSONList :: Value -> Parser [GlobalCounter]
parseJSON :: Value -> Parser GlobalCounter
$cparseJSON :: Value -> Parser GlobalCounter
FromJSON, Integer -> GlobalCounter
GlobalCounter -> GlobalCounter
GlobalCounter -> GlobalCounter -> GlobalCounter
(GlobalCounter -> GlobalCounter -> GlobalCounter)
-> (GlobalCounter -> GlobalCounter -> GlobalCounter)
-> (GlobalCounter -> GlobalCounter -> GlobalCounter)
-> (GlobalCounter -> GlobalCounter)
-> (GlobalCounter -> GlobalCounter)
-> (GlobalCounter -> GlobalCounter)
-> (Integer -> GlobalCounter)
-> Num GlobalCounter
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> GlobalCounter
$cfromInteger :: Integer -> GlobalCounter
signum :: GlobalCounter -> GlobalCounter
$csignum :: GlobalCounter -> GlobalCounter
abs :: GlobalCounter -> GlobalCounter
$cabs :: GlobalCounter -> GlobalCounter
negate :: GlobalCounter -> GlobalCounter
$cnegate :: GlobalCounter -> GlobalCounter
* :: GlobalCounter -> GlobalCounter -> GlobalCounter
$c* :: GlobalCounter -> GlobalCounter -> GlobalCounter
- :: GlobalCounter -> GlobalCounter -> GlobalCounter
$c- :: GlobalCounter -> GlobalCounter -> GlobalCounter
+ :: GlobalCounter -> GlobalCounter -> GlobalCounter
$c+ :: GlobalCounter -> GlobalCounter -> GlobalCounter
Num)

-- | When a transfer operation triggers multiple @CREATE_CONTRACT@
-- instructions, using 'GlobalCounter' to compute those contracts' addresses
-- is not enough to ensure their uniqueness.
--
-- For that reason, we also keep track of an 'OriginationIndex' that starts out as 0
-- when a transfer is initiated, and is incremented every time a @CREATE_CONTRACT@
-- instruction is interpreted.
--
-- See 'mkContractAddress'.
newtype OriginationIndex = OriginationIndex { OriginationIndex -> Int32
unOriginationIndex :: Int32 }
  deriving stock (Int -> OriginationIndex -> ShowS
[OriginationIndex] -> ShowS
OriginationIndex -> String
(Int -> OriginationIndex -> ShowS)
-> (OriginationIndex -> String)
-> ([OriginationIndex] -> ShowS)
-> Show OriginationIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OriginationIndex] -> ShowS
$cshowList :: [OriginationIndex] -> ShowS
show :: OriginationIndex -> String
$cshow :: OriginationIndex -> String
showsPrec :: Int -> OriginationIndex -> ShowS
$cshowsPrec :: Int -> OriginationIndex -> ShowS
Show, OriginationIndex -> OriginationIndex -> Bool
(OriginationIndex -> OriginationIndex -> Bool)
-> (OriginationIndex -> OriginationIndex -> Bool)
-> Eq OriginationIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OriginationIndex -> OriginationIndex -> Bool
$c/= :: OriginationIndex -> OriginationIndex -> Bool
== :: OriginationIndex -> OriginationIndex -> Bool
$c== :: OriginationIndex -> OriginationIndex -> Bool
Eq, Eq OriginationIndex
Eq OriginationIndex =>
(OriginationIndex -> OriginationIndex -> Ordering)
-> (OriginationIndex -> OriginationIndex -> Bool)
-> (OriginationIndex -> OriginationIndex -> Bool)
-> (OriginationIndex -> OriginationIndex -> Bool)
-> (OriginationIndex -> OriginationIndex -> Bool)
-> (OriginationIndex -> OriginationIndex -> OriginationIndex)
-> (OriginationIndex -> OriginationIndex -> OriginationIndex)
-> Ord OriginationIndex
OriginationIndex -> OriginationIndex -> Bool
OriginationIndex -> OriginationIndex -> Ordering
OriginationIndex -> OriginationIndex -> OriginationIndex
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 :: OriginationIndex -> OriginationIndex -> OriginationIndex
$cmin :: OriginationIndex -> OriginationIndex -> OriginationIndex
max :: OriginationIndex -> OriginationIndex -> OriginationIndex
$cmax :: OriginationIndex -> OriginationIndex -> OriginationIndex
>= :: OriginationIndex -> OriginationIndex -> Bool
$c>= :: OriginationIndex -> OriginationIndex -> Bool
> :: OriginationIndex -> OriginationIndex -> Bool
$c> :: OriginationIndex -> OriginationIndex -> Bool
<= :: OriginationIndex -> OriginationIndex -> Bool
$c<= :: OriginationIndex -> OriginationIndex -> Bool
< :: OriginationIndex -> OriginationIndex -> Bool
$c< :: OriginationIndex -> OriginationIndex -> Bool
compare :: OriginationIndex -> OriginationIndex -> Ordering
$ccompare :: OriginationIndex -> OriginationIndex -> Ordering
$cp1Ord :: Eq OriginationIndex
Ord, (forall x. OriginationIndex -> Rep OriginationIndex x)
-> (forall x. Rep OriginationIndex x -> OriginationIndex)
-> Generic OriginationIndex
forall x. Rep OriginationIndex x -> OriginationIndex
forall x. OriginationIndex -> Rep OriginationIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OriginationIndex x -> OriginationIndex
$cfrom :: forall x. OriginationIndex -> Rep OriginationIndex x
Generic)
  deriving anyclass (OriginationIndex -> ()
(OriginationIndex -> ()) -> NFData OriginationIndex
forall a. (a -> ()) -> NFData a
rnf :: OriginationIndex -> ()
$crnf :: OriginationIndex -> ()
NFData)

-- | Compute address of a contract from its origination operation, origination index and global counter.
--
-- However, in real Tezos encoding of the operation is more than just 'OriginationOperation'.
-- There an Operation has several more meta-fields plus a big sum-type of all possible operations.
--
-- See here: https://gitlab.com/tezos/tezos/-/blob/f57c50e3a657956d69a1699978de9873c98f0018/src/proto_006_PsCARTHA/lib_protocol/operation_repr.ml#L78
--
-- What is important is that one (big) Operation may lead to origination of multiple contracts. That
-- is why contract address is constructed from hash of the operation that originated and of index
-- of the contract's origination in the execution of that operation.
--
-- In other words, contract hash is calculated as the blake2b160 (20-byte) hash of
-- origination operation hash + int32 origination index + word64 global counter.
--
-- In Morley we do not yet support full encoding of Tezos Operations, therefore we choose
-- to generate contract addresses in a simplified manner.
--
-- Namely, we encode 'OriginationOperation' as we can and concat it with the origination index
-- and the global counter.
-- Then we take 'blake2b160' hash of the resulting bytes and consider it to be the contract's
-- address.
mkContractAddress
  :: OperationHash
  -> OriginationIndex
  -> GlobalCounter
  -> Address
mkContractAddress :: OperationHash -> OriginationIndex -> GlobalCounter -> Address
mkContractAddress (OperationHash opHash :: ByteString
opHash) (OriginationIndex idx :: Int32
idx) (GlobalCounter counter :: Word64
counter) =
  ContractHash -> Address
ContractAddress
  (ContractHash -> Address) -> ContractHash -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ContractHash
ContractHash
  (ByteString -> ContractHash) -> ByteString -> ContractHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b160
  (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
opHash ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BSL.toStrict (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Int32 -> Put
putInt32be Int32
idx Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be Word64
counter)

-- | Create a dummy 'ContractHash' value by hashing given 'ByteString'.
--
-- Use in tests **only**.
mkContractHashHack :: ByteString -> ContractHash
mkContractHashHack :: ByteString -> ContractHash
mkContractHashHack = ByteString -> ContractHash
ContractHash (ByteString -> ContractHash)
-> (ByteString -> ByteString) -> ByteString -> ContractHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
blake2b160

----------------------------------------------------------------------------
-- Formatting/parsing
----------------------------------------------------------------------------

-- It's a magic constant used by Tezos to encode a contract address.
-- It was deduced empirically.
contractAddressPrefix :: ByteString
contractAddressPrefix :: ByteString
contractAddressPrefix = "\2\90\121"

formatContractHash :: ContractHash -> Text
formatContractHash :: ContractHash -> Text
formatContractHash (ContractHash bs :: ByteString
bs) =
  ByteString -> Text
encodeBase58Check (ByteString
contractAddressPrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs)

formatAddress :: Address -> Text
formatAddress :: Address -> Text
formatAddress =
  \case
    KeyAddress h :: KeyHash
h -> KeyHash -> Text
formatKeyHash KeyHash
h
    ContractAddress h :: ContractHash
h -> ContractHash -> Text
formatContractHash ContractHash
h

mformatAddress :: Address -> MText
mformatAddress :: Address -> MText
mformatAddress = HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> (Address -> Text) -> Address -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
formatAddress

instance Buildable Address where
  build :: Address -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (Address -> Text) -> Address -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
formatAddress

-- | Errors that can happen during address parsing.
data ParseAddressError
  = ParseAddressWrongBase58Check
  -- ^ Address is not in Base58Check format.
  | ParseAddressBothFailed CryptoParseError ParseContractAddressError
  -- ^ Both address parsers failed with some error.
  deriving stock (Int -> ParseAddressError -> ShowS
[ParseAddressError] -> ShowS
ParseAddressError -> String
(Int -> ParseAddressError -> ShowS)
-> (ParseAddressError -> String)
-> ([ParseAddressError] -> ShowS)
-> Show ParseAddressError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseAddressError] -> ShowS
$cshowList :: [ParseAddressError] -> ShowS
show :: ParseAddressError -> String
$cshow :: ParseAddressError -> String
showsPrec :: Int -> ParseAddressError -> ShowS
$cshowsPrec :: Int -> ParseAddressError -> ShowS
Show, ParseAddressError -> ParseAddressError -> Bool
(ParseAddressError -> ParseAddressError -> Bool)
-> (ParseAddressError -> ParseAddressError -> Bool)
-> Eq ParseAddressError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseAddressError -> ParseAddressError -> Bool
$c/= :: ParseAddressError -> ParseAddressError -> Bool
== :: ParseAddressError -> ParseAddressError -> Bool
$c== :: ParseAddressError -> ParseAddressError -> Bool
Eq, (forall x. ParseAddressError -> Rep ParseAddressError x)
-> (forall x. Rep ParseAddressError x -> ParseAddressError)
-> Generic ParseAddressError
forall x. Rep ParseAddressError x -> ParseAddressError
forall x. ParseAddressError -> Rep ParseAddressError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseAddressError x -> ParseAddressError
$cfrom :: forall x. ParseAddressError -> Rep ParseAddressError x
Generic)

instance NFData ParseAddressError

instance Buildable ParseAddressError where
  build :: ParseAddressError -> Builder
build =
    \case
      ParseAddressWrongBase58Check -> "Wrong base58check format"
      ParseAddressBothFailed pkErr :: CryptoParseError
pkErr contractErr :: ParseContractAddressError
contractErr ->
        [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ "Address is neither `KeyAddress` ("
        , CryptoParseError -> Builder
forall p. Buildable p => p -> Builder
build CryptoParseError
pkErr
        , "), nor `ContractAddress` ("
        , ParseContractAddressError -> Builder
forall p. Buildable p => p -> Builder
build ParseContractAddressError
contractErr
        , ")"
        ]

-- | Parse an address from its human-readable textual representation
-- used by Tezos (e. g. "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU"). Or
-- fail if it's invalid.
parseAddress :: Text -> Either ParseAddressError Address
parseAddress :: Text -> Either ParseAddressError Address
parseAddress addressText :: Text
addressText =
  case Text -> Either CryptoParseError KeyHash
parseKeyHash Text
addressText of
    Left CryptoParseWrongBase58Check -> ParseAddressError -> Either ParseAddressError Address
forall a b. a -> Either a b
Left ParseAddressError
ParseAddressWrongBase58Check
    Left keyAddrErr :: CryptoParseError
keyAddrErr -> (ParseContractAddressError -> ParseAddressError)
-> Either ParseContractAddressError Address
-> Either ParseAddressError Address
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (CryptoParseError -> ParseContractAddressError -> ParseAddressError
ParseAddressBothFailed CryptoParseError
keyAddrErr) (Either ParseContractAddressError Address
 -> Either ParseAddressError Address)
-> Either ParseContractAddressError Address
-> Either ParseAddressError Address
forall a b. (a -> b) -> a -> b
$
      ContractHash -> Address
ContractAddress (ContractHash -> Address)
-> Either ParseContractAddressError ContractHash
-> Either ParseContractAddressError Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either ParseContractAddressError ContractHash
parseContractHash Text
addressText
    Right keyHash :: KeyHash
keyHash -> Address -> Either ParseAddressError Address
forall a b. b -> Either a b
Right (KeyHash -> Address
KeyAddress KeyHash
keyHash)

data ParseAddressRawError
  = ParseAddressRawWrongSize ByteString
  -- ^ Raw bytes representation of an address has invalid length.
  | ParseAddressRawInvalidPrefix ByteString
  -- ^ Raw bytes representation of an address has incorrect prefix.
  | ParseAddressRawMalformedSeparator ByteString
  -- ^ Raw bytes representation of an address does not end with "\00".
  deriving stock (ParseAddressRawError -> ParseAddressRawError -> Bool
(ParseAddressRawError -> ParseAddressRawError -> Bool)
-> (ParseAddressRawError -> ParseAddressRawError -> Bool)
-> Eq ParseAddressRawError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseAddressRawError -> ParseAddressRawError -> Bool
$c/= :: ParseAddressRawError -> ParseAddressRawError -> Bool
== :: ParseAddressRawError -> ParseAddressRawError -> Bool
$c== :: ParseAddressRawError -> ParseAddressRawError -> Bool
Eq, Int -> ParseAddressRawError -> ShowS
[ParseAddressRawError] -> ShowS
ParseAddressRawError -> String
(Int -> ParseAddressRawError -> ShowS)
-> (ParseAddressRawError -> String)
-> ([ParseAddressRawError] -> ShowS)
-> Show ParseAddressRawError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseAddressRawError] -> ShowS
$cshowList :: [ParseAddressRawError] -> ShowS
show :: ParseAddressRawError -> String
$cshow :: ParseAddressRawError -> String
showsPrec :: Int -> ParseAddressRawError -> ShowS
$cshowsPrec :: Int -> ParseAddressRawError -> ShowS
Show, (forall x. ParseAddressRawError -> Rep ParseAddressRawError x)
-> (forall x. Rep ParseAddressRawError x -> ParseAddressRawError)
-> Generic ParseAddressRawError
forall x. Rep ParseAddressRawError x -> ParseAddressRawError
forall x. ParseAddressRawError -> Rep ParseAddressRawError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseAddressRawError x -> ParseAddressRawError
$cfrom :: forall x. ParseAddressRawError -> Rep ParseAddressRawError x
Generic)

instance NFData ParseAddressRawError

instance Buildable ParseAddressRawError where
  build :: ParseAddressRawError -> Builder
build =
    \case
      ParseAddressRawInvalidPrefix prefix :: ByteString
prefix ->
        "Invalid prefix for raw address \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "\" provided"
      ParseAddressRawWrongSize addr :: ByteString
addr -> "Given raw address " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
addr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> " has invalid length " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall b a. (Show a, IsString b) => a -> b
show (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
addr)
      ParseAddressRawMalformedSeparator addr :: ByteString
addr -> "Given raw address " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
addr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        " does not end with \"\\00\""

-- | Parse the given address in its raw byte form used by Tezos
-- (e.g "01521139f84791537d54575df0c74a8084cc68861c00")) . Or fail otherwise
-- if it's invalid.
parseAddressRaw :: ByteString -> Either ParseAddressRawError Address
parseAddressRaw :: ByteString -> Either ParseAddressRawError Address
parseAddressRaw (Int -> ByteString -> (ByteString, ByteString)
BS.splitAt 2 -> (prefix :: ByteString
prefix, address :: ByteString
address)) =
  case Int -> ByteString -> ByteString
BS.take 1 ByteString
prefix of
    "\00" -> ByteString -> ByteString -> Either ParseAddressRawError Address
parseKeyAddressRaw (ByteString -> ByteString
BS.tail ByteString
prefix) ByteString
address
    "\01" -> ByteString -> ByteString -> Either ParseAddressRawError Address
parseContractAddressRaw ByteString
prefix ByteString
address
    _ -> ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. a -> Either a b
Left (ParseAddressRawError -> Either ParseAddressRawError Address)
-> ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawInvalidPrefix ByteString
prefix
  where
    parseKeyAddressRaw :: ByteString -> ByteString -> Either ParseAddressRawError Address
parseKeyAddressRaw keyPrefix :: ByteString
keyPrefix keyAddress :: ByteString
keyAddress
      | ByteString -> Int
forall t. Container t => t -> Int
length ByteString
keyAddress Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall n. Integral n => n
keyHashLengthBytes
          = ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. a -> Either a b
Left (ParseAddressRawError -> Either ParseAddressRawError Address)
-> ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawWrongSize ByteString
keyAddress
      | Bool
otherwise = do
        KeyHashTag
matchedPrefix <- case ByteString
keyPrefix of
          "\00" -> KeyHashTag -> Either ParseAddressRawError KeyHashTag
forall a b. b -> Either a b
Right KeyHashTag
KeyHashEd25519
          "\01" -> KeyHashTag -> Either ParseAddressRawError KeyHashTag
forall a b. b -> Either a b
Right KeyHashTag
KeyHashSecp256k1
          "\02" -> KeyHashTag -> Either ParseAddressRawError KeyHashTag
forall a b. b -> Either a b
Right KeyHashTag
KeyHashP256
          _ -> ParseAddressRawError -> Either ParseAddressRawError KeyHashTag
forall a b. a -> Either a b
Left (ParseAddressRawError -> Either ParseAddressRawError KeyHashTag)
-> ParseAddressRawError -> Either ParseAddressRawError KeyHashTag
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawInvalidPrefix ByteString
keyPrefix
        pure $ KeyHash -> Address
KeyAddress (KeyHashTag -> ByteString -> KeyHash
KeyHash KeyHashTag
matchedPrefix ByteString
keyAddress)

    parseContractAddressRaw :: ByteString -> ByteString -> Either ParseAddressRawError Address
parseContractAddressRaw contractPrefix :: ByteString
contractPrefix contractAddress :: ByteString
contractAddress
      | ByteString -> Int
forall t. Container t => t -> Int
length ByteString
contractAddress Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall n. Integral n => n
contractHashLengthBytes
          = ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. a -> Either a b
Left (ParseAddressRawError -> Either ParseAddressRawError Address)
-> ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawWrongSize ByteString
contractAddress
      | ByteString -> Word8
BS.last ByteString
contractAddress Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0x00
          = ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. a -> Either a b
Left (ParseAddressRawError -> Either ParseAddressRawError Address)
-> ParseAddressRawError -> Either ParseAddressRawError Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawMalformedSeparator ByteString
contractAddress
      | Bool
otherwise = do
        let contractAddress' :: ByteString
contractAddress' = Int -> ByteString -> ByteString
BS.drop 1 ByteString
contractPrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BS.init ByteString
contractAddress -- drop last "\00" of contract address
        Address -> Either ParseAddressRawError Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either ParseAddressRawError Address)
-> Address -> Either ParseAddressRawError Address
forall a b. (a -> b) -> a -> b
$ ContractHash -> Address
ContractAddress (ByteString -> ContractHash
ContractHash ByteString
contractAddress')

data ParseContractAddressError
  = ParseContractAddressWrongBase58Check
  | ParseContractAddressWrongSize ByteString
  | ParseContractAddressWrongPrefix ByteString
  deriving stock (Int -> ParseContractAddressError -> ShowS
[ParseContractAddressError] -> ShowS
ParseContractAddressError -> String
(Int -> ParseContractAddressError -> ShowS)
-> (ParseContractAddressError -> String)
-> ([ParseContractAddressError] -> ShowS)
-> Show ParseContractAddressError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseContractAddressError] -> ShowS
$cshowList :: [ParseContractAddressError] -> ShowS
show :: ParseContractAddressError -> String
$cshow :: ParseContractAddressError -> String
showsPrec :: Int -> ParseContractAddressError -> ShowS
$cshowsPrec :: Int -> ParseContractAddressError -> ShowS
Show, ParseContractAddressError -> ParseContractAddressError -> Bool
(ParseContractAddressError -> ParseContractAddressError -> Bool)
-> (ParseContractAddressError -> ParseContractAddressError -> Bool)
-> Eq ParseContractAddressError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseContractAddressError -> ParseContractAddressError -> Bool
$c/= :: ParseContractAddressError -> ParseContractAddressError -> Bool
== :: ParseContractAddressError -> ParseContractAddressError -> Bool
$c== :: ParseContractAddressError -> ParseContractAddressError -> Bool
Eq, (forall x.
 ParseContractAddressError -> Rep ParseContractAddressError x)
-> (forall x.
    Rep ParseContractAddressError x -> ParseContractAddressError)
-> Generic ParseContractAddressError
forall x.
Rep ParseContractAddressError x -> ParseContractAddressError
forall x.
ParseContractAddressError -> Rep ParseContractAddressError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ParseContractAddressError x -> ParseContractAddressError
$cfrom :: forall x.
ParseContractAddressError -> Rep ParseContractAddressError x
Generic)

instance NFData ParseContractAddressError

instance Buildable ParseContractAddressError where
  build :: ParseContractAddressError -> Builder
build =
    \case
      ParseContractAddressWrongBase58Check ->
        "Wrong base58check format"
      ParseContractAddressWrongSize bs :: ByteString
bs ->
        "Wrong size for a contract address: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        " (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall p. Buildable p => p -> Builder
build (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
      ParseContractAddressWrongPrefix prefix :: ByteString
prefix ->
        "Invalid prefix \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "\" provided"

parseContractHash :: Text -> Either ParseContractAddressError ContractHash
parseContractHash :: Text -> Either ParseContractAddressError ContractHash
parseContractHash text :: Text
text =
  case ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix ByteString
contractAddressPrefix Text
text of
    Left (B58CheckWithPrefixWrongPrefix prefix :: ByteString
prefix) ->
      ParseContractAddressError
-> Either ParseContractAddressError ContractHash
forall a b. a -> Either a b
Left (ByteString -> ParseContractAddressError
ParseContractAddressWrongPrefix ByteString
prefix)
    Left B58CheckWithPrefixWrongEncoding ->
      ParseContractAddressError
-> Either ParseContractAddressError ContractHash
forall a b. a -> Either a b
Left ParseContractAddressError
ParseContractAddressWrongBase58Check
    Right bs :: ByteString
bs | ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall n. Integral n => n
contractHashLengthBytes -> ContractHash -> Either ParseContractAddressError ContractHash
forall a b. b -> Either a b
Right (ByteString -> ContractHash
ContractHash ByteString
bs)
             | Bool
otherwise -> ParseContractAddressError
-> Either ParseContractAddressError ContractHash
forall a b. a -> Either a b
Left (ParseContractAddressError
 -> Either ParseContractAddressError ContractHash)
-> ParseContractAddressError
-> Either ParseContractAddressError ContractHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseContractAddressError
ParseContractAddressWrongSize ByteString
bs

----------------------------------------------------------------------------
-- Unsafe
----------------------------------------------------------------------------

-- | Parse a @KT1@ contract address, fail if address does not match
-- the expected format.
unsafeParseContractHash :: HasCallStack => Text -> ContractHash
unsafeParseContractHash :: Text -> ContractHash
unsafeParseContractHash = (ParseContractAddressError -> ContractHash)
-> (ContractHash -> ContractHash)
-> Either ParseContractAddressError ContractHash
-> ContractHash
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> ContractHash
forall a. HasCallStack => Text -> a
error (Text -> ContractHash)
-> (ParseContractAddressError -> Text)
-> ParseContractAddressError
-> ContractHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseContractAddressError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) ContractHash -> ContractHash
forall a. a -> a
id (Either ParseContractAddressError ContractHash -> ContractHash)
-> (Text -> Either ParseContractAddressError ContractHash)
-> Text
-> ContractHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseContractAddressError ContractHash
parseContractHash

-- | Partial version of 'parseAddress' which assumes that the address
-- is correct. Can be used in tests.
unsafeParseAddress :: HasCallStack => Text -> Address
unsafeParseAddress :: Text -> Address
unsafeParseAddress = (ParseAddressError -> Address)
-> (Address -> Address)
-> Either ParseAddressError Address
-> Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Address
forall a. HasCallStack => Text -> a
error (Text -> Address)
-> (ParseAddressError -> Text) -> ParseAddressError -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseAddressError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Address -> Address
forall a. a -> a
id (Either ParseAddressError Address -> Address)
-> (Text -> Either ParseAddressError Address) -> Text -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseAddressError Address
parseAddress

-- | Partially parse raw bytes representation of an address and assume that
-- it is correct from the beginning. Can be used in tests.
unsafeParseAddressRaw :: ByteString -> Address
unsafeParseAddressRaw :: ByteString -> Address
unsafeParseAddressRaw = (ParseAddressRawError -> Address)
-> (Address -> Address)
-> Either ParseAddressRawError Address
-> Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Address
forall a. HasCallStack => Text -> a
error (Text -> Address)
-> (ParseAddressRawError -> Text)
-> ParseAddressRawError
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseAddressRawError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Address -> Address
forall a. a -> a
id (Either ParseAddressRawError Address -> Address)
-> (ByteString -> Either ParseAddressRawError Address)
-> ByteString
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseAddressRawError Address
parseAddressRaw

instance HasCLReader Address where
  getReader :: ReadM Address
getReader = (String -> Either String Address) -> ReadM Address
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String Address
forall a a.
(Monoid a, IsString a, FromBuilder a, ToText a) =>
a -> Either a Address
parseAddrDo
    where
      parseAddrDo :: a -> Either a Address
parseAddrDo addr :: a
addr =
        (ParseAddressError -> Either a Address)
-> (Address -> Either a Address)
-> Either ParseAddressError Address
-> Either a Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (a -> Either a Address
forall a b. a -> Either a b
Left (a -> Either a Address)
-> (ParseAddressError -> a)
-> ParseAddressError
-> Either a Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Monoid a => a -> a -> a
mappend "Failed to parse address: " (a -> a) -> (ParseAddressError -> a) -> ParseAddressError -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseAddressError -> a
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Address -> Either a Address
forall a b. b -> Either a b
Right (Either ParseAddressError Address -> Either a Address)
-> Either ParseAddressError Address -> Either a Address
forall a b. (a -> b) -> a -> b
$
        Text -> Either ParseAddressError Address
parseAddress (Text -> Either ParseAddressError Address)
-> Text -> Either ParseAddressError Address
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToText a => a -> Text
toText a
addr
  getMetavar :: String
getMetavar = "ADDRESS"

----------------------------------------------------------------------------
-- Aeson instances
----------------------------------------------------------------------------

instance ToJSON Address where
  toJSON :: Address -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (Address -> Text) -> Address -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
formatAddress
  toEncoding :: Address -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding) -> (Address -> Text) -> Address -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
formatAddress

instance ToJSONKey Address where
  toJSONKey :: ToJSONKeyFunction Address
toJSONKey = (Address -> Text) -> ToJSONKeyFunction Address
forall a. (a -> Text) -> ToJSONKeyFunction a
AesonTypes.toJSONKeyText Address -> Text
formatAddress

instance FromJSON Address where
  parseJSON :: Value -> Parser Address
parseJSON =
    String -> (Text -> Parser Address) -> Value -> Parser Address
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText "Address" ((Text -> Parser Address) -> Value -> Parser Address)
-> (Text -> Parser Address) -> Value -> Parser Address
forall a b. (a -> b) -> a -> b
$
    (ParseAddressError -> Parser Address)
-> (Address -> Parser Address)
-> Either ParseAddressError Address
-> Parser Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Address
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Address)
-> (ParseAddressError -> String)
-> ParseAddressError
-> Parser Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseAddressError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Address -> Parser Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseAddressError Address -> Parser Address)
-> (Text -> Either ParseAddressError Address)
-> Text
-> Parser Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseAddressError Address
parseAddress

instance FromJSONKey Address where
  fromJSONKey :: FromJSONKeyFunction Address
fromJSONKey =
    (Text -> Parser Address) -> FromJSONKeyFunction Address
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
AesonTypes.FromJSONKeyTextParser
      ((ParseAddressError -> Parser Address)
-> (Address -> Parser Address)
-> Either ParseAddressError Address
-> Parser Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Address
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Address)
-> (ParseAddressError -> String)
-> ParseAddressError
-> Parser Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseAddressError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Address -> Parser Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseAddressError Address -> Parser Address)
-> (Text -> Either ParseAddressError Address)
-> Text
-> Parser Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseAddressError Address
parseAddress)