-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Address in Tezos.

{-# LANGUAGE DeriveLift #-}

module Morley.Tezos.Address
  ( ContractHash
  , Address (..)
  , TxRollupL2Address (..)
  , mkKeyAddress
  , detGenKeyAddress
  , isKeyAddress

  , GlobalCounter(..)
  , mkContractHashHack

  -- * Formatting
  , ParseAddressError (..)
  , ParseAddressRawError (..)
  , formatAddress
  , mformatAddress
  , parseAddressRaw
  , parseAddress
  , ta
  ) where

import Data.Aeson (FromJSON(..), FromJSONKey, ToJSON(..), ToJSONKey)
import Data.Aeson qualified as Aeson
import Data.Aeson.Encoding qualified as Aeson
import Data.Aeson.Types qualified as AesonTypes
import Data.ByteString qualified as BS
import Data.Text (strip)
import Fmt (Buildable(build), hexF, pretty)
import Instances.TH.Lift ()
import Language.Haskell.TH.Quote qualified as TH
import Language.Haskell.TH.Syntax (Lift)
import Language.Haskell.TH.Syntax qualified as TH
import Text.PrettyPrint.Leijen.Text (backslash, dquotes, int, (<+>))

import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDoc, renderAnyBuildable)
import Morley.Michelson.Text
import Morley.Tezos.Crypto
import Morley.Util.CLI
import Morley.Util.TypeLits

-- | Data type corresponding to address structure in Tezos.
data Address
  = KeyAddress KeyHash
  -- ^ @tz1@, @tz2@ or @tz3@ address which is a hash of a public key.
  | ContractAddress ContractHash
  -- ^ @KT@ address which corresponds to a callable contract.
  | TransactionRollupAddress TxRollupHash
  -- ^ @txr1@ address which corresponds to a transaction rollup.
  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
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, (forall (m :: * -> *). Quote m => Address -> m Exp)
-> (forall (m :: * -> *). Quote m => Address -> Code m Address)
-> Lift Address
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Address -> m Exp
forall (m :: * -> *). Quote m => Address -> Code m Address
liftTyped :: forall (m :: * -> *). Quote m => Address -> Code m Address
$cliftTyped :: forall (m :: * -> *). Quote m => Address -> Code m Address
lift :: forall (m :: * -> *). Quote m => Address -> m Exp
$clift :: forall (m :: * -> *). Quote m => Address -> m Exp
Lift)

instance NFData Address

-- | @tz4@ level-2 public key hash address, used with transaction rollups, corresponds
-- to @tx_rollup_l2_address@ Michelson type.
newtype TxRollupL2Address = TxRollupL2Address KeyHashL2
  deriving stock (Int -> TxRollupL2Address -> ShowS
[TxRollupL2Address] -> ShowS
TxRollupL2Address -> String
(Int -> TxRollupL2Address -> ShowS)
-> (TxRollupL2Address -> String)
-> ([TxRollupL2Address] -> ShowS)
-> Show TxRollupL2Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxRollupL2Address] -> ShowS
$cshowList :: [TxRollupL2Address] -> ShowS
show :: TxRollupL2Address -> String
$cshow :: TxRollupL2Address -> String
showsPrec :: Int -> TxRollupL2Address -> ShowS
$cshowsPrec :: Int -> TxRollupL2Address -> ShowS
Show, TxRollupL2Address -> TxRollupL2Address -> Bool
(TxRollupL2Address -> TxRollupL2Address -> Bool)
-> (TxRollupL2Address -> TxRollupL2Address -> Bool)
-> Eq TxRollupL2Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxRollupL2Address -> TxRollupL2Address -> Bool
$c/= :: TxRollupL2Address -> TxRollupL2Address -> Bool
== :: TxRollupL2Address -> TxRollupL2Address -> Bool
$c== :: TxRollupL2Address -> TxRollupL2Address -> Bool
Eq, Eq TxRollupL2Address
Eq TxRollupL2Address
-> (TxRollupL2Address -> TxRollupL2Address -> Ordering)
-> (TxRollupL2Address -> TxRollupL2Address -> Bool)
-> (TxRollupL2Address -> TxRollupL2Address -> Bool)
-> (TxRollupL2Address -> TxRollupL2Address -> Bool)
-> (TxRollupL2Address -> TxRollupL2Address -> Bool)
-> (TxRollupL2Address -> TxRollupL2Address -> TxRollupL2Address)
-> (TxRollupL2Address -> TxRollupL2Address -> TxRollupL2Address)
-> Ord TxRollupL2Address
TxRollupL2Address -> TxRollupL2Address -> Bool
TxRollupL2Address -> TxRollupL2Address -> Ordering
TxRollupL2Address -> TxRollupL2Address -> TxRollupL2Address
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 :: TxRollupL2Address -> TxRollupL2Address -> TxRollupL2Address
$cmin :: TxRollupL2Address -> TxRollupL2Address -> TxRollupL2Address
max :: TxRollupL2Address -> TxRollupL2Address -> TxRollupL2Address
$cmax :: TxRollupL2Address -> TxRollupL2Address -> TxRollupL2Address
>= :: TxRollupL2Address -> TxRollupL2Address -> Bool
$c>= :: TxRollupL2Address -> TxRollupL2Address -> Bool
> :: TxRollupL2Address -> TxRollupL2Address -> Bool
$c> :: TxRollupL2Address -> TxRollupL2Address -> Bool
<= :: TxRollupL2Address -> TxRollupL2Address -> Bool
$c<= :: TxRollupL2Address -> TxRollupL2Address -> Bool
< :: TxRollupL2Address -> TxRollupL2Address -> Bool
$c< :: TxRollupL2Address -> TxRollupL2Address -> Bool
compare :: TxRollupL2Address -> TxRollupL2Address -> Ordering
$ccompare :: TxRollupL2Address -> TxRollupL2Address -> Ordering
Ord, (forall x. TxRollupL2Address -> Rep TxRollupL2Address x)
-> (forall x. Rep TxRollupL2Address x -> TxRollupL2Address)
-> Generic TxRollupL2Address
forall x. Rep TxRollupL2Address x -> TxRollupL2Address
forall x. TxRollupL2Address -> Rep TxRollupL2Address x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxRollupL2Address x -> TxRollupL2Address
$cfrom :: forall x. TxRollupL2Address -> Rep TxRollupL2Address x
Generic, (forall (m :: * -> *). Quote m => TxRollupL2Address -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    TxRollupL2Address -> Code m TxRollupL2Address)
-> Lift TxRollupL2Address
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TxRollupL2Address -> m Exp
forall (m :: * -> *).
Quote m =>
TxRollupL2Address -> Code m TxRollupL2Address
liftTyped :: forall (m :: * -> *).
Quote m =>
TxRollupL2Address -> Code m TxRollupL2Address
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TxRollupL2Address -> Code m TxRollupL2Address
lift :: forall (m :: * -> *). Quote m => TxRollupL2Address -> m Exp
$clift :: forall (m :: * -> *). Quote m => TxRollupL2Address -> m Exp
Lift)
  deriving newtype TxRollupL2Address -> ()
(TxRollupL2Address -> ()) -> NFData TxRollupL2Address
forall a. (a -> ()) -> NFData a
rnf :: TxRollupL2Address -> ()
$crnf :: TxRollupL2Address -> ()
NFData

-- | Returns @True@ if given address is implicit.
isKeyAddress :: Address -> Bool
isKeyAddress :: Address -> Bool
isKeyAddress = \case
  KeyAddress KeyHash
_      -> Bool
True
  ContractAddress ContractHash
_ -> Bool
False
  TransactionRollupAddress TxRollupHash
_ -> Bool
False

-- | 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

-- | Represents the network's global counter.
--
-- We store the current value of this counter in the operation at the time of its creation
-- for the following reasons:
-- * to guarantee the uniqueness of contract addresses upon origination
--   (see 'Morley.Michelson.Typed.Operation.mkContractAddress)
-- * to prevent replay attacks by checking that an operation with the same counter value
--   con't be performed twice.
--
-- The counter is incremented after every operation execution and interpretation of instructions
-- @CREATE_CONTRACT@ and @TRANSFER_TOKENS@, and thus ensures that these addresses are unique
-- (i.e. origination of identical contracts with identical metadata will result in
-- different addresses.)
--
-- 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, GlobalCounter -> Builder
(GlobalCounter -> Builder) -> Buildable GlobalCounter
forall p. (p -> Builder) -> Buildable p
build :: GlobalCounter -> Builder
$cbuild :: GlobalCounter -> Builder
Buildable, Int -> GlobalCounter -> Int
GlobalCounter -> Int
(Int -> GlobalCounter -> Int)
-> (GlobalCounter -> Int) -> Hashable GlobalCounter
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GlobalCounter -> Int
$chash :: GlobalCounter -> Int
hashWithSalt :: Int -> GlobalCounter -> Int
$chashWithSalt :: Int -> GlobalCounter -> Int
Hashable)

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

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

formatAddress :: Address -> Text
formatAddress :: Address -> Text
formatAddress =
  \case
    KeyAddress KeyHash
h -> KeyHash -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash KeyHash
h
    ContractAddress ContractHash
h -> ContractHash -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash ContractHash
h
    TransactionRollupAddress TxRollupHash
h -> TxRollupHash -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash TxRollupHash
h

mformatAddress :: Address -> MText
mformatAddress :: Address -> MText
mformatAddress = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Address -> Either Text MText) -> Address -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (Address -> Text) -> Address -> Either Text 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

instance Buildable TxRollupL2Address where
  build :: TxRollupL2Address -> Builder
build (TxRollupL2Address KeyHashL2
kh) = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ KeyHashL2 -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash KeyHashL2
kh

-- | Errors that can happen during address parsing.
data ParseAddressError
  = ParseAddressWrongBase58Check
  -- ^ Address is not in Base58Check format.
  | ParseAddressAllFailed (NonEmpty CryptoParseError)
  -- ^ All 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 Semigroup ParseAddressError where
  ParseAddressError
ParseAddressWrongBase58Check <> :: ParseAddressError -> ParseAddressError -> ParseAddressError
<> ParseAddressError
_ =  ParseAddressError
ParseAddressWrongBase58Check
  ParseAddressError
_ <> ParseAddressError
ParseAddressWrongBase58Check =  ParseAddressError
ParseAddressWrongBase58Check
  ParseAddressAllFailed NonEmpty CryptoParseError
xs <> ParseAddressAllFailed NonEmpty CryptoParseError
ys = NonEmpty CryptoParseError -> ParseAddressError
ParseAddressAllFailed (NonEmpty CryptoParseError -> ParseAddressError)
-> NonEmpty CryptoParseError -> ParseAddressError
forall a b. (a -> b) -> a -> b
$ NonEmpty CryptoParseError
xs NonEmpty CryptoParseError
-> NonEmpty CryptoParseError -> NonEmpty CryptoParseError
forall a. Semigroup a => a -> a -> a
<> NonEmpty CryptoParseError
ys

instance NFData ParseAddressError

instance Buildable ParseAddressError where
  build :: ParseAddressError -> Builder
build = ParseAddressError -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

instance RenderDoc ParseAddressError where
  renderDoc :: RenderContext -> ParseAddressError -> Doc
renderDoc RenderContext
context =
    \case
      ParseAddressError
ParseAddressWrongBase58Check -> Doc
"Wrong base58check format"
      ParseAddressAllFailed NonEmpty CryptoParseError
pkErr ->
        [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Address failed to parse: " Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
", "
          (NonEmpty Doc -> [Element (NonEmpty Doc)]
forall t. Container t => t -> [Element t]
toList (NonEmpty Doc -> [Element (NonEmpty Doc)])
-> NonEmpty Doc -> [Element (NonEmpty Doc)]
forall a b. (a -> b) -> a -> b
$ RenderContext -> CryptoParseError -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context (CryptoParseError -> Doc)
-> NonEmpty CryptoParseError -> NonEmpty Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty CryptoParseError
pkErr)

-- | 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 Text
addressText =
  let implicit :: Either ParseAddressError Address
implicit = (KeyHash -> Address)
-> (Text -> Either CryptoParseError KeyHash)
-> (CryptoParseError -> ParseAddressError)
-> Either ParseAddressError Address
forall t b t1 a.
(t -> b) -> (Text -> Either t1 t) -> (t1 -> a) -> Either a b
tryParse KeyHash -> Address
KeyAddress Text -> Either CryptoParseError KeyHash
forall (kind :: HashKind).
AllTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash CryptoParseError -> ParseAddressError
handleCrypto
      contract :: Either ParseAddressError Address
contract = (ContractHash -> Address)
-> (Text -> Either CryptoParseError ContractHash)
-> (CryptoParseError -> ParseAddressError)
-> Either ParseAddressError Address
forall t b t1 a.
(t -> b) -> (Text -> Either t1 t) -> (t1 -> a) -> Either a b
tryParse ContractHash -> Address
ContractAddress Text -> Either CryptoParseError ContractHash
forall (kind :: HashKind).
AllTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash CryptoParseError -> ParseAddressError
handleCrypto
      txr :: Either ParseAddressError Address
txr = (TxRollupHash -> Address)
-> (Text -> Either CryptoParseError TxRollupHash)
-> (CryptoParseError -> ParseAddressError)
-> Either ParseAddressError Address
forall t b t1 a.
(t -> b) -> (Text -> Either t1 t) -> (t1 -> a) -> Either a b
tryParse TxRollupHash -> Address
TransactionRollupAddress Text -> Either CryptoParseError TxRollupHash
forall (kind :: HashKind).
AllTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash CryptoParseError -> ParseAddressError
handleCrypto
  in Either ParseAddressError Address
implicit Either ParseAddressError Address
-> Either ParseAddressError Address
-> Either ParseAddressError Address
forall a b. Semigroup a => Either a b -> Either a b -> Either a b
`merge` Either ParseAddressError Address
contract Either ParseAddressError Address
-> Either ParseAddressError Address
-> Either ParseAddressError Address
forall a b. Semigroup a => Either a b -> Either a b -> Either a b
`merge` Either ParseAddressError Address
txr
  where
    handleCrypto :: CryptoParseError -> ParseAddressError
handleCrypto = \case
      CryptoParseError
CryptoParseWrongBase58Check -> ParseAddressError
ParseAddressWrongBase58Check
      CryptoParseError
x -> NonEmpty CryptoParseError -> ParseAddressError
ParseAddressAllFailed (NonEmpty CryptoParseError -> ParseAddressError)
-> NonEmpty CryptoParseError -> ParseAddressError
forall a b. (a -> b) -> a -> b
$ CryptoParseError -> NonEmpty CryptoParseError
forall (f :: * -> *) a. Applicative f => a -> f a
pure CryptoParseError
x
    merge :: Semigroup a => Either a b -> Either a b -> Either a b
    merge :: forall a b. Semigroup a => Either a b -> Either a b -> Either a b
merge (Left a
xs) (Left a
ys) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ a
xs a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ys
    merge r :: Either a b
r@Right{} Either a b
_ = Either a b
r
    merge Either a b
_ r :: Either a b
r@Right{} = Either a b
r
    tryParse :: (t -> b) -> (Text -> Either t1 t) -> (t1 -> a) -> Either a b
    tryParse :: forall t b t1 a.
(t -> b) -> (Text -> Either t1 t) -> (t1 -> a) -> Either a b
tryParse t -> b
ctor Text -> Either t1 t
parser t1 -> a
handler =
      case Text -> Either t1 t
parser Text
addressText of
        Left t1
err -> a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ t1 -> a
handler t1
err
        Right t
res -> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$ t -> b
ctor t
res

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 RenderDoc ParseAddressRawError where
  renderDoc :: RenderContext -> ParseAddressRawError -> Doc
renderDoc RenderContext
_ =
    \case
      ParseAddressRawInvalidPrefix ByteString
prefix ->
        Doc
"Invalid prefix for raw address" Doc -> Doc -> Doc
<+> (Doc -> Doc
dquotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Builder -> Doc) -> Builder -> Doc
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
prefix) Doc -> Doc -> Doc
<+> Doc
"provided"
      ParseAddressRawWrongSize ByteString
addr -> Doc
"Given raw address+" Doc -> Doc -> Doc
<+>
        (Builder -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Builder -> Doc) -> Builder -> Doc
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
addr) Doc -> Doc -> Doc
<+> Doc
"has invalid length" Doc -> Doc -> Doc
<+> Int -> Doc
int (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
addr)
      ParseAddressRawMalformedSeparator ByteString
addr -> Doc
"Given raw address+" Doc -> Doc -> Doc
<+> (Builder -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Builder -> Doc) -> Builder -> Doc
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
addr) Doc -> Doc -> Doc
<+>
        Doc
"does not end with" Doc -> Doc -> Doc
<+> Doc -> Doc
dquotes (Doc
backslash Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"00")

instance Buildable ParseAddressRawError where
  build :: ParseAddressRawError -> Builder
build = ParseAddressRawError -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

-- | 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 ByteString
bytes =
  case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 ByteString
bytes of
    -- key hash address
    (ByteString
"\00", ByteString
rest) -> ByteString -> Either ParseAddressRawError ()
checkHashLength (Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
rest) Either ParseAddressRawError ()
-> Either ParseAddressRawError Address
-> Either ParseAddressRawError Address
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 ByteString
rest of
      (ByteString
"\00", ByteString
addr) -> 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
$ KeyHash -> Address
KeyAddress (KeyHash -> Address) -> KeyHash -> Address
forall a b. (a -> b) -> a -> b
$ HashTag 'HashKindPublicKey -> ByteString -> KeyHash
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash HashTag 'HashKindPublicKey
HashEd25519 ByteString
addr
      (ByteString
"\01", ByteString
addr) -> 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
$ KeyHash -> Address
KeyAddress (KeyHash -> Address) -> KeyHash -> Address
forall a b. (a -> b) -> a -> b
$ HashTag 'HashKindPublicKey -> ByteString -> KeyHash
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash HashTag 'HashKindPublicKey
HashSecp256k1 ByteString
addr
      (ByteString
"\02", ByteString
addr) -> 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
$ KeyHash -> Address
KeyAddress (KeyHash -> Address) -> KeyHash -> Address
forall a b. (a -> b) -> a -> b
$ HashTag 'HashKindPublicKey -> ByteString -> KeyHash
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash HashTag 'HashKindPublicKey
HashP256 ByteString
addr
      (ByteString
x, ByteString
_) -> 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
x
    (ByteString
pfx, ByteString
rest) -> do
      (ByteString
address, Word8
sep) <- Either ParseAddressRawError (ByteString, Word8)
-> ((ByteString, Word8)
    -> Either ParseAddressRawError (ByteString, Word8))
-> Maybe (ByteString, Word8)
-> Either ParseAddressRawError (ByteString, Word8)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ParseAddressRawError
-> Either ParseAddressRawError (ByteString, Word8)
forall a b. a -> Either a b
Left (ParseAddressRawError
 -> Either ParseAddressRawError (ByteString, Word8))
-> ParseAddressRawError
-> Either ParseAddressRawError (ByteString, Word8)
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawWrongSize ByteString
rest) (ByteString, Word8)
-> Either ParseAddressRawError (ByteString, Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ByteString, Word8)
 -> Either ParseAddressRawError (ByteString, Word8))
-> Maybe (ByteString, Word8)
-> Either ParseAddressRawError (ByteString, Word8)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (ByteString, Word8)
BS.unsnoc ByteString
rest
      ByteString -> Either ParseAddressRawError ()
checkHashLength ByteString
address
      Bool
-> Either ParseAddressRawError () -> Either ParseAddressRawError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
sep Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00) (Either ParseAddressRawError () -> Either ParseAddressRawError ())
-> Either ParseAddressRawError () -> Either ParseAddressRawError ()
forall a b. (a -> b) -> a -> b
$
        ParseAddressRawError -> Either ParseAddressRawError ()
forall a b. a -> Either a b
Left (ParseAddressRawError -> Either ParseAddressRawError ())
-> ParseAddressRawError -> Either ParseAddressRawError ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawMalformedSeparator ByteString
rest
      case ByteString
pfx of
        -- contract address
        ByteString
"\01" -> 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 (ContractHash -> Address) -> ContractHash -> Address
forall a b. (a -> b) -> a -> b
$ HashTag 'HashKindContract -> ByteString -> ContractHash
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash HashTag 'HashKindContract
HashContract ByteString
address
        -- transaction rollup address
        ByteString
"\02" -> 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
$ TxRollupHash -> Address
TransactionRollupAddress (TxRollupHash -> Address) -> TxRollupHash -> Address
forall a b. (a -> b) -> a -> b
$ HashTag 'HashKindTxRollup -> ByteString -> TxRollupHash
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash HashTag 'HashKindTxRollup
HashTXR ByteString
address
        ByteString
x -> 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
x
  where
    checkHashLength :: ByteString -> Either ParseAddressRawError ()
checkHashLength ByteString
addr
      | ByteString -> Int
forall t. Container t => t -> Int
length ByteString
addr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall n. Integral n => n
hashLengthBytes
      = ParseAddressRawError -> Either ParseAddressRawError ()
forall a b. a -> Either a b
Left (ParseAddressRawError -> Either ParseAddressRawError ())
-> ParseAddressRawError -> Either ParseAddressRawError ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseAddressRawError
ParseAddressRawWrongSize ByteString
addr
      | Bool
otherwise = Either ParseAddressRawError ()
forall (f :: * -> *). Applicative f => f ()
pass

-- | QuasyQuoter for constructing Tezos addresses.
--
-- Validity of result will be checked at compile time.
ta :: TH.QuasiQuoter
ta :: QuasiQuoter
ta = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
TH.quoteExp = \String
s ->
      case Text -> Either ParseAddressError Address
parseAddress (Text -> Either ParseAddressError Address)
-> (Text -> Text) -> Text -> Either ParseAddressError Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip (Text -> Either ParseAddressError Address)
-> Text -> Either ParseAddressError Address
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
s of
        Left   ParseAddressError
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ ParseAddressError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ParseAddressError
err
        Right Address
addr -> Address -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift Address
addr
  , quotePat :: String -> Q Pat
TH.quotePat = \String
_ ->
      String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use this QuasyQuotation at pattern position"
  , quoteType :: String -> Q Type
TH.quoteType = \String
_ ->
      String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use this QuasyQuotation at type position"
  , quoteDec :: String -> Q [Dec]
TH.quoteDec = \String
_ ->
      String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use this QuasyQuotation at declaration position"
  }


instance
    TypeError ('Text "There is no instance defined for (IsString Address)" ':$$:
               'Text "Consider using QuasiQuotes: `[ta|some text...|]`"
              ) =>
    IsString Address where
  fromString :: String -> Address
fromString = Text -> String -> Address
forall a. HasCallStack => Text -> a
error Text
"impossible"


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

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 {b} {a}.
(Monoid b, IsString b, FromBuilder b, ToText a) =>
a -> Either b Address
parseAddrDo
    where
      parseAddrDo :: a -> Either b Address
parseAddrDo a
addr =
        (ParseAddressError -> Either b Address)
-> (Address -> Either b Address)
-> Either ParseAddressError Address
-> Either b Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b Address
forall a b. a -> Either a b
Left (b -> Either b Address)
-> (ParseAddressError -> b)
-> ParseAddressError
-> Either b Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> b
forall a. Monoid a => a -> a -> a
mappend b
"Failed to parse address: " (b -> b) -> (ParseAddressError -> b) -> ParseAddressError -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseAddressError -> b
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Address -> Either b Address
forall a b. b -> Either a b
Right (Either ParseAddressError Address -> Either b Address)
-> Either ParseAddressError Address -> Either b 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 = String
"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 String
"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)