From f5fb4f27b4e9cecdc3afc2facc8e39717ea20524 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Tue, 26 Apr 2016 08:56:21 -0400 Subject: Initial commit This is just dataenc-0.14.0.7 from hackage with the upper bound on 'base' changed in dataenc.cabal. I couldn't find a git repo to fork, so I used 'stack unpack' --- .gitignore | 1 + GNUmakefile | 32 +++++ LICENSE | 27 +++++ Setup.hs | 22 ++++ dataenc.cabal | 51 ++++++++ src/Codec/Binary/Base16.hs | 102 ++++++++++++++++ src/Codec/Binary/Base32.hs | 155 +++++++++++++++++++++++++ src/Codec/Binary/Base32Hex.hs | 155 +++++++++++++++++++++++++ src/Codec/Binary/Base64.hs | 145 +++++++++++++++++++++++ src/Codec/Binary/Base64Url.hs | 137 ++++++++++++++++++++++ src/Codec/Binary/Base85.hs | 142 +++++++++++++++++++++++ src/Codec/Binary/DataEncoding.hs | 174 ++++++++++++++++++++++++++++ src/Codec/Binary/PythonString.hs | 109 +++++++++++++++++ src/Codec/Binary/QuotedPrintable.hs | 101 ++++++++++++++++ src/Codec/Binary/Url.hs | 100 ++++++++++++++++ src/Codec/Binary/Util.hs | 82 +++++++++++++ src/Codec/Binary/Uu.hs | 148 ++++++++++++++++++++++++ src/Codec/Binary/Xx.hs | 149 ++++++++++++++++++++++++ src/Codec/Binary/Yenc.hs | 83 +++++++++++++ test-src/DataencQC.hs | 137 ++++++++++++++++++++++ test-src/DataencUT.hs | 225 ++++++++++++++++++++++++++++++++++++ test-src/Test.hs | 16 +++ 22 files changed, 2293 insertions(+) create mode 100644 .gitignore create mode 100644 GNUmakefile create mode 100644 LICENSE create mode 100644 Setup.hs create mode 100644 dataenc.cabal create mode 100644 src/Codec/Binary/Base16.hs create mode 100644 src/Codec/Binary/Base32.hs create mode 100644 src/Codec/Binary/Base32Hex.hs create mode 100644 src/Codec/Binary/Base64.hs create mode 100644 src/Codec/Binary/Base64Url.hs create mode 100644 src/Codec/Binary/Base85.hs create mode 100644 src/Codec/Binary/DataEncoding.hs create mode 100644 src/Codec/Binary/PythonString.hs create mode 100644 src/Codec/Binary/QuotedPrintable.hs create mode 100644 src/Codec/Binary/Url.hs create mode 100644 src/Codec/Binary/Util.hs create mode 100644 src/Codec/Binary/Uu.hs create mode 100644 src/Codec/Binary/Xx.hs create mode 100644 src/Codec/Binary/Yenc.hs create mode 100644 test-src/DataencQC.hs create mode 100644 test-src/DataencUT.hs create mode 100644 test-src/Test.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3a5b475 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.stack-work/ diff --git a/GNUmakefile b/GNUmakefile new file mode 100644 index 0000000..55669af --- /dev/null +++ b/GNUmakefile @@ -0,0 +1,32 @@ +# Simple makefile for _running_ tests, use Cabal to build. + +.PHONY: all clean markup report test really-clean + +TESTS = dist/build/tests/tests + +HPC = hpc +HPC_SUM_OPTS = --exclude=Main --exclude=DataencUT --exclude=DataencQC + +all: + @echo "Use Cabal to build, this is only used to run tests!" + +test: $(TESTS) + for t in $(TESTS); do ./$${t}; done + +report : test + $(HPC) sum $(HPC_SUM_OPTS) --output run_test.tix tests.tix + $(HPC) report run_test.tix + +markup : test + $(HPC) sum $(HPC_SUM_OPTS) --output run_test.tix tests.tix + $(HPC) markup run_test.tix + +clean: + rm -f *~ *.tix *.html *.o *.hi + rm -f src/Codec/Binary/*.o + rm -f src/Codec/Binary/*.hi + rm -f src/Codec/Binary/*~ + +really-clean: clean + rm -rf .hpc + ./Setup.hs clean diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..817412c --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2007, Magnus Therning +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 the nor the names of its 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.hs b/Setup.hs new file mode 100644 index 0000000..ffea49e --- /dev/null +++ b/Setup.hs @@ -0,0 +1,22 @@ +#! /usr/bin/env runhaskell + +{- Copyright © 2007 Magnus Therning + - + - This file is part of dataenc. + - + - Dataenc is free software: you can redistribute it and/or modify it under + - the terms of the GNU Lesser General Public License as published by the + - Free Software Foundation, either version 3 of the License, or (at your + - option) any later version. + - + - Dataenc is distributed in the hope that it will be useful, but WITHOUT + - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public + - License for more details. + - + - You should have received a copy of the GNU Lesser General Public License + - along with dataenc. If not, see + -} + +import Distribution.Simple +main = defaultMain diff --git a/dataenc.cabal b/dataenc.cabal new file mode 100644 index 0000000..35f0b65 --- /dev/null +++ b/dataenc.cabal @@ -0,0 +1,51 @@ +name: dataenc +version: 0.14.0.7 +license: BSD3 +license-file: LICENSE +cabal-version: >= 1.6 +build-type: Simple +author: Magnus Therning +maintainer: Gracjan Polak +homepage: http://www.haskell.org/haskellwiki/Library/Data_encoding +copyright: Magnus Therning, 2007-2012, Gracjan Polak, 2014 +category: Codec +synopsis: Data encoding library +description: Data encoding library currently providing Base16, Base32, + Base32Hex, Base64, Base64Url, Base85, Python string escaping, + Quoted-Printable, URL encoding, uuencode, xxencode, and yEncoding. +extra-source-files: test-src/DataencUT.hs test-src/DataencQC.hs test-src/Test.hs GNUmakefile + +flag tests + Description: Build unit and quickcheck tests. + Default: False + +library + hs-source-dirs: src + build-depends: array, base >= 3.0.0, containers + exposed-modules: + Codec.Binary.Base16 + Codec.Binary.Base32 + Codec.Binary.Base32Hex + Codec.Binary.Base64 + Codec.Binary.Base64Url + Codec.Binary.Base85 + Codec.Binary.DataEncoding + Codec.Binary.PythonString + Codec.Binary.QuotedPrintable + Codec.Binary.Url + Codec.Binary.Uu + Codec.Binary.Xx + Codec.Binary.Yenc + other-modules: + Codec.Binary.Util + +executable tests + main-is: Test.hs + hs-source-dirs: test-src src + -- ghc-options: -fhpc + if flag(tests) + build-depends: test-framework, test-framework-hunit, HUnit, + test-framework-quickcheck2, QuickCheck ==2.5.*, + test-framework-th + else + buildable: False diff --git a/src/Codec/Binary/Base16.hs b/src/Codec/Binary/Base16.hs new file mode 100644 index 0000000..7faf3a5 --- /dev/null +++ b/src/Codec/Binary/Base16.hs @@ -0,0 +1,102 @@ +-- | +-- Module : Codec.Binary.Base16 +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Implemented as specified in RFC 4648 (). +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Base16 + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Control.Monad +import Data.Array +import Data.Bits +import Data.Maybe +import Data.Word +import qualified Data.Map as M + +-- {{{1 enc/dec map +_encMap = + [ (0, '0'), (1, '1'), (2, '2'), (3, '3'), (4, '4') + , (5, '5'), (6, '6'), (7, '7'), (8, '8'), (9, '9') + , (10, 'A'), (11, 'B'), (12, 'C'), (13, 'D'), (14, 'E') + , (15, 'F') ] + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (0, 64) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc EDone = EFinal [] +encodeInc (EChunk os) = EPart (concat $ map toHex os) encodeInc + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec2 cs = let + ds = map (flip M.lookup decodeMap) cs + es@[e1, e2] = map fromJust ds + o = e1 `shiftL` 4 .|. e2 + allJust = and . map isJust + in if allJust ds + then Just o + else Nothing + + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc s'@(c1:c2:cs) = maybe + (DFail acc s') + (\ b -> doDec (acc ++ [b]) cs) + (dec2 [c1, c2]) + doDec acc s = DPart acc (dI s) + +-- | Decode data. +decode :: String -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +-- +-- The length given is rounded down to the nearest multiple of 2. +chop :: Int -- ^ length of individual lines + -> String + -> [String] +chop n "" = [] +chop n s = let + enc_len | n < 2 = 2 + | otherwise = n `div` 2 * 2 + in take enc_len s : chop n (drop enc_len s) + +-- {{{1 unchop +-- | Concatenate the strings into one long string. +unchop :: [String] + -> String +unchop = foldr (++) "" diff --git a/src/Codec/Binary/Base32.hs b/src/Codec/Binary/Base32.hs new file mode 100644 index 0000000..4f88667 --- /dev/null +++ b/src/Codec/Binary/Base32.hs @@ -0,0 +1,155 @@ +-- | +-- Module : Codec.Binary.Base32 +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Implemented as specified in RFC 4648 +-- (). +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Base32 + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Control.Monad +import Data.Array +import Data.Bits +import Data.Maybe +import Data.Word +import qualified Data.Map as M + +-- {{{1 enc/dec map +_encMap = + [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E') + , (5, 'F'), (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J') + , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O') + , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T') + , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y') + , (25, 'Z'), (26, '2'), (27, '3'), (28, '4'), (29, '5') + , (30, '6'), (31, '7') ] + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (0, 32) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI [] e + where + enc5 [o1, o2, o3, o4, o5] = map (encodeArray !) [i1, i2, i3, i4, i5, i6, i7, i8] + where + i1 = o1 `shiftR` 3 + i2 = (o1 `shiftL` 2 .|. o2 `shiftR` 6) .&. 0x1f + i3 = o2 `shiftR` 1 .&. 0x1f + i4 = (o2 `shiftL` 4 .|. o3 `shiftR` 4) .&. 0x1f + i5 = (o3 `shiftL` 1 .|. o4 `shiftR` 7) .&. 0x1f + i6 = o4 `shiftR` 2 .&. 0x1f + i7 = (o4 `shiftL` 3 .|. o5 `shiftR` 5) .&. 0x1f + i8 = o5 .&. 0x1f + + eI [] EDone = EFinal [] + eI [o1] EDone = EFinal (take 2 cs ++ "======") + where + cs = enc5 [o1, 0, 0, 0, 0] + eI [o1, o2] EDone = EFinal (take 4 cs ++ "====") + where + cs = enc5 [o1, o2, 0, 0, 0] + eI [o1, o2, o3] EDone = EFinal (take 5 cs ++ "===") + where + cs = enc5 [o1, o2, o3, 0, 0] + eI [o1, o2, o3, o4] EDone = EFinal (take 7 cs ++ "=") + where + cs = enc5 [o1, o2, o3, o4, 0] + eI lo (EChunk bs) = doEnc [] (lo ++ bs) + where + doEnc acc (o1:o2:o3:o4:o5:os) = doEnc (acc ++ enc5 [o1, o2, o3, o4, o5]) os + doEnc acc os = EPart acc (eI os) + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec8 cs = let + ds = map (flip M.lookup decodeMap) cs + es@[e1, e2, e3, e4, e5, e6, e7, e8] = map fromJust ds + o1 = e1 `shiftL` 3 .|. e2 `shiftR` 2 + o2 = e2 `shiftL` 6 .|. e3 `shiftL` 1 .|. e4 `shiftR` 4 + o3 = e4 `shiftL` 4 .|. e5 `shiftR` 1 + o4 = e5 `shiftL` 7 .|. e6 `shiftL` 2 .|. e7 `shiftR` 3 + o5 = e7 `shiftL` 5 .|. e8 + allJust = and . map isJust + in if allJust ds + then Just [o1, o2, o3, o4, o5] + else Nothing + + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc s@(c1:c2:'=':'=':'=':'=':'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 1 bs) cs) + (dec8 [c1, c2, 'A', 'A', 'A', 'A', 'A', 'A']) + doDec acc s@(c1:c2:c3:c4:'=':'=':'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 2 bs) cs) + (dec8 [c1, c2, c3, c4, 'A', 'A', 'A', 'A']) + doDec acc s@(c1:c2:c3:c4:c5:'=':'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 3 bs) cs) + (dec8 [c1, c2, c3, c4, c5, 'A', 'A', 'A']) + doDec acc s@(c1:c2:c3:c4:c5:c6:c7:'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 4 bs) cs) + (dec8 [c1, c2, c3, c4, c5, c6, c7, 'A']) + doDec acc s@(c1:c2:c3:c4:c5:c6:c7:c8:cs) = maybe + (DFail acc s) + (\ bs -> doDec (acc ++ bs) cs) + (dec8 [c1, c2, c3, c4, c5, c6, c7, c8]) + doDec acc s = DPart acc (dI s) + +-- | Decode data. +decode :: String + -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +-- +-- The length given is rounded down to the nearest multiple of 8. +chop :: Int -- ^ length of individual lines + -> String + -> [String] +chop n "" = [] +chop n s = let + enc_len | n < 8 = 8 + | otherwise = n `div` 8 * 8 + in take enc_len s : chop n (drop enc_len s) + +-- {{{1 unchop +-- | Concatenate the strings into one long string. +unchop :: [String] + -> String +unchop = foldr (++) "" diff --git a/src/Codec/Binary/Base32Hex.hs b/src/Codec/Binary/Base32Hex.hs new file mode 100644 index 0000000..bdec6f3 --- /dev/null +++ b/src/Codec/Binary/Base32Hex.hs @@ -0,0 +1,155 @@ +-- | +-- Module : Codec.Binary.Base32Hex +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Implemented as specified in RFC 4648 +-- (). +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Base32Hex + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Control.Monad +import Data.Array +import Data.Bits +import Data.Maybe +import Data.Word +import qualified Data.Map as M + +import qualified Codec.Binary.Base32 as Base32 + +-- {{{1 enc/dec map +_encMap = + [ (0, '0'), (1, '1'), (2, '2'), (3, '3'), (4, '4') + , (5, '5'), (6, '6'), (7, '7'), (8, '8'), (9, '9') + , (10, 'A'), (11, 'B'), (12, 'C'), (13, 'D'), (14, 'E') + , (15, 'F'), (16, 'G'), (17, 'H'), (18, 'I'), (19, 'J') + , (20, 'K'), (21, 'L'), (22, 'M'), (23, 'N'), (24, 'O') + , (25, 'P'), (26, 'Q'), (27, 'R'), (28, 'S'), (29, 'T') + , (30, 'U'), (31, 'V') ] + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (0, 32) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI [] e + where + enc5 [o1, o2, o3, o4, o5] = map (encodeArray !) [i1, i2, i3, i4, i5, i6, i7, i8] + where + i1 = o1 `shiftR` 3 + i2 = (o1 `shiftL` 2 .|. o2 `shiftR` 6) .&. 0x1f + i3 = o2 `shiftR` 1 .&. 0x1f + i4 = (o2 `shiftL` 4 .|. o3 `shiftR` 4) .&. 0x1f + i5 = (o3 `shiftL` 1 .|. o4 `shiftR` 7) .&. 0x1f + i6 = o4 `shiftR` 2 .&. 0x1f + i7 = (o4 `shiftL` 3 .|. o5 `shiftR` 5) .&. 0x1f + i8 = o5 .&. 0x1f + + eI [] EDone = EFinal [] + eI [o1] EDone = EFinal (take 2 cs ++ "======") + where + cs = enc5 [o1, 0, 0, 0, 0] + eI [o1, o2] EDone = EFinal (take 4 cs ++ "====") + where + cs = enc5 [o1, o2, 0, 0, 0] + eI [o1, o2, o3] EDone = EFinal (take 5 cs ++ "===") + where + cs = enc5 [o1, o2, o3, 0, 0] + eI [o1, o2, o3, o4] EDone = EFinal (take 7 cs ++ "=") + where + cs = enc5 [o1, o2, o3, o4, 0] + eI lo (EChunk bs) = doEnc [] (lo ++ bs) + where + doEnc acc (o1:o2:o3:o4:o5:os) = doEnc (acc ++ enc5 [o1, o2, o3, o4, o5]) os + doEnc acc os = EPart acc (eI os) + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec8 cs = let + ds = map (flip M.lookup decodeMap) cs + es@[e1, e2, e3, e4, e5, e6, e7, e8] = map fromJust ds + o1 = e1 `shiftL` 3 .|. e2 `shiftR` 2 + o2 = e2 `shiftL` 6 .|. e3 `shiftL` 1 .|. e4 `shiftR` 4 + o3 = e4 `shiftL` 4 .|. e5 `shiftR` 1 + o4 = e5 `shiftL` 7 .|. e6 `shiftL` 2 .|. e7 `shiftR` 3 + o5 = e7 `shiftL` 5 .|. e8 + allJust = and . map isJust + in if allJust ds + then Just [o1, o2, o3, o4, o5] + else Nothing + + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc s@(c1:c2:'=':'=':'=':'=':'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 1 bs) cs) + (dec8 [c1, c2, 'A', 'A', 'A', 'A', 'A', 'A']) + doDec acc s@(c1:c2:c3:c4:'=':'=':'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 2 bs) cs) + (dec8 [c1, c2, c3, c4, 'A', 'A', 'A', 'A']) + doDec acc s@(c1:c2:c3:c4:c5:'=':'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 3 bs) cs) + (dec8 [c1, c2, c3, c4, c5, 'A', 'A', 'A']) + doDec acc s@(c1:c2:c3:c4:c5:c6:c7:'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 4 bs) cs) + (dec8 [c1, c2, c3, c4, c5, c6, c7, 'A']) + doDec acc s@(c1:c2:c3:c4:c5:c6:c7:c8:cs) = maybe + (DFail acc s) + (\ bs -> doDec (acc ++ bs) cs) + (dec8 [c1, c2, c3, c4, c5, c6, c7, c8]) + doDec acc s = DPart acc (dI s) + +-- | Decode data. +decode :: String + -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +-- +-- See 'Base32.chop' in "Base32" for more details. +chop :: Int -- ^ length of individual lines + -> String + -> [String] +chop = Base32.chop + +-- {{{1 unchop +-- | Concatenate the strings into one long string. +-- +-- See 'Base32.unchop' in "Codec.Binary.Base32" for more details. +unchop :: [String] + -> String +unchop = Base32.unchop diff --git a/src/Codec/Binary/Base64.hs b/src/Codec/Binary/Base64.hs new file mode 100644 index 0000000..faab640 --- /dev/null +++ b/src/Codec/Binary/Base64.hs @@ -0,0 +1,145 @@ +-- | +-- Module : Codec.Binary.Base64 +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Implemented as specified in RFC 4648 +-- (). +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Base64 + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Control.Monad +import Data.Array +import Data.Bits +import Data.Maybe +import Data.Word +import qualified Data.Map as M + +-- {{{1 enc/dec map +_encMap = + [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E') + , (5, 'F') , (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J') + , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O') + , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T') + , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y') + , (25, 'Z'), (26, 'a'), (27, 'b'), (28, 'c'), (29, 'd') + , (30, 'e'), (31, 'f'), (32, 'g'), (33, 'h'), (34, 'i') + , (35, 'j'), (36, 'k'), (37, 'l'), (38, 'm'), (39, 'n') + , (40, 'o'), (41, 'p'), (42, 'q'), (43, 'r'), (44, 's') + , (45, 't'), (46, 'u'), (47, 'v'), (48, 'w'), (49, 'x') + , (50, 'y'), (51, 'z'), (52, '0'), (53, '1'), (54, '2') + , (55, '3'), (56, '4'), (57, '5'), (58, '6'), (59, '7') + , (60, '8'), (61, '9'), (62, '+'), (63, '/') ] + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (0, 64) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI [] e + where + enc3 [o1, o2, o3] = cs + where + i1 = o1 `shiftR` 2 + i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f + i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f + i4 = o3 .&. 0x3f + cs = map (encodeArray !) [i1, i2, i3, i4] + + eI [] EDone = EFinal [] + eI [o1] EDone = EFinal (take 2 cs ++ "==") + where cs = enc3 [o1, 0, 0] + eI [o1, o2] EDone = EFinal (take 3 cs ++ "=") + where cs = enc3 [o1, o2, 0] + eI lo (EChunk bs) = doEnc [] (lo ++ bs) + where + doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os + doEnc acc os = EPart acc (eI os) + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec4 cs = let + ds = map (flip M.lookup decodeMap) cs + es@[e1, e2, e3, e4] = map fromJust ds + o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4 + o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2 + o3 = e3 `shiftL` 6 .|. e4 + allJust = and . map isJust + in if allJust ds + then Just [o1, o2, o3] + else Nothing + + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc s@(c1:c2:'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 1 bs) cs) + (dec4 [c1, c2, 'A', 'A']) + doDec acc s@(c1:c2:c3:'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 2 bs) cs) + (dec4 [c1, c2, c3, 'A']) + doDec acc s@(c1:c2:c3:c4:cs) = maybe + (DFail acc s) + (\ bs -> doDec (acc ++ bs) cs) + (dec4 [c1, c2, c3, c4]) + doDec acc s = DPart acc (dI s) + +-- | Decode data. +decode :: String -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +-- +-- The length given is rounded down to the nearest multiple of 4. +-- +-- /Notes:/ +-- +-- * PEM requires lines that are 64 characters long. +-- +-- * MIME requires lines that are at most 76 characters long. +chop :: Int -- ^ length of individual lines + -> String + -> [String] +chop n "" = [] +chop n s = let + enc_len | n < 4 = 4 + | otherwise = n `div` 4 * 4 + in take enc_len s : chop n (drop enc_len s) + +-- {{{1 unchop +-- | Concatenate the strings into one long string. +unchop :: [String] + -> String +unchop = foldr (++) "" diff --git a/src/Codec/Binary/Base64Url.hs b/src/Codec/Binary/Base64Url.hs new file mode 100644 index 0000000..7599670 --- /dev/null +++ b/src/Codec/Binary/Base64Url.hs @@ -0,0 +1,137 @@ +-- | +-- Module : Codec.Binary.Base64Url +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Implemented as specified in RFC 4648 (). +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Base64Url + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Data.Maybe +import Data.Word +import Data.Bits +import Data.Array +import qualified Data.Map as M + +import qualified Codec.Binary.Base64 as Base64 + +-- {{{1 enc/dec map +_encMap = + [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E') + , (5, 'F') , (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J') + , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O') + , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T') + , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y') + , (25, 'Z'), (26, 'a'), (27, 'b'), (28, 'c'), (29, 'd') + , (30, 'e'), (31, 'f'), (32, 'g'), (33, 'h'), (34, 'i') + , (35, 'j'), (36, 'k'), (37, 'l'), (38, 'm'), (39, 'n') + , (40, 'o'), (41, 'p'), (42, 'q'), (43, 'r'), (44, 's') + , (45, 't'), (46, 'u'), (47, 'v'), (48, 'w'), (49, 'x') + , (50, 'y'), (51, 'z'), (52, '0'), (53, '1'), (54, '2') + , (55, '3'), (56, '4'), (57, '5'), (58, '6'), (59, '7') + , (60, '8'), (61, '9'), (62, '-'), (63, '_') ] + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (0, 64) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI [] e + where + enc3 [o1, o2, o3] = cs + where + i1 = o1 `shiftR` 2 + i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f + i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f + i4 = o3 .&. 0x3f + cs = map (encodeArray !) [i1, i2, i3, i4] + + eI [] EDone = EFinal [] + eI [o1] EDone = EFinal (take 2 cs ++ "==") + where cs = enc3 [o1, 0, 0] + eI [o1, o2] EDone = EFinal (take 3 cs ++ "=") + where cs = enc3 [o1, o2, 0] + eI lo (EChunk bs) = doEnc [] (lo ++ bs) + where + doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os + doEnc acc os = EPart acc (eI os) + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental encoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec4 cs = let + ds = map (flip M.lookup decodeMap) cs + es@[e1, e2, e3, e4] = map fromJust ds + o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4 + o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2 + o3 = e3 `shiftL` 6 .|. e4 + allJust = and . map isJust + in if allJust ds + then Just [o1, o2, o3] + else Nothing + + dI [] (DDone) = DFinal [] [] + dI lo (DDone) = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc s@(c1:c2:'=':'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 1 bs) cs) + (dec4 [c1, c2, 'A', 'A']) + doDec acc s@(c1:c2:c3:'=':cs) = maybe + (DFail acc s) + (\ bs -> DFinal (acc ++ take 2 bs) cs) + (dec4 [c1, c2, c3, 'A']) + doDec acc s@(c1:c2:c3:c4:cs) = maybe + (DFail acc s) + (\ bs -> doDec (acc ++ bs) cs) + (dec4 [c1, c2, c3, c4]) + doDec acc s = DPart acc (dI s) + +-- | Decode data. +decode :: String -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +-- +-- See 'Base64.chop' in "Base64" for more details. +chop :: Int -- ^ length of individual lines + -> String + -> [String] +chop = Base64.chop + +-- {{{1 unchop +-- | Concatenate the strings into one long string. +-- +-- See 'Base64.unchop' in "Codec.Binary.Base64" for more details. +unchop :: [String] + -> String +unchop = Base64.unchop diff --git a/src/Codec/Binary/Base85.hs b/src/Codec/Binary/Base85.hs new file mode 100644 index 0000000..4aab150 --- /dev/null +++ b/src/Codec/Binary/Base85.hs @@ -0,0 +1,142 @@ +-- | +-- Module : Codec.Binary.Base85 +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Implemented as described at . +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Base85 + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Data.Array +import Data.Bits +import Data.Char +import Data.Maybe +import Data.Word +import qualified Data.Map as M + +-- {{{1 enc/dec map +_encMap :: [(Word8, Char)] +_encMap = [(fromIntegral i, chr i) | i <- [33..117]] + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (33, 117) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI [] e + where + enc4 [0, 0, 0, 0] = "z" + enc4 [0x20, 0x20, 0x20, 0x20] = "y" + enc4 os@[o1, o2, o3, o4] = map (encodeArray !) group + where + group2Word32 = foldl (\ a b -> a `shiftL` 8 + fromIntegral b) 0 os + encodeWord32ToWord8s :: Word32 -> [Word8] + encodeWord32ToWord8s = + map (fromIntegral . (`mod` 85)) . take 5 . iterate (`div` 85) + adjustNReverse = reverse . map (+ 33) + group = (adjustNReverse .encodeWord32ToWord8s) group2Word32 + + eI [] EDone = EFinal [] + eI [o1] EDone = EFinal (take 2 cs) + where + cs = enc4 [o1, 0, 0, 1] + eI [o1, o2] EDone = EFinal (take 3 cs) + where + cs = enc4 [o1, o2, 0, 1] + eI [o1, o2, o3] EDone = EFinal (take 4 cs) + where + cs = enc4 [o1, o2, o3, 1] + eI lo (EChunk bs) = doEnc [] (lo ++ bs) + where + doEnc acc (o1:o2:o3:o4:os) = doEnc (acc ++ enc4 [o1, o2, o3, o4]) os + doEnc acc os = EPart acc (eI os) + +-- | Encode data. +-- +-- The result will not be enclosed in \<~ ~\>. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec5 cs = let + ds = map (flip M.lookup decodeMap) cs + es@[e1, e2, e3, e4, e5] = map fromJust ds + adjRev = map (\ i -> i - 33) [e5, e4, e3, e2, e1] + group2Word32 = foldl1 (+) . zipWith (*) (map (85 ^) [0..4]) . map fromIntegral + word32ToGroup :: Word32 -> [Word8] + word32ToGroup = map fromIntegral . reverse . take 4 . iterate (`div` 256) + allJust = and . map isJust + in if allJust ds + then Just $ word32ToGroup $ group2Word32 adjRev + else Nothing + + dI lo (DChunk s) = doDec [] (lo ++ s) + dI [] DDone = DFinal [] [] + dI cs@[c1, c2] DDone = case doDec [] (cs ++ "uuu") of + (DPart r _) -> DFinal (take 1 r) [] + f -> f + dI cs@[c1, c2, c3] DDone = case doDec [] (cs ++ "uu") of + (DPart r _) -> DFinal (take 2 r) [] + f -> f + dI cs@[c1, c2, c3, c4] DDone = case doDec [] (cs ++ "u") of + (DPart r _) -> DFinal (take 3 r) [] + f -> f + dI lo DDone = DFail [] lo + + doDec acc ('z':cs) = doDec (acc ++ [0, 0, 0, 0]) cs + doDec acc ('y':cs) = doDec (acc ++ [0x20, 0x20, 0x20, 0x20]) cs + doDec acc s@(c1:c2:c3:c4:c5:cs) = maybe + (DFail acc s) + (\ bs -> doDec (acc ++ bs) cs) + (dec5 [c1, c2, c3, c4, c5]) + doDec acc cs = DPart acc (dI cs) + +-- | Decode data. +-- +-- The input must not be enclosed in \<~ ~\>. +decode :: String -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +-- +-- The length given is rounded down to the nearest multiple of 5. +chop :: Int -- ^ length of individual lines + -> String + -> [String] +chop _ "" = [] +chop n s = let + enc_len | n < 5 = 5 + | otherwise = n `div` 5 * 5 + in take enc_len s : chop n (drop enc_len s) + +-- {{{1 unchop +-- | Concatenate the strings into one long string. +unchop :: [String] + -> String +unchop = foldr (++) "" diff --git a/src/Codec/Binary/DataEncoding.hs b/src/Codec/Binary/DataEncoding.hs new file mode 100644 index 0000000..1be49c8 --- /dev/null +++ b/src/Codec/Binary/DataEncoding.hs @@ -0,0 +1,174 @@ +-- | +-- Module : Codec.Binary.DataEncoding +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- This module exposes several instances of 'DataCodec', one for each data +-- encoding implemented in the library without causing the name clashing that +-- would result from importing the individual encoding modules. +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.DataEncoding + ( DataCodec + , base16 + , base32 + , base32Hex + , base64 + , base64Url + , base85 + , chop + , decode + , encode + , py + , qp + , unchop + , url + , uu + , xx + ) + where + +import Data.Word + +import qualified Codec.Binary.Base16 as Base16 +import qualified Codec.Binary.Base32 as Base32 +import qualified Codec.Binary.Base32Hex as Base32Hex +import qualified Codec.Binary.Base64 as Base64 +import qualified Codec.Binary.Base64Url as Base64Url +import qualified Codec.Binary.Base85 as Base85 +import qualified Codec.Binary.Url as Url +import qualified Codec.Binary.Uu as Uu +import qualified Codec.Binary.Xx as Xx +import qualified Codec.Binary.QuotedPrintable as QP +import qualified Codec.Binary.PythonString as Py + +-- {{{1 DataCodec +-- | Used to group a specific data encoding's functions. +data DataCodec = DataCodec { + encode :: [Word8] -> String, + decode :: String -> Maybe [Word8], + chop :: Int -> String -> [String], + unchop :: [String] -> String +} + +-- {{{1 base16 +-- | Base16 encoding, see "Codec.Binary.Base16" for more details on +-- the individual functions. +base16 :: DataCodec +base16 = DataCodec { + encode=Base16.encode, + decode=Base16.decode, + chop=Base16.chop, + unchop=Base16.unchop +} + +-- {{{1 base32 +-- | Base32 encoding, see "Codec.Binary.Base32" for more details on +-- the individual functions. +base32 :: DataCodec +base32 = DataCodec { + encode=Base32.encode, + decode=Base32.decode, + chop=Base32.chop, + unchop=Base32.unchop +} + +-- {{{1 base32Hex +-- | Base32Hex encoding, see "Codec.Binary.Base32Hex" for more details +-- on the individual functions. +base32Hex :: DataCodec +base32Hex = DataCodec { + encode=Base32Hex.encode, + decode=Base32Hex.decode, + chop=Base32Hex.chop, + unchop=Base32Hex.unchop +} + +-- {{{1 base64 +-- | Base64 encoding, see "Codec.Binary.Base64" for more details on +-- the individual functions. +base64 :: DataCodec +base64 = DataCodec { + encode=Base64.encode, + decode=Base64.decode, + chop=Base64.chop, + unchop=Base64.unchop +} + +-- {{{1 base64Url +-- | Base64Url encoding, see "Codec.Binary.Base64Url" for more details +-- on the individual functions. +base64Url :: DataCodec +base64Url = DataCodec { + encode=Base64Url.encode, + decode=Base64Url.decode, + chop=Base64Url.chop, + unchop=Base64Url.unchop +} + +-- {{{1 base85 +-- | Base85 encoding, see "Codec.Binary.Base85" for more details +-- on the individual functions. +base85 :: DataCodec +base85 = DataCodec { + encode=Base85.encode, + decode=Base85.decode, + chop=Base85.chop, + unchop=Base85.unchop +} + +-- {{{1 uu +-- | Uuencoding, see "Codec.Binary.Uu" for more details on the +-- individual functions. +uu :: DataCodec +uu = DataCodec { + encode=Uu.encode, + decode=Uu.decode, + chop=Uu.chop, + unchop=Uu.unchop +} + +-- {{{1 xx +-- | Xxencoding, see "Codec.Binary.Xx" for more details on the +-- individual functions. +xx :: DataCodec +xx = DataCodec { + encode=Xx.encode, + decode=Xx.decode, + chop=Xx.chop, + unchop=Xx.unchop +} + +-- {{{1 quoted-printable +-- | Quoted-printable, see "Codec.Binary.QuotedPrintable" for more details on +-- the individual functions. +qp :: DataCodec +qp = DataCodec + { encode = QP.encode + , decode = QP.decode + , chop = QP.chop + , unchop = QP.unchop + } + +-- {{{1 python string +-- | Quoted-printable, see "Codec.Binary.PythonString" for more details on +-- the individual functions. +py :: DataCodec +py = DataCodec + { encode = Py.encode + , decode = Py.decode + , chop = Py.chop + , unchop = Py.unchop + } + +-- {{{1 url encoding +-- | URL encoding, see "Codec.Binary.Url" for more details on the individual +-- functions. +url :: DataCodec +url = DataCodec + { encode = Url.encode + , decode = Url.decode + , chop = Url.chop + , unchop = Url.unchop + } diff --git a/src/Codec/Binary/PythonString.hs b/src/Codec/Binary/PythonString.hs new file mode 100644 index 0000000..eae4c51 --- /dev/null +++ b/src/Codec/Binary/PythonString.hs @@ -0,0 +1,109 @@ +-- | +-- Module : Codec.Binary.PythonString +-- Copyright : (c) 2009 Magnus Therning +-- License : BSD3 +-- +-- Implementation of python escaping. +-- +-- This implementation encodes non-printable characters (0x00-0x1f, 0x7f-0xff) +-- to hex-value characters ('\xhh') while leaving printable characters as such: +-- +-- @ +-- \> encode [0, 10, 13, 110] +-- \"\\\\x00\\\\x0A\\\\x0Dn\" +-- \> putStrLn $ encode [0, 10, 13, 110] +-- \\x00\\x0A\\x0Dn +-- @ +-- +-- It also properly handles escaping of a few characters that require it: +-- +-- @ +-- \> encode [34, 39, 92] +-- \"\\\\\\\"\\\\\'\\\\\\\\\" +-- putStrLn $ encode [34, 39, 92] +-- \\\"\\'\\\\ +-- @ +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.PythonString + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Data.Char +import Data.Maybe +import Data.Word + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI e + where + enc [] = [] + enc (o:os) + | o < 0x20 || o > 0x7e = ('\\' : 'x' : toHex o) ++ enc os + | o == 34 = "\\\"" ++ enc os + | o == 39 = "\\'" ++ enc os + | o == 92 = "\\\\" ++ enc os + | otherwise = chr (fromIntegral o) : enc os + + eI EDone = EFinal [] + eI (EChunk bs) = EPart (enc bs) encodeInc + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc [] = DPart acc (dI []) + doDec acc s'@('\\':'x':c0:c1:cs) = let + o = fromHex [c0, c1] + in if isJust o + then doDec (acc ++ [fromJust o]) cs + else DFail acc s' + doDec acc s'@('\\':'\\':cs) = doDec (acc ++ [fromIntegral $ ord '\\']) cs + doDec acc s'@('\\':'\'':cs) = doDec (acc ++ [fromIntegral $ ord '\'']) cs + doDec acc s'@('\\':'\"':cs) = doDec (acc ++ [fromIntegral $ ord '\"']) cs + doDec acc s'@(c:cs) + | c /= '\\' = doDec (acc ++ [fromIntegral $ ord c]) cs + | otherwise = DPart acc (dI s') + +-- | Decode data. +decode :: String -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +chop :: Int -- ^ length of individual lines (values @\< 1@ are ignored) + -> String + -> [String] +chop n = let + _n = max 1 n + _chop [] = [] + _chop cs = take _n cs : _chop (drop _n cs) + in _chop + +-- {{{1 unchop +-- | Concatenate the list of strings into one long string. +unchop :: [String] + -> String +unchop = foldr (++) "" diff --git a/src/Codec/Binary/QuotedPrintable.hs b/src/Codec/Binary/QuotedPrintable.hs new file mode 100644 index 0000000..c953209 --- /dev/null +++ b/src/Codec/Binary/QuotedPrintable.hs @@ -0,0 +1,101 @@ +-- | +-- Module : Codec.Binary.QuotedPrintable +-- Copyright : (c) 2009 Magnus Therning +-- License : BSD3 +-- +-- Implementation of Quoted-Printable based on RFC 2045 +-- (). +-- +-- This encoding encodes _everything_ that is passed in, it will not try to +-- guess the native line ending for your architecture. In other words, if you +-- are using this to encode text you need to split it into separate lines +-- before encoding and chopping it up. +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.QuotedPrintable + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Data.Char +import Data.Maybe +import Data.Word + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI e + where + enc [] = [] + enc (o:os) + | o < 33 || o == 61 || o > 126 = ('=' : toHex o) ++ enc os + | otherwise = chr (fromIntegral o) : enc os + + eI EDone = EFinal [] + eI (EChunk bs) = EPart (enc bs) encodeInc + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc [] = DPart acc (dI []) + doDec acc s'@('=':c0:c1:cs) = let + o = fromHex [c0, c1] + in if isJust o + then doDec (acc ++ [fromJust o]) cs + else DFail acc s' + doDec acc s'@(c:cs) + | c /= '=' = doDec (acc ++ [fromIntegral $ ord c]) cs + | otherwise = DPart acc (dI s') + +-- | Decode data. +decode :: String -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +chop :: Int -- ^ length of individual lines (values @\< 4@ are ignored) + -> String + -> [String] +chop n "" = [] +chop n s = let + n' = max 3 $ n - 1 + _c i ts "" acc = ts : acc + _c i ts tss@('=' : tss') acc + | i + 2 < n' = _c (i + 1) ('=' : ts) tss' acc + | otherwise = _c 0 "" tss (('=' : ts) : acc) + _c i ts tss@(c : tss') acc + | i < n' = _c (i + 1) (c : ts) tss' acc + | otherwise = _c 0 "" tss (('=' : ts) : acc) + in map reverse . reverse $ _c 0 "" s [] + +-- {{{1 unchop +-- | Concatenate the list of strings into one long string. +unchop :: [String] -> String +unchop [] = "" +unchop (s : ss) = let + dropLast = last s == '=' + len = length s + in if dropLast + then take (len - 1) s ++ unchop ss + else s ++ unchop ss diff --git a/src/Codec/Binary/Url.hs b/src/Codec/Binary/Url.hs new file mode 100644 index 0000000..b2c57ee --- /dev/null +++ b/src/Codec/Binary/Url.hs @@ -0,0 +1,100 @@ +-- | +-- Module : Codec.Binary.Url +-- Copyright : (c) 2009 Magnus Therning +-- License : BSD3 +-- +-- URL encoding, sometimes referred to as URI encoding or percent encoding. +-- Implemented based on RFC 3986 (). +-- +-- Further documentation and information can be found at +-- . + +module Codec.Binary.Url + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData + , DecIncRes + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import qualified Data.Map as M +import Data.Char(ord) +import Data.Word(Word8) +import Data.Maybe(isJust, fromJust) + +-- {{{1 enc/dec map +_unreservedChars = zip [65..90] "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + ++ zip [97..122] "abcdefghijklmnopqrstuvwxyz" + ++ zip [48..57] "0123456789" + ++ [(45, '-'), (95, '_'), (46, '.'), (126, '~')] + +encodeMap :: M.Map Word8 Char +encodeMap = M.fromList _unreservedChars + +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(b, a) | (a, b) <- _unreservedChars] + +-- {{{1 encode +-- | Incremental decoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI e + where + enc [] = [] + enc (o : os) = case (M.lookup o encodeMap) of + Just c -> c : enc os + Nothing -> ('%' : toHex o) ++ enc os + + eI EDone = EFinal [] + eI (EChunk bs) = EPart (enc bs) encodeInc + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc [] = DPart acc (dI []) + doDec acc s'@('%':c0:c1:cs) = let + o = fromHex [c0, c1] + in if isJust o + then doDec (acc ++ [fromJust o]) cs + else DFail acc s' + doDec acc s'@(c:cs) + | c /= '%' = doDec (acc ++ [fromIntegral $ ord c]) cs + | otherwise = DPart acc (dI s') + +-- | Decode data. +decode :: String + -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +chop :: Int -- ^ length of individual lines + -> String + -> [String] +chop n = let + _n = max 1 n + _chop [] = [] + _chop cs = take _n cs : _chop (drop _n cs) + in _chop + +-- {{{1 unchop +-- | Concatenate the strings into one long string +unchop :: [String] + -> String +unchop = foldr (++) "" diff --git a/src/Codec/Binary/Util.hs b/src/Codec/Binary/Util.hs new file mode 100644 index 0000000..feaad01 --- /dev/null +++ b/src/Codec/Binary/Util.hs @@ -0,0 +1,82 @@ +-- | +-- Module : Codec.Binary.Util +-- Copyright : (c) 2009 Magnus Therning +-- License : BSD3 +-- +-- Utility functions used in the other module. +module Codec.Binary.Util + ( toHex + , fromHex + , EncIncData(..) + , EncIncRes(..) + , DecIncData(..) + , DecIncRes(..) + , encoder + , decoder + ) where + +import Data.Array +import Data.Bits +import Data.Char +import Data.Word +import qualified Data.Map as M + +-- {{{1 hex enc/dec assoc list and maps +hexEncMap = zip [0..] "0123456789ABCDEF" + +hexEncodeArray :: Array Word8 Char +hexEncodeArray = array (0, 16) hexEncMap + +hexDecodeMap :: M.Map Char Word8 +hexDecodeMap = M.fromList [(b, a) | (a, b) <- hexEncMap] + +-- {{{1 toHex +toHex :: Word8 -> String +toHex o = let + hn = o `shiftR` 4 + ln = o .&. 0xf + in [hexEncodeArray ! hn, hexEncodeArray ! ln] + +-- {{{1 fromHex +fromHex :: String -> Maybe Word8 +fromHex = let + dec [Just hn, Just ln] = let + o = hn `shiftL` 4 .|. ln + in Just o + dec _ = Nothing + in dec . map (flip M.lookup hexDecodeMap . toUpper) + +-- {{{1 incremental coding +-- | Data type for the incremental encoding functions. +data EncIncData = EChunk [Word8] -- ^ a chunk of data to be encoded + | EDone -- ^ the signal to the encoder that the stream of data is ending + +-- | Data type for the result of calling the incremental encoding functions. +data EncIncRes i = EPart i (EncIncData -> EncIncRes i) -- ^ a partial result together with the continuation to use for further encoding + | EFinal i -- ^ the final result of encoding (the response to 'EDone') + +encoder f os = case f (EChunk os) of + EPart r1 f' -> case f' EDone of + EFinal r2 -> r1 ++ r2 + +-- | Data type for the incremental decoding functions. +data DecIncData i = DChunk i -- ^ a chunk of data to be decoded + | DDone -- ^ the signal to the decoder that the stream of data is ending + +-- | Data type for the result of calling the incremental encoding functions. +data DecIncRes i = DPart [Word8] (DecIncData i -> DecIncRes i) -- ^ a partial result together with the continuation to user for further decoding + | DFinal [Word8] i -- ^ the final result of decoding (the response to 'DDone') + | DFail [Word8] i -- ^ a partial result for a failed decoding, together with the remainder of the data passed in so far + +decoder :: (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8] +decoder f s = let + d = f (DChunk s) + in case d of + DFinal da _ -> Just da + DFail _ _ -> Nothing + DPart da f -> let + d' = f DDone + in case d' of + DFinal da' _ -> Just $ da ++ da' + DFail _ _ -> Nothing + DPart _ _ -> Nothing -- should never happen diff --git a/src/Codec/Binary/Uu.hs b/src/Codec/Binary/Uu.hs new file mode 100644 index 0000000..10d1b51 --- /dev/null +++ b/src/Codec/Binary/Uu.hs @@ -0,0 +1,148 @@ +-- | +-- Module : Codec.Binary.Uu +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Uuencoding is notoriously badly specified. This implementation is +-- compatible with the GNU Sharutils +-- (). +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Uu + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Control.Monad +import Data.Array +import Data.Bits +import Data.Maybe +import Data.Word +import qualified Data.Map as M + +-- {{{1 enc/dec map +_encMap = zip [0..] "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_" + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (0, 64) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI [] e + where + enc3 [o1, o2, o3] = map (encodeArray !) [i1, i2, i3, i4] + where + i1 = o1 `shiftR` 2 + i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f + i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f + i4 = o3 .&. 0x3f + + eI [] EDone = EFinal [] + eI [o1] EDone = EFinal $ take 2 $ enc3 [o1, 0, 0] + eI [o1, o2] EDone = EFinal $ take 3 $ enc3 [o1, o2, 0] + eI lo (EChunk bs) = doEnc [] (lo ++ bs) + where + doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os + doEnc acc os = EPart acc (eI os) + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec4 cs = let + ds = map (flip M.lookup decodeMap) cs + [e1, e2, e3, e4] = map fromJust ds + o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4 + o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2 + o3 = e3 `shiftL` 6 .|. e4 + allJust = and . map isJust + in if allJust ds + then Just [o1, o2, o3] + else Nothing + + dI [] DDone = DFinal [] [] + dI lo@[c1, c2] DDone = maybe + (DFail [] lo) + (\ bs -> DFinal (take 1 bs) []) + (dec4 [c1, c2, '`', '`']) + dI lo@[c1, c2, c3] DDone = maybe + (DFail [] lo) + (\ bs -> DFinal (take 2 bs) []) + (dec4 [c1, c2, c3, '`']) + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc s'@(c1:c2:c3:c4:cs) = maybe + (DFail acc s') + (\ bs -> doDec (acc ++ bs) cs) + (dec4 [c1, c2, c3, c4]) + doDec acc s' = DPart acc (dI s') + +-- | Decode data. +decode :: String -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. Each string in the resulting list is prepended +-- with the length according to the uuencode \"specificiation\". +-- +-- /Notes:/ +-- +-- * The length of the strings in the result will be @(n -1) `div` 4 * 4 + +-- 1@. The @-1@ comes from the need to prepend the length (which explains +-- the final @+1@). Keeping it to a multiple of 4 means that strings +-- returned from 'encode' can be chopped without requiring any changes. +-- +-- * The length of lines in GNU's sharutils is 61. +chop :: Int -- ^ length (value should be in the range @[5..85]@) + -> String + -> [String] +chop n "" = [] +chop n s = let + enc_len | n < 5 = 4 + | n >= 85 = 84 + | otherwise = (n - 1) `div` 4 * 4 + enc_line = take enc_len s + act_len = fromIntegral $ case (length enc_line `divMod` 4) of + (l, 0) -> l * 3 + (l, 2) -> l * 3 + 1 + (l, 3) -> l * 3 + 2 + len = (encodeArray ! act_len) + in (len : enc_line) : chop n (drop enc_len s) + +-- {{{1 unchop +-- | Concatenate the strings into one long string. Each string is assumed to +-- be prepended with the length according to the uuencode specification. +unchop :: [String] + -> String +unchop ss = let + singleUnchop (l : cs) = let + act_len = fromIntegral $ decodeMap M.! l + enc_len = case (act_len `divMod` 3) of + (n, 0) -> n * 4 + (n, 1) -> n * 4 + 2 + (n, 2) -> n * 4 + 3 + in take enc_len cs + in foldr ((++) . singleUnchop) "" ss diff --git a/src/Codec/Binary/Xx.hs b/src/Codec/Binary/Xx.hs new file mode 100644 index 0000000..875ac04 --- /dev/null +++ b/src/Codec/Binary/Xx.hs @@ -0,0 +1,149 @@ +-- | +-- Module : Codec.Binary.Xx +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Xxencoding is obsolete but still included for completeness. Further +-- information on the encoding can be found at +-- . It should be noted that this +-- implementation performs no padding, due to the splitting up between encoding +-- and chopping. +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Xx + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Control.Monad +import Data.Array +import Data.Bits +import Data.Maybe +import Data.Word +import qualified Data.Map as M + +-- {{{1 enc/dec map +_encMap = zip [0..] "+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + +-- {{{1 encodeArray +encodeArray :: Array Word8 Char +encodeArray = array (0, 64) _encMap + +-- {{{1 decodeMap +decodeMap :: M.Map Char Word8 +decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes String +encodeInc e = eI [] e + where + enc3 [o1, o2, o3] = map (encodeArray !) [i1, i2, i3, i4] + where + i1 = o1 `shiftR` 2 + i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f + i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f + i4 = o3 .&. 0x3f + + eI [] EDone = EFinal [] + eI [o1] EDone = EFinal $ take 2 $ enc3 [o1, 0, 0] + eI [o1, o2] EDone = EFinal $ take 3 $ enc3 [o1, o2, 0] + eI lo (EChunk bs) = doEnc [] (lo ++ bs) + where + doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os + doEnc acc os = EPart acc (eI os) + +-- | Encode data. +encode :: [Word8] -> String +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData String -> DecIncRes String +decodeInc d = dI [] d + where + dec4 cs = let + ds = map (flip M.lookup decodeMap) cs + [e1, e2, e3, e4] = map fromJust ds + o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4 + o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2 + o3 = e3 `shiftL` 6 .|. e4 + allJust = and . map isJust + in if allJust ds + then Just [o1, o2, o3] + else Nothing + + dI [] DDone = DFinal [] [] + dI lo@[c1, c2] DDone = maybe + (DFail [] lo) + (\ bs -> DFinal (take 1 bs) []) + (dec4 [c1, c2, '+', '+']) + dI lo@[c1, c2, c3] DDone = maybe + (DFail [] lo) + (\ bs -> DFinal (take 2 bs) []) + (dec4 [c1, c2, c3, '+']) + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc s'@(c1:c2:c3:c4:cs) = maybe + (DFail acc s') + (\ bs -> doDec (acc ++ bs) cs) + (dec4 [c1, c2, c3, c4]) + doDec acc s' = DPart acc (dI s') + +-- | Decode data. +decode :: String + -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. Each string in the resulting list is prepended +-- with the length according to the xxencode \"specificiation\". +-- +-- /Notes:/ +-- +-- * The length of the strings in the result will be @(n -1) `div` 4 * 4 + +-- 1@. The @-1@ comes from the need to prepend the length (which explains +-- the final @+1@). Keeping it to a multiple of 4 means that strings +-- returned from 'encode' can be chopped without requiring any changes. +chop :: Int -- ^ length (value should be in the range @[5..85]@) + -> String + -> [String] +chop n "" = [] +chop n s = let + enc_len | n < 5 = 4 + | n >= 85 = 84 + | otherwise = min 64 $ (n - 1) `div` 4 * 4 + enc_line = take enc_len s + act_len = fromIntegral $ case (length enc_line `divMod` 4) of + (l, 0) -> l * 3 + (l, 2) -> l * 3 + 1 + (l, 3) -> l * 3 + 2 + len = (encodeArray ! act_len) + in (len : enc_line) : chop n (drop enc_len s) + +-- {{{1 unchop +-- | Concatenate the strings into one long string. Each string is assumed to +-- be prepended with the length according to the xxencode specification. +unchop :: [String] + -> String +unchop ss = let + singleUnchop (l : cs) = let + act_len = fromIntegral $ decodeMap M.! l + enc_len = case (act_len `divMod` 3) of + (n, 0) -> n * 4 + (n, 1) -> n * 4 + 2 + (n, 2) -> n * 4 + 3 + in take enc_len cs + in foldr ((++) . singleUnchop) "" ss diff --git a/src/Codec/Binary/Yenc.hs b/src/Codec/Binary/Yenc.hs new file mode 100644 index 0000000..526d9fe --- /dev/null +++ b/src/Codec/Binary/Yenc.hs @@ -0,0 +1,83 @@ +-- | +-- Module : Codec.Binary.Yenc +-- Copyright : (c) 2007 Magnus Therning +-- License : BSD3 +-- +-- Implementation based on the specification found at +-- . +-- +-- Further documentation and information can be found at +-- . +module Codec.Binary.Yenc + ( EncIncData(..) + , EncIncRes(..) + , encodeInc + , encode + , DecIncData(..) + , DecIncRes(..) + , decodeInc + , decode + , chop + , unchop + ) where + +import Codec.Binary.Util + +import Data.Word + +_criticalsIn = [0xd6, 0xe0, 0xe3, 0x13] +_equal = 0x3d + +-- {{{1 encode +-- | Incremental encoder function. +encodeInc :: EncIncData -> EncIncRes [Word8] +encodeInc e = eI e + where + enc [] = [] + enc (o:os) + | o `elem` _criticalsIn = _equal : o + 106 : enc os + | otherwise = o + 42 : enc os + + eI EDone = EFinal [] + eI (EChunk bs) = EPart (enc bs) encodeInc + +-- | Encode data. +encode :: [Word8] -> [Word8] +encode = encoder encodeInc + +-- {{{1 decode +-- | Incremental decoder function. +decodeInc :: DecIncData [Word8] -> DecIncRes [Word8] +decodeInc d = dI [] d + where + dI [] DDone = DFinal [] [] + dI lo DDone = DFail [] lo + dI lo (DChunk s) = doDec [] (lo ++ s) + where + doDec acc (0x3d:d:ds) = doDec (acc ++ [d + 150]) ds + doDec acc (d:ds) = doDec (acc ++ [d + 214]) ds + doDec acc s' = DPart acc (dI s') + +-- | Decode data. +decode :: [Word8] -> Maybe [Word8] +decode = decoder decodeInc + +-- {{{1 chop +-- | Chop up a string in parts. +chop :: Int -- ^ length of individual lines + -> [Word8] + -> [[Word8]] +chop _ [] = [] +chop n ws = let + _n = max n 1 + (p1, p2) = splitAt _n ws + in + if last p1 == _equal + then (p1 ++ take 1 p2) : chop _n (drop 1 p2) + else p1 : chop _n p2 + +-- {{{1 unchop +-- | Concatenate the strings into one long string. +unchop :: [[Word8]] + -> [Word8] +unchop = concat diff --git a/test-src/DataencQC.hs b/test-src/DataencQC.hs new file mode 100644 index 0000000..d35c09c --- /dev/null +++ b/test-src/DataencQC.hs @@ -0,0 +1,137 @@ +{-# OPTIONS_GHC -XTemplateHaskell #-} + +{- + - Copyright : (c) 2007 Magnus Therning + - License : BSD3 + -} + +module DataencQC + where + +import Test.Framework.TH + +import Data.Maybe +import Data.Word +import Test.QuickCheck +import Test.Framework.Providers.QuickCheck2 + +import qualified Codec.Binary.Uu as Uu +import qualified Codec.Binary.Uu as Xx +import qualified Codec.Binary.Base85 as Base85 +import qualified Codec.Binary.Base64 as Base64 +import qualified Codec.Binary.Base64Url as Base64Url +import qualified Codec.Binary.Base32 as Base32 +import qualified Codec.Binary.Base32Hex as Base32Hex +import qualified Codec.Binary.Base16 as Base16 +import qualified Codec.Binary.Yenc as Yenc +import qualified Codec.Binary.QuotedPrintable as QP +import qualified Codec.Binary.PythonString as Py +import qualified Codec.Binary.Url as Url + +-- {{{1 uuencode properties +prop_uuEncode ws = ws == (fromJust . Uu.decode . Uu.encode) ws + where types = ws::[Word8] + +prop_uuChop n ws = s == (Uu.unchop . Uu.chop n) s + where + types = (n :: Int, ws::[Word8]) + s = Uu.encode ws + +prop_uuCombined n ws = ws == fromJust (Uu.decode $ Uu.unchop $ Uu.chop n $ Uu.encode ws) + where types = (n::Int, ws::[Word8]) + +-- {{{1 xxencode properties +prop_xxEncode ws = ws == (fromJust . Xx.decode . Xx.encode) ws + where types = ws::[Word8] + +prop_xxChop n ws = s == (Xx.unchop . Xx.chop n) s + where + types = (n:: Int, ws::[Word8]) + s = Xx.encode ws + +prop_xxCombined n ws = ws == fromJust (Xx.decode $ Xx.unchop $ Xx.chop n $ Xx.encode ws) + where types = (n::Int, ws::[Word8]) + +-- {{{1 base85 properties +prop_base85Encode ws = ws == fromJust (Base85.decode $ Base85.encode ws) + where types = ws::[Word8] + +prop_base85Chop n s = s == Base85.unchop (Base85.chop n s) + where types = (n::Int, s::String) + +-- {{{1 base64 properties +prop_base64Encode ws = ws == fromJust (Base64.decode $ Base64.encode ws) + where types = ws::[Word8] + +prop_base64Chop n s = s == Base64.unchop (Base64.chop n s) + where types = (n::Int, s::String) + +-- {{{1 base64url properties +prop_base64UrlEncode ws = ws == fromJust (Base64Url.decode $ Base64Url.encode ws) + where types = ws::[Word8] + +prop_base64UrlChop n s = s == Base64Url.unchop (Base64Url.chop n s) + where types = (n::Int, s::String) + +-- {{{1 base32 +prop_base32Encode ws = ws == fromJust (Base32.decode $ Base32.encode ws) + where types = ws::[Word8] + +prop_base32Chop n s = s == Base32.unchop (Base32.chop n s) + where types = (n::Int, s::String) + +-- {{{1 base32hex +prop_base32HexEncode ws = ws == fromJust (Base32Hex.decode $ Base32Hex.encode ws) + where types = ws::[Word8] + +prop_base32HexChop n s = s == Base32Hex.unchop (Base32Hex.chop n s) + where types = (n::Int, s::String) + +-- {{{1 base16 +prop_base16Encode ws = ws == fromJust (Base16.decode $ Base16.encode ws) + where types = ws::[Word8] + +prop_base16Chop n s = s == Base16.unchop (Base16.chop n s) + where types = (n::Int, s::String) + +-- {{{1 yEncoding +prop_yencEncode ws = ws == fromJust (Yenc.decode $ Yenc.encode ws) + where types = ws ::[Word8] + +prop_yencChop n ws = ws == Yenc.unchop (Yenc.chop n ws) + where types = (n::Int, ws :: [Word8]) + +-- {{{1 qp +prop_qpEncode ws = ws == fromJust (QP.decode $ QP.encode ws) + where types = ws :: [Word8] + +prop_qpChop n ws = s == (QP.unchop . QP.chop n) s + where + types = (n::Int, ws::[Word8]) + s = QP.encode ws + +prop_qpCombined n ws = ws == fromJust (QP.decode $ QP.unchop $ QP.chop n $ QP.encode ws) + where types = (n::Int, ws::[Word8]) + +-- {{{1 py +prop_pyEncode ws = ws == fromJust (Py.decode $ Py.encode ws) + where types = ws :: [Word8] + +prop_pyChop n s = s == Py.unchop (Py.chop n s) + where types = (n :: Int, s :: String) + +prop_pyCombined n ws = ws == fromJust (runAll ws) + where runAll = Py.decode . Py.unchop . Py.chop n . Py.encode + +-- {{{1 url +prop_urlEncode ws = ws == fromJust (Url.decode $ Url.encode ws) + where types = ws :: [Word8] + +prop_urlChop n s = s == Url.unchop (Url.chop n s) + where types = (n :: Int, s :: String) + +prop_urlCombined n ws = ws == fromJust (runAll ws) + where runAll = Url.decode . Url.unchop . Url.chop n . Url.encode + +-- {{{1 all the tests +allTests = $(testGroupGenerator) diff --git a/test-src/DataencUT.hs b/test-src/DataencUT.hs new file mode 100644 index 0000000..af91a0f --- /dev/null +++ b/test-src/DataencUT.hs @@ -0,0 +1,225 @@ +{-# OPTIONS_GHC -XTemplateHaskell #-} +{- + - Copyright : (c) 2007 Magnus Therning + - License : BSD3 + -} + +module DataencUT + where + +import Test.HUnit +import Control.Monad +import System.Exit +import Data.Maybe +import qualified Test.Framework.Providers.API as TFAPI +import Test.Framework.TH +import Test.Framework.Providers.HUnit + +import Codec.Binary.DataEncoding +import qualified Codec.Binary.Yenc as Yenc + +-- {{{1 checkAssertions +checkAssertions (suite, desc, enc, dec, codec) = do + enc @=? encode codec dec + dec @=? fromJust (decode codec enc) + +-- {{{1 uuencode tests +uuTestData = + [ ("uu", "empty", "", [], uu) + , ("uu", "\\0", "``", [0], uu) + , ("uu", "\\255", "_P", [255], uu) + , ("uu", "AA", "04$", [65, 65], uu) + , ("uu", "AAA", "04%!", [65, 65, 65], uu) + , ("uu", "AAAA", "04%!00", [65, 65, 65, 65], uu) + , ("uu", "Example", "17AA;7!L90", [69,120,97,109,112,108,101], uu) + ] +case_uuTests = mapM_ checkAssertions uuTestData + +case_uuTests2 = do + "EI2" @=? unchop uu (chop uu 1 "EI2") + "EI3-" @=? unchop uu (chop uu 1 "EI3-") + "EI3-EE" @=? unchop uu (chop uu 1 "EI3-EE") + [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 1 $ encode uu [0..255]) + [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 61 $ encode uu [0..255]) + [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 100 $ encode uu [0..255]) + +case_uuTestsFail = do + Nothing @=? decode uu "A" + Nothing @=? decode uu "aa" + +-- {{{1 xxencode tests +xxTestData = + [ ("xx", "empty", "", [], xx) + , ("xx", "\\0", "++", [0], xx) + , ("xx", "\\255", "zk", [255], xx) + , ("xx", "AA", "EI2", [65, 65], xx) + , ("xx", "AAA", "EI3-", [65, 65, 65], xx) + , ("xx", "AAAA", "EI3-EE", [65, 65, 65, 65], xx) + , ("xx", "Example", "FLVVPL-gNE", [69,120,97,109,112,108,101], xx) + ] +case_xxTest = mapM_ checkAssertions xxTestData + +case_xxTests2 = do + "EI2" @=? unchop xx (chop xx 1 "EI2") + "EI3-" @=? unchop xx (chop xx 1 "EI3-") + "EI3-EE" @=? unchop xx (chop xx 1 "EI3-EE") + [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 1 $ encode xx [0..255]) + [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 61 $ encode xx [0..255]) + [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 100 $ encode xx [0..255]) + +case_xxTestsFail = do + Nothing @=? decode xx "A" + Nothing @=? decode xx "''" + +-- {{{1 base85 tests +base85TestData = + [ ("base85", "empty", "", [], base85) + , ("base85", "f", "Ac", [102], base85) + , ("base85", "fo", "Ao@", [102,111], base85) + , ("base85", "foo", "AoDS", [102,111,111], base85) + , ("base85", "foob", "AoDTs", [102,111,111,98], base85) + , ("base85", "fooba", "AoDTs@/", [102,111,111,98,97], base85) + , ("base85", "foobar", "AoDTs@<)", [102,111,111,98,97,114], base85) + , ("base85", "\0", "!!", [0], base85) + , ("base85", "foob\0\0\0\0ar", "AoDTszEW", [102,111,111,98,0,0,0,0,114], base85) + , ("base85", "Example", "7<0x1f><0x20><0x7e><0x7f><0xff>", "\\x00\\x1F ~\\x7F\\xFF", [0x00, 0x1f, 0x20, 0x7e, 0x7f, 0xff], py) + , ("py", "\"\'\\", "\\\"\\'\\\\", [34, 39, 92], py) + ] +case_pyTests = mapM_ checkAssertions pyTestData + +case_pyTestsFail = do + Nothing @=? decode py "\\z" + +-- {{{1 url encoding +urlTestData = + [ ("url", "empty", "", [], url) + , ("url", "aA", "aA", [97, 65], url) + , ("url", "~ ", "~%20", [126, 0x20], url) + ] +case_urlTests = mapM_ checkAssertions urlTestData + +case_urlTestsFail = do + Nothing @=? decode url "%ga" + Nothing @=? decode url "%%" + +-- {{{1 all the tests +allTests = $(testGroupGenerator) diff --git a/test-src/Test.hs b/test-src/Test.hs new file mode 100644 index 0000000..2155bdf --- /dev/null +++ b/test-src/Test.hs @@ -0,0 +1,16 @@ +{- + - Copyright : (c) 2009 Magnus Therning + - License : BSD3 + -} + +module Main + where + +import Test.Framework + +import qualified DataencQC as DQC +import qualified DataencUT as DUT + +tests = [ DQC.allTests , DUT.allTests ] + +main = defaultMain tests -- cgit v1.2.3