bech32

commit 696fa7b0d0e4d860360d361a2becc7d8e6863235
parent ed09668566073916d18ec23caff41a1e87274173
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri, 15 Nov 2024 16:18:21 +0400

lib: use more familiar module structure

Diffstat:
D
lib/Codec/Binary/Bech32.hs
 | 
4
----
A
lib/Data/ByteString/Bech32.hs
 | 
46
++++++++++++++++++++++++++++++++++++++++++++++
M
ppad-bech32.cabal
 | 
2
+-

3 files changed, 47 insertions(+), 5 deletions(-)
diff --git a/lib/Codec/Binary/Bech32.hs b/lib/Codec/Binary/Bech32.hs
@@ -1,4 +0,0 @@
-
-module Codec.Binary.Bech32 where
-
-
diff --git a/lib/Data/ByteString/Bech32.hs b/lib/Data/ByteString/Bech32.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Data.ByteString.Bech32 where
+
+-- this entire module is an adaptation of the official haskell
+-- reference, which can be found at:
+--
+-- github.com/sipa/bech32/blob/master/ref/haskell/src/Codec/Binary/Bech32.hs
+
+import Data.Bits ((.|.), (.&.))
+import qualified Data.Bits as B
+import qualified Data.ByteString as BS
+
+base256_to_base32 = undefined
+
+base32_to_base256 = undefined
+
+data Pad = Pad | NoPad
+
+-- XX e0 ~ 5, e1 ~ 8 (or vice versa)
+convert_base2 :: BS.ByteString -> Int -> Int -> Pad -> BS.ByteString
+convert_base2 bs e0 e1 pad = loop 0 mempty 0 0 where
+  mask = 2 ^ e1 - 1
+  len = BS.length bs
+
+  loop j !acc !car !pos
+    | j == len = BS.pack . reverse $ case pad of
+        Pad | pos > 0 ->
+          let car0 = (car `B.unsafeShiftL` (e1 - pos)) .&. mask
+          in  car0 : acc
+        _ -> acc
+
+    | otherwise =
+        let word = BS.index bs j
+            car0 = (car `B.unsafeShiftL` e0) .|. word
+            pos0 = pos + e0
+            (nacc, pos1) = loop_pos car0 pos0 acc
+            car1 = car0 .&. (2 ^ pos1 - 1)
+        in  loop (succ j) nacc car1 pos1
+
+  loop_pos !car !pos !acc
+    | pos < e1 = (acc, pos)
+    | otherwise =
+        let nacc = ((car `B.unsafeShiftR` (pos - e1)) .&. mask) : acc
+        in  loop_pos car (pos - e1) nacc
+
diff --git a/ppad-bech32.cabal b/ppad-bech32.cabal
@@ -24,7 +24,7 @@ library
   ghc-options:
       -Wall
   exposed-modules:
-      Codec.Binary.Bech32
+      Data.ByteString.Bech32
   build-depends:
       base >= 4.9 && < 5
     , bytestring >= 0.9 && < 0.13