diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -3,3 +3,12 @@ ## 1.0.0 -- 2019-09-27 + Initial release pulled from https://github.com/input-output-hk/cardano-wallet + +## 1.0.1 -- 2020-02-13 + ++ Improved module documentation, adding basic examples to help beginner users + quickly get up to speed. ++ Exposed functions `dataPartFromWords` and `dataPartToWords` within public + interface. ++ Exposed the `Word5` type within the public interface. ++ Exposed the `CharPosition` type within the public interface. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -186,7 +186,7 @@ same "printed page" as the copyright notice for easier identification within third-party archives. - Copyright © 2018-2019 IOHK + Copyright © 2019-2020 IOHK Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/bech32.cabal b/bech32.cabal --- a/bech32.cabal +++ b/bech32.cabal @@ -1,11 +1,11 @@ name: bech32 -version: 1.0.0 +version: 1.0.1 synopsis: Implementation of the Bech32 cryptocurrency address format (BIP 0173). description: Implementation of the Bech32 cryptocurrency address format documented in the BIP (Bitcoin Improvement Proposal) 0173. author: IOHK Engineering Team -maintainer: operations@iohk.io, erikd@mega-nerd.com -copyright: 2017 Marko Bencun, 2019 IOHK +maintainer: operations@iohk.io, erikd@mega-nerd.com, jonathan.knowles@iohk.io +copyright: 2017 Marko Bencun, 2019-2020 IOHK license: Apache-2.0 license-file: LICENSE homepage: https://github.com/input-output-hk/bech32 diff --git a/src/Codec/Binary/Bech32.hs b/src/Codec/Binary/Bech32.hs --- a/src/Codec/Binary/Bech32.hs +++ b/src/Codec/Binary/Bech32.hs @@ -1,37 +1,79 @@ -- | --- Copyright: © 2017 Marko Bencun, 2018-2019 IOHK +-- Copyright: © 2017 Marko Bencun, 2019-2020 IOHK -- License: Apache-2.0 -- -- Implementation of the [Bech32] -- (https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki) -- address format. -- --- From an original implementation by Marko Bencun: --- --- [sipa/bech32](https://github.com/sipa/bech32/tree/bdc264f84014c234e908d72026b7b780122be11f/ref/haskell) +-- Based on an [original implementation](https://github.com/sipa/bech32/tree/bdc264f84014c234e908d72026b7b780122be11f/ref/haskell) +-- by [Marko Bencun](https://github.com/sipa). module Codec.Binary.Bech32 ( - -- * Encoding & Decoding + -- * Basic Usage + + -- ** Encoding encode - , encodeLenient - , EncodingError (..) + -- ** Decoding , decode - , decodeLenient + + -- * Error Handling + + -- ** Encoding + , EncodingError (..) + -- ** Decoding , DecodingError (..) - -- * Data Part + -- * Core Types + + -- ** Data Payloads , DataPart + -- *** Conversion to and from Words + , dataPartFromWords + , dataPartToWords + -- *** Conversion to and from Bytes , dataPartFromBytes - , dataPartFromText , dataPartToBytes + -- *** Conversion to and from Text + , dataPartFromText , dataPartToText - -- * Human-Readable Part + -- ** Human-Readable Prefixes , HumanReadablePart - , HumanReadablePartError (..) + -- *** Conversion to and from Text , humanReadablePartFromText , humanReadablePartToText + -- *** Error Handling + , HumanReadablePartError (..) + + -- * Additional Types + + -- ** Character Positions + , CharPosition (..) + -- ** Data Words + , Word5 + + -- * Advanced Usage + + -- ** Encoding and Decoding with Greater Leniency + , encodeLenient + , decodeLenient + + -- * Fundamental Constants + + -- ** Data Payloads + , dataCharList + -- ** Human-Readable Prefixes + , humanReadablePartMinLength + , humanReadablePartMaxLength + , humanReadableCharMinBound + , humanReadableCharMaxBound + -- ** Encoded Strings + , encodedStringMaxLength + , encodedStringMinLength + , separatorChar + ) where import Codec.Binary.Bech32.Internal diff --git a/src/Codec/Binary/Bech32/Internal.hs b/src/Codec/Binary/Bech32/Internal.hs --- a/src/Codec/Binary/Bech32/Internal.hs +++ b/src/Codec/Binary/Bech32/Internal.hs @@ -7,7 +7,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | --- Copyright: © 2017 Marko Bencun, 2018-2019 IOHK +-- Copyright: © 2017 Marko Bencun, 2019-2020 IOHK -- License: Apache-2.0 -- -- Implementation of the [Bech32] @@ -54,6 +54,7 @@ , humanReadablePartToWords , humanReadablePartMinLength , humanReadablePartMaxLength + , humanReadableCharIsValid , humanReadableCharMinBound , humanReadableCharMaxBound @@ -146,10 +147,11 @@ dataPartToBytes dp = BS.pack <$> (toBase256 =<< traverse dataCharToWord (T.unpack $ dataPartToText dp)) --- | Constructs a 'DataPart' from textual input. All characters in the input --- must be a member of 'dataCharList', the set of characters permitted to --- appear within the data part of a Bech32 string. +-- | Constructs a 'DataPart' from textual input. -- +-- All characters in the input must be a member of 'dataCharList', the set of +-- characters permitted to appear within the data part of a Bech32 string. +-- -- Returns 'Nothing' if any character in the input is not a member of -- 'dataCharList'. -- @@ -174,7 +176,7 @@ dataPartToText :: DataPart -> Text dataPartToText (DataPart t) = t --- | Construct a 'DataPart' directly from words. +-- | Construct a 'DataPart' directly from a list of words. -- -- This function guarantees to satisfy the following properties: -- @@ -184,19 +186,29 @@ dataPartFromWords :: [Word5] -> DataPart dataPartFromWords = DataPart . T.pack . fmap dataCharFromWord --- | Convert a 'DataPart' into words. +-- | Unpack a 'DataPart' into a list of its constituent words. -- +-- This function guarantees to satisfy the following properties: +-- +-- > dataPartFromWords (dataPartToWords d) == d +-- > dataPartToWords (dataPartFromWords w) == w +--- dataPartToWords :: DataPart -> [Word5] dataPartToWords = mapMaybe dataCharToWord . T.unpack . dataPartToText -- | Returns true iff. the specified character is permitted to appear within -- the data part of a Bech32 string. --- See here for more details: https://git.io/fj8FS +-- +-- See here for more details: https://git.io/fj8FS +-- dataCharIsValid :: Char -> Bool dataCharIsValid = (`Map.member` dataCharToWordMap) -- | A list of all characters that are permitted to appear within the data part --- of a Bech32 string. See here for more details: https://git.io/fj8FS +-- of a Bech32 string. +-- +-- See here for more details: https://git.io/fj8FS +-- dataCharList :: String dataCharList = "qpzry9x8gf2tvdw0s3jn54khce6mua7l" @@ -249,8 +261,15 @@ -- human-readable part of a Bech32 string. data HumanReadablePartError = HumanReadablePartTooShort + -- ^ The human-readable part is /shorter than/ + -- 'humanReadablePartMinLength'. | HumanReadablePartTooLong + -- ^ The human-readable part is /longer than/ + -- 'humanReadablePartMaxLength'. | HumanReadablePartContainsInvalidChars [CharPosition] + -- ^ The human-readable part contains one or more characters whose values + -- are /less than/ 'humanReadableCharMinBound' or /greater than/ + -- 'humanReadableCharMaxBound'. deriving (Eq, Show) -- | Get the raw text of the human-readable part of a Bech32 string. @@ -295,15 +314,16 @@ Encoding & Decoding -------------------------------------------------------------------------------} --- | Like 'encode' but allows output to be longer than 90 characters. This isn't --- ideal as the error detection becomes worse as string get longer but it's --- still acceptable. +-- | Like 'encode' but allows output to be longer than 90 characters. -- --- From BIP-0173: +-- This isn't ideal, as Bech32 error detection becomes worse as strings get +-- longer, but it may be useful in certain circumstances. -- --- Even though the chosen code performs reasonably well up to 1023 +-- From [BIP-0173](https://en.bitcoin.it/wiki/BIP_0173): +-- +-- "Even though the chosen code performs reasonably well up to 1023 -- characters, other designs are preferable for lengths above 89 --- characters (excluding the separator). +-- characters (excluding the separator)." -- encodeLenient :: HumanReadablePart -> DataPart -> Text encodeLenient hrp dp = humanReadablePartToText hrp @@ -312,7 +332,28 @@ where dcp = dataCharFromWord <$> dataPartToWords dp <> createChecksum hrp dp --- | Encode a human-readable string and data payload into a Bech32 string. +-- | Encode a Bech32 string from a human-readable prefix and data payload. +-- +-- == Example +-- +-- >>> import Prelude +-- >>> import Codec.Binary.Bech32 +-- >>> import Data.Text.Encoding +-- +-- First, prepare a human-readable prefix: +-- +-- >>> Right prefix = humanReadablePartFromText "example" +-- +-- Next, prepare a data payload: +-- +-- >>> messageToEncode = "Lorem ipsum dolor sit amet!" +-- >>> dataPart = dataPartFromBytes $ encodeUtf8 messageToEncode +-- +-- Finally, produce a Bech32 string: +-- +-- >>> encode prefix dataPart +-- Right "example1f3hhyetdyp5hqum4d5sxgmmvdaezqumfwssxzmt9wsss9un3cx" +-- encode :: HumanReadablePart -> DataPart -> Either EncodingError Text encode hrp dp | T.length result > encodedStringMaxLength = Left EncodedStringTooLong @@ -322,11 +363,15 @@ -- | Represents the set of error conditions that may occur while encoding a -- Bech32 string. -data EncodingError = EncodedStringTooLong +data EncodingError = + EncodedStringTooLong + -- ^ The resultant encoded string would be /longer than/ + -- 'encodedStringMaxLength'. deriving (Eq, Show) --- | Like 'decode' but does not enforce a maximum length. See also --- 'encodeLenient' for details. +-- | Like 'decode' but does not enforce a maximum length. +-- +-- See also 'encodeLenient' for details. decodeLenient :: Text -> Either DecodingError (HumanReadablePart, DataPart) decodeLenient bech32 = do guardE (T.length bech32 >= encodedStringMinLength) StringToDecodeTooShort @@ -362,7 +407,29 @@ (T.length bech32 - separatorLength - 1 - ) <$> locateErrors (fromIntegral residue) (T.length bech32 - 1) --- | Decode a Bech32 string into a human-readable part and data part. +-- | Decode a Bech32 string into a human-readable prefix and data payload. +-- +-- == Example +-- +-- >>> import Prelude +-- >>> import Codec.Binary.Bech32 +-- >>> import Data.Text.Encoding +-- +-- First, decode the input: +-- +-- >>> input = "example1f3hhyetdyp5hqum4d5sxgmmvdaezqumfwssxzmt9wsss9un3cx" +-- >>> Right (prefix, dataPart) = decode input +-- +-- Next, examine the decoded human-readable prefix: +-- +-- >>> humanReadablePartToText prefix +-- "example" +-- +-- Finally, examine the decoded data payload: +-- +-- >>> decodeUtf8 <$> dataPartToBytes dataPart +-- Just "Lorem ipsum dolor sit amet!" +-- decode :: Text -> Either DecodingError (HumanReadablePart, DataPart) decode bech32 = do guardE (T.length bech32 <= encodedStringMaxLength) StringToDecodeTooLong @@ -398,19 +465,31 @@ -- string with the 'decode' function. data DecodingError = StringToDecodeTooLong + -- ^ The string to decode is /longer than/ 'encodedStringMaxLength'. | StringToDecodeTooShort + -- ^ The string to decode is /shorter than/ 'encodedStringMinLength'. | StringToDecodeHasMixedCase + -- ^ The string to decode contains /both/ upper case /and/ lower case + -- characters. | StringToDecodeMissingSeparatorChar + -- ^ The string to decode is missing the /separator character/, specified + -- by 'separatorChar'. | StringToDecodeContainsInvalidChars [CharPosition] - -- ^ In cases where it is possible to determine the exact locations of + -- ^ The string to decode contains one or more /invalid characters/. + -- + -- In cases where it /is/ possible to determine the exact locations of -- erroneous characters, this list will encode those locations. Clients - -- can use this information to provide user feedback. In cases where it - -- isn't possible to reliably determine the locations of erroneous - -- characters, this list will be empty. + -- can use this information to provide user feedback. + -- + -- In cases where it /isn't/ possible to reliably determine the locations + -- of erroneous characters, this list will be empty. deriving (Eq, Show) --- | The separator character. This character appears immediately after the --- human-readable part and before the data part. +-- | The separator character. +-- +-- This character appears immediately after the human-readable part and before +-- the data part in an encoded string. +-- separatorChar :: Char separatorChar = '1' @@ -422,15 +501,19 @@ separatorLength :: Int separatorLength = 1 --- | The maximum length of an encoded string, in bytes. This length includes the --- human-readable part, the separator character, the encoded data portion, --- and the checksum. +-- | The maximum length of an encoded string, in bytes. +-- +-- This length includes the human-readable part, the separator character, the +-- encoded data portion, and the checksum. +-- encodedStringMaxLength :: Int encodedStringMaxLength = 90 --- | The minimum length of an encoded string, in bytes. This length includes the --- human-readable part, the separator character, the encoded data portion, --- and the checksum. +-- | The minimum length of an encoded string, in bytes. +-- +-- This length includes the human-readable part, the separator character, the +-- encoded data portion, and the checksum. +-- encodedStringMinLength :: Int encodedStringMinLength = humanReadablePartMinLength + separatorLength + checksumLength @@ -440,6 +523,11 @@ -------------------------------------------------------------------------------} -- | The zero-based position of a character in a string, counting from the left. +-- +-- Values of this type are typically used to reflect the positions of errors. +-- +-- See 'DecodingError'. +-- newtype CharPosition = CharPosition Int deriving (Eq, Ord, Show) @@ -451,6 +539,21 @@ (.>>.) = unsafeShiftR (.<<.) = unsafeShiftL +-- | Represents a __data word__ of __5 bits__ in width. +-- +-- Each character in the data portion of a Bech32 string encodes exactly 5 bits +-- of data. +-- +-- === Construction and Deconstruction +-- +-- Use the 'toEnum' and 'fromEnum' functions to construct and deconstruct +-- 'Word5' values. +-- +-- === Packing Words into Data Payloads +-- +-- Use the 'dataPartFromWords' and 'dataPartToWords' functions to pack and +-- unpack 'Word5' values into and out of data payloads. +-- newtype Word5 = Word5 { getWord5 :: Word8 } deriving (Eq, Ord, Show) @@ -468,7 +571,7 @@ inRange (m,n) i = m <= i && i <= n word5 :: Integral a => a -> Word5 -word5 x = Word5 ((fromIntegral x) .&. 31) +word5 x = Word5 (fromIntegral x .&. 31) {-# INLINE word5 #-} {-# SPECIALIZE INLINE word5 :: Word8 -> Word5 #-} @@ -483,7 +586,7 @@ go chk value = foldl' xor chk' [g | (g, i) <- zip generator [25 ..], testBit chk i] where - chk' = chk .<<. 5 `xor` (fromWord5 value) + chk' = chk .<<. 5 `xor` fromWord5 value generator = [ 0x3b6a57b2 , 0x26508e6d @@ -751,7 +854,7 @@ l_s1 /= -1 && l_s2 /= -1 && (2 * l_s1 - l_s2 - l_s0 + 2046) `mod` 1023 == 0 = let p1 = (l_s1 - l_s0 + 1023) `mod` 1023 in - if (p1 >= len) then [] else + if p1 >= len then [] else let l_e1 = l_s0 + (1023 - 997) * p1 in [p1 | l_e1 `mod` 33 <= 0] | otherwise = @@ -776,7 +879,7 @@ | s1_s0p2 == 0 = [] | l_e2 `mod` 33 > 0 = [] | l_e1 `mod` 33 > 0 = [] - | (p1 < p2) = [p1, p2] + | p1 < p2 = [p1, p2] | otherwise = [p2, p1] where inv_p1_p2 = 1023 - diff --git a/test/Codec/Binary/Bech32Spec.hs b/test/Codec/Binary/Bech32Spec.hs --- a/test/Codec/Binary/Bech32Spec.hs +++ b/test/Codec/Binary/Bech32Spec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -17,14 +18,18 @@ , DataPart , DecodingError (..) , HumanReadablePart + , HumanReadablePartError (..) , dataPartFromBytes , dataPartFromText , dataPartFromWords , dataPartIsValid , dataPartToWords + , humanReadableCharIsValid , humanReadableCharMaxBound , humanReadableCharMinBound , humanReadablePartFromText + , humanReadablePartMaxLength + , humanReadablePartMinLength , humanReadablePartToText , separatorChar ) @@ -62,10 +67,13 @@ ( Arbitrary (..) , Positive (..) , arbitraryBoundedEnum + , checkCoverage , choose , counterexample , cover , elements + , frequency + , oneof , property , withMaxSuccess , (.&&.) @@ -97,9 +105,9 @@ T.breakOnEnd (T.singleton separatorChar) checksum let Just (first, rest') = T.uncons rest let checksumCorrupted = - (hrp `T.snoc` (chr (ord first `xor` 1))) + (hrp `T.snoc` chr (ord first `xor` 1)) `T.append` rest' - (Bech32.decode checksumCorrupted) `shouldSatisfy` isLeft' + Bech32.decode checksumCorrupted `shouldSatisfy` isLeft' -- test that re-encoding the decoded checksum results in -- the same checksum. let checksumEncoded = Bech32.encode resultHRP resultData @@ -109,8 +117,73 @@ describe "Invalid Checksums" $ forM_ invalidChecksums $ \(checksum, expect) -> it (T.unpack checksum) $ - Bech32.decode checksum `shouldBe` (Left expect) + 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 -> + fmap humanReadablePartToText + (humanReadablePartFromText hrp) + `shouldBe` Right (T.toLower hrp) + | otherwise -> + 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" @@ -301,24 +374,24 @@ (Bech32.decode corruptedString `shouldBe` Left StringToDecodeHasMixedCase) - describe "Roundtrip (encode . decode)" $ do + 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)" $ do + describe "Roundtrip (dataPartToBytes . dataPartFromBytes)" $ it "Can perform roundtrip base conversion" $ property $ \bs -> (Bech32.dataPartToBytes . Bech32.dataPartFromBytes) bs === Just bs - describe "Roundtrip (dataPartFromText . dataPartToText)" $ do + describe "Roundtrip (dataPartFromText . dataPartToText)" $ it "Can perform roundtrip conversion" $ property $ \dp -> (Bech32.dataPartFromText . Bech32.dataPartToText) dp === Just dp - describe "Roundtrip (dataPartFromWords . dataPartToWords)" $ do + describe "Roundtrip (dataPartFromWords . dataPartToWords)" $ it "Can perform roundtrip conversion" $ property $ \dp -> (Bech32.dataPartFromWords . Bech32.dataPartToWords) dp === dp - describe "Roundtrip (dataPartToWords . dataPartFromWords)" $ do + describe "Roundtrip (dataPartToWords . dataPartFromWords)" $ it "Can perform roundtrip conversion" $ property $ \ws -> (Bech32.dataPartToWords . Bech32.dataPartFromWords) ws === ws @@ -327,16 +400,16 @@ (Bech32.humanReadablePartFromText . Bech32.humanReadablePartToText) hrp === Right hrp - describe "Roundtrip (toBase256 . toBase32)" $ do + describe "Roundtrip (toBase256 . toBase32)" $ it "Can perform roundtrip base conversion" $ property $ \ws -> (Bech32.toBase256 . Bech32.toBase32) ws === Just ws - describe "Roundtrip (toBase32 . toBase256)" $ do + 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)" $ do + describe "Roundtrip (dataCharToWord . dataCharFromWord)" $ it "can perform roundtrip character set conversion" $ property $ \w -> Bech32.dataCharToWord (toLower (Bech32.dataCharFromWord w)) @@ -400,10 +473,26 @@ .&&. (outputWordsSuffix `shouldSatisfy` all (== 0)) - describe "Pointless test to trigger coverage on derived instances" $ do + 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" @@ -514,8 +603,8 @@ bech32CharSet = Set.filter (not . isUpper) $ Set.fromList [humanReadableCharMinBound .. humanReadableCharMaxBound] - `Set.union` (Set.singleton separatorChar) - `Set.union` (Set.fromList Bech32.dataCharList) + `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 @@ -606,6 +695,63 @@ ] 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 = []