streaming-base64 (empty) → 0.1.0.0

raw patch · 4 files changed

+204/−0 lines, 4 filesdep +basedep +safe-exceptionsdep +streamingsetup-changed

Dependencies added: base, safe-exceptions, streaming, streaming-base64, streaming-bytestring, tasty, tasty-hunit, transformers

Files

• Setup.hs +2/−0
• src/Streaming/Base64.hs +137/−0
• streaming-base64.cabal +34/−0
• test/UnitTests.hs +31/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,137 @@+-- | This module should be imported as qualified.+module Streaming.Base64 (encode, decode, Base64Exception(..)) where++-- {{{ Imports+import           Control.Arrow+import           Control.Exception.Safe+import           Control.Monad+import           Control.Monad.Trans.Class+import           Data.Bits+import           Data.ByteString.Streaming (ByteString)+import qualified Data.ByteString.Streaming as ByteString+import           Data.Char+import           Data.Function+import           Data.Maybe+import           Data.Semigroup+import           Data.Word+import           Streaming.Prelude         (Of (..), Stream, cons, for, next,+                                            yield)+import qualified Streaming.Prelude         as Stream+-- }}}+++data Base64Exception = PrematureEndOfInput deriving(Eq, Ord, Read, Show)++instance Exception Base64Exception where+  displayException PrematureEndOfInput = "Premature end of base-64 text"++characters :: String+characters = ['A'..'Z'] <> ['a'..'z'] <> ['0'..'9'] <> ['+', '/']++digits :: [Word8]+digits = [0..63]+++padWord :: Word8+padWord = fromIntegral $ ord '='++data Validate a = Valid a | Invalid a++isInvalid :: Validate a -> Bool+isInvalid (Valid _) = False+isInvalid _         = True++getValid (Valid a) = Just a+getValid _         = Nothing++getValue (Valid a)   = a+getValue (Invalid a) = a++-- | Encode a binary stream in base64 format.+--+-- Output will be padded to be always a multiple of 4 bytes in length.+encode :: Monad m => ByteString m r -> Stream (Of Word8) m r+encode = ByteString.unpack >>> groupPad3 zeroBits >>> encodeStream++encodeStream :: Monad m => Stream (Of (Word8, Validate Word8, Validate Word8)) m r -> Stream (Of Word8) m r+encodeStream stream = do+  element <- lift $ next stream+  case element of+    Right ((a, b, c), stream') -> do+      let b' = getValue b+          c' = getValue c+      yield $ encodeWord $ shiftR a 2+      yield $ encodeWord $ shiftL (a .&. 0x3) 4 + shiftR b' 4+      yield $ if isInvalid b then padWord else encodeWord $ shiftL (b' .&. 0xF) 2 + shiftR c' 6+      yield $ if isInvalid c then padWord else encodeWord $ c' .&. 0x3F+      encodeStream stream'+    Left r -> return r++encodeWord :: Word8 -> Word8+encodeWord word = maybe zeroBits (fromIntegral . ord) $ lookup word $ zip digits characters++groupPad3 :: Monad m => a -> Stream (Of a) m r -> Stream (Of (a, Validate a, Validate a)) m r+groupPad3 padding stream =+  do+    element <- lift $ next stream+    case element of+      Right (a, stream2) -> do+        (b, stream3) <- nextDef padding stream2+        (c, stream4) <- nextDef padding stream3+        yield (a, b, c)+        groupPad3 padding stream4+      Left r -> return r+  where+    nextDef a s = do+      element <- lift $ next s+      return $ either (const (Invalid padding, s)) (first Valid) element+++group4Pad2 :: Monad m => a -> Stream (Of a) m r -> Stream (Of (a, a, Validate a, Validate a)) m (Either Base64Exception r)+group4Pad2 padding stream = do+  element1 <- lift $ next stream+  case element1 of+    Right (a, stream2) -> do+      element2 <- lift $ next stream2+      case element2 of+        Right (b, stream3) -> do+          (c, stream4) <- nextDef padding stream3+          (d, stream5) <- nextDef padding stream4+          yield (a, b, c, d)+          group4Pad2 padding stream5+        _ -> return $ Left PrematureEndOfInput+    Left r -> return $ Right r+  where+    nextDef a s = do+      element <- lift $ next s+      return $ either (const (Invalid padding, s)) (first Valid) element+++decodeStream :: Monad m => Stream (Of (Word8, Word8, Validate Word8, Validate Word8)) m r -> Stream (Of Word8) m r+decodeStream stream =+  do+    elements <- lift $ next stream+    case elements of+      Right ((a, b, c, d), stream') -> do+        let a' = decodeWord a+            b' = decodeWord b+        yield $ shiftL a' 2 + shiftR b' 4++        forM_ (fmap decodeWord $ getValid $ invalidate padWord c) $ \c' -> do+          yield $ shiftL (b' .&. 0xF) 4 + shiftR c' 2++          forM_ (fmap decodeWord $ getValid $ invalidate padWord d) $ \d' ->+            yield $ shiftL (c' .&. 0x3) 6 + d'++        decodeStream stream'+      Left r -> return r+  where+    invalidate a (Valid b) = if a == b then Invalid b else Valid b+    invalidate _ b         = b++decodeWord :: Word8 -> Word8+decodeWord word = fromMaybe zeroBits $ lookup (chr $ fromIntegral word) $ zip characters digits++-- | Decode base64-encoded data into a binary stream.+decode :: Monad m => Stream (Of Word8) m r -> ByteString m (Either Base64Exception r)+decode = group4Pad2 padWord >>> decodeStream >>> ByteString.pack

@@ -0,0 +1,34 @@+cabal-version: 2.2+-- cabal-version:       >=1.10+name:                streaming-base64+version:             0.1.0.0+synopsis:            Streaming conversion from/to base64+-- description:+-- license:             PublicDomain+license:             CC0-1.0+author:              koral+maintainer:          koral@mailoo.org+-- category:+build-type:          Simple+-- extra-source-files:  ChangeLog.md++source-repository head+    type: git+    location: git://github.com/k0ral/streaming-base64.git++library+  exposed-modules:+    Streaming.Base64+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.9 && <5, safe-exceptions, streaming, streaming-bytestring, transformers+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite unit-tests+  type: exitcode-stdio-1.0+  main-is: UnitTests.hs+  build-depends: base >=4.9 && <5, streaming-base64, streaming-bytestring, tasty, tasty-hunit+  default-language: Haskell2010+  hs-source-dirs: test+  -- other-modules:

@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+import qualified Streaming.Base64          as Base64++import           Control.Arrow+import           Control.Monad+import           Data.ByteString.Streaming (ByteString)+import qualified Data.ByteString.Streaming as Bytes+import           Test.Tasty+import           Test.Tasty.HUnit++main :: IO ()+main = defaultMain $ testGroup "Unit tests"+  [ encodeCase+  , decodeCase+  ]++examples =+  [ ("Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure.",   "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=")+  ]++encodeCase :: TestTree+encodeCase = testCase "encode" $ do+  forM_ examples $ \(input, expected) -> do+    result <- (Bytes.toLazy_ <<< Bytes.pack <<< Base64.encode <<< Bytes.fromLazy) input+    result @?= expected++decodeCase :: TestTree+decodeCase = testCase "decode" $ do+  forM_ examples $ \(expected, input) -> do+    result <- (Bytes.toLazy_ <<< Base64.decode <<< Bytes.unpack <<< Bytes.fromLazy) input+    result @?= expected