Bech32Spec.hs

{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}

module Haskoin.Address.Bech32Spec (spec) where

import Control.Monad
import Data.Bits (xor)
import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import Data.Char (chr, ord, toLower)
import Data.Maybe
import Data.String.Conversions
import Data.Text (Text, append, pack, snoc, uncons)
import Data.Text qualified as Text
import Data.Word (Word8)
import Haskoin.Address
import Haskoin.Address.Bech32
import Haskoin.Util
import Test.HUnit
import Test.Hspec

spec = do
  describe "bech32 checksum" $ do
    it "should be valid" $
      forM_ validChecksums (uncurry testValidChecksum)
    it "should be invalid" $
      forM_ invalidChecksums testInvalidChecksum
    it "should be case-insensitive" $
      all ((== Just "test12hrzfj") . flip (bech32Encode Bech32) []) hrpCaseVariants
  describe "bech32 address" $ do
    it "should be valid" $
      forM_ validChecksums (uncurry testValidChecksum)
    it "should be invalid" $
      forM_ invalidChecksums testInvalidChecksum
    it "should be case-insensitive" $
      all ((== Just "test12hrzfj") . flip (bech32Encode Bech32) []) hrpCaseVariants
  describe "bech32 encoding/decoding" $ do
    it "should not encode long data string" $
      assert . isNothing $
        bech32Encode Bech32 "bc" (replicate 82 (word5 (1 :: Word8)))
    it "should not encode bad version number" $
      assert $
        isNothing $
          segwitEncode "bc" 17 []
    it "should not encode invalid length for version 0" $
      assert $
        isNothing $
          segwitEncode "bc" 0 (replicate 30 1)
    it "should relax length restrictions for versions other than 0" $
      assert $
        isJust $
          segwitEncode "bc" 1 (replicate 30 1)
    it "should not encode another long data string" $
      assert $
        isNothing $
          segwitEncode "bc" 1 (replicate 41 1)
    it "should not encode empty human readable part" $
      assert $
        isNothing $
          bech32Encode Bech32 "" []
    it "should not decode empty human-readable part" $
      assert $
        isNothing $
          bech32Decode "10a06t8"
    it "human-readable part should be case-insensitive" $
      bech32Encode Bech32 "HRP" [] `shouldBe` bech32Encode Bech32 "hrp" []

testValidChecksum :: Bech32Encoding -> Bech32 -> Assertion
testValidChecksum enc checksum = case bech32Decode checksum of
  Nothing -> assertFailure (show checksum)
  Just (enc', resultHRP, resultData) -> do
    assertEqual (show checksum ++ " encoding incorrect") enc enc'
    -- test that a corrupted checksum fails decoding.
    let (hrp, rest) = Text.breakOnEnd "1" checksum
        Just (first, rest') = uncons rest
        checksumCorrupted = (hrp `snoc` chr (ord first `xor` 1)) `append` rest'
    assertBool (show checksum ++ " corrupted") $
      isNothing (bech32Decode checksumCorrupted)
    -- test that re-encoding the decoded checksum results in the same checksum.
    let checksumEncoded = bech32Encode enc' resultHRP resultData
        expectedChecksum = Just $ Text.toLower checksum
    assertEqual
      (show checksum ++ " re-encode")
      expectedChecksum
      checksumEncoded

testInvalidChecksum :: Bech32 -> Assertion
testInvalidChecksum checksum =
  assertBool (show checksum) (isNothing $ bech32Decode checksum)

testValidAddress :: (Text, Text) -> Assertion
testValidAddress (address, hexscript) = do
  let address' = Text.toLower address
      hrp = Text.take 2 address'
  case segwitDecode hrp address of
    Nothing ->
      assertFailure (Text.unpack address <> ": decode failed")
    Just (witver, witprog) -> do
      assertEqual
        (show address)
        (decodeHex hexscript)
        (Just $ segwitScriptPubkey witver witprog)
      assertEqual
        (show address)
        (Just address')
        (segwitEncode hrp witver witprog)

testInvalidAddress :: Text -> Assertion
testInvalidAddress address = do
  assertBool (show address) (isNothing $ segwitDecode "bc" address)
  assertBool (show address) (isNothing $ segwitDecode "tb" address)

segwitScriptPubkey :: Word8 -> [Word8] -> ByteString
segwitScriptPubkey witver witprog =
  ByteString.pack $ witver' : fromIntegral (length witprog) : witprog
  where
    witver' = if witver == 0 then 0 else witver + 0x50

validChecksums :: [(Bech32Encoding, Text)]
validChecksums =
  [ ( Bech32,
      "A12UEL5L"
    ),
    ( Bech32,
      "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"
    ),
    ( Bech32,
      "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"
    ),
    ( Bech32,
      "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"
    ),
    ( Bech32,
      "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"
    ),
    ( Bech32m,
      "A1LQFN3A"
    ),
    ( Bech32m,
      "a1lqfn3a"
    ),
    ( Bech32m,
      "an83characterlonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11sg7hg6"
    ),
    ( Bech32m,
      "abcdef1l7aum6echk45nj3s0wdvt2fg8x9yrzpqzd3ryx"
    ),
    ( Bech32m,
      "11llllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllludsr8"
    ),
    ( Bech32m,
      "split1checkupstagehandshakeupstreamerranterredcaperredlc445v"
    ),
    ( Bech32m,
      "?1v759aa"
    )
  ]

invalidChecksums :: [Text]
invalidChecksums =
  [ " 1nwldj5",
    "\DEL1axkwrx",
    "an84characterslonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1569pvx",
    "pzry9x0s0muk",
    "1pzry9x0s0muk",
    "x1b4n0q5v",
    "li1dgmt3",
    "de1lg7wt\xFF"
  ]

validAddresses :: [(Text, Text)]
validAddresses =
  [ ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4",
      "0014751e76e8199196d454941c45d1b3a323f1433bd6"
    ),
    ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7",
      "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262"
    ),
    ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy",
      "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433"
    ),
    ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4",
      "0014751e76e8199196d454941c45d1b3a323f1433bd6"
    ),
    ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7",
      "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262"
    ),
    ( "bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kt5nd6y",
      "5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6"
    ),
    ( "BC1SW50QGDZ25J",
      "6002751e"
    ),
    ( "bc1zw508d6qejxtdg4y5r3zarvaryvaxxpcs",
      "5210751e76e8199196d454941c45d1b3a323"
    ),
    ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy",
      "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433"
    ),
    ( "tb1pqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesf3hn0c",
      "5120000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433"
    ),
    ( "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqzk5jj0",
      "512079be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
    )
  ]

invalidAddresses :: [Text]
invalidAddresses =
  [ "tc1qw508d6qejxtdg4y5r3zarvary0c5xw7kg3g4ty",
    "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t5",
    "BC13W508D6QEJXTDG4Y5R3ZARVARY0C5XW7KN40WF2",
    "bc1rw5uspcuh",
    "bc10w508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kw5rljs90",
    "BC1QR508D6QEJXTDG4Y5R3ZARVARYV98GJ9P",
    "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sL5k7",
    "bc1zw508d6qejxtdg4y5r3zarvaryvqyzf3du",
    "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3pjxtptv",
    "bc1gmk9yu",
    "tc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq5zuyut",
    "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqh2y7hd",
    "tb1z0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqglt7rf",
    "BC1S0XLXVLHEMJA6C4DQV22UAPCTQUPFHLXM9H8Z3K2E72Q4K9HCZ7VQ54WELL",
    "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kemeawh",
    "tb1q0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq24jc47",
    "bc1p38j9r5y49hruaue7wxjce0updqjuyyx0kh56v8s25huc6995vvpql3jow4",
    "BC130XLXVLHEMJA6C4DQV22UAPCTQUPFHLXM9H8Z3K2E72Q4K9HCZ7VQ7ZWS8R",
    "bc1pw5dgrnzv",
    "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7v8n0nx0muaewav253zgeav",
    "tb1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq47Zagq",
    "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7v07qwwzcrf",
    "tb1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vpggkg4j"
  ]

hrpCaseVariants :: [Text]
hrpCaseVariants = map Text.pack hrpTestPermutations

hrpTestPermutations :: [String]
hrpTestPermutations = do
  a <- ['t', 'T']
  b <- ['e', 'E']
  c <- ['s', 'S']
  d <- ['t', 'T']
  return [a, b, c, d]