diff --git a/Data/Conduit/Base64.hs b/Data/Conduit/Base64.hs new file mode 100644 --- /dev/null +++ b/Data/Conduit/Base64.hs @@ -0,0 +1,57 @@ +module Data.Conduit.Base64 + ( encode + , decode + , encodeURL + , decodeURL + ) where + +import Control.Monad (unless) +import Control.Exception (assert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as S + +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.URL as B64U + +import Data.Conduit + +encode :: Monad m => GInfConduit ByteString m ByteString +encode = codeWith 3 B64.encode + +decode :: Monad m => GInfConduit ByteString m ByteString +decode = codeWith 4 B64.decodeLenient + +encodeURL :: Monad m => GInfConduit ByteString m ByteString +encodeURL = codeWith 3 B64U.encode + +decodeURL :: Monad m => GInfConduit ByteString m ByteString +decodeURL = codeWith 4 B64U.decodeLenient + +codeWith :: Monad m => Int -> (ByteString -> ByteString) -> GInfConduit ByteString m ByteString +codeWith size f = + loop + where + loop = awaitE >>= either return push + + loopWith bs + | S.null bs = loop + | otherwise = awaitE >>= either (\r -> yield (f bs) >> return r) (pushWith bs) + + push bs = do + let (x, y) = S.splitAt (len - (len `mod` size)) bs + unless (S.null x) $ yield $ f x + loopWith y + where + len = S.length bs + + pushWith bs1 bs2 | S.length bs1 + S.length bs2 < size = loopWith (S.append bs1 bs2) + pushWith bs1 bs2 = assertion1 $ assertion2 $ do + yield $ f bs1' + push y + where + m = S.length bs1 `mod` size + (x, y) = S.splitAt (size - m) bs2 + bs1' = S.append bs1 x + + assertion1 = assert $ S.length bs1 < size + assertion2 = assert $ S.length bs1' `mod` size == 0 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, Michael Snoyman + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Michael Snoyman nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/base64-conduit.cabal b/base64-conduit.cabal new file mode 100644 --- /dev/null +++ b/base64-conduit.cabal @@ -0,0 +1,40 @@ +Name: base64-conduit +Version: 0.5.0 +Synopsis: Base64-encode and decode streams of bytes. +Description: Base64-encode and decode streams of bytes. +License: BSD3 +License-file: LICENSE +Author: Michael Snoyman +Maintainer: michael@snoyman.com +Category: Data, Conduit +Build-type: Simple +Cabal-version: >=1.8 +Homepage: http://github.com/snoyberg/conduit +extra-source-files: test/main.hs + +Library + Exposed-modules: Data.Conduit.Base64 + Build-depends: base >= 4 && < 5 + , bytestring >= 0.9 + , base64-bytestring >= 0.1.1.1 + , conduit >= 0.5 && < 0.6 + ghc-options: -Wall + +test-suite test + hs-source-dirs: test + main-is: main.hs + type: exitcode-stdio-1.0 + cpp-options: -DTEST + build-depends: conduit + , base + , hspec >= 1.3 + , bytestring + , QuickCheck + , base64-conduit + , base64-bytestring + , transformers + ghc-options: -Wall + +source-repository head + type: git + location: git://github.com/snoyberg/conduit.git diff --git a/test/main.hs b/test/main.hs new file mode 100644 --- /dev/null +++ b/test/main.hs @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +import Test.Hspec +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck.Arbitrary + +import Data.Conduit +import Data.Conduit.Base64 +import qualified Data.Conduit.List as CL + +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.URL as B64U +import Data.Functor.Identity (runIdentity) + +instance Arbitrary S.ByteString where + arbitrary = fmap S8.pack arbitrary + +main :: IO () +main = hspec $ do + describe "encode/decode is idempotent" $ do + prop "non-url" $ \bss -> L.fromChunks bss == L.fromChunks (runIdentity (CL.sourceList bss $$ encode =$ decode =$ CL.consume)) + prop "url" $ \bss -> L.fromChunks bss == L.fromChunks (runIdentity (CL.sourceList bss $$ encodeURL =$ decodeURL =$ CL.consume)) + describe "encode is identical" $ do + prop "non-url" $ \bss -> B64.encode (S.concat bss) == S.concat (runIdentity $ CL.sourceList bss $$ encode =$ CL.consume) + prop "url" $ \bss -> B64U.encode (S.concat bss) == S.concat (runIdentity $ CL.sourceList bss $$ encodeURL =$ CL.consume)