Address.hs

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

-- | Tests for 'Morley.Tezos.Address'.

module Test.Tezos.Address
  ( test_Roundtrip
  , test_parseAddress
  , test_decodeAddress
  , unit_ta
  ) where

import Test.HUnit (Assertion, (@?=))
import Test.Hspec (shouldSatisfy)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Hedgehog.Gen.Tezos.Address (genAddress)
import Morley.Tezos.Address
  (Address, formatAddress, parseAddress, parseAddressRaw, ta, unsafeParseAddress,
  unsafeParseAddressRaw)
import Test.Cleveland.Util (fromHex, unsafeFromHex)

import Test.Util.Hedgehog (ShowThroughBuild(..), aesonRoundtrip, roundtripTreeSTB)

test_Roundtrip :: [TestTree]
test_Roundtrip =
    [ testGroup "parse . format ≡ pure"
      [ roundtripTreeSTB genAddress formatAddress parseAddress ]
    , testGroup "JSON encoding/deconding"
      [ aesonRoundtrip genAddress ]
    ]

test_parseAddress :: [TestTree]
test_parseAddress =
  [ testCase "Successfully parses valid sample data in canonical form" $
    forM_ sampleAddresses (\(a, _) -> bimap STB STB (parseAddress a) `shouldSatisfy` isRight)
  , testCase "Successfully parses valid sample data in raw byte form" $
    forM_ sampleAddresses (\(_, b) -> bimap STB STB (parseAddressRaw . unsafeFromHex $ b) `shouldSatisfy` isRight)
  , testCase "Parsed addresses are equivalent in canonical and raw byte form" $
    forM_ sampleAddresses (\(a, b) -> (STB . unsafeParseAddressRaw . unsafeFromHex $ b) @?= (STB . unsafeParseAddress $ a))
  , testCase "Fails to parse invalid data" $ do
    forM_ invalidAddresses (\a -> bimap STB STB (parseAddress a) `shouldSatisfy` isLeft)
  ]

test_decodeAddress :: [TestTree]
test_decodeAddress = mconcat
  [ [ testCase ("Successfully encodes " <> toString b)
      (formatAddress (unsafeParseAddressRaw (unsafeFromHex b)) @?= a) | (a, b) <- sampleAddresses ]
  , [ testCase ("Fails to parse invalid address " <> toString a)
      (parseInvalidAddresses a `shouldSatisfy` isNothing) | a <- invalidRawAddresses ]
  ]
  where
    parseInvalidAddresses :: Text -> Maybe Address
    parseInvalidAddresses a = do
      bs <- fromHex a
      rightToMaybe (parseAddressRaw bs)

unit_ta :: Assertion
unit_ta = do
  [ta|tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU|]
    @?= unsafeParseAddress "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU"
  [ta|tz1Wit2PqodvPeuRRhdQXmkrtU8e8bRYZecd|]
    @?= unsafeParseAddress "tz1Wit2PqodvPeuRRhdQXmkrtU8e8bRYZecd"
  [ta|KT1G4hcQj2STN86GwC1XAkPtwPPhgfPKuE45|]
    @?= unsafeParseAddress "KT1G4hcQj2STN86GwC1XAkPtwPPhgfPKuE45"
  [ta|KT1QbdJ7M7uAQZwLpvzerUyk7LYkJWDL7eDh|]
    @?= unsafeParseAddress "KT1QbdJ7M7uAQZwLpvzerUyk7LYkJWDL7eDh"

sampleAddresses :: [(Text, Text)]
sampleAddresses =
  [ ("tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU", "0000dac9f52543da1aed0bc1d6b46bf7c10db7014cd6")
  , ("tz1Wit2PqodvPeuRRhdQXmkrtU8e8bRYZecd", "000079943a60100e0394ac1c8f6ccfaeee71ec9c2d94")
  , ("tz2EfqCbLmpfv7mNiLcMmhxAwdgHtPTcwR4W", "000145b5e7d31bf6612e61ebfa7a6d929ce7800a55a4")
  , ("tz2Darj3LyQzekU98ZK8diHvuyn1YYjcHpc6", "000139ccf913874519b2d20917bf5f2de537420d2726")
  , ("tz3UoffC7FG7zfpmvmjUmUeAaHvzdcUvAj6r", "00025cfa532f50de3e12befc0ad21603835dd7698d35")
  , ("tz3NExpXn9aPNZPorRE4SdjJ2RGrfbJgMAaV", "000214fa2b36471a318d2f244997c48c5f23b8001eed")
  , ("KT1G4hcQj2STN86GwC1XAkPtwPPhgfPKuE45", "01521139f84791537d54575df0c74a8084cc68861c00")
  , ("KT1QbdJ7M7uAQZwLpvzerUyk7LYkJWDL7eDh", "01afab866e7f1e74f9bba388d66b246276ce50bf4700")
  ]

invalidRawAddresses :: [Text]
invalidRawAddresses =
  [ ""
  , "qehrwu"
  , "0000dac9f52543da1aed0bc1d6b46bf7c10db7014cd"
  , "0000dac9f52543da1aed0bc1d6b46bf7c10db7014cd6a"
  , "0000dac9f52543da1aed0bc1d6b46bf7c10db7014cds"
  , "1000dac9f52543da1aed0bc1d6b46bf7c10db7014cd6"
  ]

invalidAddresses :: [Text]
invalidAddresses =
  [ ""
  , "1"
  -- These are slightly modified versions of some valid addresses above.
  , "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUZU"
  , "tz2darj3LyQzekU98ZK8diHvuyn1YYjcHpc6"
  , "tz3UoffC8FG7zfpmvmjUmUeAaHvzdcUvAj6r"
  , "KT1G4hcQj2STN86GwC1XAkPtwPPhgfPKuE46"
  ]