Commits

Ian Lynagh  committed 17b0501

Add .Lazy variants of the two Base64 modules

  • Participants
  • Parent commits 4c6e559

Comments (0)

Files changed (5)

File Data/ByteString/Base64/Internal.hs

     , joinWith
     , done
     , peek8, poke8, peek8_32
+    , reChunkIn
     ) where
 
 import Data.Bits ((.|.), (.&.), shiftL, shiftR)
 done :: Integral a => a
 done = 99
 {-# INLINE done #-}
+
+-- This takes a list of ByteStrings, and returns a list in which each
+-- (apart from possibly the last) has length that is a multiple of n
+reChunkIn :: Int -> [ByteString] -> [ByteString]
+reChunkIn _ [] = []
+reChunkIn _ [y] = [y]
+reChunkIn n (y : ys) = case B.length y `divMod` n of
+                       (_, 0) ->
+                           y : reChunkIn n ys
+                       (d, _) ->
+                           case B.splitAt (d * n) y of
+                           (prefix, suffix) -> prefix : fixup suffix ys
+    where fixup acc [] = [acc]
+          fixup acc (z : zs) = case B.splitAt (n - B.length acc) z of
+                               (prefix, suffix) ->
+                                   let acc' = acc `B.append` prefix
+                                   in if B.length acc' == n
+                                      then let zs' = if B.null suffix
+                                                     then          zs
+                                                     else suffix : zs
+                                           in acc' : reChunkIn n zs'
+                                      else -- suffix must be null
+                                           fixup acc' zs
+

File Data/ByteString/Base64/Lazy.hs

+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-- |
+-- Module      : Data.ByteString.Base64.Lazy
+-- Copyright   : (c) 2012 Ian Lynagh
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Fast and efficient encoding and decoding of base64-encoded
+-- lazy bytestrings.
+
+module Data.ByteString.Base64.Lazy
+    (
+      encode
+    , decode
+    , decodeLenient
+    ) where
+
+import Data.ByteString.Base64.Internal
+import qualified Data.ByteString.Base64     as B64
+import qualified Data.ByteString            as S
+import qualified Data.ByteString.Lazy       as L
+import qualified Data.ByteString.Lazy.Char8 as LC
+import Data.Char
+
+-- | Encode a string into base64 form.  The result will always be a
+-- multiple of 4 bytes in length.
+encode :: L.ByteString -> L.ByteString
+encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks
+
+-- | Decode a base64-encoded string.  This function strictly follows
+-- the specification in RFC 4648,
+-- <http://www.apps.ietf.org/rfc/rfc4648.html>.
+decode :: L.ByteString -> Either String L.ByteString
+decode b = -- Returning an Either type means that the entire result will
+           -- need to be in memory at once anyway, so we may as well
+           -- keep it simple and just convert to and from a strict byte
+           -- string
+           -- TODO: Use L.{fromStrict,toStrict} once we can rely on
+           -- a new enough bytestring
+           case B64.decode $ S.concat $ L.toChunks b of
+           Left err -> Left err
+           Right b' -> Right $ L.fromChunks [b']
+
+-- | Decode a base64-encoded string.  This function is lenient in
+-- following the specification from RFC 4648,
+-- <http://www.apps.ietf.org/rfc/rfc4648.html>, and will not generate
+-- parse errors no matter how poor its input.
+decodeLenient :: L.ByteString -> L.ByteString
+decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks
+              . LC.filter goodChar
+    where -- We filter out and '=' padding here, but B64.decodeLenient
+          -- handles that
+          goodChar c = isAlphaNum c || c == '+' || c == '/'
+

File Data/ByteString/Base64/URL/Lazy.hs

+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-- |
+-- Module      : Data.ByteString.Base64.URL.Lazy
+-- Copyright   : (c) 2012 Ian Lynagh
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Fast and efficient encoding and decoding of base64-encoded
+-- lazy bytestrings.
+
+module Data.ByteString.Base64.URL.Lazy
+    (
+      encode
+    , decode
+    , decodeLenient
+    ) where
+
+import Data.ByteString.Base64.Internal
+import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.ByteString            as S
+import qualified Data.ByteString.Lazy       as L
+import qualified Data.ByteString.Lazy.Char8 as LC
+import Data.Char
+
+-- | Encode a string into base64 form.  The result will always be a
+-- multiple of 4 bytes in length.
+encode :: L.ByteString -> L.ByteString
+encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks
+
+-- | Decode a base64-encoded string.  This function strictly follows
+-- the specification in RFC 4648,
+-- <http://www.apps.ietf.org/rfc/rfc4648.html>.
+decode :: L.ByteString -> Either String L.ByteString
+decode b = -- Returning an Either type means that the entire result will
+           -- need to be in memory at once anyway, so we may as well
+           -- keep it simple and just convert to and from a strict byte
+           -- string
+           -- TODO: Use L.{fromStrict,toStrict} once we can rely on
+           -- a new enough bytestring
+           case B64.decode $ S.concat $ L.toChunks b of
+           Left err -> Left err
+           Right b' -> Right $ L.fromChunks [b']
+
+-- | Decode a base64-encoded string.  This function is lenient in
+-- following the specification from RFC 4648,
+-- <http://www.apps.ietf.org/rfc/rfc4648.html>, and will not generate
+-- parse errors no matter how poor its input.
+decodeLenient :: L.ByteString -> L.ByteString
+decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks
+              . LC.filter goodChar
+    where -- We filter out and '=' padding here, but B64.decodeLenient
+          -- handles that
+          goodChar c = isAlphaNum c || c == '-' || c == '_'
+

File base64-bytestring.cabal

 name:                base64-bytestring
-version:             0.1.2.0
+version:             0.1.2.1
 synopsis:            Fast base64 encoding and deconding for ByteStrings
 description:         Fast base64 encoding and deconding for ByteStrings
 homepage:            https://github.com/bos/base64-bytestring
   exposed-modules:
     Data.ByteString.Base64
     Data.ByteString.Base64.URL
+    Data.ByteString.Base64.Lazy
+    Data.ByteString.Base64.URL.Lazy
   
   other-modules:
     Data.ByteString.Base64.Internal

File tests/Tests.hs

-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Main (main) where
 import Test.QuickCheck (Arbitrary(..), Positive(..))
 
 import Control.Monad (liftM)
-import qualified Data.ByteString.Base64 as Base64
-import qualified Data.ByteString.Base64.URL as Base64URL
+import qualified Data.ByteString.Base64          as Base64
+import qualified Data.ByteString.Base64.Lazy     as LBase64
+import qualified Data.ByteString.Base64.URL      as Base64URL
+import qualified Data.ByteString.Base64.URL.Lazy as LBase64URL
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 ()
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.String
 import Test.HUnit hiding (Test)
 
 
 main :: IO ()
 main = defaultMain tests
 
+data Impl bs = Impl String
+                    (bs -> bs)
+                    (bs -> Either String bs)
+                    (bs -> bs)
+
 tests :: [Test]
 tests = [
     testGroup "joinWith" [
         testProperty "all_endsWith" joinWith_all_endsWith
       , testProperty "endsWith" joinWith_endsWith
     ]
-  , testGroup "Base64" [
+  , testsRegular $ Impl "Base64"     Base64.encode     Base64.decode     Base64.decodeLenient
+  , testsRegular $ Impl "LBase64"    LBase64.encode    LBase64.decode    LBase64.decodeLenient
+  , testsURL     $ Impl "Base64URL"  Base64URL.encode  Base64URL.decode  Base64URL.decodeLenient
+  , testsURL     $ Impl "LBase64URL" LBase64URL.encode LBase64URL.decode LBase64URL.decodeLenient
+  ]
+
+testsRegular :: (IsString bs, Show bs, Eq bs, Arbitrary bs)
+             => Impl bs -> Test
+testsRegular impl@(Impl name encode decode decodeLenient)
+    = testGroup name [
+          testProperty "decodeEncode" $
+            genericDecodeEncode encode decode
+        , testProperty "decodeEncode Lenient" $
+            genericDecodeEncode encode (liftM Right decodeLenient)
+        , testGroup "base64-string tests" (base64_string_tests impl)
+      ]
+
+testsURL :: (IsString bs, Show bs, Eq bs, Arbitrary bs)
+         => Impl bs -> Test
+testsURL impl@(Impl name encode decode decodeLenient)
+    = testGroup name [
         testProperty "decodeEncode" $
-          genericDecodeEncode Base64.encode Base64.decode
+          genericDecodeEncode encode decode
       , testProperty "decodeEncode Lenient" $
-          genericDecodeEncode Base64.encode
-                              (liftM Right Base64.decodeLenient)
-      , testGroup "base64-string tests" base64_string_tests
+          genericDecodeEncode encode
+                              (liftM Right decodeLenient)
+      , testGroup "base64-string tests" (base64url_string_tests impl)
     ]
-  , testGroup "Base64URL" [
-        testProperty "decodeEncode" $
-          genericDecodeEncode Base64URL.encode Base64URL.decode
-      , testProperty "decodeEncode Lenient" $
-          genericDecodeEncode Base64URL.encode
-                              (liftM Right Base64URL.decodeLenient)
-      , testGroup "base64-string tests" base64url_string_tests
-    ]
-  ]
 
 instance Arbitrary ByteString where
   arbitrary = liftM B.pack arbitrary
 
+-- Ideally the arbitrary instance would have arbitrary chunks as well as
+-- arbitrary content
+instance Arbitrary L.ByteString where
+  arbitrary = liftM L.pack arbitrary
+
 joinWith_endsWith :: ByteString -> Positive Int -> ByteString -> Bool
 joinWith_endsWith brk (Positive int) str =
   brk `B.isSuffixOf` Base64.joinWith brk int str
   where k = B.length brk + min int (B.length str)
 
 -- | Decoding an encoded sintrg should produce the original string.
-genericDecodeEncode :: (ByteString -> ByteString)
-                    -> (ByteString -> Either String ByteString)
-                    -> ByteString -> Bool
+genericDecodeEncode :: (Arbitrary bs, Eq bs)
+                    => (bs -> bs)
+                    -> (bs -> Either String bs)
+                    -> bs -> Bool
 genericDecodeEncode enc dec x = case dec (enc x) of
                                   Left  _  -> False
                                   Right x' -> x == x'
 -- Copyright (c) Ian Lynagh, 2005, 2007.
 --
 
-base64_string_tests :: [Test]
-base64_string_tests =
-  base64_string_test Base64.encode Base64.decode testData ++
-  base64_string_test Base64.encode decodeURL testData
-  where decodeURL :: ByteString -> Either String ByteString
-        decodeURL = liftM Right Base64.decodeLenient
-        testData :: [(ByteString, ByteString)]
+base64_string_tests :: forall bs
+                    . (IsString bs, Show bs, Eq bs) => Impl bs -> [Test]
+base64_string_tests (Impl _ encode decode decodeLenient) =
+  base64_string_test encode decode         testData ++
+  base64_string_test encode decodeLenient' testData
+  where decodeLenient' :: bs -> Either String bs
+        decodeLenient' = liftM Right decodeLenient
+        testData :: [(bs, bs)]
         testData = [("",                "")
                    ,("\0",              "AA==")
                    ,("\255",            "/w==")
                    ]
 
 -- | Same as the base64_string_tests but using the alternative alphabet
-base64url_string_tests :: [Test]
-base64url_string_tests =
-  base64_string_test Base64URL.encode Base64URL.decode testData ++
-  base64_string_test Base64URL.encode decodeURL testData
-  where decodeURL :: ByteString -> Either String ByteString
-        decodeURL = liftM Right Base64URL.decodeLenient
-        testData :: [(ByteString, ByteString)]
+base64url_string_tests :: forall bs
+                       . (IsString bs, Show bs, Eq bs) => Impl bs -> [Test]
+base64url_string_tests (Impl _ encode decode decodeLenient) =
+  base64_string_test encode decode         testData ++
+  base64_string_test encode decodeLenient' testData
+  where decodeLenient' :: bs -> Either String bs
+        decodeLenient' = liftM Right decodeLenient
+        testData :: [(bs, bs)]
         testData = [("",                "")
                    ,("\0",              "AA==")
                    ,("\255",            "_w==")
 
 -- | Generic test given encod enad decode funstions and a
 -- list of (plain, encoded) pairs
-base64_string_test :: (ByteString -> ByteString)
-                   -> (ByteString -> Either String ByteString)
-                   -> [(ByteString, ByteString)] -> [Test]
+base64_string_test :: (Eq bs, Show bs)
+                   => (bs -> bs)
+                   -> (bs -> Either String bs)
+                   -> [(bs, bs)] -> [Test]
 base64_string_test enc dec testData = concat
       [ [ testCase ("base64-string: Encode " ++ show plain)
                    (encoded_plain @?= encoded),