summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2016-04-26 08:56:21 -0400
committerAndrew Cady <d@jerkface.net>2016-04-26 08:57:11 -0400
commitf5fb4f27b4e9cecdc3afc2facc8e39717ea20524 (patch)
treec0ba039c0fb8eadfb4c22d9b370df997ff81aa19
Initial commitHEADmaster
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'
Diffstat
-rw-r--r--.gitignore1
-rw-r--r--GNUmakefile32
-rw-r--r--LICENSE27
-rw-r--r--Setup.hs22
-rw-r--r--dataenc.cabal51
-rw-r--r--src/Codec/Binary/Base16.hs102
-rw-r--r--src/Codec/Binary/Base32.hs155
-rw-r--r--src/Codec/Binary/Base32Hex.hs155
-rw-r--r--src/Codec/Binary/Base64.hs145
-rw-r--r--src/Codec/Binary/Base64Url.hs137
-rw-r--r--src/Codec/Binary/Base85.hs142
-rw-r--r--src/Codec/Binary/DataEncoding.hs174
-rw-r--r--src/Codec/Binary/PythonString.hs109
-rw-r--r--src/Codec/Binary/QuotedPrintable.hs101
-rw-r--r--src/Codec/Binary/Url.hs100
-rw-r--r--src/Codec/Binary/Util.hs82
-rw-r--r--src/Codec/Binary/Uu.hs148
-rw-r--r--src/Codec/Binary/Xx.hs149
-rw-r--r--src/Codec/Binary/Yenc.hs83
-rw-r--r--test-src/DataencQC.hs137
-rw-r--r--test-src/DataencUT.hs225
-rw-r--r--test-src/Test.hs16
22 files changed, 2293 insertions, 0 deletions
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 @@
1# Simple makefile for _running_ tests, use Cabal to build.
2
3.PHONY: all clean markup report test really-clean
4
5TESTS = dist/build/tests/tests
6
7HPC = hpc
8HPC_SUM_OPTS = --exclude=Main --exclude=DataencUT --exclude=DataencQC
9
10all:
11 @echo "Use Cabal to build, this is only used to run tests!"
12
13test: $(TESTS)
14 for t in $(TESTS); do ./$${t}; done
15
16report : test
17 $(HPC) sum $(HPC_SUM_OPTS) --output run_test.tix tests.tix
18 $(HPC) report run_test.tix
19
20markup : test
21 $(HPC) sum $(HPC_SUM_OPTS) --output run_test.tix tests.tix
22 $(HPC) markup run_test.tix
23
24clean:
25 rm -f *~ *.tix *.html *.o *.hi
26 rm -f src/Codec/Binary/*.o
27 rm -f src/Codec/Binary/*.hi
28 rm -f src/Codec/Binary/*~
29
30really-clean: clean
31 rm -rf .hpc
32 ./Setup.hs clean
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..817412c
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
1Copyright (c) 2007, Magnus Therning
2All rights reserved.
3
4Redistribution and use in source and binary forms, with or without
5modification, are permitted provided that the following conditions are met:
6
7 - Redistributions of source code must retain the above copyright notice,
8 this list of conditions and the following disclaimer.
9
10 - Redistributions in binary form must reproduce the above copyright notice,
11 this list of conditions and the following disclaimer in the documentation
12 and/or other materials provided with the distribution.
13
14 - Neither the name of the <ORGANIZATION> nor the names of its contributors
15 may be used to endorse or promote products derived from this software
16 without specific prior written permission.
17
18THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
19ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
21DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
22ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
23(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
24LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
25ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
26(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27SOFTWARE, 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 @@
1#! /usr/bin/env runhaskell
2
3{- Copyright © 2007 Magnus Therning
4 -
5 - This file is part of dataenc.
6 -
7 - Dataenc is free software: you can redistribute it and/or modify it under
8 - the terms of the GNU Lesser General Public License as published by the
9 - Free Software Foundation, either version 3 of the License, or (at your
10 - option) any later version.
11 -
12 - Dataenc is distributed in the hope that it will be useful, but WITHOUT
13 - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
15 - License for more details.
16 -
17 - You should have received a copy of the GNU Lesser General Public License
18 - along with dataenc. If not, see <http://www.gnu.org/licenses/>
19 -}
20
21import Distribution.Simple
22main = 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 @@
1name: dataenc
2version: 0.14.0.7
3license: BSD3
4license-file: LICENSE
5cabal-version: >= 1.6
6build-type: Simple
7author: Magnus Therning
8maintainer: Gracjan Polak <gracjanpolak@gmail.com>
9homepage: http://www.haskell.org/haskellwiki/Library/Data_encoding
10copyright: Magnus Therning, 2007-2012, Gracjan Polak, 2014
11category: Codec
12synopsis: Data encoding library
13description: Data encoding library currently providing Base16, Base32,
14 Base32Hex, Base64, Base64Url, Base85, Python string escaping,
15 Quoted-Printable, URL encoding, uuencode, xxencode, and yEncoding.
16extra-source-files: test-src/DataencUT.hs test-src/DataencQC.hs test-src/Test.hs GNUmakefile
17
18flag tests
19 Description: Build unit and quickcheck tests.
20 Default: False
21
22library
23 hs-source-dirs: src
24 build-depends: array, base >= 3.0.0, containers
25 exposed-modules:
26 Codec.Binary.Base16
27 Codec.Binary.Base32
28 Codec.Binary.Base32Hex
29 Codec.Binary.Base64
30 Codec.Binary.Base64Url
31 Codec.Binary.Base85
32 Codec.Binary.DataEncoding
33 Codec.Binary.PythonString
34 Codec.Binary.QuotedPrintable
35 Codec.Binary.Url
36 Codec.Binary.Uu
37 Codec.Binary.Xx
38 Codec.Binary.Yenc
39 other-modules:
40 Codec.Binary.Util
41
42executable tests
43 main-is: Test.hs
44 hs-source-dirs: test-src src
45 -- ghc-options: -fhpc
46 if flag(tests)
47 build-depends: test-framework, test-framework-hunit, HUnit,
48 test-framework-quickcheck2, QuickCheck ==2.5.*,
49 test-framework-th
50 else
51 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 @@
1-- |
2-- Module : Codec.Binary.Base16
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Implemented as specified in RFC 4648 (<http://tools.ietf.org/html/rfc4648>).
7--
8-- Further documentation and information can be found at
9-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
10module Codec.Binary.Base16
11 ( EncIncData(..)
12 , EncIncRes(..)
13 , encodeInc
14 , encode
15 , DecIncData(..)
16 , DecIncRes(..)
17 , decodeInc
18 , decode
19 , chop
20 , unchop
21 ) where
22
23import Codec.Binary.Util
24
25import Control.Monad
26import Data.Array
27import Data.Bits
28import Data.Maybe
29import Data.Word
30import qualified Data.Map as M
31
32-- {{{1 enc/dec map
33_encMap =
34 [ (0, '0'), (1, '1'), (2, '2'), (3, '3'), (4, '4')
35 , (5, '5'), (6, '6'), (7, '7'), (8, '8'), (9, '9')
36 , (10, 'A'), (11, 'B'), (12, 'C'), (13, 'D'), (14, 'E')
37 , (15, 'F') ]
38
39-- {{{1 encodeArray
40encodeArray :: Array Word8 Char
41encodeArray = array (0, 64) _encMap
42
43-- {{{1 decodeMap
44decodeMap :: M.Map Char Word8
45decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
46
47-- {{{1 encode
48-- | Incremental encoder function.
49encodeInc :: EncIncData -> EncIncRes String
50encodeInc EDone = EFinal []
51encodeInc (EChunk os) = EPart (concat $ map toHex os) encodeInc
52
53-- | Encode data.
54encode :: [Word8] -> String
55encode = encoder encodeInc
56
57-- {{{1 decode
58-- | Incremental decoder function.
59decodeInc :: DecIncData String -> DecIncRes String
60decodeInc d = dI [] d
61 where
62 dec2 cs = let
63 ds = map (flip M.lookup decodeMap) cs
64 es@[e1, e2] = map fromJust ds
65 o = e1 `shiftL` 4 .|. e2
66 allJust = and . map isJust
67 in if allJust ds
68 then Just o
69 else Nothing
70
71 dI [] DDone = DFinal [] []
72 dI lo DDone = DFail [] lo
73 dI lo (DChunk s) = doDec [] (lo ++ s)
74 where
75 doDec acc s'@(c1:c2:cs) = maybe
76 (DFail acc s')
77 (\ b -> doDec (acc ++ [b]) cs)
78 (dec2 [c1, c2])
79 doDec acc s = DPart acc (dI s)
80
81-- | Decode data.
82decode :: String -> Maybe [Word8]
83decode = decoder decodeInc
84
85-- {{{1 chop
86-- | Chop up a string in parts.
87--
88-- The length given is rounded down to the nearest multiple of 2.
89chop :: Int -- ^ length of individual lines
90 -> String
91 -> [String]
92chop n "" = []
93chop n s = let
94 enc_len | n < 2 = 2
95 | otherwise = n `div` 2 * 2
96 in take enc_len s : chop n (drop enc_len s)
97
98-- {{{1 unchop
99-- | Concatenate the strings into one long string.
100unchop :: [String]
101 -> String
102unchop = 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 @@
1-- |
2-- Module : Codec.Binary.Base32
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Implemented as specified in RFC 4648
7-- (<http://tools.ietf.org/html/rfc4648>).
8--
9-- Further documentation and information can be found at
10-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
11module Codec.Binary.Base32
12 ( EncIncData(..)
13 , EncIncRes(..)
14 , encodeInc
15 , encode
16 , DecIncData(..)
17 , DecIncRes(..)
18 , decodeInc
19 , decode
20 , chop
21 , unchop
22 ) where
23
24import Codec.Binary.Util
25
26import Control.Monad
27import Data.Array
28import Data.Bits
29import Data.Maybe
30import Data.Word
31import qualified Data.Map as M
32
33-- {{{1 enc/dec map
34_encMap =
35 [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E')
36 , (5, 'F'), (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J')
37 , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O')
38 , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T')
39 , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y')
40 , (25, 'Z'), (26, '2'), (27, '3'), (28, '4'), (29, '5')
41 , (30, '6'), (31, '7') ]
42
43-- {{{1 encodeArray
44encodeArray :: Array Word8 Char
45encodeArray = array (0, 32) _encMap
46
47-- {{{1 decodeMap
48decodeMap :: M.Map Char Word8
49decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
50
51-- {{{1 encode
52-- | Incremental encoder function.
53encodeInc :: EncIncData -> EncIncRes String
54encodeInc e = eI [] e
55 where
56 enc5 [o1, o2, o3, o4, o5] = map (encodeArray !) [i1, i2, i3, i4, i5, i6, i7, i8]
57 where
58 i1 = o1 `shiftR` 3
59 i2 = (o1 `shiftL` 2 .|. o2 `shiftR` 6) .&. 0x1f
60 i3 = o2 `shiftR` 1 .&. 0x1f
61 i4 = (o2 `shiftL` 4 .|. o3 `shiftR` 4) .&. 0x1f
62 i5 = (o3 `shiftL` 1 .|. o4 `shiftR` 7) .&. 0x1f
63 i6 = o4 `shiftR` 2 .&. 0x1f
64 i7 = (o4 `shiftL` 3 .|. o5 `shiftR` 5) .&. 0x1f
65 i8 = o5 .&. 0x1f
66
67 eI [] EDone = EFinal []
68 eI [o1] EDone = EFinal (take 2 cs ++ "======")
69 where
70 cs = enc5 [o1, 0, 0, 0, 0]
71 eI [o1, o2] EDone = EFinal (take 4 cs ++ "====")
72 where
73 cs = enc5 [o1, o2, 0, 0, 0]
74 eI [o1, o2, o3] EDone = EFinal (take 5 cs ++ "===")
75 where
76 cs = enc5 [o1, o2, o3, 0, 0]
77 eI [o1, o2, o3, o4] EDone = EFinal (take 7 cs ++ "=")
78 where
79 cs = enc5 [o1, o2, o3, o4, 0]
80 eI lo (EChunk bs) = doEnc [] (lo ++ bs)
81 where
82 doEnc acc (o1:o2:o3:o4:o5:os) = doEnc (acc ++ enc5 [o1, o2, o3, o4, o5]) os
83 doEnc acc os = EPart acc (eI os)
84
85-- | Encode data.
86encode :: [Word8] -> String
87encode = encoder encodeInc
88
89-- {{{1 decode
90-- | Incremental decoder function.
91decodeInc :: DecIncData String -> DecIncRes String
92decodeInc d = dI [] d
93 where
94 dec8 cs = let
95 ds = map (flip M.lookup decodeMap) cs
96 es@[e1, e2, e3, e4, e5, e6, e7, e8] = map fromJust ds
97 o1 = e1 `shiftL` 3 .|. e2 `shiftR` 2
98 o2 = e2 `shiftL` 6 .|. e3 `shiftL` 1 .|. e4 `shiftR` 4
99 o3 = e4 `shiftL` 4 .|. e5 `shiftR` 1
100 o4 = e5 `shiftL` 7 .|. e6 `shiftL` 2 .|. e7 `shiftR` 3
101 o5 = e7 `shiftL` 5 .|. e8
102 allJust = and . map isJust
103 in if allJust ds
104 then Just [o1, o2, o3, o4, o5]
105 else Nothing
106
107 dI [] DDone = DFinal [] []
108 dI lo DDone = DFail [] lo
109 dI lo (DChunk s) = doDec [] (lo ++ s)
110 where
111 doDec acc s@(c1:c2:'=':'=':'=':'=':'=':'=':cs) = maybe
112 (DFail acc s)
113 (\ bs -> DFinal (acc ++ take 1 bs) cs)
114 (dec8 [c1, c2, 'A', 'A', 'A', 'A', 'A', 'A'])
115 doDec acc s@(c1:c2:c3:c4:'=':'=':'=':'=':cs) = maybe
116 (DFail acc s)
117 (\ bs -> DFinal (acc ++ take 2 bs) cs)
118 (dec8 [c1, c2, c3, c4, 'A', 'A', 'A', 'A'])
119 doDec acc s@(c1:c2:c3:c4:c5:'=':'=':'=':cs) = maybe
120 (DFail acc s)
121 (\ bs -> DFinal (acc ++ take 3 bs) cs)
122 (dec8 [c1, c2, c3, c4, c5, 'A', 'A', 'A'])
123 doDec acc s@(c1:c2:c3:c4:c5:c6:c7:'=':cs) = maybe
124 (DFail acc s)
125 (\ bs -> DFinal (acc ++ take 4 bs) cs)
126 (dec8 [c1, c2, c3, c4, c5, c6, c7, 'A'])
127 doDec acc s@(c1:c2:c3:c4:c5:c6:c7:c8:cs) = maybe
128 (DFail acc s)
129 (\ bs -> doDec (acc ++ bs) cs)
130 (dec8 [c1, c2, c3, c4, c5, c6, c7, c8])
131 doDec acc s = DPart acc (dI s)
132
133-- | Decode data.
134decode :: String
135 -> Maybe [Word8]
136decode = decoder decodeInc
137
138-- {{{1 chop
139-- | Chop up a string in parts.
140--
141-- The length given is rounded down to the nearest multiple of 8.
142chop :: Int -- ^ length of individual lines
143 -> String
144 -> [String]
145chop n "" = []
146chop n s = let
147 enc_len | n < 8 = 8
148 | otherwise = n `div` 8 * 8
149 in take enc_len s : chop n (drop enc_len s)
150
151-- {{{1 unchop
152-- | Concatenate the strings into one long string.
153unchop :: [String]
154 -> String
155unchop = 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 @@
1-- |
2-- Module : Codec.Binary.Base32Hex
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Implemented as specified in RFC 4648
7-- (<http://tools.ietf.org/html/rfc4648>).
8--
9-- Further documentation and information can be found at
10-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
11module Codec.Binary.Base32Hex
12 ( EncIncData(..)
13 , EncIncRes(..)
14 , encodeInc
15 , encode
16 , DecIncData(..)
17 , DecIncRes(..)
18 , decodeInc
19 , decode
20 , chop
21 , unchop
22 ) where
23
24import Codec.Binary.Util
25
26import Control.Monad
27import Data.Array
28import Data.Bits
29import Data.Maybe
30import Data.Word
31import qualified Data.Map as M
32
33import qualified Codec.Binary.Base32 as Base32
34
35-- {{{1 enc/dec map
36_encMap =
37 [ (0, '0'), (1, '1'), (2, '2'), (3, '3'), (4, '4')
38 , (5, '5'), (6, '6'), (7, '7'), (8, '8'), (9, '9')
39 , (10, 'A'), (11, 'B'), (12, 'C'), (13, 'D'), (14, 'E')
40 , (15, 'F'), (16, 'G'), (17, 'H'), (18, 'I'), (19, 'J')
41 , (20, 'K'), (21, 'L'), (22, 'M'), (23, 'N'), (24, 'O')
42 , (25, 'P'), (26, 'Q'), (27, 'R'), (28, 'S'), (29, 'T')
43 , (30, 'U'), (31, 'V') ]
44
45-- {{{1 encodeArray
46encodeArray :: Array Word8 Char
47encodeArray = array (0, 32) _encMap
48
49-- {{{1 decodeMap
50decodeMap :: M.Map Char Word8
51decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
52
53-- {{{1 encode
54-- | Incremental encoder function.
55encodeInc :: EncIncData -> EncIncRes String
56encodeInc e = eI [] e
57 where
58 enc5 [o1, o2, o3, o4, o5] = map (encodeArray !) [i1, i2, i3, i4, i5, i6, i7, i8]
59 where
60 i1 = o1 `shiftR` 3
61 i2 = (o1 `shiftL` 2 .|. o2 `shiftR` 6) .&. 0x1f
62 i3 = o2 `shiftR` 1 .&. 0x1f
63 i4 = (o2 `shiftL` 4 .|. o3 `shiftR` 4) .&. 0x1f
64 i5 = (o3 `shiftL` 1 .|. o4 `shiftR` 7) .&. 0x1f
65 i6 = o4 `shiftR` 2 .&. 0x1f
66 i7 = (o4 `shiftL` 3 .|. o5 `shiftR` 5) .&. 0x1f
67 i8 = o5 .&. 0x1f
68
69 eI [] EDone = EFinal []
70 eI [o1] EDone = EFinal (take 2 cs ++ "======")
71 where
72 cs = enc5 [o1, 0, 0, 0, 0]
73 eI [o1, o2] EDone = EFinal (take 4 cs ++ "====")
74 where
75 cs = enc5 [o1, o2, 0, 0, 0]
76 eI [o1, o2, o3] EDone = EFinal (take 5 cs ++ "===")
77 where
78 cs = enc5 [o1, o2, o3, 0, 0]
79 eI [o1, o2, o3, o4] EDone = EFinal (take 7 cs ++ "=")
80 where
81 cs = enc5 [o1, o2, o3, o4, 0]
82 eI lo (EChunk bs) = doEnc [] (lo ++ bs)
83 where
84 doEnc acc (o1:o2:o3:o4:o5:os) = doEnc (acc ++ enc5 [o1, o2, o3, o4, o5]) os
85 doEnc acc os = EPart acc (eI os)
86
87-- | Encode data.
88encode :: [Word8] -> String
89encode = encoder encodeInc
90
91-- {{{1 decode
92-- | Incremental decoder function.
93decodeInc :: DecIncData String -> DecIncRes String
94decodeInc d = dI [] d
95 where
96 dec8 cs = let
97 ds = map (flip M.lookup decodeMap) cs
98 es@[e1, e2, e3, e4, e5, e6, e7, e8] = map fromJust ds
99 o1 = e1 `shiftL` 3 .|. e2 `shiftR` 2
100 o2 = e2 `shiftL` 6 .|. e3 `shiftL` 1 .|. e4 `shiftR` 4
101 o3 = e4 `shiftL` 4 .|. e5 `shiftR` 1
102 o4 = e5 `shiftL` 7 .|. e6 `shiftL` 2 .|. e7 `shiftR` 3
103 o5 = e7 `shiftL` 5 .|. e8
104 allJust = and . map isJust
105 in if allJust ds
106 then Just [o1, o2, o3, o4, o5]
107 else Nothing
108
109 dI [] DDone = DFinal [] []
110 dI lo DDone = DFail [] lo
111 dI lo (DChunk s) = doDec [] (lo ++ s)
112 where
113 doDec acc s@(c1:c2:'=':'=':'=':'=':'=':'=':cs) = maybe
114 (DFail acc s)
115 (\ bs -> DFinal (acc ++ take 1 bs) cs)
116 (dec8 [c1, c2, 'A', 'A', 'A', 'A', 'A', 'A'])
117 doDec acc s@(c1:c2:c3:c4:'=':'=':'=':'=':cs) = maybe
118 (DFail acc s)
119 (\ bs -> DFinal (acc ++ take 2 bs) cs)
120 (dec8 [c1, c2, c3, c4, 'A', 'A', 'A', 'A'])
121 doDec acc s@(c1:c2:c3:c4:c5:'=':'=':'=':cs) = maybe
122 (DFail acc s)
123 (\ bs -> DFinal (acc ++ take 3 bs) cs)
124 (dec8 [c1, c2, c3, c4, c5, 'A', 'A', 'A'])
125 doDec acc s@(c1:c2:c3:c4:c5:c6:c7:'=':cs) = maybe
126 (DFail acc s)
127 (\ bs -> DFinal (acc ++ take 4 bs) cs)
128 (dec8 [c1, c2, c3, c4, c5, c6, c7, 'A'])
129 doDec acc s@(c1:c2:c3:c4:c5:c6:c7:c8:cs) = maybe
130 (DFail acc s)
131 (\ bs -> doDec (acc ++ bs) cs)
132 (dec8 [c1, c2, c3, c4, c5, c6, c7, c8])
133 doDec acc s = DPart acc (dI s)
134
135-- | Decode data.
136decode :: String
137 -> Maybe [Word8]
138decode = decoder decodeInc
139
140-- {{{1 chop
141-- | Chop up a string in parts.
142--
143-- See 'Base32.chop' in "Base32" for more details.
144chop :: Int -- ^ length of individual lines
145 -> String
146 -> [String]
147chop = Base32.chop
148
149-- {{{1 unchop
150-- | Concatenate the strings into one long string.
151--
152-- See 'Base32.unchop' in "Codec.Binary.Base32" for more details.
153unchop :: [String]
154 -> String
155unchop = 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 @@
1-- |
2-- Module : Codec.Binary.Base64
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Implemented as specified in RFC 4648
7-- (<http://tools.ietf.org/html/rfc4648>).
8--
9-- Further documentation and information can be found at
10-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
11module Codec.Binary.Base64
12 ( EncIncData(..)
13 , EncIncRes(..)
14 , encodeInc
15 , encode
16 , DecIncData(..)
17 , DecIncRes(..)
18 , decodeInc
19 , decode
20 , chop
21 , unchop
22 ) where
23
24import Codec.Binary.Util
25
26import Control.Monad
27import Data.Array
28import Data.Bits
29import Data.Maybe
30import Data.Word
31import qualified Data.Map as M
32
33-- {{{1 enc/dec map
34_encMap =
35 [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E')
36 , (5, 'F') , (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J')
37 , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O')
38 , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T')
39 , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y')
40 , (25, 'Z'), (26, 'a'), (27, 'b'), (28, 'c'), (29, 'd')
41 , (30, 'e'), (31, 'f'), (32, 'g'), (33, 'h'), (34, 'i')
42 , (35, 'j'), (36, 'k'), (37, 'l'), (38, 'm'), (39, 'n')
43 , (40, 'o'), (41, 'p'), (42, 'q'), (43, 'r'), (44, 's')
44 , (45, 't'), (46, 'u'), (47, 'v'), (48, 'w'), (49, 'x')
45 , (50, 'y'), (51, 'z'), (52, '0'), (53, '1'), (54, '2')
46 , (55, '3'), (56, '4'), (57, '5'), (58, '6'), (59, '7')
47 , (60, '8'), (61, '9'), (62, '+'), (63, '/') ]
48
49-- {{{1 encodeArray
50encodeArray :: Array Word8 Char
51encodeArray = array (0, 64) _encMap
52
53-- {{{1 decodeMap
54decodeMap :: M.Map Char Word8
55decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
56
57-- {{{1 encode
58-- | Incremental encoder function.
59encodeInc :: EncIncData -> EncIncRes String
60encodeInc e = eI [] e
61 where
62 enc3 [o1, o2, o3] = cs
63 where
64 i1 = o1 `shiftR` 2
65 i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f
66 i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f
67 i4 = o3 .&. 0x3f
68 cs = map (encodeArray !) [i1, i2, i3, i4]
69
70 eI [] EDone = EFinal []
71 eI [o1] EDone = EFinal (take 2 cs ++ "==")
72 where cs = enc3 [o1, 0, 0]
73 eI [o1, o2] EDone = EFinal (take 3 cs ++ "=")
74 where cs = enc3 [o1, o2, 0]
75 eI lo (EChunk bs) = doEnc [] (lo ++ bs)
76 where
77 doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os
78 doEnc acc os = EPart acc (eI os)
79
80-- | Encode data.
81encode :: [Word8] -> String
82encode = encoder encodeInc
83
84-- {{{1 decode
85-- | Incremental decoder function.
86decodeInc :: DecIncData String -> DecIncRes String
87decodeInc d = dI [] d
88 where
89 dec4 cs = let
90 ds = map (flip M.lookup decodeMap) cs
91 es@[e1, e2, e3, e4] = map fromJust ds
92 o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4
93 o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2
94 o3 = e3 `shiftL` 6 .|. e4
95 allJust = and . map isJust
96 in if allJust ds
97 then Just [o1, o2, o3]
98 else Nothing
99
100 dI [] DDone = DFinal [] []
101 dI lo DDone = DFail [] lo
102 dI lo (DChunk s) = doDec [] (lo ++ s)
103 where
104 doDec acc s@(c1:c2:'=':'=':cs) = maybe
105 (DFail acc s)
106 (\ bs -> DFinal (acc ++ take 1 bs) cs)
107 (dec4 [c1, c2, 'A', 'A'])
108 doDec acc s@(c1:c2:c3:'=':cs) = maybe
109 (DFail acc s)
110 (\ bs -> DFinal (acc ++ take 2 bs) cs)
111 (dec4 [c1, c2, c3, 'A'])
112 doDec acc s@(c1:c2:c3:c4:cs) = maybe
113 (DFail acc s)
114 (\ bs -> doDec (acc ++ bs) cs)
115 (dec4 [c1, c2, c3, c4])
116 doDec acc s = DPart acc (dI s)
117
118-- | Decode data.
119decode :: String -> Maybe [Word8]
120decode = decoder decodeInc
121
122-- {{{1 chop
123-- | Chop up a string in parts.
124--
125-- The length given is rounded down to the nearest multiple of 4.
126--
127-- /Notes:/
128--
129-- * PEM requires lines that are 64 characters long.
130--
131-- * MIME requires lines that are at most 76 characters long.
132chop :: Int -- ^ length of individual lines
133 -> String
134 -> [String]
135chop n "" = []
136chop n s = let
137 enc_len | n < 4 = 4
138 | otherwise = n `div` 4 * 4
139 in take enc_len s : chop n (drop enc_len s)
140
141-- {{{1 unchop
142-- | Concatenate the strings into one long string.
143unchop :: [String]
144 -> String
145unchop = 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 @@
1-- |
2-- Module : Codec.Binary.Base64Url
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Implemented as specified in RFC 4648 (<http://tools.ietf.org/html/rfc4648>).
7--
8-- Further documentation and information can be found at
9-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
10module Codec.Binary.Base64Url
11 ( EncIncData(..)
12 , EncIncRes(..)
13 , encodeInc
14 , encode
15 , DecIncData(..)
16 , DecIncRes(..)
17 , decodeInc
18 , decode
19 , chop
20 , unchop
21 ) where
22
23import Codec.Binary.Util
24
25import Data.Maybe
26import Data.Word
27import Data.Bits
28import Data.Array
29import qualified Data.Map as M
30
31import qualified Codec.Binary.Base64 as Base64
32
33-- {{{1 enc/dec map
34_encMap =
35 [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E')
36 , (5, 'F') , (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J')
37 , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O')
38 , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T')
39 , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y')
40 , (25, 'Z'), (26, 'a'), (27, 'b'), (28, 'c'), (29, 'd')
41 , (30, 'e'), (31, 'f'), (32, 'g'), (33, 'h'), (34, 'i')
42 , (35, 'j'), (36, 'k'), (37, 'l'), (38, 'm'), (39, 'n')
43 , (40, 'o'), (41, 'p'), (42, 'q'), (43, 'r'), (44, 's')
44 , (45, 't'), (46, 'u'), (47, 'v'), (48, 'w'), (49, 'x')
45 , (50, 'y'), (51, 'z'), (52, '0'), (53, '1'), (54, '2')
46 , (55, '3'), (56, '4'), (57, '5'), (58, '6'), (59, '7')
47 , (60, '8'), (61, '9'), (62, '-'), (63, '_') ]
48
49-- {{{1 encodeArray
50encodeArray :: Array Word8 Char
51encodeArray = array (0, 64) _encMap
52
53-- {{{1 decodeMap
54decodeMap :: M.Map Char Word8
55decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
56
57-- {{{1 encode
58-- | Incremental encoder function.
59encodeInc :: EncIncData -> EncIncRes String
60encodeInc e = eI [] e
61 where
62 enc3 [o1, o2, o3] = cs
63 where
64 i1 = o1 `shiftR` 2
65 i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f
66 i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f
67 i4 = o3 .&. 0x3f
68 cs = map (encodeArray !) [i1, i2, i3, i4]
69
70 eI [] EDone = EFinal []
71 eI [o1] EDone = EFinal (take 2 cs ++ "==")
72 where cs = enc3 [o1, 0, 0]
73 eI [o1, o2] EDone = EFinal (take 3 cs ++ "=")
74 where cs = enc3 [o1, o2, 0]
75 eI lo (EChunk bs) = doEnc [] (lo ++ bs)
76 where
77 doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os
78 doEnc acc os = EPart acc (eI os)
79
80-- | Encode data.
81encode :: [Word8] -> String
82encode = encoder encodeInc
83
84-- {{{1 decode
85-- | Incremental encoder function.
86decodeInc :: DecIncData String -> DecIncRes String
87decodeInc d = dI [] d
88 where
89 dec4 cs = let
90 ds = map (flip M.lookup decodeMap) cs
91 es@[e1, e2, e3, e4] = map fromJust ds
92 o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4
93 o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2
94 o3 = e3 `shiftL` 6 .|. e4
95 allJust = and . map isJust
96 in if allJust ds
97 then Just [o1, o2, o3]
98 else Nothing
99
100 dI [] (DDone) = DFinal [] []
101 dI lo (DDone) = DFail [] lo
102 dI lo (DChunk s) = doDec [] (lo ++ s)
103 where
104 doDec acc s@(c1:c2:'=':'=':cs) = maybe
105 (DFail acc s)
106 (\ bs -> DFinal (acc ++ take 1 bs) cs)
107 (dec4 [c1, c2, 'A', 'A'])
108 doDec acc s@(c1:c2:c3:'=':cs) = maybe
109 (DFail acc s)
110 (\ bs -> DFinal (acc ++ take 2 bs) cs)
111 (dec4 [c1, c2, c3, 'A'])
112 doDec acc s@(c1:c2:c3:c4:cs) = maybe
113 (DFail acc s)
114 (\ bs -> doDec (acc ++ bs) cs)
115 (dec4 [c1, c2, c3, c4])
116 doDec acc s = DPart acc (dI s)
117
118-- | Decode data.
119decode :: String -> Maybe [Word8]
120decode = decoder decodeInc
121
122-- {{{1 chop
123-- | Chop up a string in parts.
124--
125-- See 'Base64.chop' in "Base64" for more details.
126chop :: Int -- ^ length of individual lines
127 -> String
128 -> [String]
129chop = Base64.chop
130
131-- {{{1 unchop
132-- | Concatenate the strings into one long string.
133--
134-- See 'Base64.unchop' in "Codec.Binary.Base64" for more details.
135unchop :: [String]
136 -> String
137unchop = 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 @@
1-- |
2-- Module : Codec.Binary.Base85
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Implemented as described at <http://en.wikipedia.org/wiki/Ascii85>.
7--
8-- Further documentation and information can be found at
9-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
10module Codec.Binary.Base85
11 ( EncIncData(..)
12 , EncIncRes(..)
13 , encodeInc
14 , encode
15 , DecIncData(..)
16 , DecIncRes(..)
17 , decodeInc
18 , decode
19 , chop
20 , unchop
21 ) where
22
23import Codec.Binary.Util
24
25import Data.Array
26import Data.Bits
27import Data.Char
28import Data.Maybe
29import Data.Word
30import qualified Data.Map as M
31
32-- {{{1 enc/dec map
33_encMap :: [(Word8, Char)]
34_encMap = [(fromIntegral i, chr i) | i <- [33..117]]
35
36-- {{{1 encodeArray
37encodeArray :: Array Word8 Char
38encodeArray = array (33, 117) _encMap
39
40-- {{{1 decodeMap
41decodeMap :: M.Map Char Word8
42decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
43
44-- {{{1 encode
45-- | Incremental encoder function.
46encodeInc :: EncIncData -> EncIncRes String
47encodeInc e = eI [] e
48 where
49 enc4 [0, 0, 0, 0] = "z"
50 enc4 [0x20, 0x20, 0x20, 0x20] = "y"
51 enc4 os@[o1, o2, o3, o4] = map (encodeArray !) group
52 where
53 group2Word32 = foldl (\ a b -> a `shiftL` 8 + fromIntegral b) 0 os
54 encodeWord32ToWord8s :: Word32 -> [Word8]
55 encodeWord32ToWord8s =
56 map (fromIntegral . (`mod` 85)) . take 5 . iterate (`div` 85)
57 adjustNReverse = reverse . map (+ 33)
58 group = (adjustNReverse .encodeWord32ToWord8s) group2Word32
59
60 eI [] EDone = EFinal []
61 eI [o1] EDone = EFinal (take 2 cs)
62 where
63 cs = enc4 [o1, 0, 0, 1]
64 eI [o1, o2] EDone = EFinal (take 3 cs)
65 where
66 cs = enc4 [o1, o2, 0, 1]
67 eI [o1, o2, o3] EDone = EFinal (take 4 cs)
68 where
69 cs = enc4 [o1, o2, o3, 1]
70 eI lo (EChunk bs) = doEnc [] (lo ++ bs)
71 where
72 doEnc acc (o1:o2:o3:o4:os) = doEnc (acc ++ enc4 [o1, o2, o3, o4]) os
73 doEnc acc os = EPart acc (eI os)
74
75-- | Encode data.
76--
77-- The result will not be enclosed in \<~ ~\>.
78encode :: [Word8] -> String
79encode = encoder encodeInc
80
81-- {{{1 decode
82-- | Incremental decoder function.
83decodeInc :: DecIncData String -> DecIncRes String
84decodeInc d = dI [] d
85 where
86 dec5 cs = let
87 ds = map (flip M.lookup decodeMap) cs
88 es@[e1, e2, e3, e4, e5] = map fromJust ds
89 adjRev = map (\ i -> i - 33) [e5, e4, e3, e2, e1]
90 group2Word32 = foldl1 (+) . zipWith (*) (map (85 ^) [0..4]) . map fromIntegral
91 word32ToGroup :: Word32 -> [Word8]
92 word32ToGroup = map fromIntegral . reverse . take 4 . iterate (`div` 256)
93 allJust = and . map isJust
94 in if allJust ds
95 then Just $ word32ToGroup $ group2Word32 adjRev
96 else Nothing
97
98 dI lo (DChunk s) = doDec [] (lo ++ s)
99 dI [] DDone = DFinal [] []
100 dI cs@[c1, c2] DDone = case doDec [] (cs ++ "uuu") of
101 (DPart r _) -> DFinal (take 1 r) []
102 f -> f
103 dI cs@[c1, c2, c3] DDone = case doDec [] (cs ++ "uu") of
104 (DPart r _) -> DFinal (take 2 r) []
105 f -> f
106 dI cs@[c1, c2, c3, c4] DDone = case doDec [] (cs ++ "u") of
107 (DPart r _) -> DFinal (take 3 r) []
108 f -> f
109 dI lo DDone = DFail [] lo
110
111 doDec acc ('z':cs) = doDec (acc ++ [0, 0, 0, 0]) cs
112 doDec acc ('y':cs) = doDec (acc ++ [0x20, 0x20, 0x20, 0x20]) cs
113 doDec acc s@(c1:c2:c3:c4:c5:cs) = maybe
114 (DFail acc s)
115 (\ bs -> doDec (acc ++ bs) cs)
116 (dec5 [c1, c2, c3, c4, c5])
117 doDec acc cs = DPart acc (dI cs)
118
119-- | Decode data.
120--
121-- The input must not be enclosed in \<~ ~\>.
122decode :: String -> Maybe [Word8]
123decode = decoder decodeInc
124
125-- {{{1 chop
126-- | Chop up a string in parts.
127--
128-- The length given is rounded down to the nearest multiple of 5.
129chop :: Int -- ^ length of individual lines
130 -> String
131 -> [String]
132chop _ "" = []
133chop n s = let
134 enc_len | n < 5 = 5
135 | otherwise = n `div` 5 * 5
136 in take enc_len s : chop n (drop enc_len s)
137
138-- {{{1 unchop
139-- | Concatenate the strings into one long string.
140unchop :: [String]
141 -> String
142unchop = 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 @@
1-- |
2-- Module : Codec.Binary.DataEncoding
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- This module exposes several instances of 'DataCodec', one for each data
7-- encoding implemented in the library without causing the name clashing that
8-- would result from importing the individual encoding modules.
9--
10-- Further documentation and information can be found at
11-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
12module Codec.Binary.DataEncoding
13 ( DataCodec
14 , base16
15 , base32
16 , base32Hex
17 , base64
18 , base64Url
19 , base85
20 , chop
21 , decode
22 , encode
23 , py
24 , qp
25 , unchop
26 , url
27 , uu
28 , xx
29 )
30 where
31
32import Data.Word
33
34import qualified Codec.Binary.Base16 as Base16
35import qualified Codec.Binary.Base32 as Base32
36import qualified Codec.Binary.Base32Hex as Base32Hex
37import qualified Codec.Binary.Base64 as Base64
38import qualified Codec.Binary.Base64Url as Base64Url
39import qualified Codec.Binary.Base85 as Base85
40import qualified Codec.Binary.Url as Url
41import qualified Codec.Binary.Uu as Uu
42import qualified Codec.Binary.Xx as Xx
43import qualified Codec.Binary.QuotedPrintable as QP
44import qualified Codec.Binary.PythonString as Py
45
46-- {{{1 DataCodec
47-- | Used to group a specific data encoding's functions.
48data DataCodec = DataCodec {
49 encode :: [Word8] -> String,
50 decode :: String -> Maybe [Word8],
51 chop :: Int -> String -> [String],
52 unchop :: [String] -> String
53}
54
55-- {{{1 base16
56-- | Base16 encoding, see "Codec.Binary.Base16" for more details on
57-- the individual functions.
58base16 :: DataCodec
59base16 = DataCodec {
60 encode=Base16.encode,
61 decode=Base16.decode,
62 chop=Base16.chop,
63 unchop=Base16.unchop
64}
65
66-- {{{1 base32
67-- | Base32 encoding, see "Codec.Binary.Base32" for more details on
68-- the individual functions.
69base32 :: DataCodec
70base32 = DataCodec {
71 encode=Base32.encode,
72 decode=Base32.decode,
73 chop=Base32.chop,
74 unchop=Base32.unchop
75}
76
77-- {{{1 base32Hex
78-- | Base32Hex encoding, see "Codec.Binary.Base32Hex" for more details
79-- on the individual functions.
80base32Hex :: DataCodec
81base32Hex = DataCodec {
82 encode=Base32Hex.encode,
83 decode=Base32Hex.decode,
84 chop=Base32Hex.chop,
85 unchop=Base32Hex.unchop
86}
87
88-- {{{1 base64
89-- | Base64 encoding, see "Codec.Binary.Base64" for more details on
90-- the individual functions.
91base64 :: DataCodec
92base64 = DataCodec {
93 encode=Base64.encode,
94 decode=Base64.decode,
95 chop=Base64.chop,
96 unchop=Base64.unchop
97}
98
99-- {{{1 base64Url
100-- | Base64Url encoding, see "Codec.Binary.Base64Url" for more details
101-- on the individual functions.
102base64Url :: DataCodec
103base64Url = DataCodec {
104 encode=Base64Url.encode,
105 decode=Base64Url.decode,
106 chop=Base64Url.chop,
107 unchop=Base64Url.unchop
108}
109
110-- {{{1 base85
111-- | Base85 encoding, see "Codec.Binary.Base85" for more details
112-- on the individual functions.
113base85 :: DataCodec
114base85 = DataCodec {
115 encode=Base85.encode,
116 decode=Base85.decode,
117 chop=Base85.chop,
118 unchop=Base85.unchop
119}
120
121-- {{{1 uu
122-- | Uuencoding, see "Codec.Binary.Uu" for more details on the
123-- individual functions.
124uu :: DataCodec
125uu = DataCodec {
126 encode=Uu.encode,
127 decode=Uu.decode,
128 chop=Uu.chop,
129 unchop=Uu.unchop
130}
131
132-- {{{1 xx
133-- | Xxencoding, see "Codec.Binary.Xx" for more details on the
134-- individual functions.
135xx :: DataCodec
136xx = DataCodec {
137 encode=Xx.encode,
138 decode=Xx.decode,
139 chop=Xx.chop,
140 unchop=Xx.unchop
141}
142
143-- {{{1 quoted-printable
144-- | Quoted-printable, see "Codec.Binary.QuotedPrintable" for more details on
145-- the individual functions.
146qp :: DataCodec
147qp = DataCodec
148 { encode = QP.encode
149 , decode = QP.decode
150 , chop = QP.chop
151 , unchop = QP.unchop
152 }
153
154-- {{{1 python string
155-- | Quoted-printable, see "Codec.Binary.PythonString" for more details on
156-- the individual functions.
157py :: DataCodec
158py = DataCodec
159 { encode = Py.encode
160 , decode = Py.decode
161 , chop = Py.chop
162 , unchop = Py.unchop
163 }
164
165-- {{{1 url encoding
166-- | URL encoding, see "Codec.Binary.Url" for more details on the individual
167-- functions.
168url :: DataCodec
169url = DataCodec
170 { encode = Url.encode
171 , decode = Url.decode
172 , chop = Url.chop
173 , unchop = Url.unchop
174 }
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 @@
1-- |
2-- Module : Codec.Binary.PythonString
3-- Copyright : (c) 2009 Magnus Therning
4-- License : BSD3
5--
6-- Implementation of python escaping.
7--
8-- This implementation encodes non-printable characters (0x00-0x1f, 0x7f-0xff)
9-- to hex-value characters ('\xhh') while leaving printable characters as such:
10--
11-- @
12-- \> encode [0, 10, 13, 110]
13-- \"\\\\x00\\\\x0A\\\\x0Dn\"
14-- \> putStrLn $ encode [0, 10, 13, 110]
15-- \\x00\\x0A\\x0Dn
16-- @
17--
18-- It also properly handles escaping of a few characters that require it:
19--
20-- @
21-- \> encode [34, 39, 92]
22-- \"\\\\\\\"\\\\\'\\\\\\\\\"
23-- putStrLn $ encode [34, 39, 92]
24-- \\\"\\'\\\\
25-- @
26--
27-- Further documentation and information can be found at
28-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
29module Codec.Binary.PythonString
30 ( EncIncData(..)
31 , EncIncRes(..)
32 , encodeInc
33 , encode
34 , DecIncData(..)
35 , DecIncRes(..)
36 , decodeInc
37 , decode
38 , chop
39 , unchop
40 ) where
41
42import Codec.Binary.Util
43
44import Data.Char
45import Data.Maybe
46import Data.Word
47
48-- {{{1 encode
49-- | Incremental encoder function.
50encodeInc :: EncIncData -> EncIncRes String
51encodeInc e = eI e
52 where
53 enc [] = []
54 enc (o:os)
55 | o < 0x20 || o > 0x7e = ('\\' : 'x' : toHex o) ++ enc os
56 | o == 34 = "\\\"" ++ enc os
57 | o == 39 = "\\'" ++ enc os
58 | o == 92 = "\\\\" ++ enc os
59 | otherwise = chr (fromIntegral o) : enc os
60
61 eI EDone = EFinal []
62 eI (EChunk bs) = EPart (enc bs) encodeInc
63
64-- | Encode data.
65encode :: [Word8] -> String
66encode = encoder encodeInc
67
68-- {{{1 decode
69-- | Incremental decoder function.
70decodeInc :: DecIncData String -> DecIncRes String
71decodeInc d = dI [] d
72 where
73 dI [] DDone = DFinal [] []
74 dI lo DDone = DFail [] lo
75 dI lo (DChunk s) = doDec [] (lo ++ s)
76 where
77 doDec acc [] = DPart acc (dI [])
78 doDec acc s'@('\\':'x':c0:c1:cs) = let
79 o = fromHex [c0, c1]
80 in if isJust o
81 then doDec (acc ++ [fromJust o]) cs
82 else DFail acc s'
83 doDec acc s'@('\\':'\\':cs) = doDec (acc ++ [fromIntegral $ ord '\\']) cs
84 doDec acc s'@('\\':'\'':cs) = doDec (acc ++ [fromIntegral $ ord '\'']) cs
85 doDec acc s'@('\\':'\"':cs) = doDec (acc ++ [fromIntegral $ ord '\"']) cs
86 doDec acc s'@(c:cs)
87 | c /= '\\' = doDec (acc ++ [fromIntegral $ ord c]) cs
88 | otherwise = DPart acc (dI s')
89
90-- | Decode data.
91decode :: String -> Maybe [Word8]
92decode = decoder decodeInc
93
94-- {{{1 chop
95-- | Chop up a string in parts.
96chop :: Int -- ^ length of individual lines (values @\< 1@ are ignored)
97 -> String
98 -> [String]
99chop n = let
100 _n = max 1 n
101 _chop [] = []
102 _chop cs = take _n cs : _chop (drop _n cs)
103 in _chop
104
105-- {{{1 unchop
106-- | Concatenate the list of strings into one long string.
107unchop :: [String]
108 -> String
109unchop = 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 @@
1-- |
2-- Module : Codec.Binary.QuotedPrintable
3-- Copyright : (c) 2009 Magnus Therning
4-- License : BSD3
5--
6-- Implementation of Quoted-Printable based on RFC 2045
7-- (<http://tools.ietf.org/html/rfc2045>).
8--
9-- This encoding encodes _everything_ that is passed in, it will not try to
10-- guess the native line ending for your architecture. In other words, if you
11-- are using this to encode text you need to split it into separate lines
12-- before encoding and chopping it up.
13--
14-- Further documentation and information can be found at
15-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
16module Codec.Binary.QuotedPrintable
17 ( EncIncData(..)
18 , EncIncRes(..)
19 , encodeInc
20 , encode
21 , DecIncData(..)
22 , DecIncRes(..)
23 , decodeInc
24 , decode
25 , chop
26 , unchop
27 ) where
28
29import Codec.Binary.Util
30
31import Data.Char
32import Data.Maybe
33import Data.Word
34
35-- {{{1 encode
36-- | Incremental encoder function.
37encodeInc :: EncIncData -> EncIncRes String
38encodeInc e = eI e
39 where
40 enc [] = []
41 enc (o:os)
42 | o < 33 || o == 61 || o > 126 = ('=' : toHex o) ++ enc os
43 | otherwise = chr (fromIntegral o) : enc os
44
45 eI EDone = EFinal []
46 eI (EChunk bs) = EPart (enc bs) encodeInc
47
48-- | Encode data.
49encode :: [Word8] -> String
50encode = encoder encodeInc
51
52-- {{{1 decode
53-- | Incremental decoder function.
54decodeInc :: DecIncData String -> DecIncRes String
55decodeInc d = dI [] d
56 where
57 dI [] DDone = DFinal [] []
58 dI lo DDone = DFail [] lo
59 dI lo (DChunk s) = doDec [] (lo ++ s)
60 where
61 doDec acc [] = DPart acc (dI [])
62 doDec acc s'@('=':c0:c1:cs) = let
63 o = fromHex [c0, c1]
64 in if isJust o
65 then doDec (acc ++ [fromJust o]) cs
66 else DFail acc s'
67 doDec acc s'@(c:cs)
68 | c /= '=' = doDec (acc ++ [fromIntegral $ ord c]) cs
69 | otherwise = DPart acc (dI s')
70
71-- | Decode data.
72decode :: String -> Maybe [Word8]
73decode = decoder decodeInc
74
75-- {{{1 chop
76-- | Chop up a string in parts.
77chop :: Int -- ^ length of individual lines (values @\< 4@ are ignored)
78 -> String
79 -> [String]
80chop n "" = []
81chop n s = let
82 n' = max 3 $ n - 1
83 _c i ts "" acc = ts : acc
84 _c i ts tss@('=' : tss') acc
85 | i + 2 < n' = _c (i + 1) ('=' : ts) tss' acc
86 | otherwise = _c 0 "" tss (('=' : ts) : acc)
87 _c i ts tss@(c : tss') acc
88 | i < n' = _c (i + 1) (c : ts) tss' acc
89 | otherwise = _c 0 "" tss (('=' : ts) : acc)
90 in map reverse . reverse $ _c 0 "" s []
91
92-- {{{1 unchop
93-- | Concatenate the list of strings into one long string.
94unchop :: [String] -> String
95unchop [] = ""
96unchop (s : ss) = let
97 dropLast = last s == '='
98 len = length s
99 in if dropLast
100 then take (len - 1) s ++ unchop ss
101 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 @@
1-- |
2-- Module : Codec.Binary.Url
3-- Copyright : (c) 2009 Magnus Therning
4-- License : BSD3
5--
6-- URL encoding, sometimes referred to as URI encoding or percent encoding.
7-- Implemented based on RFC 3986 (<http://tools.ietf.org/html/rfc3986>).
8--
9-- Further documentation and information can be found at
10-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
11
12module Codec.Binary.Url
13 ( EncIncData(..)
14 , EncIncRes(..)
15 , encodeInc
16 , encode
17 , DecIncData
18 , DecIncRes
19 , decodeInc
20 , decode
21 , chop
22 , unchop
23 ) where
24
25import Codec.Binary.Util
26
27import qualified Data.Map as M
28import Data.Char(ord)
29import Data.Word(Word8)
30import Data.Maybe(isJust, fromJust)
31
32-- {{{1 enc/dec map
33_unreservedChars = zip [65..90] "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
34 ++ zip [97..122] "abcdefghijklmnopqrstuvwxyz"
35 ++ zip [48..57] "0123456789"
36 ++ [(45, '-'), (95, '_'), (46, '.'), (126, '~')]
37
38encodeMap :: M.Map Word8 Char
39encodeMap = M.fromList _unreservedChars
40
41decodeMap :: M.Map Char Word8
42decodeMap = M.fromList [(b, a) | (a, b) <- _unreservedChars]
43
44-- {{{1 encode
45-- | Incremental decoder function.
46encodeInc :: EncIncData -> EncIncRes String
47encodeInc e = eI e
48 where
49 enc [] = []
50 enc (o : os) = case (M.lookup o encodeMap) of
51 Just c -> c : enc os
52 Nothing -> ('%' : toHex o) ++ enc os
53
54 eI EDone = EFinal []
55 eI (EChunk bs) = EPart (enc bs) encodeInc
56
57-- | Encode data.
58encode :: [Word8] -> String
59encode = encoder encodeInc
60
61-- {{{1 decode
62-- | Incremental decoder function.
63decodeInc :: DecIncData String -> DecIncRes String
64decodeInc d = dI [] d
65 where
66 dI [] DDone = DFinal [] []
67 dI lo DDone = DFail [] lo
68 dI lo (DChunk s) = doDec [] (lo ++ s)
69 where
70 doDec acc [] = DPart acc (dI [])
71 doDec acc s'@('%':c0:c1:cs) = let
72 o = fromHex [c0, c1]
73 in if isJust o
74 then doDec (acc ++ [fromJust o]) cs
75 else DFail acc s'
76 doDec acc s'@(c:cs)
77 | c /= '%' = doDec (acc ++ [fromIntegral $ ord c]) cs
78 | otherwise = DPart acc (dI s')
79
80-- | Decode data.
81decode :: String
82 -> Maybe [Word8]
83decode = decoder decodeInc
84
85-- {{{1 chop
86-- | Chop up a string in parts.
87chop :: Int -- ^ length of individual lines
88 -> String
89 -> [String]
90chop n = let
91 _n = max 1 n
92 _chop [] = []
93 _chop cs = take _n cs : _chop (drop _n cs)
94 in _chop
95
96-- {{{1 unchop
97-- | Concatenate the strings into one long string
98unchop :: [String]
99 -> String
100unchop = 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 @@
1-- |
2-- Module : Codec.Binary.Util
3-- Copyright : (c) 2009 Magnus Therning
4-- License : BSD3
5--
6-- Utility functions used in the other module.
7module Codec.Binary.Util
8 ( toHex
9 , fromHex
10 , EncIncData(..)
11 , EncIncRes(..)
12 , DecIncData(..)
13 , DecIncRes(..)
14 , encoder
15 , decoder
16 ) where
17
18import Data.Array
19import Data.Bits
20import Data.Char
21import Data.Word
22import qualified Data.Map as M
23
24-- {{{1 hex enc/dec assoc list and maps
25hexEncMap = zip [0..] "0123456789ABCDEF"
26
27hexEncodeArray :: Array Word8 Char
28hexEncodeArray = array (0, 16) hexEncMap
29
30hexDecodeMap :: M.Map Char Word8
31hexDecodeMap = M.fromList [(b, a) | (a, b) <- hexEncMap]
32
33-- {{{1 toHex
34toHex :: Word8 -> String
35toHex o = let
36 hn = o `shiftR` 4
37 ln = o .&. 0xf
38 in [hexEncodeArray ! hn, hexEncodeArray ! ln]
39
40-- {{{1 fromHex
41fromHex :: String -> Maybe Word8
42fromHex = let
43 dec [Just hn, Just ln] = let
44 o = hn `shiftL` 4 .|. ln
45 in Just o
46 dec _ = Nothing
47 in dec . map (flip M.lookup hexDecodeMap . toUpper)
48
49-- {{{1 incremental coding
50-- | Data type for the incremental encoding functions.
51data EncIncData = EChunk [Word8] -- ^ a chunk of data to be encoded
52 | EDone -- ^ the signal to the encoder that the stream of data is ending
53
54-- | Data type for the result of calling the incremental encoding functions.
55data EncIncRes i = EPart i (EncIncData -> EncIncRes i) -- ^ a partial result together with the continuation to use for further encoding
56 | EFinal i -- ^ the final result of encoding (the response to 'EDone')
57
58encoder f os = case f (EChunk os) of
59 EPart r1 f' -> case f' EDone of
60 EFinal r2 -> r1 ++ r2
61
62-- | Data type for the incremental decoding functions.
63data DecIncData i = DChunk i -- ^ a chunk of data to be decoded
64 | DDone -- ^ the signal to the decoder that the stream of data is ending
65
66-- | Data type for the result of calling the incremental encoding functions.
67data DecIncRes i = DPart [Word8] (DecIncData i -> DecIncRes i) -- ^ a partial result together with the continuation to user for further decoding
68 | DFinal [Word8] i -- ^ the final result of decoding (the response to 'DDone')
69 | DFail [Word8] i -- ^ a partial result for a failed decoding, together with the remainder of the data passed in so far
70
71decoder :: (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]
72decoder f s = let
73 d = f (DChunk s)
74 in case d of
75 DFinal da _ -> Just da
76 DFail _ _ -> Nothing
77 DPart da f -> let
78 d' = f DDone
79 in case d' of
80 DFinal da' _ -> Just $ da ++ da'
81 DFail _ _ -> Nothing
82 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 @@
1-- |
2-- Module : Codec.Binary.Uu
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Uuencoding is notoriously badly specified. This implementation is
7-- compatible with the GNU Sharutils
8-- (<http://www.gnu.org/software/sharutils/>).
9--
10-- Further documentation and information can be found at
11-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
12module Codec.Binary.Uu
13 ( EncIncData(..)
14 , EncIncRes(..)
15 , encodeInc
16 , encode
17 , DecIncData(..)
18 , DecIncRes(..)
19 , decodeInc
20 , decode
21 , chop
22 , unchop
23 ) where
24
25import Codec.Binary.Util
26
27import Control.Monad
28import Data.Array
29import Data.Bits
30import Data.Maybe
31import Data.Word
32import qualified Data.Map as M
33
34-- {{{1 enc/dec map
35_encMap = zip [0..] "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"
36
37-- {{{1 encodeArray
38encodeArray :: Array Word8 Char
39encodeArray = array (0, 64) _encMap
40
41-- {{{1 decodeMap
42decodeMap :: M.Map Char Word8
43decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
44
45-- {{{1 encode
46-- | Incremental encoder function.
47encodeInc :: EncIncData -> EncIncRes String
48encodeInc e = eI [] e
49 where
50 enc3 [o1, o2, o3] = map (encodeArray !) [i1, i2, i3, i4]
51 where
52 i1 = o1 `shiftR` 2
53 i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f
54 i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f
55 i4 = o3 .&. 0x3f
56
57 eI [] EDone = EFinal []
58 eI [o1] EDone = EFinal $ take 2 $ enc3 [o1, 0, 0]
59 eI [o1, o2] EDone = EFinal $ take 3 $ enc3 [o1, o2, 0]
60 eI lo (EChunk bs) = doEnc [] (lo ++ bs)
61 where
62 doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os
63 doEnc acc os = EPart acc (eI os)
64
65-- | Encode data.
66encode :: [Word8] -> String
67encode = encoder encodeInc
68
69-- {{{1 decode
70-- | Incremental decoder function.
71decodeInc :: DecIncData String -> DecIncRes String
72decodeInc d = dI [] d
73 where
74 dec4 cs = let
75 ds = map (flip M.lookup decodeMap) cs
76 [e1, e2, e3, e4] = map fromJust ds
77 o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4
78 o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2
79 o3 = e3 `shiftL` 6 .|. e4
80 allJust = and . map isJust
81 in if allJust ds
82 then Just [o1, o2, o3]
83 else Nothing
84
85 dI [] DDone = DFinal [] []
86 dI lo@[c1, c2] DDone = maybe
87 (DFail [] lo)
88 (\ bs -> DFinal (take 1 bs) [])
89 (dec4 [c1, c2, '`', '`'])
90 dI lo@[c1, c2, c3] DDone = maybe
91 (DFail [] lo)
92 (\ bs -> DFinal (take 2 bs) [])
93 (dec4 [c1, c2, c3, '`'])
94 dI lo DDone = DFail [] lo
95 dI lo (DChunk s) = doDec [] (lo ++ s)
96 where
97 doDec acc s'@(c1:c2:c3:c4:cs) = maybe
98 (DFail acc s')
99 (\ bs -> doDec (acc ++ bs) cs)
100 (dec4 [c1, c2, c3, c4])
101 doDec acc s' = DPart acc (dI s')
102
103-- | Decode data.
104decode :: String -> Maybe [Word8]
105decode = decoder decodeInc
106
107-- {{{1 chop
108-- | Chop up a string in parts. Each string in the resulting list is prepended
109-- with the length according to the uuencode \"specificiation\".
110--
111-- /Notes:/
112--
113-- * The length of the strings in the result will be @(n -1) `div` 4 * 4 +
114-- 1@. The @-1@ comes from the need to prepend the length (which explains
115-- the final @+1@). Keeping it to a multiple of 4 means that strings
116-- returned from 'encode' can be chopped without requiring any changes.
117--
118-- * The length of lines in GNU's sharutils is 61.
119chop :: Int -- ^ length (value should be in the range @[5..85]@)
120 -> String
121 -> [String]
122chop n "" = []
123chop n s = let
124 enc_len | n < 5 = 4
125 | n >= 85 = 84
126 | otherwise = (n - 1) `div` 4 * 4
127 enc_line = take enc_len s
128 act_len = fromIntegral $ case (length enc_line `divMod` 4) of
129 (l, 0) -> l * 3
130 (l, 2) -> l * 3 + 1
131 (l, 3) -> l * 3 + 2
132 len = (encodeArray ! act_len)
133 in (len : enc_line) : chop n (drop enc_len s)
134
135-- {{{1 unchop
136-- | Concatenate the strings into one long string. Each string is assumed to
137-- be prepended with the length according to the uuencode specification.
138unchop :: [String]
139 -> String
140unchop ss = let
141 singleUnchop (l : cs) = let
142 act_len = fromIntegral $ decodeMap M.! l
143 enc_len = case (act_len `divMod` 3) of
144 (n, 0) -> n * 4
145 (n, 1) -> n * 4 + 2
146 (n, 2) -> n * 4 + 3
147 in take enc_len cs
148 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 @@
1-- |
2-- Module : Codec.Binary.Xx
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Xxencoding is obsolete but still included for completeness. Further
7-- information on the encoding can be found at
8-- <http://en.wikipedia.org/wiki/Xxencode>. It should be noted that this
9-- implementation performs no padding, due to the splitting up between encoding
10-- and chopping.
11--
12-- Further documentation and information can be found at
13-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
14module Codec.Binary.Xx
15 ( EncIncData(..)
16 , EncIncRes(..)
17 , encodeInc
18 , encode
19 , DecIncData(..)
20 , DecIncRes(..)
21 , decodeInc
22 , decode
23 , chop
24 , unchop
25 ) where
26
27import Codec.Binary.Util
28
29import Control.Monad
30import Data.Array
31import Data.Bits
32import Data.Maybe
33import Data.Word
34import qualified Data.Map as M
35
36-- {{{1 enc/dec map
37_encMap = zip [0..] "+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
38
39-- {{{1 encodeArray
40encodeArray :: Array Word8 Char
41encodeArray = array (0, 64) _encMap
42
43-- {{{1 decodeMap
44decodeMap :: M.Map Char Word8
45decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]
46
47-- {{{1 encode
48-- | Incremental encoder function.
49encodeInc :: EncIncData -> EncIncRes String
50encodeInc e = eI [] e
51 where
52 enc3 [o1, o2, o3] = map (encodeArray !) [i1, i2, i3, i4]
53 where
54 i1 = o1 `shiftR` 2
55 i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f
56 i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f
57 i4 = o3 .&. 0x3f
58
59 eI [] EDone = EFinal []
60 eI [o1] EDone = EFinal $ take 2 $ enc3 [o1, 0, 0]
61 eI [o1, o2] EDone = EFinal $ take 3 $ enc3 [o1, o2, 0]
62 eI lo (EChunk bs) = doEnc [] (lo ++ bs)
63 where
64 doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os
65 doEnc acc os = EPart acc (eI os)
66
67-- | Encode data.
68encode :: [Word8] -> String
69encode = encoder encodeInc
70
71-- {{{1 decode
72-- | Incremental decoder function.
73decodeInc :: DecIncData String -> DecIncRes String
74decodeInc d = dI [] d
75 where
76 dec4 cs = let
77 ds = map (flip M.lookup decodeMap) cs
78 [e1, e2, e3, e4] = map fromJust ds
79 o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4
80 o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2
81 o3 = e3 `shiftL` 6 .|. e4
82 allJust = and . map isJust
83 in if allJust ds
84 then Just [o1, o2, o3]
85 else Nothing
86
87 dI [] DDone = DFinal [] []
88 dI lo@[c1, c2] DDone = maybe
89 (DFail [] lo)
90 (\ bs -> DFinal (take 1 bs) [])
91 (dec4 [c1, c2, '+', '+'])
92 dI lo@[c1, c2, c3] DDone = maybe
93 (DFail [] lo)
94 (\ bs -> DFinal (take 2 bs) [])
95 (dec4 [c1, c2, c3, '+'])
96 dI lo DDone = DFail [] lo
97 dI lo (DChunk s) = doDec [] (lo ++ s)
98 where
99 doDec acc s'@(c1:c2:c3:c4:cs) = maybe
100 (DFail acc s')
101 (\ bs -> doDec (acc ++ bs) cs)
102 (dec4 [c1, c2, c3, c4])
103 doDec acc s' = DPart acc (dI s')
104
105-- | Decode data.
106decode :: String
107 -> Maybe [Word8]
108decode = decoder decodeInc
109
110-- {{{1 chop
111-- | Chop up a string in parts. Each string in the resulting list is prepended
112-- with the length according to the xxencode \"specificiation\".
113--
114-- /Notes:/
115--
116-- * The length of the strings in the result will be @(n -1) `div` 4 * 4 +
117-- 1@. The @-1@ comes from the need to prepend the length (which explains
118-- the final @+1@). Keeping it to a multiple of 4 means that strings
119-- returned from 'encode' can be chopped without requiring any changes.
120chop :: Int -- ^ length (value should be in the range @[5..85]@)
121 -> String
122 -> [String]
123chop n "" = []
124chop n s = let
125 enc_len | n < 5 = 4
126 | n >= 85 = 84
127 | otherwise = min 64 $ (n - 1) `div` 4 * 4
128 enc_line = take enc_len s
129 act_len = fromIntegral $ case (length enc_line `divMod` 4) of
130 (l, 0) -> l * 3
131 (l, 2) -> l * 3 + 1
132 (l, 3) -> l * 3 + 2
133 len = (encodeArray ! act_len)
134 in (len : enc_line) : chop n (drop enc_len s)
135
136-- {{{1 unchop
137-- | Concatenate the strings into one long string. Each string is assumed to
138-- be prepended with the length according to the xxencode specification.
139unchop :: [String]
140 -> String
141unchop ss = let
142 singleUnchop (l : cs) = let
143 act_len = fromIntegral $ decodeMap M.! l
144 enc_len = case (act_len `divMod` 3) of
145 (n, 0) -> n * 4
146 (n, 1) -> n * 4 + 2
147 (n, 2) -> n * 4 + 3
148 in take enc_len cs
149 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 @@
1-- |
2-- Module : Codec.Binary.Yenc
3-- Copyright : (c) 2007 Magnus Therning
4-- License : BSD3
5--
6-- Implementation based on the specification found at
7-- <http://yence.sourceforge.net/docs/protocol/version1_3_draft.html>.
8--
9-- Further documentation and information can be found at
10-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
11module Codec.Binary.Yenc
12 ( EncIncData(..)
13 , EncIncRes(..)
14 , encodeInc
15 , encode
16 , DecIncData(..)
17 , DecIncRes(..)
18 , decodeInc
19 , decode
20 , chop
21 , unchop
22 ) where
23
24import Codec.Binary.Util
25
26import Data.Word
27
28_criticalsIn = [0xd6, 0xe0, 0xe3, 0x13]
29_equal = 0x3d
30
31-- {{{1 encode
32-- | Incremental encoder function.
33encodeInc :: EncIncData -> EncIncRes [Word8]
34encodeInc e = eI e
35 where
36 enc [] = []
37 enc (o:os)
38 | o `elem` _criticalsIn = _equal : o + 106 : enc os
39 | otherwise = o + 42 : enc os
40
41 eI EDone = EFinal []
42 eI (EChunk bs) = EPart (enc bs) encodeInc
43
44-- | Encode data.
45encode :: [Word8] -> [Word8]
46encode = encoder encodeInc
47
48-- {{{1 decode
49-- | Incremental decoder function.
50decodeInc :: DecIncData [Word8] -> DecIncRes [Word8]
51decodeInc d = dI [] d
52 where
53 dI [] DDone = DFinal [] []
54 dI lo DDone = DFail [] lo
55 dI lo (DChunk s) = doDec [] (lo ++ s)
56 where
57 doDec acc (0x3d:d:ds) = doDec (acc ++ [d + 150]) ds
58 doDec acc (d:ds) = doDec (acc ++ [d + 214]) ds
59 doDec acc s' = DPart acc (dI s')
60
61-- | Decode data.
62decode :: [Word8] -> Maybe [Word8]
63decode = decoder decodeInc
64
65-- {{{1 chop
66-- | Chop up a string in parts.
67chop :: Int -- ^ length of individual lines
68 -> [Word8]
69 -> [[Word8]]
70chop _ [] = []
71chop n ws = let
72 _n = max n 1
73 (p1, p2) = splitAt _n ws
74 in
75 if last p1 == _equal
76 then (p1 ++ take 1 p2) : chop _n (drop 1 p2)
77 else p1 : chop _n p2
78
79-- {{{1 unchop
80-- | Concatenate the strings into one long string.
81unchop :: [[Word8]]
82 -> [Word8]
83unchop = 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 @@
1{-# OPTIONS_GHC -XTemplateHaskell #-}
2
3{-
4 - Copyright : (c) 2007 Magnus Therning
5 - License : BSD3
6 -}
7
8module DataencQC
9 where
10
11import Test.Framework.TH
12
13import Data.Maybe
14import Data.Word
15import Test.QuickCheck
16import Test.Framework.Providers.QuickCheck2
17
18import qualified Codec.Binary.Uu as Uu
19import qualified Codec.Binary.Uu as Xx
20import qualified Codec.Binary.Base85 as Base85
21import qualified Codec.Binary.Base64 as Base64
22import qualified Codec.Binary.Base64Url as Base64Url
23import qualified Codec.Binary.Base32 as Base32
24import qualified Codec.Binary.Base32Hex as Base32Hex
25import qualified Codec.Binary.Base16 as Base16
26import qualified Codec.Binary.Yenc as Yenc
27import qualified Codec.Binary.QuotedPrintable as QP
28import qualified Codec.Binary.PythonString as Py
29import qualified Codec.Binary.Url as Url
30
31-- {{{1 uuencode properties
32prop_uuEncode ws = ws == (fromJust . Uu.decode . Uu.encode) ws
33 where types = ws::[Word8]
34
35prop_uuChop n ws = s == (Uu.unchop . Uu.chop n) s
36 where
37 types = (n :: Int, ws::[Word8])
38 s = Uu.encode ws
39
40prop_uuCombined n ws = ws == fromJust (Uu.decode $ Uu.unchop $ Uu.chop n $ Uu.encode ws)
41 where types = (n::Int, ws::[Word8])
42
43-- {{{1 xxencode properties
44prop_xxEncode ws = ws == (fromJust . Xx.decode . Xx.encode) ws
45 where types = ws::[Word8]
46
47prop_xxChop n ws = s == (Xx.unchop . Xx.chop n) s
48 where
49 types = (n:: Int, ws::[Word8])
50 s = Xx.encode ws
51
52prop_xxCombined n ws = ws == fromJust (Xx.decode $ Xx.unchop $ Xx.chop n $ Xx.encode ws)
53 where types = (n::Int, ws::[Word8])
54
55-- {{{1 base85 properties
56prop_base85Encode ws = ws == fromJust (Base85.decode $ Base85.encode ws)
57 where types = ws::[Word8]
58
59prop_base85Chop n s = s == Base85.unchop (Base85.chop n s)
60 where types = (n::Int, s::String)
61
62-- {{{1 base64 properties
63prop_base64Encode ws = ws == fromJust (Base64.decode $ Base64.encode ws)
64 where types = ws::[Word8]
65
66prop_base64Chop n s = s == Base64.unchop (Base64.chop n s)
67 where types = (n::Int, s::String)
68
69-- {{{1 base64url properties
70prop_base64UrlEncode ws = ws == fromJust (Base64Url.decode $ Base64Url.encode ws)
71 where types = ws::[Word8]
72
73prop_base64UrlChop n s = s == Base64Url.unchop (Base64Url.chop n s)
74 where types = (n::Int, s::String)
75
76-- {{{1 base32
77prop_base32Encode ws = ws == fromJust (Base32.decode $ Base32.encode ws)
78 where types = ws::[Word8]
79
80prop_base32Chop n s = s == Base32.unchop (Base32.chop n s)
81 where types = (n::Int, s::String)
82
83-- {{{1 base32hex
84prop_base32HexEncode ws = ws == fromJust (Base32Hex.decode $ Base32Hex.encode ws)
85 where types = ws::[Word8]
86
87prop_base32HexChop n s = s == Base32Hex.unchop (Base32Hex.chop n s)
88 where types = (n::Int, s::String)
89
90-- {{{1 base16
91prop_base16Encode ws = ws == fromJust (Base16.decode $ Base16.encode ws)
92 where types = ws::[Word8]
93
94prop_base16Chop n s = s == Base16.unchop (Base16.chop n s)
95 where types = (n::Int, s::String)
96
97-- {{{1 yEncoding
98prop_yencEncode ws = ws == fromJust (Yenc.decode $ Yenc.encode ws)
99 where types = ws ::[Word8]
100
101prop_yencChop n ws = ws == Yenc.unchop (Yenc.chop n ws)
102 where types = (n::Int, ws :: [Word8])
103
104-- {{{1 qp
105prop_qpEncode ws = ws == fromJust (QP.decode $ QP.encode ws)
106 where types = ws :: [Word8]
107
108prop_qpChop n ws = s == (QP.unchop . QP.chop n) s
109 where
110 types = (n::Int, ws::[Word8])
111 s = QP.encode ws
112
113prop_qpCombined n ws = ws == fromJust (QP.decode $ QP.unchop $ QP.chop n $ QP.encode ws)
114 where types = (n::Int, ws::[Word8])
115
116-- {{{1 py
117prop_pyEncode ws = ws == fromJust (Py.decode $ Py.encode ws)
118 where types = ws :: [Word8]
119
120prop_pyChop n s = s == Py.unchop (Py.chop n s)
121 where types = (n :: Int, s :: String)
122
123prop_pyCombined n ws = ws == fromJust (runAll ws)
124 where runAll = Py.decode . Py.unchop . Py.chop n . Py.encode
125
126-- {{{1 url
127prop_urlEncode ws = ws == fromJust (Url.decode $ Url.encode ws)
128 where types = ws :: [Word8]
129
130prop_urlChop n s = s == Url.unchop (Url.chop n s)
131 where types = (n :: Int, s :: String)
132
133prop_urlCombined n ws = ws == fromJust (runAll ws)
134 where runAll = Url.decode . Url.unchop . Url.chop n . Url.encode
135
136-- {{{1 all the tests
137allTests = $(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 @@
1{-# OPTIONS_GHC -XTemplateHaskell #-}
2{-
3 - Copyright : (c) 2007 Magnus Therning
4 - License : BSD3
5 -}
6
7module DataencUT
8 where
9
10import Test.HUnit
11import Control.Monad
12import System.Exit
13import Data.Maybe
14import qualified Test.Framework.Providers.API as TFAPI
15import Test.Framework.TH
16import Test.Framework.Providers.HUnit
17
18import Codec.Binary.DataEncoding
19import qualified Codec.Binary.Yenc as Yenc
20
21-- {{{1 checkAssertions
22checkAssertions (suite, desc, enc, dec, codec) = do
23 enc @=? encode codec dec
24 dec @=? fromJust (decode codec enc)
25
26-- {{{1 uuencode tests
27uuTestData =
28 [ ("uu", "empty", "", [], uu)
29 , ("uu", "\\0", "``", [0], uu)
30 , ("uu", "\\255", "_P", [255], uu)
31 , ("uu", "AA", "04$", [65, 65], uu)
32 , ("uu", "AAA", "04%!", [65, 65, 65], uu)
33 , ("uu", "AAAA", "04%!00", [65, 65, 65, 65], uu)
34 , ("uu", "Example", "17AA;7!L90", [69,120,97,109,112,108,101], uu)
35 ]
36case_uuTests = mapM_ checkAssertions uuTestData
37
38case_uuTests2 = do
39 "EI2" @=? unchop uu (chop uu 1 "EI2")
40 "EI3-" @=? unchop uu (chop uu 1 "EI3-")
41 "EI3-EE" @=? unchop uu (chop uu 1 "EI3-EE")
42 [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 1 $ encode uu [0..255])
43 [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 61 $ encode uu [0..255])
44 [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 100 $ encode uu [0..255])
45
46case_uuTestsFail = do
47 Nothing @=? decode uu "A"
48 Nothing @=? decode uu "aa"
49
50-- {{{1 xxencode tests
51xxTestData =
52 [ ("xx", "empty", "", [], xx)
53 , ("xx", "\\0", "++", [0], xx)
54 , ("xx", "\\255", "zk", [255], xx)
55 , ("xx", "AA", "EI2", [65, 65], xx)
56 , ("xx", "AAA", "EI3-", [65, 65, 65], xx)
57 , ("xx", "AAAA", "EI3-EE", [65, 65, 65, 65], xx)
58 , ("xx", "Example", "FLVVPL-gNE", [69,120,97,109,112,108,101], xx)
59 ]
60case_xxTest = mapM_ checkAssertions xxTestData
61
62case_xxTests2 = do
63 "EI2" @=? unchop xx (chop xx 1 "EI2")
64 "EI3-" @=? unchop xx (chop xx 1 "EI3-")
65 "EI3-EE" @=? unchop xx (chop xx 1 "EI3-EE")
66 [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 1 $ encode xx [0..255])
67 [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 61 $ encode xx [0..255])
68 [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 100 $ encode xx [0..255])
69
70case_xxTestsFail = do
71 Nothing @=? decode xx "A"
72 Nothing @=? decode xx "''"
73
74-- {{{1 base85 tests
75base85TestData =
76 [ ("base85", "empty", "", [], base85)
77 , ("base85", "f", "Ac", [102], base85)
78 , ("base85", "fo", "Ao@", [102,111], base85)
79 , ("base85", "foo", "AoDS", [102,111,111], base85)
80 , ("base85", "foob", "AoDTs", [102,111,111,98], base85)
81 , ("base85", "fooba", "AoDTs@/", [102,111,111,98,97], base85)
82 , ("base85", "foobar", "AoDTs@<)", [102,111,111,98,97,114], base85)
83 , ("base85", "\0", "!!", [0], base85)
84 , ("base85", "foob\0\0\0\0ar", "AoDTszEW", [102,111,111,98,0,0,0,0,114], base85)
85 , ("base85", "Example", "7<i6XE,9(", [69,120,97,109,112,108,101], base85)
86 , ("base85", "zeros", "z", [0, 0, 0, 0], base85)
87 , ("base85", "spaces", "y", [0x20, 0x20, 0x20, 0x20], base85)
88 ]
89case_base85Tests = mapM_ checkAssertions base85TestData
90
91case_base85TestsFail = do
92 Nothing @=? decode base85 "A"
93 Nothing @=? decode base85 "!z"
94 Nothing @=? decode base85 "!z!"
95 Nothing @=? decode base85 "!z!z"
96
97-- {{{1 base64 tests
98base64TestData =
99 [ ("base64", "empty", "", [], base64)
100 , ("base64", "f", "Zg==", [102], base64)
101 , ("base64", "fo", "Zm8=", [102,111], base64)
102 , ("base64", "foo", "Zm9v", [102,111,111], base64)
103 , ("base64", "foob", "Zm9vYg==", [102,111,111,98], base64)
104 , ("base64", "fooba", "Zm9vYmE=", [102,111,111,98,97], base64)
105 , ("base64", "foobar", "Zm9vYmFy", [102,111,111,98,97,114], base64)
106 , ("base64", "\0", "AA==", [0], base64)
107 , ("base64", "\255", "/w==", [255], base64)
108 , ("base64", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64)
109 ]
110case_base64Tests = mapM_ checkAssertions base64TestData
111
112case_base64TestsFail = do
113 Nothing @=? decode base64 "A"
114 Nothing @=? decode base64 "!!"
115
116-- {{{1 base64url tests
117base64UrlTestData =
118 [ ("base64url", "empty", "", [], base64Url)
119 , ("base64url", "\0", "AA==", [0], base64Url)
120 , ("base64url", "\255", "_w==", [255], base64Url)
121 , ("base64url", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64Url)
122 ]
123case_base64UrlTests = mapM_ checkAssertions base64UrlTestData
124
125-- {{{1 base32 tests
126base32TestData =
127 [ ("base32", "empty", "", [], base32)
128 , ("base32", "f", "MY======", [102], base32)
129 , ("base32", "fo", "MZXQ====", [102,111], base32)
130 , ("base32", "foo", "MZXW6===", [102,111,111], base32)
131 , ("base32", "foob", "MZXW6YQ=", [102,111,111,98], base32)
132 , ("base32", "fooba", "MZXW6YTB", [102,111,111,98,97], base32)
133 , ("base32", "foobar", "MZXW6YTBOI======", [102,111,111,98,97,114], base32)
134 ]
135case_base32Tests = mapM_ checkAssertions base32TestData
136
137case_base32TestsFail = do
138 Nothing @=? decode base32 "A"
139 Nothing @=? decode base32 "gh"
140
141-- {{{1 base32hex tests
142base32HexTestData =
143 [ ("base32hex", "empty", "", [], base32Hex)
144 , ("base32hex", "f", "CO======", [102], base32Hex)
145 , ("base32hex", "fo", "CPNG====", [102,111], base32Hex)
146 , ("base32hex", "foo", "CPNMU===", [102,111,111], base32Hex)
147 , ("base32hex", "foob", "CPNMUOG=", [102,111,111,98], base32Hex)
148 , ("base32hex", "fooba", "CPNMUOJ1", [102,111,111,98,97], base32Hex)
149 , ("base32hex", "foobar", "CPNMUOJ1E8======", [102,111,111,98,97,114], base32Hex)
150 ]
151case_base32HexTests = mapM_ checkAssertions base32HexTestData
152
153case_base32HexTestsFail = do
154 Nothing @=? decode base32Hex "A"
155 Nothing @=? decode base32Hex "gh"
156
157-- {{{1 base16 (hex)
158base16TestData =
159 [ ("base16", "empty", "", [], base16)
160 , ("base16", "f", "66", [102], base16)
161 , ("base16", "fo", "666F", [102,111], base16)
162 , ("base16", "foo", "666F6F", [102,111,111], base16)
163 , ("base16", "foob", "666F6F62", [102,111,111,98], base16)
164 , ("base16", "fooba", "666F6F6261", [102,111,111,98,97], base16)
165 , ("base16", "foobar", "666F6F626172", [102,111,111,98,97,114], base16)
166 ]
167case_base16Tests = mapM_ checkAssertions base16TestData
168
169case_base16TestsFail = do
170 Nothing @=? decode base16 "A"
171 Nothing @=? decode base16 "GH"
172
173-- {{{1 yEncoding
174case_yencTests = do
175 [] @=? Yenc.encode []
176 Just [] @=? Yenc.decode []
177 [0x90] @=? Yenc.encode [0x66]
178 Just [0x66] @=? Yenc.decode [0x90]
179 [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c] @=? Yenc.encode [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72]
180 Just [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72] @=? Yenc.decode [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c]
181 [0x3d, 0x40, 0x01] @=? Yenc.encode [0xd6, 0xd7]
182 Just [0xd6, 0xd7] @=? Yenc.decode [0x3d, 0x40, 0x01]
183 [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d] @=? Yenc.encode [0xd6, 0xe0, 0xe3, 0x13]
184 Just [0xd6, 0xe0, 0xe3, 0x13] @=? Yenc.decode [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d]
185 [[0x3d, 0x40], [0x01, 0x3d, 0x4a]] @=? Yenc.chop 2 [0x3d, 0x40, 0x01, 0x3d, 0x4a]
186
187-- {{{1 quoted-printable
188qpTestData =
189 [ ("qp", "empty", "", [], qp)
190 , ("qp", "foo=bar", "foo=3Dbar", [102,111,111,61,98,97,114], qp)
191 ]
192case_qpTests = mapM_ checkAssertions qpTestData
193
194case_qpTestsSucc = do
195 ["foo=","=3D=","bar"] @=? chop qp 4 "foo=3Dbar"
196
197case_qpTestsFail = do
198 Nothing @=? decode qp "=4"
199 Nothing @=? decode qp "=G"
200
201-- {{{1 python string
202pyTestData =
203 [ ("py", "empty", "", [], py)
204 , ("py", "<0x00><0x1f><0x20><0x7e><0x7f><0xff>", "\\x00\\x1F ~\\x7F\\xFF", [0x00, 0x1f, 0x20, 0x7e, 0x7f, 0xff], py)
205 , ("py", "\"\'\\", "\\\"\\'\\\\", [34, 39, 92], py)
206 ]
207case_pyTests = mapM_ checkAssertions pyTestData
208
209case_pyTestsFail = do
210 Nothing @=? decode py "\\z"
211
212-- {{{1 url encoding
213urlTestData =
214 [ ("url", "empty", "", [], url)
215 , ("url", "aA", "aA", [97, 65], url)
216 , ("url", "~ ", "~%20", [126, 0x20], url)
217 ]
218case_urlTests = mapM_ checkAssertions urlTestData
219
220case_urlTestsFail = do
221 Nothing @=? decode url "%ga"
222 Nothing @=? decode url "%%"
223
224-- {{{1 all the tests
225allTests = $(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 @@
1{-
2 - Copyright : (c) 2009 Magnus Therning
3 - License : BSD3
4 -}
5
6module Main
7 where
8
9import Test.Framework
10
11import qualified DataencQC as DQC
12import qualified DataencUT as DUT
13
14tests = [ DQC.allTests , DUT.allTests ]
15
16main = defaultMain tests
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-24 05:21:44 +0000