{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- 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://git.io/fj8FV)
--
module Codec.Binary.Bech32.Internal
    (
      -- * Encoding & Decoding
      encode
    , encodeLenient
    , EncodingError (..)
    , decode
    , decodeLenient
    , DecodingError (..)
    , checksumLength
    , encodedStringMaxLength
    , encodedStringMinLength
    , separatorChar
    , separatorLength

      -- * Data Part
    , DataPart
    , dataPartIsValid
    , dataPartFromBytes
    , dataPartFromText
    , dataPartFromWords
    , dataPartToBytes
    , dataPartToText
    , dataPartToWords
    , dataCharToWord
    , dataCharFromWord
    , dataCharList

      -- * Human-Readable Part
    , HumanReadablePart
    , HumanReadablePartError (..)
    , humanReadablePartFromText
    , humanReadablePartToText
    , humanReadablePartToWords
    , humanReadablePartMinLength
    , humanReadablePartMaxLength
    , humanReadableCharIsValid
    , humanReadableCharMinBound
    , humanReadableCharMaxBound

      -- * Bit Manipulation
    , convertBits
    , Word5
    , word5
    , getWord5
    , toBase256
    , toBase32
    , noPadding
    , yesPadding

      -- * Character Manipulation
    , CharPosition (..)

    ) where

import Prelude

import Control.Exception
    ( Exception )
import Control.Monad
    ( guard, join )
import Data.Array
    ( Array )
import Data.Bifunctor
    ( first )
import Data.Bits
    ( Bits, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.) )
import Data.ByteString
    ( ByteString )
import Data.Char
    ( chr, ord, toLower, toUpper )
import Data.Either.Extra
    ( maybeToEither )
import Data.Foldable
    ( foldl' )
import Data.Functor.Identity
    ( Identity, runIdentity )
import Data.Ix
    ( Ix (..) )
import Data.List
    ( sort )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( isNothing, mapMaybe )
import Data.Text
    ( Text )
import Data.Word
    ( Word8 )

import qualified Data.Array as Arr
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import qualified Data.Text as T

{-------------------------------------------------------------------------------
                                 Data Part
-------------------------------------------------------------------------------}

-- | Represents the data part of a Bech32 string, as defined here:
--   https://git.io/fj8FS
newtype DataPart = DataPart Text
    deriving newtype (DataPart -> DataPart -> Bool
(DataPart -> DataPart -> Bool)
-> (DataPart -> DataPart -> Bool) -> Eq DataPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataPart -> DataPart -> Bool
$c/= :: DataPart -> DataPart -> Bool
== :: DataPart -> DataPart -> Bool
$c== :: DataPart -> DataPart -> Bool
Eq, Semigroup DataPart
DataPart
Semigroup DataPart
-> DataPart
-> (DataPart -> DataPart -> DataPart)
-> ([DataPart] -> DataPart)
-> Monoid DataPart
[DataPart] -> DataPart
DataPart -> DataPart -> DataPart
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [DataPart] -> DataPart
$cmconcat :: [DataPart] -> DataPart
mappend :: DataPart -> DataPart -> DataPart
$cmappend :: DataPart -> DataPart -> DataPart
mempty :: DataPart
$cmempty :: DataPart
$cp1Monoid :: Semigroup DataPart
Monoid, b -> DataPart -> DataPart
NonEmpty DataPart -> DataPart
DataPart -> DataPart -> DataPart
(DataPart -> DataPart -> DataPart)
-> (NonEmpty DataPart -> DataPart)
-> (forall b. Integral b => b -> DataPart -> DataPart)
-> Semigroup DataPart
forall b. Integral b => b -> DataPart -> DataPart
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> DataPart -> DataPart
$cstimes :: forall b. Integral b => b -> DataPart -> DataPart
sconcat :: NonEmpty DataPart -> DataPart
$csconcat :: NonEmpty DataPart -> DataPart
<> :: DataPart -> DataPart -> DataPart
$c<> :: DataPart -> DataPart -> DataPart
Semigroup)
    deriving stock Int -> DataPart -> ShowS
[DataPart] -> ShowS
DataPart -> String
(Int -> DataPart -> ShowS)
-> (DataPart -> String) -> ([DataPart] -> ShowS) -> Show DataPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataPart] -> ShowS
$cshowList :: [DataPart] -> ShowS
show :: DataPart -> String
$cshow :: DataPart -> String
showsPrec :: Int -> DataPart -> ShowS
$cshowsPrec :: Int -> DataPart -> ShowS
Show

-- | Returns true iff. the specified 'DataPart' is valid.
--
dataPartIsValid :: DataPart -> Bool
dataPartIsValid :: DataPart -> Bool
dataPartIsValid (DataPart Text
dp) = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
dataCharIsValid Text
dp

-- | Constructs a 'DataPart' from a 'ByteString'.
--
-- This function encodes a 'ByteString' in such a way that guarantees it can be
-- successfully decoded with the 'dataPartToBytes' function:
--
-- > dataPartToBytes (dataPartFromBytes b) == Just b
--
dataPartFromBytes :: ByteString -> DataPart
dataPartFromBytes :: ByteString -> DataPart
dataPartFromBytes =
    Text -> DataPart
DataPart (Text -> DataPart)
-> (ByteString -> Text) -> ByteString -> DataPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word5 -> Char) -> [Word5] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word5 -> Char
dataCharFromWord ([Word5] -> String)
-> (ByteString -> [Word5]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word5]
toBase32 ([Word8] -> [Word5])
-> (ByteString -> [Word8]) -> ByteString -> [Word5]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack

-- | Attempts to extract a 'ByteString' from a 'DataPart'.
--
-- This function guarantees to satisfy the following property:
--
-- > dataPartToBytes (dataPartFromBytes b) == Just b
--
dataPartToBytes :: DataPart -> Maybe ByteString
dataPartToBytes :: DataPart -> Maybe ByteString
dataPartToBytes DataPart
dp = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Maybe [Word8] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ([Word5] -> Maybe [Word8]
toBase256 ([Word5] -> Maybe [Word8]) -> Maybe [Word5] -> Maybe [Word8]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Maybe Word5) -> String -> Maybe [Word5]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Maybe Word5
dataCharToWord (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DataPart -> Text
dataPartToText DataPart
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.
--
-- Returns 'Nothing' if any character in the input is not a member of
-- 'dataCharList'.
--
-- This function guarantees to satisfy the following property:
--
-- > dataPartFromText (dataPartToText d) == Just d
--
dataPartFromText :: Text -> Maybe DataPart
dataPartFromText :: Text -> Maybe DataPart
dataPartFromText Text
text
    | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
dataCharIsValid) Text
textLower = Maybe DataPart
forall a. Maybe a
Nothing
    | Bool
otherwise = DataPart -> Maybe DataPart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataPart -> Maybe DataPart) -> DataPart -> Maybe DataPart
forall a b. (a -> b) -> a -> b
$ Text -> DataPart
DataPart Text
textLower
  where
    textLower :: Text
textLower = Text -> Text
T.toLower Text
text

-- | Converts a 'DataPart' to 'Text', using the Bech32 character set to render
--   the data.
--
-- This function guarantees to satisfy the following property:
--
-- > dataPartFromText (dataPartToText d) == Just d
--
dataPartToText :: DataPart -> Text
dataPartToText :: DataPart -> Text
dataPartToText (DataPart Text
t) = Text
t

-- | Construct a 'DataPart' directly from a list of words.
--
-- This function guarantees to satisfy the following properties:
--
-- > dataPartFromWords (dataPartToWords d) == d
-- > dataPartToWords (dataPartFromWords w) == w
--
dataPartFromWords :: [Word5] -> DataPart
dataPartFromWords :: [Word5] -> DataPart
dataPartFromWords = Text -> DataPart
DataPart (Text -> DataPart) -> ([Word5] -> Text) -> [Word5] -> DataPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ([Word5] -> String) -> [Word5] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word5 -> Char) -> [Word5] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word5 -> Char
dataCharFromWord

-- | 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 :: DataPart -> [Word5]
dataPartToWords = (Char -> Maybe Word5) -> String -> [Word5]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Word5
dataCharToWord (String -> [Word5]) -> (DataPart -> String) -> DataPart -> [Word5]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (DataPart -> Text) -> DataPart -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataPart -> Text
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
--
dataCharIsValid :: Char -> Bool
dataCharIsValid :: Char -> Bool
dataCharIsValid = (Char -> Map Char Word5 -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Char Word5
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
--
dataCharList :: String
dataCharList :: String
dataCharList = String
"qpzry9x8gf2tvdw0s3jn54khce6mua7l"

-- | If the specified character is permitted to appear within the data part
--   of a Bech32 string, this function returns that character's corresponding
--   'Word5' value. If the specified character is not permitted, or if the
--   specified character is upper-case, returns 'Nothing'.
dataCharToWord :: Char -> Maybe Word5
dataCharToWord :: Char -> Maybe Word5
dataCharToWord = (Char -> Map Char Word5 -> Maybe Word5
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Char Word5
dataCharToWordMap)

dataCharToWordMap :: Map Char Word5
dataCharToWordMap :: Map Char Word5
dataCharToWordMap = [(Char, Word5)] -> Map Char Word5
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Char, Word5)] -> Map Char Word5)
-> [(Char, Word5)] -> Map Char Word5
forall a b. (a -> b) -> a -> b
$ String
dataCharList String -> [Word5] -> [(Char, Word5)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Word5
forall a. Bounded a => a
minBound .. Word5
forall a. Bounded a => a
maxBound]

-- | Maps the specified 'Word5' onto a character that is permitted to appear
--   within the data part of a Bech32 string.
dataCharFromWord :: Word5 -> Char
dataCharFromWord :: Word5 -> Char
dataCharFromWord = (Array Word5 Char
dataCharFromWordArray Array Word5 Char -> Word5 -> Char
forall i e. Ix i => Array i e -> i -> e
Arr.!)

dataCharFromWordArray :: Array Word5 Char
dataCharFromWordArray :: Array Word5 Char
dataCharFromWordArray = (Word5, Word5) -> String -> Array Word5 Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
Arr.listArray (Word5
forall a. Bounded a => a
minBound, Word5
forall a. Bounded a => a
maxBound) String
dataCharList

{-------------------------------------------------------------------------------
                            Human Readable Part
-------------------------------------------------------------------------------}

-- | Represents the human-readable part of a Bech32 string, as defined here:
--   https://git.io/fj8FS
newtype HumanReadablePart = HumanReadablePart Text
    deriving newtype (HumanReadablePart -> HumanReadablePart -> Bool
(HumanReadablePart -> HumanReadablePart -> Bool)
-> (HumanReadablePart -> HumanReadablePart -> Bool)
-> Eq HumanReadablePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HumanReadablePart -> HumanReadablePart -> Bool
$c/= :: HumanReadablePart -> HumanReadablePart -> Bool
== :: HumanReadablePart -> HumanReadablePart -> Bool
$c== :: HumanReadablePart -> HumanReadablePart -> Bool
Eq, Semigroup HumanReadablePart
HumanReadablePart
Semigroup HumanReadablePart
-> HumanReadablePart
-> (HumanReadablePart -> HumanReadablePart -> HumanReadablePart)
-> ([HumanReadablePart] -> HumanReadablePart)
-> Monoid HumanReadablePart
[HumanReadablePart] -> HumanReadablePart
HumanReadablePart -> HumanReadablePart -> HumanReadablePart
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [HumanReadablePart] -> HumanReadablePart
$cmconcat :: [HumanReadablePart] -> HumanReadablePart
mappend :: HumanReadablePart -> HumanReadablePart -> HumanReadablePart
$cmappend :: HumanReadablePart -> HumanReadablePart -> HumanReadablePart
mempty :: HumanReadablePart
$cmempty :: HumanReadablePart
$cp1Monoid :: Semigroup HumanReadablePart
Monoid, b -> HumanReadablePart -> HumanReadablePart
NonEmpty HumanReadablePart -> HumanReadablePart
HumanReadablePart -> HumanReadablePart -> HumanReadablePart
(HumanReadablePart -> HumanReadablePart -> HumanReadablePart)
-> (NonEmpty HumanReadablePart -> HumanReadablePart)
-> (forall b.
    Integral b =>
    b -> HumanReadablePart -> HumanReadablePart)
-> Semigroup HumanReadablePart
forall b. Integral b => b -> HumanReadablePart -> HumanReadablePart
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> HumanReadablePart -> HumanReadablePart
$cstimes :: forall b. Integral b => b -> HumanReadablePart -> HumanReadablePart
sconcat :: NonEmpty HumanReadablePart -> HumanReadablePart
$csconcat :: NonEmpty HumanReadablePart -> HumanReadablePart
<> :: HumanReadablePart -> HumanReadablePart -> HumanReadablePart
$c<> :: HumanReadablePart -> HumanReadablePart -> HumanReadablePart
Semigroup)
    deriving stock Int -> HumanReadablePart -> ShowS
[HumanReadablePart] -> ShowS
HumanReadablePart -> String
(Int -> HumanReadablePart -> ShowS)
-> (HumanReadablePart -> String)
-> ([HumanReadablePart] -> ShowS)
-> Show HumanReadablePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HumanReadablePart] -> ShowS
$cshowList :: [HumanReadablePart] -> ShowS
show :: HumanReadablePart -> String
$cshow :: HumanReadablePart -> String
showsPrec :: Int -> HumanReadablePart -> ShowS
$cshowsPrec :: Int -> HumanReadablePart -> ShowS
Show

-- | Parses the human-readable part of a Bech32 string, as defined here:
--   https://git.io/fj8FS
humanReadablePartFromText
    :: Text -> Either HumanReadablePartError HumanReadablePart
humanReadablePartFromText :: Text -> Either HumanReadablePartError HumanReadablePart
humanReadablePartFromText Text
hrp
    | Text -> Int
T.length Text
hrp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
humanReadablePartMinLength =
        HumanReadablePartError
-> Either HumanReadablePartError HumanReadablePart
forall a b. a -> Either a b
Left HumanReadablePartError
HumanReadablePartTooShort
    | Text -> Int
T.length Text
hrp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
humanReadablePartMaxLength =
        HumanReadablePartError
-> Either HumanReadablePartError HumanReadablePart
forall a b. a -> Either a b
Left HumanReadablePartError
HumanReadablePartTooLong
    | Bool -> Bool
not ([CharPosition] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CharPosition]
invalidCharPositions) =
        HumanReadablePartError
-> Either HumanReadablePartError HumanReadablePart
forall a b. a -> Either a b
Left (HumanReadablePartError
 -> Either HumanReadablePartError HumanReadablePart)
-> HumanReadablePartError
-> Either HumanReadablePartError HumanReadablePart
forall a b. (a -> b) -> a -> b
$ [CharPosition] -> HumanReadablePartError
HumanReadablePartContainsInvalidChars [CharPosition]
invalidCharPositions
    | Bool
otherwise =
        HumanReadablePart
-> Either HumanReadablePartError HumanReadablePart
forall a b. b -> Either a b
Right (HumanReadablePart
 -> Either HumanReadablePartError HumanReadablePart)
-> HumanReadablePart
-> Either HumanReadablePartError HumanReadablePart
forall a b. (a -> b) -> a -> b
$ Text -> HumanReadablePart
HumanReadablePart (Text -> HumanReadablePart) -> Text -> HumanReadablePart
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
hrp
  where
    invalidCharPositions :: [CharPosition]
invalidCharPositions = Int -> CharPosition
CharPosition (Int -> CharPosition)
-> ((Int, Char) -> Int) -> (Int, Char) -> CharPosition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Int
forall a b. (a, b) -> a
fst ((Int, Char) -> CharPosition) -> [(Int, Char)] -> [CharPosition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, Char) -> Bool) -> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> Bool) -> [a] -> [a]
filter
        ((Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
humanReadableCharIsValid) (Char -> Bool) -> ((Int, Char) -> Char) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd) ([Int
0 .. ] [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Text -> String
T.unpack Text
hrp)

-- | Represents the set of error conditions that may occur while parsing the
--   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 (HumanReadablePartError -> HumanReadablePartError -> Bool
(HumanReadablePartError -> HumanReadablePartError -> Bool)
-> (HumanReadablePartError -> HumanReadablePartError -> Bool)
-> Eq HumanReadablePartError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HumanReadablePartError -> HumanReadablePartError -> Bool
$c/= :: HumanReadablePartError -> HumanReadablePartError -> Bool
== :: HumanReadablePartError -> HumanReadablePartError -> Bool
$c== :: HumanReadablePartError -> HumanReadablePartError -> Bool
Eq, Int -> HumanReadablePartError -> ShowS
[HumanReadablePartError] -> ShowS
HumanReadablePartError -> String
(Int -> HumanReadablePartError -> ShowS)
-> (HumanReadablePartError -> String)
-> ([HumanReadablePartError] -> ShowS)
-> Show HumanReadablePartError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HumanReadablePartError] -> ShowS
$cshowList :: [HumanReadablePartError] -> ShowS
show :: HumanReadablePartError -> String
$cshow :: HumanReadablePartError -> String
showsPrec :: Int -> HumanReadablePartError -> ShowS
$cshowsPrec :: Int -> HumanReadablePartError -> ShowS
Show)

instance Exception HumanReadablePartError

-- | Get the raw text of the human-readable part of a Bech32 string.
humanReadablePartToText :: HumanReadablePart -> Text
humanReadablePartToText :: HumanReadablePart -> Text
humanReadablePartToText (HumanReadablePart Text
t) = Text
t

-- | Convert the specified human-readable part to a list of words.
humanReadablePartToWords :: HumanReadablePart -> [Word5]
humanReadablePartToWords :: HumanReadablePart -> [Word5]
humanReadablePartToWords (HumanReadablePart Text
hrp) =
    (Word8 -> Word5) -> [Word8] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Word5
Word5 (Word8 -> Word5) -> (Word8 -> Word8) -> Word8 -> Word5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
5)) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Word8) -> String -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack Text
hrp)
        [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word8 -> Word5
Word5 Word8
0]
        [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ (Int -> Word5) -> [Int] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word5
forall a. Integral a => a -> Word5
word5 (Char -> Int
ord (Char -> Int) -> String -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack Text
hrp)

-- | The shortest length permitted for the human-readable part of a Bech32
--   string.
humanReadablePartMinLength :: Int
humanReadablePartMinLength :: Int
humanReadablePartMinLength = Int
1

-- | The longest length permitted for the human-readable part of a Bech32
--   string.
humanReadablePartMaxLength :: Int
humanReadablePartMaxLength :: Int
humanReadablePartMaxLength = Int
83

-- | Returns true iff. the specified character is permitted to appear
--   within the human-readable part of a Bech32 string.
humanReadableCharIsValid :: Char -> Bool
humanReadableCharIsValid :: Char -> Bool
humanReadableCharIsValid Char
c =
    Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
humanReadableCharMinBound Bool -> Bool -> Bool
&&
    Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
humanReadableCharMaxBound

-- | The lower bound of the set of characters permitted to appear within the
--   human-readable part of a Bech32 string.
humanReadableCharMinBound :: Char
humanReadableCharMinBound :: Char
humanReadableCharMinBound = Int -> Char
chr Int
33

-- | The upper bound of the set of characters permitted to appear within the
--   human-readable part of a Bech32 string.
humanReadableCharMaxBound :: Char
humanReadableCharMaxBound :: Char
humanReadableCharMaxBound = Int -> Char
chr Int
126

{-------------------------------------------------------------------------------
                            Encoding & Decoding
-------------------------------------------------------------------------------}

-- | Like 'encode' but allows output to be longer than 90 characters.
--
-- This isn't ideal, as Bech32 error detection becomes worse as strings get
-- longer, but it may be useful in certain circumstances.
--
-- 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)."
--
encodeLenient :: HumanReadablePart -> DataPart -> Text
encodeLenient :: HumanReadablePart -> DataPart -> Text
encodeLenient HumanReadablePart
hrp DataPart
dp = HumanReadablePart -> Text
humanReadablePartToText HumanReadablePart
hrp
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
separatorChar
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
dcp
  where
    dcp :: String
dcp = Word5 -> Char
dataCharFromWord (Word5 -> Char) -> [Word5] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataPart -> [Word5]
dataPartToWords DataPart
dp [Word5] -> [Word5] -> [Word5]
forall a. Semigroup a => a -> a -> a
<> HumanReadablePart -> DataPart -> [Word5]
createChecksum HumanReadablePart
hrp DataPart
dp

-- | 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 :: HumanReadablePart -> DataPart -> Either EncodingError Text
encode HumanReadablePart
hrp DataPart
dp
    | Text -> Int
T.length Text
result Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
encodedStringMaxLength = EncodingError -> Either EncodingError Text
forall a b. a -> Either a b
Left EncodingError
EncodedStringTooLong
    | Bool
otherwise = Text -> Either EncodingError Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
result
  where
    result :: Text
result = HumanReadablePart -> DataPart -> Text
encodeLenient HumanReadablePart
hrp DataPart
dp

-- | Represents the set of error conditions that may occur while encoding a
--   Bech32 string.
data EncodingError =
    EncodedStringTooLong
    -- ^ The resultant encoded string would be /longer than/
    -- 'encodedStringMaxLength'.
    deriving (EncodingError -> EncodingError -> Bool
(EncodingError -> EncodingError -> Bool)
-> (EncodingError -> EncodingError -> Bool) -> Eq EncodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncodingError -> EncodingError -> Bool
$c/= :: EncodingError -> EncodingError -> Bool
== :: EncodingError -> EncodingError -> Bool
$c== :: EncodingError -> EncodingError -> Bool
Eq, Int -> EncodingError -> ShowS
[EncodingError] -> ShowS
EncodingError -> String
(Int -> EncodingError -> ShowS)
-> (EncodingError -> String)
-> ([EncodingError] -> ShowS)
-> Show EncodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodingError] -> ShowS
$cshowList :: [EncodingError] -> ShowS
show :: EncodingError -> String
$cshow :: EncodingError -> String
showsPrec :: Int -> EncodingError -> ShowS
$cshowsPrec :: Int -> EncodingError -> ShowS
Show)

-- | Like 'decode' but does not enforce a maximum length.
--
-- See also 'encodeLenient' for details.
decodeLenient :: Text -> Either DecodingError (HumanReadablePart, DataPart)
decodeLenient :: Text -> Either DecodingError (HumanReadablePart, DataPart)
decodeLenient Text
bech32 = do
    Bool -> DecodingError -> Either DecodingError ()
forall e. Bool -> e -> Either e ()
guardE (Text -> Int
T.length Text
bech32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
encodedStringMinLength) DecodingError
StringToDecodeTooShort
    Bool -> DecodingError -> Either DecodingError ()
forall e. Bool -> e -> Either e ()
guardE ((Char -> Char) -> Text -> Text
T.map Char -> Char
toUpper Text
bech32 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bech32 Bool -> Bool -> Bool
|| (Char -> Char) -> Text -> Text
T.map Char -> Char
toLower Text
bech32 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bech32)
        DecodingError
StringToDecodeHasMixedCase
    (Text
hrpUnparsed, Text
dcpUnparsed) <-
        DecodingError
-> Maybe (Text, Text) -> Either DecodingError (Text, Text)
forall a b. a -> Maybe b -> Either a b
maybeToEither DecodingError
StringToDecodeMissingSeparatorChar (Maybe (Text, Text) -> Either DecodingError (Text, Text))
-> Maybe (Text, Text) -> Either DecodingError (Text, Text)
forall a b. (a -> b) -> a -> b
$
            Char -> Text -> Maybe (Text, Text)
splitAtLastOccurrence Char
separatorChar (Text -> Maybe (Text, Text)) -> Text -> Maybe (Text, Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
T.map Char -> Char
toLower Text
bech32
    HumanReadablePart
hrp <- (HumanReadablePartError -> DecodingError)
-> Either HumanReadablePartError HumanReadablePart
-> Either DecodingError HumanReadablePart
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HumanReadablePartError -> DecodingError
humanReadablePartError (Either HumanReadablePartError HumanReadablePart
 -> Either DecodingError HumanReadablePart)
-> Either HumanReadablePartError HumanReadablePart
-> Either DecodingError HumanReadablePart
forall a b. (a -> b) -> a -> b
$ Text -> Either HumanReadablePartError HumanReadablePart
humanReadablePartFromText Text
hrpUnparsed
    [Word5]
dcp <- ([CharPosition] -> DecodingError)
-> Either [CharPosition] [Word5] -> Either DecodingError [Word5]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
        ([CharPosition] -> DecodingError
StringToDecodeContainsInvalidChars ([CharPosition] -> DecodingError)
-> ([CharPosition] -> [CharPosition])
-> [CharPosition]
-> DecodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharPosition -> CharPosition) -> [CharPosition] -> [CharPosition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\(CharPosition Int
p) ->
                Int -> CharPosition
CharPosition (Int -> CharPosition) -> Int -> CharPosition
forall a b. (a -> b) -> a -> b
$ Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
hrpUnparsed Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
separatorLength))
        (Text -> Either [CharPosition] [Word5]
parseDataWithChecksumPart Text
dcpUnparsed)
    Bool -> DecodingError -> Either DecodingError ()
forall e. Bool -> e -> Either e ()
guardE ([Word5] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word5]
dcp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
checksumLength) DecodingError
StringToDecodeTooShort
    Bool -> DecodingError -> Either DecodingError ()
forall e. Bool -> e -> Either e ()
guardE (HumanReadablePart -> [Word5] -> Bool
verifyChecksum HumanReadablePart
hrp [Word5]
dcp) (DecodingError -> Either DecodingError ())
-> DecodingError -> Either DecodingError ()
forall a b. (a -> b) -> a -> b
$
        [CharPosition] -> DecodingError
StringToDecodeContainsInvalidChars ([CharPosition] -> DecodingError)
-> [CharPosition] -> DecodingError
forall a b. (a -> b) -> a -> b
$ HumanReadablePart -> [Word5] -> [CharPosition]
findErrorPositions HumanReadablePart
hrp [Word5]
dcp
    let dp :: DataPart
dp = [Word5] -> DataPart
dataPartFromWords ([Word5] -> DataPart) -> [Word5] -> DataPart
forall a b. (a -> b) -> a -> b
$ Int -> [Word5] -> [Word5]
forall a. Int -> [a] -> [a]
take ([Word5] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word5]
dcp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
checksumLength) [Word5]
dcp
    (HumanReadablePart, DataPart)
-> Either DecodingError (HumanReadablePart, DataPart)
forall (m :: * -> *) a. Monad m => a -> m a
return (HumanReadablePart
hrp, DataPart
dp)
  where
    -- Use properties of the checksum algorithm to find the locations of errors
    -- within the human-readable part and data-with-checksum part.
    findErrorPositions :: HumanReadablePart -> [Word5] -> [CharPosition]
    findErrorPositions :: HumanReadablePart -> [Word5] -> [CharPosition]
findErrorPositions HumanReadablePart
hrp [Word5]
dcp
        | Word
residue Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = []
        | Bool
otherwise = [CharPosition] -> [CharPosition]
forall a. Ord a => [a] -> [a]
sort ([CharPosition] -> [CharPosition])
-> [CharPosition] -> [CharPosition]
forall a b. (a -> b) -> a -> b
$ Int -> CharPosition
toCharPosition (Int -> CharPosition) -> [Int] -> [CharPosition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
errorPositionsIgnoringSeparator
      where
        residue :: Word
residue = [Word5] -> Word
polymod (HumanReadablePart -> [Word5]
humanReadablePartToWords HumanReadablePart
hrp [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word5]
dcp) Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
1
        toCharPosition :: Int -> CharPosition
toCharPosition Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length (HumanReadablePart -> Text
humanReadablePartToText HumanReadablePart
hrp) = Int -> CharPosition
CharPosition Int
i
            | Bool
otherwise = Int -> CharPosition
CharPosition (Int -> CharPosition) -> Int -> CharPosition
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
separatorLength
        errorPositionsIgnoringSeparator :: [Int]
errorPositionsIgnoringSeparator =
            (Text -> Int
T.length Text
bech32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
separatorLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ) (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                Int -> Int -> [Int]
locateErrors (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
residue) (Text -> Int
T.length Text
bech32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | 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 :: Text -> Either DecodingError (HumanReadablePart, DataPart)
decode Text
bech32 = do
    Bool -> DecodingError -> Either DecodingError ()
forall e. Bool -> e -> Either e ()
guardE (Text -> Int
T.length Text
bech32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
encodedStringMaxLength) DecodingError
StringToDecodeTooLong
    Text -> Either DecodingError (HumanReadablePart, DataPart)
decodeLenient Text
bech32

-- | Parse a data-with-checksum part, checking that each character is part
-- of the supported character set. If one or more characters are not in the
-- supported character set, return the list of illegal character positions.
parseDataWithChecksumPart :: Text -> Either [CharPosition] [Word5]
parseDataWithChecksumPart :: Text -> Either [CharPosition] [Word5]
parseDataWithChecksumPart Text
dcpUnparsed =
    case (Char -> Maybe Word5) -> String -> Maybe [Word5]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe Word5
dataCharToWord (String -> Maybe [Word5]) -> String -> Maybe [Word5]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
dcpUnparsed of
        Maybe [Word5]
Nothing -> [CharPosition] -> Either [CharPosition] [Word5]
forall a b. a -> Either a b
Left [CharPosition]
invalidCharPositions
        Just [Word5]
dcp -> [Word5] -> Either [CharPosition] [Word5]
forall a b. b -> Either a b
Right [Word5]
dcp
  where
    invalidCharPositions :: [CharPosition]
invalidCharPositions =
        Int -> CharPosition
CharPosition (Int -> CharPosition)
-> ((Int, Maybe Word5) -> Int)
-> (Int, Maybe Word5)
-> CharPosition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Word5) -> Int
forall a b. (a, b) -> a
fst ((Int, Maybe Word5) -> CharPosition)
-> [(Int, Maybe Word5)] -> [CharPosition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, Maybe Word5) -> Bool)
-> [(Int, Maybe Word5)] -> [(Int, Maybe Word5)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Word5 -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Word5 -> Bool)
-> ((Int, Maybe Word5) -> Maybe Word5)
-> (Int, Maybe Word5)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Word5) -> Maybe Word5
forall a b. (a, b) -> b
snd)
            ([Int
0 .. ] [Int] -> [Maybe Word5] -> [(Int, Maybe Word5)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Char -> Maybe Word5
dataCharToWord (Char -> Maybe Word5) -> String -> [Maybe Word5]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack Text
dcpUnparsed))

-- | Convert an error encountered while parsing a human-readable part into a
-- general decoding error.
humanReadablePartError :: HumanReadablePartError -> DecodingError
humanReadablePartError :: HumanReadablePartError -> DecodingError
humanReadablePartError = \case
    HumanReadablePartError
HumanReadablePartTooLong ->
        [CharPosition] -> DecodingError
StringToDecodeContainsInvalidChars
            [Int -> CharPosition
CharPosition Int
humanReadablePartMaxLength]
    HumanReadablePartError
HumanReadablePartTooShort ->
        [CharPosition] -> DecodingError
StringToDecodeContainsInvalidChars
            [Int -> CharPosition
CharPosition (Int -> CharPosition) -> Int -> CharPosition
forall a b. (a -> b) -> a -> b
$ Int
humanReadablePartMinLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    HumanReadablePartContainsInvalidChars [CharPosition]
ps ->
        [CharPosition] -> DecodingError
StringToDecodeContainsInvalidChars [CharPosition]
ps

-- | Represents the set of errors that may occur while decoding a Bech32
-- 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]
      -- ^ 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.
    deriving (DecodingError -> DecodingError -> Bool
(DecodingError -> DecodingError -> Bool)
-> (DecodingError -> DecodingError -> Bool) -> Eq DecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecodingError -> DecodingError -> Bool
$c/= :: DecodingError -> DecodingError -> Bool
== :: DecodingError -> DecodingError -> Bool
$c== :: DecodingError -> DecodingError -> Bool
Eq, Int -> DecodingError -> ShowS
[DecodingError] -> ShowS
DecodingError -> String
(Int -> DecodingError -> ShowS)
-> (DecodingError -> String)
-> ([DecodingError] -> ShowS)
-> Show DecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodingError] -> ShowS
$cshowList :: [DecodingError] -> ShowS
show :: DecodingError -> String
$cshow :: DecodingError -> String
showsPrec :: Int -> DecodingError -> ShowS
$cshowsPrec :: Int -> DecodingError -> ShowS
Show)

-- | The separator character.
--
-- This character appears immediately after the human-readable part and before
-- the data part in an encoded string.
--
separatorChar :: Char
separatorChar :: Char
separatorChar = Char
'1'

-- | The length of the checksum portion of an encoded string, in bytes.
checksumLength :: Int
checksumLength :: Int
checksumLength = Int
6

-- | The length of the separator portion of an encoded string, in bytes.
separatorLength :: Int
separatorLength :: Int
separatorLength = Int
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.
--
encodedStringMaxLength :: Int
encodedStringMaxLength :: Int
encodedStringMaxLength = Int
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.
--
encodedStringMinLength :: Int
encodedStringMinLength :: Int
encodedStringMinLength =
    Int
humanReadablePartMinLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
separatorLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
checksumLength

{-------------------------------------------------------------------------------
                            Character Manipulation
-------------------------------------------------------------------------------}

-- | 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 (CharPosition -> CharPosition -> Bool
(CharPosition -> CharPosition -> Bool)
-> (CharPosition -> CharPosition -> Bool) -> Eq CharPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharPosition -> CharPosition -> Bool
$c/= :: CharPosition -> CharPosition -> Bool
== :: CharPosition -> CharPosition -> Bool
$c== :: CharPosition -> CharPosition -> Bool
Eq, Eq CharPosition
Eq CharPosition
-> (CharPosition -> CharPosition -> Ordering)
-> (CharPosition -> CharPosition -> Bool)
-> (CharPosition -> CharPosition -> Bool)
-> (CharPosition -> CharPosition -> Bool)
-> (CharPosition -> CharPosition -> Bool)
-> (CharPosition -> CharPosition -> CharPosition)
-> (CharPosition -> CharPosition -> CharPosition)
-> Ord CharPosition
CharPosition -> CharPosition -> Bool
CharPosition -> CharPosition -> Ordering
CharPosition -> CharPosition -> CharPosition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CharPosition -> CharPosition -> CharPosition
$cmin :: CharPosition -> CharPosition -> CharPosition
max :: CharPosition -> CharPosition -> CharPosition
$cmax :: CharPosition -> CharPosition -> CharPosition
>= :: CharPosition -> CharPosition -> Bool
$c>= :: CharPosition -> CharPosition -> Bool
> :: CharPosition -> CharPosition -> Bool
$c> :: CharPosition -> CharPosition -> Bool
<= :: CharPosition -> CharPosition -> Bool
$c<= :: CharPosition -> CharPosition -> Bool
< :: CharPosition -> CharPosition -> Bool
$c< :: CharPosition -> CharPosition -> Bool
compare :: CharPosition -> CharPosition -> Ordering
$ccompare :: CharPosition -> CharPosition -> Ordering
$cp1Ord :: Eq CharPosition
Ord, Int -> CharPosition -> ShowS
[CharPosition] -> ShowS
CharPosition -> String
(Int -> CharPosition -> ShowS)
-> (CharPosition -> String)
-> ([CharPosition] -> ShowS)
-> Show CharPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharPosition] -> ShowS
$cshowList :: [CharPosition] -> ShowS
show :: CharPosition -> String
$cshow :: CharPosition -> String
showsPrec :: Int -> CharPosition -> ShowS
$cshowsPrec :: Int -> CharPosition -> ShowS
Show)

{-------------------------------------------------------------------------------
                              Bit Manipulation
-------------------------------------------------------------------------------}

(.>>.), (.<<.) :: Bits a => a -> Int -> a
.>>. :: a -> Int -> a
(.>>.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR
.<<. :: a -> Int -> a
(.<<.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
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 { Word5 -> Word8
getWord5 :: Word8 }
    deriving (Word5 -> Word5 -> Bool
(Word5 -> Word5 -> Bool) -> (Word5 -> Word5 -> Bool) -> Eq Word5
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word5 -> Word5 -> Bool
$c/= :: Word5 -> Word5 -> Bool
== :: Word5 -> Word5 -> Bool
$c== :: Word5 -> Word5 -> Bool
Eq, Eq Word5
Eq Word5
-> (Word5 -> Word5 -> Ordering)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Word5)
-> (Word5 -> Word5 -> Word5)
-> Ord Word5
Word5 -> Word5 -> Bool
Word5 -> Word5 -> Ordering
Word5 -> Word5 -> Word5
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Word5 -> Word5 -> Word5
$cmin :: Word5 -> Word5 -> Word5
max :: Word5 -> Word5 -> Word5
$cmax :: Word5 -> Word5 -> Word5
>= :: Word5 -> Word5 -> Bool
$c>= :: Word5 -> Word5 -> Bool
> :: Word5 -> Word5 -> Bool
$c> :: Word5 -> Word5 -> Bool
<= :: Word5 -> Word5 -> Bool
$c<= :: Word5 -> Word5 -> Bool
< :: Word5 -> Word5 -> Bool
$c< :: Word5 -> Word5 -> Bool
compare :: Word5 -> Word5 -> Ordering
$ccompare :: Word5 -> Word5 -> Ordering
$cp1Ord :: Eq Word5
Ord, Int -> Word5 -> ShowS
[Word5] -> ShowS
Word5 -> String
(Int -> Word5 -> ShowS)
-> (Word5 -> String) -> ([Word5] -> ShowS) -> Show Word5
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word5] -> ShowS
$cshowList :: [Word5] -> ShowS
show :: Word5 -> String
$cshow :: Word5 -> String
showsPrec :: Int -> Word5 -> ShowS
$cshowsPrec :: Int -> Word5 -> ShowS
Show)

instance Bounded Word5 where
    minBound :: Word5
minBound = Word8 -> Word5
Word5 Word8
0
    maxBound :: Word5
maxBound = Word8 -> Word5
Word5 Word8
31

instance Enum Word5 where
    toEnum :: Int -> Word5
toEnum = Int -> Word5
forall a. Integral a => a -> Word5
word5
    fromEnum :: Word5 -> Int
fromEnum = Word5 -> Int
forall a. Integral a => Word5 -> a
fromWord5

instance Ix Word5 where
    range :: (Word5, Word5) -> [Word5]
range (Word5 Word8
m, Word5 Word8
n) = (Word8 -> Word5) -> [Word8] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word5
Word5 ([Word8] -> [Word5]) -> [Word8] -> [Word5]
forall a b. (a -> b) -> a -> b
$ (Word8, Word8) -> [Word8]
forall a. Ix a => (a, a) -> [a]
range (Word8
m, Word8
n)
    index :: (Word5, Word5) -> Word5 -> Int
index (Word5 Word8
m, Word5 Word8
n) (Word5 Word8
i) = (Word8, Word8) -> Word8 -> Int
forall a. Ix a => (a, a) -> a -> Int
index (Word8
m, Word8
n) Word8
i
    inRange :: (Word5, Word5) -> Word5 -> Bool
inRange (Word5
m,Word5
n) Word5
i = Word5
m Word5 -> Word5 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word5
i Bool -> Bool -> Bool
&& Word5
i Word5 -> Word5 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word5
n

word5 :: Integral a => a -> Word5
word5 :: a -> Word5
word5 a
x = Word8 -> Word5
Word5 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31)
{-# INLINE word5 #-}
{-# SPECIALIZE INLINE word5 :: Word8 -> Word5 #-}

fromWord5 :: Integral a => Word5 -> a
fromWord5 :: Word5 -> a
fromWord5 (Word5 Word8
x) = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
{-# INLINE fromWord5 #-}
{-# SPECIALIZE INLINE fromWord5 :: Word5 -> Word8 #-}

polymod :: [Word5] -> Word
polymod :: [Word5] -> Word
polymod [Word5]
values = (Word -> Word5 -> Word) -> Word -> [Word5] -> Word
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word -> Word5 -> Word
forall a. (Bits a, Integral a) => a -> Word5 -> a
go Word
1 [Word5]
values Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3fffffff
  where
    go :: a -> Word5 -> a
go a
chk Word5
value =
        (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Bits a => a -> a -> a
xor a
chk' [a
g | (a
g, Int
i) <- [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
generator [Int
25 ..], a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
chk Int
i]
      where
        chk' :: a
chk' = a
chk a -> Int -> a
forall a. Bits a => a -> Int -> a
.<<. Int
5 a -> a -> a
forall a. Bits a => a -> a -> a
`xor` Word5 -> a
forall a. Integral a => Word5 -> a
fromWord5 Word5
value
        generator :: [a]
generator =
            [ a
0x3b6a57b2
            , a
0x26508e6d
            , a
0x1ea119fa
            , a
0x3d4233dd
            , a
0x2a1462b3 ]

createChecksum :: HumanReadablePart -> DataPart -> [Word5]
createChecksum :: HumanReadablePart -> DataPart -> [Word5]
createChecksum HumanReadablePart
hrp DataPart
dat = [Word -> Word5
forall a. Integral a => a -> Word5
word5 (Word
polymod' Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.>>. Int
i) | Int
i <- [Int
25, Int
20 .. Int
0]]
  where
    values :: [Word5]
values = HumanReadablePart -> [Word5]
humanReadablePartToWords HumanReadablePart
hrp [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ DataPart -> [Word5]
dataPartToWords DataPart
dat
    polymod' :: Word
polymod' =
        [Word5] -> Word
polymod ([Word5]
values [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ (Word8 -> Word5) -> [Word8] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word5
Word5 [Word8
0, Word8
0, Word8
0, Word8
0, Word8
0, Word8
0]) Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
1

verifyChecksum :: HumanReadablePart -> [Word5] -> Bool
verifyChecksum :: HumanReadablePart -> [Word5] -> Bool
verifyChecksum HumanReadablePart
hrp [Word5]
dat = [Word5] -> Word
polymod (HumanReadablePart -> [Word5]
humanReadablePartToWords HumanReadablePart
hrp [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word5]
dat) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
1

type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]]

yesPadding :: Pad Identity
yesPadding :: Pad Identity
yesPadding Int
_ Int
0 Word
_ [[Word]]
result = [[Word]] -> Identity [[Word]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Word]]
result
yesPadding Int
_ Int
_ Word
padValue [[Word]]
result = [[Word]] -> Identity [[Word]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Word]] -> Identity [[Word]]) -> [[Word]] -> Identity [[Word]]
forall a b. (a -> b) -> a -> b
$ [Word
padValue] [Word] -> [[Word]] -> [[Word]]
forall a. a -> [a] -> [a]
: [[Word]]
result
{-# INLINE yesPadding #-}

noPadding :: Pad Maybe
noPadding :: Pad Maybe
noPadding Int
frombits Int
bits Word
padValue [[Word]]
result = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
frombits Bool -> Bool -> Bool
&& Word
padValue Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
    [[Word]] -> Maybe [[Word]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Word]]
result
{-# INLINE noPadding #-}

-- | Big-endian conversion of a word string from base '2^frombits' to base
-- '2^tobits'. The 'frombits' and 'twobits' parameters must be positive, while
-- '2^frombits' and '2^tobits' must be smaller than the size of 'Word'. Every
-- value in 'dat' must be strictly smaller than '2^frombits'.
convertBits :: Functor f => [Word] -> Int -> Int -> Pad f -> f [Word]
convertBits :: [Word] -> Int -> Int -> Pad f -> f [Word]
convertBits [Word]
dat Int
frombits Int
tobits Pad f
pad = [[Word]] -> [Word]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word]] -> [Word])
-> ([[Word]] -> [[Word]]) -> [[Word]] -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word]] -> [[Word]]
forall a. [a] -> [a]
reverse ([[Word]] -> [Word]) -> f [[Word]] -> f [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word] -> Word -> Int -> [[Word]] -> f [[Word]]
go [Word]
dat Word
0 Int
0 []
  where
    go :: [Word] -> Word -> Int -> [[Word]] -> f [[Word]]
go [] Word
acc Int
bits [[Word]]
result =
        let padValue :: Word
padValue = (Word
acc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.<<. (Int
tobits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bits)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
maxv
        in Pad f
pad Int
frombits Int
bits Word
padValue [[Word]]
result
    go (Word
value:[Word]
dat') Word
acc Int
bits [[Word]]
result =
        [Word] -> Word -> Int -> [[Word]] -> f [[Word]]
go [Word]
dat' Word
acc' (Int
bits' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
tobits) ([Word]
result' [Word] -> [[Word]] -> [[Word]]
forall a. a -> [a] -> [a]
: [[Word]]
result)
      where
        acc' :: Word
acc' = (Word
acc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.<<. Int
frombits) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
value
        bits' :: Int
bits' = Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
frombits
        result' :: [Word]
result' =
            [ (Word
acc' Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.>>. Int
b) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
maxv
            | Int
b <- [Int
bits' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tobits, Int
bits' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tobits .. Int
0] ]
    maxv :: Word
maxv = (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.<<. Int
tobits) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
{-# INLINE convertBits #-}

toBase32 :: [Word8] -> [Word5]
toBase32 :: [Word8] -> [Word5]
toBase32 [Word8]
dat =
    (Word -> Word5) -> [Word] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Word5
forall a. Integral a => a -> Word5
word5 ([Word] -> [Word5]) -> [Word] -> [Word5]
forall a b. (a -> b) -> a -> b
$ Identity [Word] -> [Word]
forall a. Identity a -> a
runIdentity (Identity [Word] -> [Word]) -> Identity [Word] -> [Word]
forall a b. (a -> b) -> a -> b
$ [Word] -> Int -> Int -> Pad Identity -> Identity [Word]
forall (f :: * -> *).
Functor f =>
[Word] -> Int -> Int -> Pad f -> f [Word]
convertBits ((Word8 -> Word) -> [Word8] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8]
dat) Int
8 Int
5 Pad Identity
yesPadding

toBase256 :: [Word5] -> Maybe [Word8]
toBase256 :: [Word5] -> Maybe [Word8]
toBase256 [Word5]
dat =
    (Word -> Word8) -> [Word] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word] -> [Word8]) -> Maybe [Word] -> Maybe [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word] -> Int -> Int -> Pad Maybe -> Maybe [Word]
forall (f :: * -> *).
Functor f =>
[Word] -> Int -> Int -> Pad f -> f [Word]
convertBits ((Word5 -> Word) -> [Word5] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Word5 -> Word
forall a. Integral a => Word5 -> a
fromWord5 [Word5]
dat) Int
5 Int
8 Pad Maybe
noPadding

{-------------------------------------------------------------------------------
                           Error Location Detection
-------------------------------------------------------------------------------}

-- | This lookup table is a Haskell translation of the reference JavaScript
--   implementation here: https://git.io/fj8FR
gf_1024_exp :: Array Int Int
gf_1024_exp :: Array Int Int
gf_1024_exp = (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
Arr.listArray (Int
0, Int
1023) [
    Int
1, Int
303, Int
635, Int
446, Int
997, Int
640, Int
121, Int
142, Int
959, Int
420, Int
350, Int
438, Int
166, Int
39, Int
543,
    Int
335, Int
831, Int
691, Int
117, Int
632, Int
719, Int
97, Int
107, Int
374, Int
558, Int
797, Int
54, Int
150, Int
858, Int
877,
    Int
724, Int
1013, Int
294, Int
23, Int
354, Int
61, Int
164, Int
633, Int
992, Int
538, Int
469, Int
659, Int
174, Int
868, Int
184,
    Int
809, Int
766, Int
563, Int
866, Int
851, Int
257, Int
520, Int
45, Int
770, Int
535, Int
524, Int
408, Int
213, Int
436, Int
760,
    Int
472, Int
330, Int
933, Int
799, Int
616, Int
361, Int
15, Int
391, Int
756, Int
814, Int
58, Int
608, Int
554, Int
680, Int
993,
    Int
821, Int
942, Int
813, Int
843, Int
484, Int
193, Int
935, Int
321, Int
919, Int
572, Int
741, Int
423, Int
559, Int
562,
    Int
589, Int
296, Int
191, Int
493, Int
685, Int
891, Int
665, Int
435, Int
60, Int
395, Int
2, Int
606, Int
511, Int
853, Int
746,
    Int
32, Int
219, Int
284, Int
631, Int
840, Int
661, Int
837, Int
332, Int
78, Int
311, Int
670, Int
887, Int
111, Int
195, Int
505,
    Int
190, Int
194, Int
214, Int
709, Int
380, Int
819, Int
69, Int
261, Int
957, Int
1018, Int
161, Int
739, Int
588, Int
7, Int
708,
    Int
83, Int
328, Int
507, Int
736, Int
317, Int
899, Int
47, Int
348, Int
1000, Int
345, Int
882, Int
245, Int
367, Int
996, Int
943,
    Int
514, Int
304, Int
90, Int
804, Int
295, Int
312, Int
793, Int
387, Int
833, Int
249, Int
921, Int
660, Int
618, Int
823, Int
496,
    Int
722, Int
30, Int
782, Int
225, Int
892, Int
93, Int
480, Int
372, Int
112, Int
738, Int
867, Int
636, Int
890, Int
950, Int
968,
    Int
386, Int
622, Int
642, Int
551, Int
369, Int
234, Int
846, Int
382, Int
365, Int
442, Int
592, Int
343, Int
986, Int
122,
    Int
1023, Int
59, Int
847, Int
81, Int
790, Int
4, Int
437, Int
983, Int
931, Int
244, Int
64, Int
415, Int
529, Int
487, Int
944,
    Int
35, Int
938, Int
664, Int
156, Int
583, Int
53, Int
999, Int
222, Int
390, Int
987, Int
341, Int
388, Int
389, Int
170, Int
721,
    Int
879, Int
138, Int
522, Int
627, Int
765, Int
322, Int
230, Int
440, Int
14, Int
168, Int
143, Int
656, Int
991, Int
224, Int
595,
    Int
550, Int
94, Int
657, Int
752, Int
667, Int
1005, Int
451, Int
734, Int
744, Int
638, Int
292, Int
585, Int
157, Int
872,
    Int
590, Int
601, Int
827, Int
774, Int
930, Int
475, Int
571, Int
33, Int
500, Int
871, Int
969, Int
173, Int
21, Int
828, Int
450,
    Int
1009, Int
147, Int
960, Int
705, Int
201, Int
228, Int
998, Int
497, Int
1021, Int
613, Int
688, Int
772, Int
508, Int
36,
    Int
366, Int
715, Int
468, Int
956, Int
725, Int
730, Int
861, Int
425, Int
647, Int
701, Int
221, Int
759, Int
95, Int
958, Int
139,
    Int
805, Int
8, Int
835, Int
679, Int
614, Int
449, Int
128, Int
791, Int
299, Int
974, Int
617, Int
70, Int
628, Int
57, Int
273,
    Int
430, Int
67, Int
750, Int
405, Int
780, Int
703, Int
643, Int
776, Int
778, Int
340, Int
171, Int
1022, Int
276, Int
308,
    Int
495, Int
243, Int
644, Int
460, Int
857, Int
28, Int
336, Int
286, Int
41, Int
695, Int
448, Int
431, Int
364, Int
149, Int
43,
    Int
233, Int
63, Int
762, Int
902, Int
181, Int
240, Int
501, Int
584, Int
434, Int
275, Int
1008, Int
444, Int
443, Int
895,
    Int
812, Int
612, Int
927, Int
383, Int
66, Int
961, Int
1006, Int
690, Int
346, Int
3, Int
881, Int
900, Int
747, Int
271, Int
672,
    Int
162, Int
402, Int
456, Int
748, Int
971, Int
755, Int
490, Int
105, Int
808, Int
977, Int
72, Int
732, Int
182, Int
897, Int
625,
    Int
163, Int
189, Int
947, Int
850, Int
46, Int
115, Int
403, Int
231, Int
151, Int
629, Int
278, Int
874, Int
16, Int
934, Int
110,
    Int
492, Int
898, Int
256, Int
807, Int
598, Int
700, Int
498, Int
140, Int
481, Int
91, Int
523, Int
860, Int
134, Int
252, Int
771,
    Int
824, Int
119, Int
38, Int
816, Int
820, Int
641, Int
342, Int
757, Int
513, Int
577, Int
990, Int
463, Int
40, Int
920, Int
955,
    Int
17, Int
649, Int
533, Int
82, Int
103, Int
896, Int
862, Int
728, Int
259, Int
86, Int
466, Int
87, Int
253, Int
556, Int
323,
    Int
457, Int
963, Int
432, Int
845, Int
527, Int
745, Int
849, Int
863, Int
1015, Int
888, Int
488, Int
567, Int
727, Int
132,
    Int
674, Int
764, Int
109, Int
669, Int
6, Int
1003, Int
552, Int
246, Int
542, Int
96, Int
324, Int
781, Int
912, Int
248, Int
694,
    Int
239, Int
980, Int
210, Int
880, Int
683, Int
144, Int
177, Int
325, Int
546, Int
491, Int
326, Int
339, Int
623, Int
941, Int
92,
    Int
207, Int
783, Int
462, Int
263, Int
483, Int
517, Int
1012, Int
9, Int
620, Int
220, Int
984, Int
548, Int
512, Int
878, Int
421,
    Int
113, Int
973, Int
280, Int
962, Int
159, Int
310, Int
945, Int
268, Int
465, Int
806, Int
889, Int
199, Int
76, Int
873, Int
865,
    Int
34, Int
645, Int
227, Int
290, Int
418, Int
693, Int
926, Int
80, Int
569, Int
639, Int
11, Int
50, Int
291, Int
141, Int
206,
    Int
544, Int
949, Int
185, Int
518, Int
133, Int
909, Int
135, Int
467, Int
376, Int
646, Int
914, Int
678, Int
841, Int
954,
    Int
318, Int
242, Int
939, Int
951, Int
743, Int
1017, Int
976, Int
359, Int
167, Int
264, Int
100, Int
241, Int
218, Int
51, Int
12,
    Int
758, Int
368, Int
453, Int
309, Int
192, Int
648, Int
826, Int
553, Int
473, Int
101, Int
478, Int
673, Int
397, Int
1001,
    Int
118, Int
265, Int
331, Int
650, Int
356, Int
982, Int
652, Int
655, Int
510, Int
634, Int
145, Int
414, Int
830, Int
924,
    Int
526, Int
966, Int
298, Int
737, Int
18, Int
504, Int
401, Int
697, Int
360, Int
288, Int
1020, Int
842, Int
203, Int
698,
    Int
537, Int
676, Int
279, Int
581, Int
619, Int
536, Int
907, Int
876, Int
1019, Int
398, Int
152, Int
1010, Int
994, Int
68,
    Int
42, Int
454, Int
580, Int
836, Int
99, Int
565, Int
137, Int
379, Int
503, Int
22, Int
77, Int
582, Int
282, Int
412, Int
352,
    Int
611, Int
347, Int
300, Int
266, Int
570, Int
270, Int
911, Int
729, Int
44, Int
557, Int
108, Int
946, Int
637, Int
597, Int
461,
    Int
630, Int
615, Int
238, Int
763, Int
681, Int
718, Int
334, Int
528, Int
200, Int
459, Int
413, Int
79, Int
24, Int
229, Int
713,
    Int
906, Int
579, Int
384, Int
48, Int
893, Int
370, Int
923, Int
202, Int
917, Int
98, Int
794, Int
754, Int
197, Int
530, Int
662,
    Int
52, Int
712, Int
677, Int
56, Int
62, Int
981, Int
509, Int
267, Int
789, Int
885, Int
561, Int
316, Int
684, Int
596, Int
226,
    Int
13, Int
985, Int
779, Int
123, Int
720, Int
576, Int
753, Int
948, Int
406, Int
125, Int
315, Int
104, Int
519, Int
426, Int
502,
    Int
313, Int
566, Int
1016, Int
767, Int
796, Int
281, Int
749, Int
740, Int
136, Int
84, Int
908, Int
424, Int
936, Int
198,
    Int
355, Int
274, Int
735, Int
967, Int
5, Int
154, Int
428, Int
541, Int
785, Int
704, Int
486, Int
671, Int
600, Int
532, Int
381,
    Int
540, Int
574, Int
187, Int
88, Int
378, Int
216, Int
621, Int
499, Int
419, Int
922, Int
485, Int
494, Int
476, Int
255, Int
114,
    Int
188, Int
668, Int
297, Int
400, Int
918, Int
787, Int
158, Int
25, Int
458, Int
178, Int
564, Int
422, Int
768, Int
73, Int
1011,
    Int
717, Int
575, Int
404, Int
547, Int
196, Int
829, Int
237, Int
394, Int
301, Int
37, Int
65, Int
176, Int
106, Int
89, Int
85,
    Int
675, Int
979, Int
534, Int
803, Int
995, Int
363, Int
593, Int
120, Int
417, Int
452, Int
26, Int
699, Int
822, Int
223, Int
169,
    Int
416, Int
235, Int
609, Int
773, Int
211, Int
607, Int
208, Int
302, Int
852, Int
965, Int
603, Int
357, Int
761, Int
247,
    Int
817, Int
539, Int
250, Int
232, Int
272, Int
129, Int
568, Int
848, Int
624, Int
396, Int
710, Int
525, Int
183, Int
686, Int
10,
    Int
285, Int
856, Int
307, Int
811, Int
160, Int
972, Int
55, Int
441, Int
289, Int
723, Int
305, Int
373, Int
351, Int
153, Int
733,
    Int
409, Int
506, Int
975, Int
838, Int
573, Int
970, Int
988, Int
913, Int
471, Int
205, Int
337, Int
49, Int
594, Int
777, Int
549,
    Int
815, Int
277, Int
27, Int
916, Int
333, Int
353, Int
844, Int
800, Int
146, Int
751, Int
186, Int
375, Int
769, Int
358, Int
392,
    Int
883, Int
474, Int
788, Int
602, Int
74, Int
130, Int
329, Int
212, Int
155, Int
131, Int
102, Int
687, Int
293, Int
870, Int
742,
    Int
726, Int
427, Int
217, Int
834, Int
904, Int
29, Int
127, Int
869, Int
407, Int
338, Int
832, Int
470, Int
482, Int
810, Int
399,
    Int
439, Int
393, Int
604, Int
929, Int
682, Int
447, Int
714, Int
251, Int
455, Int
875, Int
319, Int
477, Int
464, Int
521,
    Int
258, Int
377, Int
937, Int
489, Int
792, Int
172, Int
314, Int
327, Int
124, Int
20, Int
531, Int
953, Int
591, Int
886, Int
320,
    Int
696, Int
71, Int
859, Int
578, Int
175, Int
587, Int
707, Int
663, Int
283, Int
179, Int
795, Int
989, Int
702, Int
940, Int
371,
    Int
692, Int
689, Int
555, Int
903, Int
410, Int
651, Int
75, Int
429, Int
818, Int
362, Int
894, Int
515, Int
31, Int
545, Int
666,
    Int
706, Int
952, Int
864, Int
269, Int
254, Int
349, Int
711, Int
802, Int
716, Int
784, Int
1007, Int
925, Int
801, Int
445,
    Int
148, Int
260, Int
658, Int
385, Int
287, Int
262, Int
204, Int
126, Int
586, Int
1004, Int
236, Int
165, Int
854, Int
411,
    Int
932, Int
560, Int
19, Int
215, Int
1002, Int
775, Int
653, Int
928, Int
901, Int
964, Int
884, Int
798, Int
839, Int
786,
    Int
433, Int
610, Int
116, Int
855, Int
180, Int
479, Int
910, Int
1014, Int
599, Int
915, Int
905, Int
306, Int
516, Int
731,
    Int
626, Int
978, Int
825, Int
344, Int
605, Int
654, Int
209 ]

-- | This lookup table is a Haskell translation of the reference JavaScript
--   implementation here: https://git.io/fj8FE
gf_1024_log :: Array Int Int
gf_1024_log :: Array Int Int
gf_1024_log = (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
Arr.listArray (Int
0, Int
1023) [
    -Int
1, Int
0, Int
99, Int
363, Int
198, Int
726, Int
462, Int
132, Int
297, Int
495, Int
825, Int
528, Int
561, Int
693, Int
231,
    Int
66, Int
396, Int
429, Int
594, Int
990, Int
924, Int
264, Int
627, Int
33, Int
660, Int
759, Int
792, Int
858, Int
330, Int
891,
    Int
165, Int
957, Int
104, Int
259, Int
518, Int
208, Int
280, Int
776, Int
416, Int
13, Int
426, Int
333, Int
618, Int
339, Int
641,
    Int
52, Int
388, Int
140, Int
666, Int
852, Int
529, Int
560, Int
678, Int
213, Int
26, Int
832, Int
681, Int
309, Int
70, Int
194,
    Int
97, Int
35, Int
682, Int
341, Int
203, Int
777, Int
358, Int
312, Int
617, Int
125, Int
307, Int
931, Int
379, Int
765, Int
875,
    Int
951, Int
515, Int
628, Int
112, Int
659, Int
525, Int
196, Int
432, Int
134, Int
717, Int
781, Int
438, Int
440, Int
740,
    Int
780, Int
151, Int
408, Int
487, Int
169, Int
239, Int
293, Int
467, Int
21, Int
672, Int
622, Int
557, Int
571, Int
881, Int
433,
    Int
704, Int
376, Int
779, Int
22, Int
643, Int
460, Int
398, Int
116, Int
172, Int
503, Int
751, Int
389, Int
1004, Int
18, Int
576,
    Int
415, Int
789, Int
6, Int
192, Int
696, Int
923, Int
702, Int
981, Int
892, Int
302, Int
816, Int
876, Int
880, Int
457, Int
537,
    Int
411, Int
539, Int
716, Int
624, Int
224, Int
295, Int
406, Int
531, Int
7, Int
233, Int
478, Int
586, Int
864, Int
268, Int
974,
    Int
338, Int
27, Int
392, Int
614, Int
839, Int
727, Int
879, Int
211, Int
250, Int
758, Int
507, Int
830, Int
129, Int
369, Int
384,
    Int
36, Int
985, Int
12, Int
555, Int
232, Int
796, Int
221, Int
321, Int
920, Int
263, Int
42, Int
934, Int
778, Int
479, Int
761,
    Int
939, Int
1006, Int
344, Int
381, Int
823, Int
44, Int
535, Int
866, Int
739, Int
752, Int
385, Int
119, Int
91, Int
566, Int
80,
    Int
120, Int
117, Int
771, Int
675, Int
721, Int
514, Int
656, Int
271, Int
670, Int
602, Int
980, Int
850, Int
532, Int
488,
    Int
803, Int
1022, Int
475, Int
801, Int
878, Int
57, Int
121, Int
991, Int
742, Int
888, Int
559, Int
105, Int
497, Int
291,
    Int
215, Int
795, Int
236, Int
167, Int
692, Int
520, Int
272, Int
661, Int
229, Int
391, Int
814, Int
340, Int
184, Int
798,
    Int
984, Int
773, Int
650, Int
473, Int
345, Int
558, Int
548, Int
326, Int
202, Int
145, Int
465, Int
810, Int
471, Int
158,
    Int
813, Int
908, Int
412, Int
441, Int
964, Int
750, Int
401, Int
50, Int
915, Int
437, Int
975, Int
126, Int
979, Int
491, Int
556,
    Int
577, Int
636, Int
685, Int
510, Int
963, Int
638, Int
367, Int
815, Int
310, Int
723, Int
349, Int
323, Int
857, Int
394,
    Int
606, Int
505, Int
713, Int
630, Int
938, Int
106, Int
826, Int
332, Int
978, Int
599, Int
834, Int
521, Int
530, Int
248,
    Int
883, Int
32, Int
153, Int
90, Int
754, Int
592, Int
304, Int
635, Int
775, Int
804, Int
1, Int
150, Int
836, Int
1013, Int
828,
    Int
324, Int
565, Int
508, Int
113, Int
154, Int
708, Int
921, Int
703, Int
689, Int
138, Int
547, Int
911, Int
929, Int
82, Int
228,
    Int
443, Int
468, Int
480, Int
483, Int
922, Int
135, Int
877, Int
61, Int
578, Int
111, Int
860, Int
654, Int
15, Int
331, Int
851,
    Int
895, Int
484, Int
320, Int
218, Int
420, Int
190, Int
1019, Int
143, Int
362, Int
634, Int
141, Int
965, Int
10, Int
838,
    Int
632, Int
861, Int
34, Int
722, Int
580, Int
808, Int
869, Int
554, Int
598, Int
65, Int
954, Int
787, Int
337, Int
187, Int
281,
    Int
146, Int
563, Int
183, Int
668, Int
944, Int
171, Int
837, Int
23, Int
867, Int
541, Int
916, Int
741, Int
625, Int
123, Int
736,
    Int
186, Int
357, Int
665, Int
977, Int
179, Int
156, Int
219, Int
220, Int
216, Int
67, Int
870, Int
902, Int
774, Int
98, Int
820,
    Int
574, Int
613, Int
900, Int
755, Int
596, Int
370, Int
390, Int
769, Int
314, Int
701, Int
894, Int
56, Int
841, Int
949, Int
987,
    Int
631, Int
658, Int
587, Int
204, Int
797, Int
790, Int
522, Int
745, Int
9, Int
502, Int
763, Int
86, Int
719, Int
288, Int
706,
    Int
887, Int
728, Int
952, Int
311, Int
336, Int
446, Int
1002, Int
348, Int
96, Int
58, Int
199, Int
11, Int
901, Int
230, Int
833,
    Int
188, Int
352, Int
351, Int
973, Int
3, Int
906, Int
335, Int
301, Int
266, Int
244, Int
791, Int
564, Int
619, Int
909, Int
371,
    Int
444, Int
760, Int
657, Int
328, Int
647, Int
490, Int
425, Int
913, Int
511, Int
439, Int
540, Int
283, Int
40, Int
897, Int
849,
    Int
60, Int
570, Int
872, Int
257, Int
749, Int
912, Int
572, Int
1007, Int
170, Int
407, Int
898, Int
492, Int
79, Int
747, Int
732,
    Int
206, Int
454, Int
918, Int
375, Int
482, Int
399, Int
92, Int
748, Int
325, Int
163, Int
274, Int
405, Int
744, Int
260, Int
346,
    Int
707, Int
626, Int
595, Int
118, Int
842, Int
136, Int
279, Int
684, Int
584, Int
101, Int
500, Int
422, Int
149, Int
956,
    Int
1014, Int
493, Int
536, Int
705, Int
51, Int
914, Int
225, Int
409, Int
55, Int
822, Int
590, Int
448, Int
655, Int
205, Int
676,
    Int
925, Int
735, Int
431, Int
784, Int
54, Int
609, Int
604, Int
39, Int
812, Int
737, Int
729, Int
466, Int
14, Int
533, Int
958,
    Int
481, Int
770, Int
499, Int
855, Int
238, Int
182, Int
464, Int
569, Int
72, Int
947, Int
442, Int
642, Int
24, Int
87, Int
989,
    Int
688, Int
88, Int
47, Int
762, Int
623, Int
709, Int
455, Int
817, Int
526, Int
637, Int
258, Int
84, Int
845, Int
738, Int
768,
    Int
698, Int
423, Int
933, Int
664, Int
620, Int
607, Int
629, Int
212, Int
347, Int
249, Int
982, Int
935, Int
131, Int
89, Int
252,
    Int
927, Int
189, Int
788, Int
853, Int
237, Int
691, Int
646, Int
403, Int
1010, Int
734, Int
253, Int
874, Int
807, Int
903,
    Int
1020, Int
100, Int
802, Int
71, Int
799, Int
1003, Int
633, Int
355, Int
276, Int
300, Int
649, Int
64, Int
306, Int
161,
    Int
608, Int
496, Int
743, Int
180, Int
485, Int
819, Int
383, Int
1016, Int
226, Int
308, Int
393, Int
648, Int
107, Int
19, Int
37,
    Int
585, Int
2, Int
175, Int
645, Int
247, Int
527, Int
5, Int
419, Int
181, Int
317, Int
327, Int
519, Int
542, Int
289, Int
567,
    Int
430, Int
579, Int
950, Int
582, Int
994, Int
1021, Int
583, Int
234, Int
240, Int
976, Int
41, Int
160, Int
109, Int
677,
    Int
937, Int
210, Int
95, Int
959, Int
242, Int
753, Int
461, Int
114, Int
733, Int
368, Int
573, Int
458, Int
782, Int
605, Int
680,
    Int
544, Int
299, Int
73, Int
652, Int
905, Int
477, Int
690, Int
93, Int
824, Int
882, Int
277, Int
946, Int
361, Int
17, Int
945,
    Int
523, Int
472, Int
334, Int
930, Int
597, Int
603, Int
793, Int
404, Int
290, Int
942, Int
316, Int
731, Int
270, Int
960,
    Int
936, Int
133, Int
122, Int
821, Int
966, Int
679, Int
662, Int
907, Int
282, Int
968, Int
767, Int
653, Int
20, Int
697, Int
222,
    Int
164, Int
835, Int
30, Int
285, Int
886, Int
456, Int
436, Int
640, Int
286, Int
1015, Int
380, Int
840, Int
245, Int
724,
    Int
137, Int
593, Int
173, Int
130, Int
715, Int
85, Int
885, Int
551, Int
246, Int
449, Int
103, Int
366, Int
372, Int
714, Int
313,
    Int
865, Int
241, Int
699, Int
674, Int
374, Int
68, Int
421, Int
562, Int
292, Int
59, Int
809, Int
342, Int
651, Int
459, Int
227,
    Int
46, Int
711, Int
764, Int
868, Int
53, Int
413, Int
278, Int
800, Int
255, Int
993, Int
318, Int
854, Int
319, Int
695, Int
315,
    Int
469, Int
166, Int
489, Int
969, Int
730, Int
1001, Int
757, Int
873, Int
686, Int
197, Int
303, Int
919, Int
155, Int
673,
    Int
940, Int
712, Int
25, Int
999, Int
63, Int
863, Int
972, Int
967, Int
785, Int
152, Int
296, Int
512, Int
402, Int
377, Int
45,
    Int
899, Int
829, Int
354, Int
77, Int
69, Int
856, Int
417, Int
811, Int
953, Int
124, Int
418, Int
75, Int
794, Int
162, Int
414,
    Int
1018, Int
568, Int
254, Int
265, Int
772, Int
588, Int
16, Int
896, Int
157, Int
889, Int
298, Int
621, Int
110, Int
844,
    Int
1000, Int
108, Int
545, Int
601, Int
78, Int
862, Int
447, Int
185, Int
195, Int
818, Int
450, Int
387, Int
49, Int
805, Int
102,
    Int
986, Int
1005, Int
827, Int
329, Int
28, Int
932, Int
410, Int
287, Int
435, Int
451, Int
962, Int
517, Int
48, Int
174, Int
43,
    Int
893, Int
884, Int
261, Int
251, Int
516, Int
395, Int
910, Int
611, Int
29, Int
501, Int
223, Int
476, Int
364, Int
144, Int
871,
    Int
998, Int
687, Int
928, Int
115, Int
453, Int
513, Int
176, Int
94, Int
168, Int
667, Int
955, Int
353, Int
434, Int
382, Int
400,
    Int
139, Int
365, Int
996, Int
343, Int
948, Int
890, Int
1012, Int
663, Int
610, Int
718, Int
538, Int
1008, Int
639, Int
470,
    Int
848, Int
543, Int
1011, Int
859, Int
671, Int
756, Int
83, Int
427, Int
159, Int
746, Int
669, Int
589, Int
971, Int
524,
    Int
356, Int
995, Int
904, Int
256, Int
201, Int
988, Int
62, Int
397, Int
81, Int
720, Int
917, Int
209, Int
549, Int
943, Int
486,
    Int
76, Int
148, Int
207, Int
509, Int
644, Int
386, Int
700, Int
534, Int
177, Int
550, Int
961, Int
926, Int
546, Int
428, Int
284,
    Int
127, Int
294, Int
8, Int
269, Int
359, Int
506, Int
445, Int
997, Int
806, Int
591, Int
725, Int
178, Int
262, Int
846, Int
373,
    Int
831, Int
504, Int
305, Int
843, Int
553, Int
378, Int
1017, Int
783, Int
474, Int
683, Int
581, Int
200, Int
498, Int
694,
    Int
191, Int
217, Int
847, Int
941, Int
424, Int
235, Int
38, Int
74, Int
616, Int
786, Int
147, Int
4, Int
273, Int
214, Int
142,
    Int
575, Int
992, Int
463, Int
983, Int
243, Int
360, Int
970, Int
350, Int
267, Int
615, Int
766, Int
494, Int
31, Int
1009,
    Int
452, Int
710, Int
552, Int
128, Int
612, Int
600, Int
275, Int
322, Int
193 ]

-- | This function is a Haskell translation of the reference JavaScript
--   implementation here: https://git.io/fj8Fu
syndrome :: (Bits a, Num a) => a -> a
syndrome :: a -> a
syndrome a
residue = a
low
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (a
low a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
10)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (a
low a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
20)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit`  Int
5 then a
0x31edd3c4 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit`  Int
6 then a
0x335f86a8 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit`  Int
7 then a
0x363b8870 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit`  Int
8 then a
0x3e6390c9 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit`  Int
9 then a
0x2ec72192 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
10 then a
0x1046f79d else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
11 then a
0x208d4e33 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
12 then a
0x130ebd6f else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
13 then a
0x2499fade else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
14 then a
0x1b27d4b5 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
15 then a
0x04be1eb4 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
16 then a
0x0968b861 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
17 then a
0x1055f0c2 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
18 then a
0x20ab4584 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
19 then a
0x1342af08 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
20 then a
0x24f1f318 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
21 then a
0x1be34739 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
22 then a
0x35562f7b else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
23 then a
0x3a3c5bff else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
24 then a
0x266c96f7 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
25 then a
0x25c78b65 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
26 then a
0x1b1f13ea else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
27 then a
0x34baa2f4 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
28 then a
0x3b61c0e1 else a
0)
    a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (if a
residue a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
29 then a
0x265325c2 else a
0)
  where
    low :: a
low = a
residue a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x1f

-- | For a given Bech32 string residue and Bech32 string length, reports the
-- positions of detectably erroneous characters in the original Bech32 string.
--
-- The reported character positions are zero-based, counting from right to left
-- within the original string, but omitting the separation character (which is
-- not counted).
--
-- Returns the empty list if it is not possible to reliably determine the
-- locations of errors.
--
-- This function is a Haskell translation of the reference JavaScript
-- implementation here: https://git.io/fj8Fz
--
locateErrors :: Int -> Int -> [Int]
locateErrors :: Int -> Int -> [Int]
locateErrors Int
residue Int
len
    | Int
residue Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
    | Int
l_s0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 Bool -> Bool -> Bool
&&
      Int
l_s1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 Bool -> Bool -> Bool
&&
      Int
l_s2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 Bool -> Bool -> Bool
&& (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l_s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l_s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l_s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2046) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1023 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
          let p1 :: Int
p1 = (Int
l_s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l_s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1023) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1023 in
          if Int
p1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then [] else
          let l_e1 :: Int
l_e1 = Int
l_s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1023 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
997) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
p1 in
          [Int
p1 | Int
l_e1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
33 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0]
    | Bool
otherwise =
          case ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (Int -> [Int]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Int]
findError [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] of
              [] -> []
              [[Int]]
es -> [[Int]] -> [Int]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[Int]]
es
  where
    syn :: Int
syn = Int -> Int
forall a. (Bits a, Num a) => a -> a
syndrome Int
residue
    s0 :: Int
s0 = Int
syn Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
    s1 :: Int
s1 = (Int
syn Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
10) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
    s2 :: Int
s2 = Int
syn Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
20
    l_s0 :: Int
l_s0 = Array Int Int
gf_1024_log Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
s0
    l_s1 :: Int
l_s1 = Array Int Int
gf_1024_log Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
s1
    l_s2 :: Int
l_s2 = Array Int Int
gf_1024_log Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
s2

    findError :: Int -> [Int]
    findError :: Int -> [Int]
findError Int
p1
        | Int
s2_s1p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0      = []
        | Int
s1_s0p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0      = []
        | Int
p2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len         = []
        | Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2          = []
        | Int
s1_s0p2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0      = []
        | Int
l_e2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
33 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = []
        | Int
l_e1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
33 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = []
        | Int
p1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p2           = [Int
p1, Int
p2]
        | Bool
otherwise         = [Int
p2, Int
p1]
      where
        inv_p1_p2 :: Int
inv_p1_p2 = Int
1023 Int -> Int -> Int
forall a. Num a => a -> a -> a
-
            (Array Int Int
gf_1024_log Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! (Array Int Int
gf_1024_exp Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
p1)) Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor`
            (Array Int Int
gf_1024_exp Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
p2)
        l_e1 :: Int
l_e1 = (Array Int Int
gf_1024_log Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
s1_s0p2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inv_p1_p2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1023 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
997) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
p1
        l_e2 :: Int
l_e2 = Int
l_s1_s0p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inv_p1_p2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1023 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
997) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
p2
        l_s1_s0p1 :: Int
l_s1_s0p1 = Array Int Int
gf_1024_log Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
s1_s0p1
        p2 :: Int
p2 = ((Array Int Int
gf_1024_log Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! Int
s2_s1p1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l_s1_s0p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1023) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1023
        s1_s0p1 :: Int
s1_s0p1 = Int
s1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor`
            (if Int
s0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Array Int Int
gf_1024_exp Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! ((Int
l_s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1023))
        s1_s0p2 :: Int
s1_s0p2 = Int
s1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor`
            (if Int
s0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Array Int Int
gf_1024_exp Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! ((Int
l_s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1023))
        s2_s1p1 :: Int
s2_s1p1 = Int
s2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor`
            (if Int
s1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Array Int Int
gf_1024_exp Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
Arr.! ((Int
l_s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1023))

{-------------------------------------------------------------------------------
                                   Utilities
-------------------------------------------------------------------------------}

guardE :: Bool -> e -> Either e ()
guardE :: Bool -> e -> Either e ()
guardE Bool
b e
e = if Bool
b then () -> Either e ()
forall a b. b -> Either a b
Right () else e -> Either e ()
forall a b. a -> Either a b
Left e
e

-- | Splits the given 'Text' into a prefix and a suffix using the last
-- occurrence of the specified separator character as a splitting point.
-- Evaluates to 'Nothing' if the specified 'Text' does not contain the
-- separator character.
splitAtLastOccurrence :: Char -> Text -> Maybe (Text, Text)
splitAtLastOccurrence :: Char -> Text -> Maybe (Text, Text)
splitAtLastOccurrence Char
c Text
s
    | Maybe Char -> Bool
forall a. Maybe a -> Bool
isNothing ((Char -> Bool) -> Text -> Maybe Char
T.find (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
s) = Maybe (Text, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
prefix, Text
suffix)
  where
    (Text
prefixPlusOne, Text
suffix) = Text -> Text -> (Text, Text)
T.breakOnEnd (String -> Text
T.pack [Char
c]) Text
s
    prefix :: Text
prefix = Int -> Text -> Text
T.dropEnd Int
1 Text
prefixPlusOne