{-# LANGUAGE DeriveLift #-}
module Morley.Tezos.Address
( ContractHash (..)
, Address (..)
, mkKeyAddress
, detGenKeyAddress
, isKeyAddress
, GlobalCounter(..)
, mkContractHashHack
, ParseAddressError (..)
, ParseAddressRawError (..)
, ParseContractAddressError (..)
, formatAddress
, mformatAddress
, parseAddressRaw
, parseContractHash
, parseAddress
, ta
, 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 qualified Data.ByteString as BS
import Data.Text (strip)
import Fmt (Buildable(build), hexF, pretty)
import Instances.TH.Lift ()
import qualified Language.Haskell.TH.Quote as TH
import Language.Haskell.TH.Syntax (Lift)
import qualified Language.Haskell.TH.Syntax as TH
import Text.PrettyPrint.Leijen.Text (backslash, dquotes, int, parens, (<+>))
import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDoc, renderAnyBuildable)
import Morley.Michelson.Text
import Morley.Tezos.Crypto
import Morley.Util.CLI
import Morley.Util.TypeLits
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, ContractHash -> Q Exp
ContractHash -> Q (TExp ContractHash)
(ContractHash -> Q Exp)
-> (ContractHash -> Q (TExp ContractHash)) -> Lift ContractHash
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ContractHash -> Q (TExp ContractHash)
$cliftTyped :: ContractHash -> Q (TExp ContractHash)
lift :: ContractHash -> Q Exp
$clift :: ContractHash -> Q Exp
Lift)
instance NFData ContractHash
contractHashLengthBytes :: Integral n => n
contractHashLengthBytes :: n
contractHashLengthBytes = n
20
data Address
= KeyAddress KeyHash
| ContractAddress ContractHash
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, Address -> Q Exp
Address -> Q (TExp Address)
(Address -> Q Exp) -> (Address -> Q (TExp Address)) -> Lift Address
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Address -> Q (TExp Address)
$cliftTyped :: Address -> Q (TExp Address)
lift :: Address -> Q Exp
$clift :: Address -> Q Exp
Lift)
instance NFData Address
isKeyAddress :: Address -> Bool
isKeyAddress :: Address -> Bool
isKeyAddress = \case
KeyAddress KeyHash
_ -> Bool
True
ContractAddress ContractHash
_ -> Bool
False
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
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 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)
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
contractAddressPrefix :: ByteString
contractAddressPrefix :: ByteString
contractAddressPrefix = ByteString
"\2\90\121"
formatContractHash :: ContractHash -> Text
formatContractHash :: ContractHash -> Text
formatContractHash (ContractHash 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 KeyHash
h -> KeyHash -> Text
formatKeyHash KeyHash
h
ContractAddress ContractHash
h -> ContractHash -> Text
formatContractHash ContractHash
h
mformatAddress :: Address -> MText
mformatAddress :: Address -> MText
mformatAddress = HasCallStack => Text -> MText
Text -> MText
unsafeMkMText (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
data ParseAddressError
= ParseAddressWrongBase58Check
| ParseAddressBothFailed CryptoParseError ParseContractAddressError
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 = 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"
ParseAddressBothFailed CryptoParseError
pkErr ParseContractAddressError
contractErr ->
[Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
[ Doc
"Address is neither `KeyAddress` "
, Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ RenderContext -> CryptoParseError -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context CryptoParseError
pkErr
, Doc
", nor `ContractAddress` "
, Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ RenderContext -> ParseContractAddressError -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context ParseContractAddressError
contractErr
]
parseAddress :: Text -> Either ParseAddressError Address
parseAddress :: Text -> Either ParseAddressError Address
parseAddress Text
addressText =
case Text -> Either CryptoParseError KeyHash
parseKeyHash Text
addressText of
Left CryptoParseError
CryptoParseWrongBase58Check -> ParseAddressError -> Either ParseAddressError Address
forall a b. a -> Either a b
Left ParseAddressError
ParseAddressWrongBase58Check
Left 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 -> Address -> Either ParseAddressError Address
forall a b. b -> Either a b
Right (KeyHash -> Address
KeyAddress KeyHash
keyHash)
data ParseAddressRawError
= ParseAddressRawWrongSize ByteString
| ParseAddressRawInvalidPrefix ByteString
| ParseAddressRawMalformedSeparator ByteString
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
parseAddressRaw :: ByteString -> Either ParseAddressRawError Address
parseAddressRaw :: ByteString -> Either ParseAddressRawError Address
parseAddressRaw (Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
2 -> (ByteString
prefix, ByteString
address)) =
case Int -> ByteString -> ByteString
BS.take Int
1 ByteString
prefix of
ByteString
"\00" -> ByteString -> ByteString -> Either ParseAddressRawError Address
parseKeyAddressRaw (ByteString -> ByteString
BS.tail ByteString
prefix) ByteString
address
ByteString
"\01" -> ByteString -> ByteString -> Either ParseAddressRawError Address
parseContractAddressRaw ByteString
prefix ByteString
address
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
prefix
where
parseKeyAddressRaw :: ByteString -> ByteString -> Either ParseAddressRawError Address
parseKeyAddressRaw ByteString
keyPrefix 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
ByteString
"\00" -> KeyHashTag -> Either ParseAddressRawError KeyHashTag
forall a b. b -> Either a b
Right KeyHashTag
KeyHashEd25519
ByteString
"\01" -> KeyHashTag -> Either ParseAddressRawError KeyHashTag
forall a b. b -> Either a b
Right KeyHashTag
KeyHashSecp256k1
ByteString
"\02" -> KeyHashTag -> Either ParseAddressRawError KeyHashTag
forall a b. b -> Either a b
Right KeyHashTag
KeyHashP256
ByteString
_ -> 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 ByteString
contractPrefix 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
/= Word8
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 Int
1 ByteString
contractPrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BS.init ByteString
contractAddress
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 = ParseContractAddressError -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc
instance RenderDoc ParseContractAddressError where
renderDoc :: RenderContext -> ParseContractAddressError -> Doc
renderDoc RenderContext
_ =
\case
ParseContractAddressError
ParseContractAddressWrongBase58Check ->
Doc
"Wrong base58check format"
ParseContractAddressWrongSize ByteString
bs ->
Doc
"Wrong size for a contract 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
bs) Doc -> Doc -> Doc
<+>
(Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc
int (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs))
ParseContractAddressWrongPrefix ByteString
prefix ->
Doc
"Invalid prefix" 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"
parseContractHash :: Text -> Either ParseContractAddressError ContractHash
parseContractHash :: Text -> Either ParseContractAddressError ContractHash
parseContractHash Text
text =
case ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix ByteString
contractAddressPrefix Text
text of
Left (B58CheckWithPrefixWrongPrefix ByteString
prefix) ->
ParseContractAddressError
-> Either ParseContractAddressError ContractHash
forall a b. a -> Either a b
Left (ByteString -> ParseContractAddressError
ParseContractAddressWrongPrefix ByteString
prefix)
Left B58CheckWithPrefixError
B58CheckWithPrefixWrongEncoding ->
ParseContractAddressError
-> Either ParseContractAddressError ContractHash
forall a b. a -> Either a b
Left ParseContractAddressError
ParseContractAddressWrongBase58Check
Right 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
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. Lift t => t -> Q 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"
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
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
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 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 a
"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 = String
"ADDRESS"
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)