content: {-# LANGUAGE DerivingStrategies #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiWayIf #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Codec.Binary.Bech32Spec
      ( spec
      ) where
  
  import Prelude
  
  import Codec.Binary.Bech32.Internal
      ( CharPosition (..)
      , DataPart
      , DecodingError (..)
      , HumanReadablePart
      , HumanReadablePartError (..)
      , dataPartFromBytes
      , dataPartFromText
      , dataPartFromWords
      , dataPartIsValid
      , dataPartToWords
      , humanReadableCharIsValid
      , humanReadableCharMaxBound
      , humanReadableCharMinBound
      , humanReadablePartFromText
      , humanReadablePartMaxLength
      , humanReadablePartMinLength
      , humanReadablePartToText
      , separatorChar
      )
  import Control.DeepSeq
      ( deepseq )
  import Control.Monad
      ( forM_, replicateM )
  import Data.Bits
      ( xor, (.&.) )
  import Data.ByteString
      ( ByteString )
  import Data.Char
      ( chr, isUpper, ord, toLower, toUpper )
  import Data.Either
      ( fromRight, isRight )
  import Data.Either.Extra
      ( eitherToMaybe )
  import Data.Functor.Identity
      ( runIdentity )
  import Data.List
      ( intercalate )
  import Data.Maybe
      ( fromMaybe, isJust, mapMaybe )
  import Data.Set
      ( Set )
  import Data.Text
      ( Text )
  import Data.Vector
      ( Vector )
  import Data.Word
      ( Word8 )
  import Test.Hspec
      ( Spec, describe, expectationFailure, it, shouldBe, shouldSatisfy )
  import Test.QuickCheck
      ( Arbitrary (..)
      , Positive (..)
      , arbitraryBoundedEnum
      , checkCoverage
      , choose
      , counterexample
      , cover
      , elements
      , frequency
      , oneof
      , property
      , withMaxSuccess
      , (.&&.)
      , (.||.)
      , (===)
      , (==>)
      )
  
  import qualified Codec.Binary.Bech32.Internal as Bech32
  import qualified Data.ByteString as BS
  import qualified Data.Set as Set
  import qualified Data.Text as T
  import qualified Data.Vector as V
  
  spec :: Spec
  spec = do
      describe "Valid Reference Strings" $
          it "should always decode successfully" $
              forM_ validBech32Strings $ \s ->
                  Bech32.decode s `shouldSatisfy` isRight
  
      describe "Valid Checksums" $ forM_ validChecksums $ \checksum ->
          it (T.unpack checksum) $ case Bech32.decode checksum of
              Left _ ->
                  expectationFailure (show checksum)
              Right (resultHRP, resultData) -> do
                  -- test that a corrupted checksum fails decoding.
                  let (hrp, rest) =
                          T.breakOnEnd (T.singleton separatorChar) checksum
                  let (first, rest') =
                          fromMaybe (error "empty rest") $ T.uncons rest
                  let checksumCorrupted =
                          (hrp `T.snoc` chr (ord first `xor` 1))
                          `T.append` rest'
                  Bech32.decode checksumCorrupted `shouldSatisfy` isLeft'
                  -- test that re-encoding the decoded checksum results in
                  -- the same checksum.
                  let checksumEncoded = Bech32.encode resultHRP resultData
                  let expectedChecksum = Right $ T.map toLower checksum
                  checksumEncoded `shouldBe` expectedChecksum
  
      describe "Invalid Checksums" $ forM_ invalidChecksums $
          \(checksum, expect) ->
              it (T.unpack checksum) $
                  Bech32.decode checksum `shouldBe` Left expect
  
      describe "Parsing human-readable parts from text" $ do
  
          describe "Known-good human readable parts parse correctly." $
              forM_ validHumanReadableParts $ \hrp ->
                  it (T.unpack hrp) $
                      (humanReadablePartToText <$> humanReadablePartFromText hrp)
                      `shouldBe` Right hrp
  
          describe "Known-bad human readable parts fail to parse." $
              forM_ invalidHumanReadableParts $ \hrp ->
                  it (T.unpack hrp) $
                      humanReadablePartFromText hrp `shouldSatisfy` isLeft'
  
          it "Characters are checked correctly for validity." $
              property $ \(HumanReadablePartWithSuspiciousChars hrp) ->
                  let isValid = T.all humanReadableCharIsValid hrp
                      invalidError = HumanReadablePartContainsInvalidChars $
                          CharPosition . fst <$>
                          filter
                              ((not . humanReadableCharIsValid) . snd)
                              ([0 .. ] `zip` T.unpack hrp)
                  in
                  checkCoverage
                      $ cover 10 isValid
                          "no invalid characters"
                      $ cover 10 (not isValid)
                          "one or more invalid characters"
                      $ if isValid then
                          fmap humanReadablePartToText
                              (humanReadablePartFromText hrp)
                              `shouldBe` Right (T.toLower hrp)
                         else
                          humanReadablePartFromText hrp
                              `shouldBe` Left invalidError
  
          it "Lengths are checked correctly." $
              property $ \(HumanReadablePartWithSuspiciousLength hrp) ->
                  let lo  = humanReadablePartMinLength
                      hi  = humanReadablePartMaxLength
                      len = T.length hrp
                  in
                  checkCoverage
                      $ cover 10 (len < lo)
                          "too short"
                      $ cover 10 (len == lo)
                          "minimum length"
                      $ cover 10 (len > lo && len < hi)
                          "comfortably within bounds"
                      $ cover 10 (len == hi)
                          "maximum length"
                      $ cover 10 (len > hi)
                          "too long"
                      $ if
                      | len < lo ->
                          humanReadablePartFromText hrp
                              `shouldBe` Left HumanReadablePartTooShort
                      | len > hi ->
                          humanReadablePartFromText hrp
                              `shouldBe` Left HumanReadablePartTooLong
                      | otherwise ->
                          fmap humanReadablePartToText
                              (humanReadablePartFromText hrp)
                              `shouldBe` Right (T.toLower hrp)
  
      describe "More Encoding/Decoding Cases" $ do
          it "length > maximum" $ do
              let hrpUnpacked = "ca"
              let hrpLength = length hrpUnpacked
              let hrp = unsafeHumanReadablePartFromText (T.pack hrpUnpacked)
              let maxDataLength =
                      Bech32.encodedStringMaxLength
                      - Bech32.checksumLength - Bech32.separatorLength - hrpLength
              Bech32.encode hrp
                  (dataPartFromWords (replicate (maxDataLength + 1)
                      $ Bech32.word5 @Word8 1))
                  `shouldBe` Left Bech32.EncodedStringTooLong
  
          it "hrp lowercased" $ do
              let hrp = unsafeHumanReadablePartFromText "HRP"
              Bech32.encode hrp mempty `shouldBe` Right "hrp1vhqs52"
  
      describe "Arbitrary Bech32String" $
  
          it "Generation always produces a valid string that can be decoded." $
              property $ \v ->
                  Bech32.decode (getBech32String v) `shouldBe`
                      Right (humanReadablePart v, unencodedDataPart v)
  
      describe "Arbitrary Bech32Char" $ do
  
          it "Generation always produces a valid character." $
              property $ withMaxSuccess 10000 $ \c ->
                  let char = getBech32Char c in
                  cover 30 (      isDataChar char) "is a data character: TRUE"  $
                  cover 30 (not $ isDataChar char) "is a data character: FALSE" $
                  isBech32Char char
  
          it "Shrinking always produces valid characters." $
              property $ withMaxSuccess 10000 $ \c ->
                  all (isBech32Char . getBech32Char) $ shrink c
  
          it "Shrinking always produces characters with codes that are smaller." $
              property $ withMaxSuccess 10000 $ \c ->
                  all (< c) $ shrink (c :: Bech32Char)
  
      describe "Decoding a corrupted string should fail" $ do
  
          it "Decoding fails when an adjacent pair of characters is swapped." $
              property $ withMaxSuccess 10000 $ \s -> do
                  let originalString = getBech32String s
                  index <- choose (0, T.length originalString - 2)
                  let prefix = T.take index originalString
                  let suffix = T.drop (index + 2) originalString
                  let char1 = T.singleton (T.index originalString index)
                  let char2 = T.singleton (T.index originalString $ index + 1)
                  let corruptedString = prefix <> char2 <> char1 <> suffix
                  let description = intercalate "\n"
                          [ "index of char #1: " <> show index
                          , "index of char #2: " <> show (index + 1)
                          , "         char #1: " <> show char1
                          , "         char #2: " <> show char2
                          , " original string: " <> show originalString
                          , "corrupted string: " <> show corruptedString ]
                  return $ counterexample description $
                      char1 /= char2 ==>
                          (T.length corruptedString === T.length originalString)
                          .&&.
                          (Bech32.decode corruptedString `shouldSatisfy` isLeft')
  
          it "Decoding fails when a character is omitted." $
              property $ withMaxSuccess 10000 $ \s -> do
                  let originalString = getBech32String s
                  index <- choose (0, T.length originalString - 1)
                  let char = T.index originalString index
                  let prefix = T.take index originalString
                  let suffix = T.drop (index + 1) originalString
                  let corruptedString = prefix <> suffix
                  let description = intercalate "\n"
                          [ "index of omitted char: " <> show index
                          , "         omitted char: " <> show char
                          , "      original string: " <> show originalString
                          , "     corrupted string: " <> show corruptedString ]
                  return $ counterexample description $
                      (T.length corruptedString === T.length originalString - 1)
                      .&&.
                      (Bech32.decode corruptedString `shouldSatisfy` isLeft')
                      .||.
                      -- In the case where the tail of a valid Bech32 string is
                      -- composed of one or more consecutive 'q' characters
                      -- followed by a single 'p' character, omitting any or all
                      -- of the 'q' characters will still result in a valid
                      -- Bech32 string:
                      (T.length suffix > 0
                          && T.last suffix == 'p'
                          && char == 'q'
                          && T.all (== 'q') (T.dropEnd 1 suffix))
  
          it "Decoding fails when a character is inserted." $
              property $ withMaxSuccess 10000 $ \s c -> do
                  let originalString = getBech32String s
                  let char = getBech32Char c
                  index <- choose (0, T.length originalString)
                  let prefix = T.take index originalString
                  let suffix = T.drop index originalString
                  let corruptedString = prefix <> T.singleton char <> suffix
                  let description = intercalate "\n"
                          [ "index of inserted char: " <> show index
                          , "         inserted char: " <> show char
                          , "       original string: " <> show originalString
                          , "      corrupted string: " <> show corruptedString ]
                  return $
                      counterexample description $
                      cover 2 (T.null prefix)
                          "inserted before the start" $
                      cover 2 (T.null suffix)
                          "inserted after the end" $
                      cover 10 (not (T.null prefix) && not (T.null suffix))
                          "inserted into the middle" $
                      (T.length corruptedString === T.length originalString + 1)
                      .&&.
                      (Bech32.decode corruptedString `shouldSatisfy` isLeft')
                      .||.
                      -- In the case where the last character of a valid Bech32
                      -- string is the character 'p', inserting any number of
                      -- consecutive 'q' characters immediately before the 'p'
                      -- will still result in a valid Bech32 string.
                      (T.length suffix > 0
                          && T.last suffix == 'p'
                          && char == 'q'
                          && T.all (== 'q') (T.dropEnd 1 suffix))
  
          it "Decoding fails when a single character is mutated." $
             withMaxSuccess 10000 $ property $ \s c -> do
                  let originalString = getBech32String s
                  index <- choose (0, T.length originalString - 1)
                  let originalChar = T.index originalString index
                  let replacementChar = getBech32Char c
                  let prefix = T.take index originalString
                  let suffix = T.drop (index + 1) originalString
                  let corruptedString =
                          prefix <> T.singleton replacementChar <> suffix
                  let description = intercalate "\n"
                          [ "index of mutated char: " <> show index
                          , "        original char: " <> show originalChar
                          , "     replacement char: " <> show replacementChar
                          , "      original string: " <> show originalString
                          , "     corrupted string: " <> show corruptedString ]
                  let result = Bech32.decode corruptedString
                  return $ counterexample description $
                      corruptedString /= originalString ==>
                          (T.length corruptedString === T.length originalString)
                          .&&.
                          (result `shouldSatisfy` isLeft')
  
          it "Decoding fails for an upper-case string with a lower-case \
             \character." $
              withMaxSuccess 10000 $ property $ \s -> do
                  let originalString = T.map toUpper $ getBech32String s
                  index <- choose (0, T.length originalString - 1)
                  let prefix = T.take index originalString
                  let suffix = T.drop (index + 1) originalString
                  let char = toLower $ T.index originalString index
                  let corruptedString = prefix <> T.singleton char <> suffix
                  let description = intercalate "\n"
                          [ "index of mutated char: " <> show index
                          , "      original string: " <> show originalString
                          , "     corrupted string: " <> show corruptedString ]
                  return $ counterexample description $
                      isMixedCase corruptedString ==>
                          (T.length corruptedString === T.length originalString)
                          .&&.
                          (Bech32.decode corruptedString `shouldBe` Left
                              StringToDecodeHasMixedCase)
  
          it "Decoding fails for a lower-case string with an upper-case \
             \character." $
              withMaxSuccess 10000 $ property $ \s -> do
                  let originalString = T.map toLower $ getBech32String s
                  index <- choose (0, T.length originalString - 1)
                  let prefix = T.take index originalString
                  let suffix = T.drop (index + 1) originalString
                  let char = toUpper $ T.index originalString index
                  let corruptedString = prefix <> T.singleton char <> suffix
                  let description = intercalate "\n"
                          [ "index of mutated char: " <> show index
                          , "      original string: " <> show originalString
                          , "     corrupted string: " <> show corruptedString ]
                  return $ counterexample description $
                      isMixedCase corruptedString ==>
                          (T.length corruptedString === T.length originalString)
                          .&&.
                          (Bech32.decode corruptedString `shouldBe` Left
                              StringToDecodeHasMixedCase)
  
      describe "Roundtrip (encode . decode)" $
          it "Can perform roundtrip for valid data" $ property $ \(hrp, dp) ->
              (eitherToMaybe (Bech32.encode hrp dp)
                  >>= eitherToMaybe . Bech32.decode) === Just (hrp, dp)
  
      describe "Roundtrip (dataPartToBytes . dataPartFromBytes)" $
          it "Can perform roundtrip base conversion" $ property $ \bs ->
              (Bech32.dataPartToBytes . Bech32.dataPartFromBytes) bs === Just bs
  
      describe "Roundtrip (dataPartFromText . dataPartToText)" $
          it "Can perform roundtrip conversion" $ property $ \dp ->
              (Bech32.dataPartFromText . Bech32.dataPartToText) dp === Just dp
  
      describe "Roundtrip (dataPartFromWords . dataPartToWords)" $
          it "Can perform roundtrip conversion" $ property $ \dp ->
              (Bech32.dataPartFromWords . Bech32.dataPartToWords) dp === dp
  
      describe "Roundtrip (dataPartToWords . dataPartFromWords)" $
          it "Can perform roundtrip conversion" $ property $ \ws ->
              (Bech32.dataPartToWords . Bech32.dataPartFromWords) ws === ws
  
      describe "Roundtrip (humanReadablePartFromText . humanReadablePartToText)" $
          it "Can perform roundtrip conversion" $ property $ \hrp ->
              (Bech32.humanReadablePartFromText . Bech32.humanReadablePartToText)
                  hrp === Right hrp
  
      describe "Roundtrip (toBase256 . toBase32)" $
          it "Can perform roundtrip base conversion" $ property $ \ws ->
              (Bech32.toBase256 . Bech32.toBase32) ws === Just ws
  
      describe "Roundtrip (toBase32 . toBase256)" $
          it "Can perform roundtrip base conversion" $ property $ \ws ->
              isJust (Bech32.toBase256 ws) ==>
                  (Bech32.toBase32 <$> Bech32.toBase256 ws) === Just ws
  
      describe "Roundtrip (dataCharToWord . dataCharFromWord)" $
          it "can perform roundtrip character set conversion" $
              property $ \w ->
                  Bech32.dataCharToWord (toLower (Bech32.dataCharFromWord w))
                      === Just w
  
      describe "Constructors produce valid values" $ do
  
          it "dataPartFromBytes" $
              property $ \bytes -> do
                  let value = dataPartFromBytes bytes
                  let counterexampleText = mconcat
                          [ "input:  ", show bytes, "\n"
                          , "output: ", show value, "\n" ]
                  counterexample counterexampleText $
                      dataPartIsValid value
  
          it "dataPartFromText" $
              property $ \chars -> do
                  let value = dataPartFromText (T.pack $ getDataChar <$> chars)
                  let counterexampleText = mconcat
                          [ "input:  ", show chars, "\n"
                          , "output: ", show value, "\n" ]
                  counterexample counterexampleText $
                      fmap dataPartIsValid value === Just True
  
          it "dataPartFromWords" $
              property $ \ws -> do
                  let value = dataPartFromWords ws
                  let counterexampleText = mconcat
                          [ "input:  ", show ws   , "\n"
                          , "output: ", show value, "\n" ]
                  counterexample counterexampleText $
                      dataPartIsValid value
  
      describe "Conversion of word string from one word size to another" $ do
  
          it "With identical word sizes, conversion is the identity transform" $
              property $ \inputWordsUnmasked -> do
                  size <- choose (1, 16)
                  let mask (Positive w) = w .&. (2 ^ size - 1)
                  let inputWords = mask <$> inputWordsUnmasked
                  pure $ inputWords === runIdentity
                      (Bech32.convertBits inputWords size size Bech32.yesPadding)
  
          it "With different word sizes, roundtripping preserves data" $
              property $ \inputWordsUnmasked -> do
                  sourceSize <- choose (1, 16)
                  targetSize <- choose (1, 16)
                  let mask size (Positive w) = w .&. (2 ^ size - 1)
                  let inputWords = mask sourceSize <$> inputWordsUnmasked
                  let convert s0 s1 inputData =
                          runIdentity $
                              Bech32.convertBits inputData s0 s1 Bech32.yesPadding
                  let outputWords =
                          convert targetSize sourceSize $
                          convert sourceSize targetSize inputWords
                  let outputWordsPrefix = take (length inputWords) outputWords
                  let outputWordsSuffix = drop (length inputWords) outputWords
                  pure $
                      (inputWords === outputWordsPrefix)
                      .&&.
                      (outputWordsSuffix `shouldSatisfy` all (== 0))
  
      describe "Pointless test to trigger coverage on derived instances" $
          it (show $ humanReadablePartFromText $ T.pack "ca") True
  
  -- Taken from the BIP 0173 specification: https://git.io/fjBIN
  validHumanReadableParts :: [Text]
  validHumanReadableParts =
      [ "addr"
      , "ca"
      , "bc"
      , "tb"
      , "xprv"
      ]
  
  invalidHumanReadableParts :: [Text]
  invalidHumanReadableParts =
      [ "鑫"
      , "臥虎藏龍"
      ]
  
  -- Taken from the BIP 0173 specification: https://git.io/fjBIN
  validBech32Strings :: [Text]
  validBech32Strings =
      [ "A12UEL5L"
      , "a12uel5l"
      , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcluded\
        \charactersbio1tt5tgs"
      , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"
      , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq\
        \qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"
      , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"
      , "?1ezyfcl"
      , "BC1SW50QA3JX3S"
      , "bc1zw508d6qejxtdg4y5r3zarvaryvg6kdaj"
      , "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t4"
      , "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4"
      , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7"
      , "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy"
      , "bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0\
        \c5xw7k7grplx"
      , "tc1qw508d6qejxtdg4y5r3zarvary0c5xw7kg3g4ty"
      , "BC13W508D6QEJXTDG4Y5R3ZARVARY0C5XW7KN40WF2"
      , "bc1rw5uspcuh"
      , "bc10w508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kw5rljs90"
      , "BC1QR508D6QEJXTDG4Y5R3ZARVARYV98GJ9P"
      , "bc1zw508d6qejxtdg4y5r3zarvaryvqyzf3du"
      , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3pjxtptv"
      , "bc1gmk9yu"
      ]
  
  validChecksums :: [Text]
  validChecksums =
      [ "A12UEL5L"
      , "an83characterlonghumanreadablepartthatcontain\
        \sthenumber1andtheexcludedcharactersbio1tt5tgs"
      , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"
      , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq\
        \qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"
      , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"
      ]
  
  invalidChecksums :: [(Text, Bech32.DecodingError)]
  invalidChecksums =
      [ ( " 1nwldj5"
        , Bech32.StringToDecodeContainsInvalidChars [Bech32.CharPosition 0] )
      , ( "\DEL1axkwrx"
        , Bech32.StringToDecodeContainsInvalidChars [Bech32.CharPosition 0] )
      , ( "an84characterslonghumanreadablepartthatcontain\
          \sthenumber1andtheexcludedcharactersbio1569pvx"
        , Bech32.StringToDecodeTooLong)
      , ( "pzry9x0s0muk", Bech32.StringToDecodeMissingSeparatorChar )
      , ( "1pzry9x0s0muk"
        , Bech32.StringToDecodeContainsInvalidChars [Bech32.CharPosition 0] )
      , ( "x1b4n0q5v"
        , Bech32.StringToDecodeContainsInvalidChars [Bech32.CharPosition 2] )
      , ( "x1n4n0q5v"
        , Bech32.StringToDecodeContainsInvalidChars [] )
      , ( "11111111111111111111111111111111111111111111111111111111111111\
          \1111111111111111111111111111"
         , Bech32.StringToDecodeContainsInvalidChars [Bech32.CharPosition 83] )
      , ( "li1dgmt3"
        , Bech32.StringToDecodeTooShort )
      , ( "", Bech32.StringToDecodeTooShort )
      , ( "de1lg7wt\xFF"
        , Bech32.StringToDecodeContainsInvalidChars [Bech32.CharPosition 8] )
      , ( "aBcdef1qpzry9x8gf2tvDw0s3jn54khce6mua7lmqqqXw"
        , Bech32.StringToDecodeHasMixedCase )
      , ( "A1G7SGD8", Bech32.StringToDecodeContainsInvalidChars [] )
      , ( "10a06t8", Bech32.StringToDecodeTooShort )
      , ( "1qzzfhee", Bech32.StringToDecodeContainsInvalidChars [CharPosition 0] )
      , ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sL5k7"
        , Bech32.StringToDecodeHasMixedCase )
      , ( "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t5"
        , Bech32.StringToDecodeContainsInvalidChars [CharPosition 41] )
      ]
  
  -- | Represents a character that is permitted to appear within a Bech32 string.
  newtype Bech32Char = Bech32Char
      { getBech32Char :: Char }
      deriving newtype (Eq, Ord, Show)
  
  instance Arbitrary Bech32Char where
      arbitrary =
          Bech32Char . (bech32CharVector V.!) <$>
              choose (0, V.length bech32CharVector - 1)
      shrink (Bech32Char c) =
          case sortedVectorElemIndex c bech32CharVector of
              Nothing -> []
              Just ci -> Bech32Char . (bech32CharVector V.!) <$> shrink ci
  
  -- | Returns true iff. the specified character is permitted to appear within
  --   a Bech32 string AND is not upper case.
  isBech32Char :: Char -> Bool
  isBech32Char c = Set.member c bech32CharSet
  
  -- | Returns true iff. the specified character is permitted to appear within
  --   the data portion of a Bech32 string AND is not upper case.
  isDataChar :: Char -> Bool
  isDataChar = isJust . Bech32.dataCharToWord
  
  -- | A vector containing all valid Bech32 characters in ascending sorted order.
  --   Upper-case characters are not included.
  bech32CharVector :: Vector Char
  bech32CharVector = V.fromList $ Set.toAscList bech32CharSet
  
  -- | The set of all valid Bech32 characters.
  --   Upper-case characters are not included.
  bech32CharSet :: Set Char
  bech32CharSet =
      Set.filter (not . isUpper) $
          Set.fromList [humanReadableCharMinBound .. humanReadableCharMaxBound]
              `Set.union` Set.singleton separatorChar
              `Set.union` Set.fromList Bech32.dataCharList
  
  -- | Find the index of an element in a sorted vector using simple binary search.
  sortedVectorElemIndex :: Ord a => a -> Vector a -> Maybe Int
  sortedVectorElemIndex a v = search 0 (V.length v - 1)
    where
      search l r
          | l >  r    = Nothing
          | a == b    = Just m
          | a <  b    = search l (m - 1)
          | a >  b    = search (m + 1) r
          | otherwise = Nothing
        where
          b = v V.! m
          m = (l + r) `div` 2
  
  newtype DataChar = DataChar
      { getDataChar :: Char
      } deriving (Eq, Ord, Show)
  
  instance Arbitrary DataChar where
      arbitrary = DataChar <$> elements Bech32.dataCharList
      shrink (DataChar c) =
          DataChar . Bech32.dataCharFromWord <$> shrink
              (fromMaybe
                  (error "unable to shrink a Bech32 data character.")
                  (Bech32.dataCharToWord c))
  
  newtype HumanReadableChar = HumanReadableChar
      { getHumanReadableChar :: Char
      } deriving (Eq, Ord, Show)
  
  instance Arbitrary HumanReadableChar where
      arbitrary = HumanReadableChar <$>
          choose (humanReadableCharMinBound, humanReadableCharMaxBound)
  
  data Bech32String = Bech32String
      { getBech32String :: Text
      , humanReadablePart :: HumanReadablePart
      , unencodedDataPart :: DataPart
      } deriving (Eq, Show)
  
  mkBech32String :: HumanReadablePart -> DataPart -> Bech32String
  mkBech32String hrp udp = Bech32String
      { getBech32String =
          fromRight (error "unable to make a valid Bech32 string.") $
              Bech32.encode hrp udp
      , humanReadablePart = hrp
      , unencodedDataPart = udp
      }
  
  instance Arbitrary Bech32String where
      arbitrary = mkBech32String <$> arbitrary <*> arbitrary
      shrink v = do
          let hrpOriginal = humanReadablePart v
          let udpOriginal = unencodedDataPart v
          hrpShrunk <- take 3 $ shrink $ humanReadablePart v
          udpShrunk <- take 3 $ shrink $ unencodedDataPart v
          uncurry mkBech32String <$>
              [ (hrpShrunk, udpShrunk)
              , (hrpShrunk, udpOriginal)
              , (hrpOriginal, udpShrunk) ]
  
  instance Arbitrary DataPart where
      arbitrary = do
          len <- choose (0, 64)
          dataPartFromWords <$> replicateM len arbitrary
      shrink dp
          | null ws = []
          | otherwise = dataPartFromWords <$>
              [ take (length ws `div` 2) ws
              , drop 1 ws
              ]
        where
          ws = dataPartToWords dp
  
  instance Arbitrary HumanReadablePart where
      arbitrary = do
          len <- choose (1, 10)
          chars <- replicateM len arbitrary
          let hrp = unsafeHumanReadablePartFromText
                  $ T.pack
                  $ getHumanReadableChar <$> chars
          return hrp
      shrink hrp
          | T.null chars = []
          | otherwise = mapMaybe (eitherToMaybe . humanReadablePartFromText)
              [ T.take (T.length chars `div` 2) chars
              , T.drop 1 chars
              ]
        where
          chars = humanReadablePartToText hrp
  
  -- | A human-readable part that may (or may not) contain one or more invalid
  --   characters.
  newtype HumanReadablePartWithSuspiciousChars =
      HumanReadablePartWithSuspiciousChars Text
      deriving (Eq, Show)
  
  instance Arbitrary HumanReadablePartWithSuspiciousChars where
      arbitrary = do
          len <- genLength
          chars <- replicateM len genChar
          return $ HumanReadablePartWithSuspiciousChars $ T.pack chars
        where
          genChar = frequency
              [ (98, genCharValid)
              , ( 1, genCharBelowMinBound)
              , ( 1, genCharAboveMaxBound)
              ]
          genCharValid = choose
              ( humanReadableCharMinBound
              , humanReadableCharMaxBound
              )
          genCharBelowMinBound = choose
              ( toEnum 0
              , toEnum (fromEnum humanReadableCharMinBound - 1)
              )
          genCharAboveMaxBound = choose
              ( toEnum (fromEnum humanReadableCharMaxBound + 1)
              , toEnum (fromEnum humanReadableCharMaxBound * 2)
              )
          genLength = choose
              ( humanReadablePartMinLength
              , humanReadablePartMaxLength
              )
  
  -- | A human-readable part that may (or may not) be too long or too short.
  newtype HumanReadablePartWithSuspiciousLength =
      HumanReadablePartWithSuspiciousLength Text
      deriving (Eq, Show)
  
  instance Arbitrary HumanReadablePartWithSuspiciousLength where
      arbitrary = do
          len <- oneof
              [ choose (0, lo - 1)
              , pure lo
              , choose (lo + 1, hi - 1)
              , pure hi
              , choose (hi + 1, hi * 2)
              ]
          chars <- replicateM len arbitrary
          return
              $ HumanReadablePartWithSuspiciousLength
              $ T.pack
              $ fmap getHumanReadableChar chars
        where
          lo = humanReadablePartMinLength
          hi = humanReadablePartMaxLength
  
  instance Arbitrary ByteString where
      shrink bytes | BS.null bytes = []
      shrink bytes =
          [ BS.take (BS.length bytes `div` 2) bytes
          , BS.drop 1 bytes
          ]
      arbitrary = do
          count <- choose (0, 32)
          BS.pack <$> replicateM count arbitrary
  
  instance Arbitrary Bech32.Word5 where
      arbitrary = arbitraryBoundedEnum
      shrink w = Bech32.word5 <$> shrink (Bech32.getWord5 w)
  
  -- | Returns true iff. the given string has both lower-case and upper-case
  --   characters.
  --
  isMixedCase :: Text -> Bool
  isMixedCase t =
      T.toUpper t /= t &&
      T.toLower t /= t
  
  -- | Strict `isLeft`, evaluate the left-side and return 'True' if 'Left'.
  -- 'False' otherwise.
  isLeft' :: Show e => Either e a -> Bool
  isLeft' = \case
      Left e -> show e `deepseq` True
      Right _ -> False
  
  --------------------------------------------------------------------------------
  -- Utilities
  --------------------------------------------------------------------------------
  
  -- | Unsafely parses a human-readable prefix from text.
  --
  -- Throws a run-time error if the given text could not be parsed as a
  -- human-readable prefix.
  --
  unsafeHumanReadablePartFromText :: Text -> HumanReadablePart
  unsafeHumanReadablePartFromText
      = either (error . ("Error while parsing Bech32: " <>) . show) id
      . humanReadablePartFromText
  