1 files changed, 46 insertions, 0 deletions

diff --git a/src/Data/ByteString/Base32/Internal.hs b/src/Data/ByteString/Base32/Internal.hs
index c34e80c..725be37 100644
--- a/src/Data/ByteString/Base32/Internal.hs
+++ b/src/Data/ByteString/Base32/Internal.hs
@@ -18,6 +18,7 @@ module Data.ByteString.Base32.Internal
 
        , DecTable
        , pack5
+       , pack5Lenient
        , invIx
        ) where
 
@@ -228,3 +229,48 @@ pack5 (PS fptr off len) bs
     unsafePerformIO $ do
       withForeignPtr fptr $ \ptr ->
         return $ pack5Ptr (ptr `advancePtr` off) bs
+
+{-----------------------------------------------------------------------
+-- Lenient Decoding
+-----------------------------------------------------------------------}
+
+pack5PtrLenient :: Ptr Word5 -> ByteString -> ByteString
+pack5PtrLenient !tbl bs @ (PS fptr off sz) =
+  unsafePerformIO $ do
+    BS.createAndTrim (sz * 2) $ \ dst -> do
+        withForeignPtr fptr $ \ ptr -> do
+          dst_end <- smallStep dst (advancePtr ptr off) sz 0 0
+          return (dst_end `minusPtr` dst)
+  where
+    lookupTable :: Word8 -> Word5
+    lookupTable ix = inlinePerformIO (peekByteOff tbl (fromIntegral ix))
+    {-# INLINE lookupTable #-}
+
+    smallStep :: Ptr Word8 -> Ptr Word5 -> Int -> Word -> Int
+              -> IO (Ptr Word5)
+    smallStep !dst !src !s !unused !un_cnt
+      | un_cnt >= 8 = do
+        poke dst $ fromIntegral (unused `unsafeShiftR` (un_cnt - 8))
+        smallStep (dst `advancePtr` 1) src s unused (un_cnt - 8)
+
+      |   s == 0  = return dst
+      | otherwise = do
+        w8 <- peek src
+        if w2c w8 == '='
+           then if (bit un_cnt - 1) .&. unused == 0
+                then smallStep dst src 0 0 0
+                else smallStep dst src 0 (unused `shiftL` (8 - un_cnt)) 8
+           else smallStep dst
+                  (src `advancePtr` 1) (pred s)
+                  ((unused `unsafeShiftL` 5)
+                   .|. fromIntegral (lookupTable (fromIntegral w8)))
+                  (un_cnt + 5)
+
+pack5Lenient :: DecTable -> ByteString -> ByteString
+pack5Lenient (PS fptr off len) bs
+  | len /= 256
+  = error $ "base32: pack5: invalid lookup table size " ++ show len
+  |  otherwise  =
+    unsafePerformIO $ do
+      withForeignPtr fptr $ \ptr ->
+        return $ pack5Ptr (ptr `advancePtr` off) bs