Address.hs

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

-- | Address in Tezos.

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

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

  -- * Formatting
  , ParseAddressError (..)
  , ParseContractAddressError
  , formatAddress
  , mformatAddress
  , parseAddress
  , 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, runPut)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Fmt (fmt, hexF, pretty)
import qualified Formatting.Buildable as Buildable
import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.QuickCheck (Arbitrary(..), oneof, vector)

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 (Show, Eq, Ord, Generic)

instance NFData ContractHash

-- | 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 (Show, Eq, Ord, Generic)

instance NFData Address

-- | Smart constructor for 'KeyAddress'.
mkKeyAddress :: PublicKey -> Address
mkKeyAddress = KeyAddress . hashKey

-- | Deterministically generate a random 'KeyAddress' and discard its
-- secret key.
detGenKeyAddress :: ByteString -> Address
detGenKeyAddress = mkKeyAddress . toPublic . detSecretKey

newtype OperationHash = OperationHash
  { unOperationHash :: ByteString
  }
  deriving stock (Show, Eq, Ord, Generic)
  deriving anyclass (NFData)

newtype OriginationIndex = OriginationIndex { unOriginationIndex :: Int32 }
  deriving stock (Show, Eq, Ord, Generic)
  deriving anyclass (NFData)

-- | Compute address of a contract from its origination operation and origination index.
--
-- 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/master/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.
--
-- 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.
-- Then we take 'blake2b160' hash of the resulting bytes and consider it to be the contract's
-- address.
mkContractAddress
  :: OperationHash
  -> OriginationIndex
  -> Address
mkContractAddress (OperationHash opHash) (OriginationIndex idx) =
  ContractAddress
  $ ContractHash
  $ blake2b160
  $ opHash <> BSL.toStrict (runPut $ putInt32be idx)

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

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

formatContractHash :: ContractHash -> Text
formatContractHash (ContractHash bs) =
  encodeBase58Check (contractAddressPrefix <> bs)

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

mformatAddress :: Address -> MText
mformatAddress = mkMTextUnsafe . formatAddress

instance Buildable.Buildable Address where
  build = Buildable.build . 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 (Show, Eq, Generic)

instance NFData ParseAddressError

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

-- | 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 addressText =
  case parseKeyHash addressText of
    Left CryptoParseWrongBase58Check -> Left ParseAddressWrongBase58Check
    Left keyAddrErr -> first (ParseAddressBothFailed keyAddrErr) $
      ContractAddress <$> parseContractHash addressText
    Right keyHash -> Right (KeyAddress keyHash)

-- | Partial version of 'parseAddress' which assumes that the address
-- is correct. Can be used in tests.
unsafeParseAddress :: HasCallStack => Text -> Address
unsafeParseAddress = either (error . pretty) id . parseAddress

data ParseContractAddressError
  = ParseContractAddressWrongBase58Check
  | ParseContractAddressWrongTag ByteString
  | ParseContractAddressWrongSize Int
  deriving stock (Show, Eq, Generic)

instance NFData ParseContractAddressError

instance Buildable.Buildable ParseContractAddressError where
  build =
    \case
      ParseContractAddressWrongBase58Check ->
        "Wrong base58check format"
      ParseContractAddressWrongTag tag ->
        "Wrong tag for a contract address: " <> fmt (hexF tag)
      ParseContractAddressWrongSize s ->
        "Wrong size for a contract address: " <> Buildable.build s

parseContractHash :: Text -> Either ParseContractAddressError ContractHash
parseContractHash text =
  case decodeBase58CheckWithPrefix contractAddressPrefix text of
    Left (B58CheckWithPrefixWrongPrefix prefix) ->
      Left (ParseContractAddressWrongTag prefix)
    Left B58CheckWithPrefixWrongEncoding ->
      Left ParseContractAddressWrongBase58Check
    -- We know that the length must be 20.
    -- Currently it's hardcoded here, later we'll probably have a `Hash` type.
    Right bs | length bs == 20 -> Right (ContractHash bs)
             | otherwise -> Left $ ParseContractAddressWrongSize (length bs)

-- | Parse a `TK` contract address, fail if address does not match
-- the expected format.
unsafeParseContractHash :: HasCallStack => Text -> ContractHash
unsafeParseContractHash =
  either (error . pretty) id . parseContractHash

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

instance HasCLReader Address where
  getReader = eitherReader parseAddrDo
    where
      parseAddrDo addr =
        either (Left . mappend "Failed to parse address: " . pretty) Right $
        parseAddress $ toText addr
  getMetavar = "ADDRESS"

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

instance ToJSON ContractHash where
  toJSON = Aeson.String . formatContractHash
  toEncoding = Aeson.text . formatContractHash

instance ToJSONKey ContractHash where
  toJSONKey = AesonTypes.toJSONKeyText formatContractHash

instance FromJSON ContractHash where
  parseJSON =
    Aeson.withText "ContractHash" $
    either (fail . pretty) pure . parseContractHash

instance FromJSONKey ContractHash where
  fromJSONKey =
    AesonTypes.FromJSONKeyTextParser
      (either (fail . pretty) pure . parseContractHash)


instance ToJSON Address where
  toJSON = Aeson.String . formatAddress
  toEncoding = Aeson.text . formatAddress

instance ToJSONKey Address where
  toJSONKey = AesonTypes.toJSONKeyText formatAddress

instance FromJSON Address where
  parseJSON =
    Aeson.withText "Address" $
    either (fail . pretty) pure . parseAddress

instance FromJSONKey Address where
  fromJSONKey =
    AesonTypes.FromJSONKeyTextParser
      (either (fail . pretty) pure . parseAddress)

----------------------------------------------------------------------------
-- Arbitrary
----------------------------------------------------------------------------

instance Arbitrary Address where
  arbitrary = oneof [genKeyAddress, genContractAddress]
    where
      genKeyAddress = KeyAddress <$> arbitrary
      genContractAddress = ContractAddress . ContractHash . BS.pack <$> vector 20

genAddress :: MonadGen m => m Address
genAddress = Gen.choice [genKeyAddress, genContractAddress]
  where
    genKeyAddress = KeyAddress <$> genKeyHash
    genContractAddress = ContractAddress . ContractHash <$> Gen.bytes (Range.singleton 20)