diff options
author | Andrew Cady <d@jerkface.net> | 2016-04-26 08:56:21 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2016-04-26 08:57:11 -0400 |
commit | f5fb4f27b4e9cecdc3afc2facc8e39717ea20524 (patch) | |
tree | c0ba039c0fb8eadfb4c22d9b370df997ff81aa19 |
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'
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | GNUmakefile | 32 | ||||
-rw-r--r-- | LICENSE | 27 | ||||
-rw-r--r-- | Setup.hs | 22 | ||||
-rw-r--r-- | dataenc.cabal | 51 | ||||
-rw-r--r-- | src/Codec/Binary/Base16.hs | 102 | ||||
-rw-r--r-- | src/Codec/Binary/Base32.hs | 155 | ||||
-rw-r--r-- | src/Codec/Binary/Base32Hex.hs | 155 | ||||
-rw-r--r-- | src/Codec/Binary/Base64.hs | 145 | ||||
-rw-r--r-- | src/Codec/Binary/Base64Url.hs | 137 | ||||
-rw-r--r-- | src/Codec/Binary/Base85.hs | 142 | ||||
-rw-r--r-- | src/Codec/Binary/DataEncoding.hs | 174 | ||||
-rw-r--r-- | src/Codec/Binary/PythonString.hs | 109 | ||||
-rw-r--r-- | src/Codec/Binary/QuotedPrintable.hs | 101 | ||||
-rw-r--r-- | src/Codec/Binary/Url.hs | 100 | ||||
-rw-r--r-- | src/Codec/Binary/Util.hs | 82 | ||||
-rw-r--r-- | src/Codec/Binary/Uu.hs | 148 | ||||
-rw-r--r-- | src/Codec/Binary/Xx.hs | 149 | ||||
-rw-r--r-- | src/Codec/Binary/Yenc.hs | 83 | ||||
-rw-r--r-- | test-src/DataencQC.hs | 137 | ||||
-rw-r--r-- | test-src/DataencUT.hs | 225 | ||||
-rw-r--r-- | test-src/Test.hs | 16 |
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 | |||
5 | TESTS = dist/build/tests/tests | ||
6 | |||
7 | HPC = hpc | ||
8 | HPC_SUM_OPTS = --exclude=Main --exclude=DataencUT --exclude=DataencQC | ||
9 | |||
10 | all: | ||
11 | @echo "Use Cabal to build, this is only used to run tests!" | ||
12 | |||
13 | test: $(TESTS) | ||
14 | for t in $(TESTS); do ./$${t}; done | ||
15 | |||
16 | report : test | ||
17 | $(HPC) sum $(HPC_SUM_OPTS) --output run_test.tix tests.tix | ||
18 | $(HPC) report run_test.tix | ||
19 | |||
20 | markup : test | ||
21 | $(HPC) sum $(HPC_SUM_OPTS) --output run_test.tix tests.tix | ||
22 | $(HPC) markup run_test.tix | ||
23 | |||
24 | clean: | ||
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 | |||
30 | really-clean: clean | ||
31 | rm -rf .hpc | ||
32 | ./Setup.hs clean | ||
@@ -0,0 +1,27 @@ | |||
1 | Copyright (c) 2007, Magnus Therning | ||
2 | All rights reserved. | ||
3 | |||
4 | Redistribution and use in source and binary forms, with or without | ||
5 | modification, 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 | |||
18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND | ||
19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED | ||
20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE | ||
21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR | ||
22 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES | ||
23 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; | ||
24 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON | ||
25 | ANY 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 | ||
27 | 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 @@ | |||
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 | |||
21 | import Distribution.Simple | ||
22 | 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 @@ | |||
1 | name: dataenc | ||
2 | version: 0.14.0.7 | ||
3 | license: BSD3 | ||
4 | license-file: LICENSE | ||
5 | cabal-version: >= 1.6 | ||
6 | build-type: Simple | ||
7 | author: Magnus Therning | ||
8 | maintainer: Gracjan Polak <gracjanpolak@gmail.com> | ||
9 | homepage: http://www.haskell.org/haskellwiki/Library/Data_encoding | ||
10 | copyright: Magnus Therning, 2007-2012, Gracjan Polak, 2014 | ||
11 | category: Codec | ||
12 | synopsis: Data encoding library | ||
13 | description: Data encoding library currently providing Base16, Base32, | ||
14 | Base32Hex, Base64, Base64Url, Base85, Python string escaping, | ||
15 | Quoted-Printable, URL encoding, uuencode, xxencode, and yEncoding. | ||
16 | extra-source-files: test-src/DataencUT.hs test-src/DataencQC.hs test-src/Test.hs GNUmakefile | ||
17 | |||
18 | flag tests | ||
19 | Description: Build unit and quickcheck tests. | ||
20 | Default: False | ||
21 | |||
22 | library | ||
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 | |||
42 | executable 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>. | ||
10 | module 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 | |||
23 | import Codec.Binary.Util | ||
24 | |||
25 | import Control.Monad | ||
26 | import Data.Array | ||
27 | import Data.Bits | ||
28 | import Data.Maybe | ||
29 | import Data.Word | ||
30 | import 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 | ||
40 | encodeArray :: Array Word8 Char | ||
41 | encodeArray = array (0, 64) _encMap | ||
42 | |||
43 | -- {{{1 decodeMap | ||
44 | decodeMap :: M.Map Char Word8 | ||
45 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
46 | |||
47 | -- {{{1 encode | ||
48 | -- | Incremental encoder function. | ||
49 | encodeInc :: EncIncData -> EncIncRes String | ||
50 | encodeInc EDone = EFinal [] | ||
51 | encodeInc (EChunk os) = EPart (concat $ map toHex os) encodeInc | ||
52 | |||
53 | -- | Encode data. | ||
54 | encode :: [Word8] -> String | ||
55 | encode = encoder encodeInc | ||
56 | |||
57 | -- {{{1 decode | ||
58 | -- | Incremental decoder function. | ||
59 | decodeInc :: DecIncData String -> DecIncRes String | ||
60 | decodeInc 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. | ||
82 | decode :: String -> Maybe [Word8] | ||
83 | decode = 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. | ||
89 | chop :: Int -- ^ length of individual lines | ||
90 | -> String | ||
91 | -> [String] | ||
92 | chop n "" = [] | ||
93 | chop 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. | ||
100 | unchop :: [String] | ||
101 | -> String | ||
102 | 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 @@ | |||
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>. | ||
11 | module 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 | |||
24 | import Codec.Binary.Util | ||
25 | |||
26 | import Control.Monad | ||
27 | import Data.Array | ||
28 | import Data.Bits | ||
29 | import Data.Maybe | ||
30 | import Data.Word | ||
31 | import 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 | ||
44 | encodeArray :: Array Word8 Char | ||
45 | encodeArray = array (0, 32) _encMap | ||
46 | |||
47 | -- {{{1 decodeMap | ||
48 | decodeMap :: M.Map Char Word8 | ||
49 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
50 | |||
51 | -- {{{1 encode | ||
52 | -- | Incremental encoder function. | ||
53 | encodeInc :: EncIncData -> EncIncRes String | ||
54 | encodeInc 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. | ||
86 | encode :: [Word8] -> String | ||
87 | encode = encoder encodeInc | ||
88 | |||
89 | -- {{{1 decode | ||
90 | -- | Incremental decoder function. | ||
91 | decodeInc :: DecIncData String -> DecIncRes String | ||
92 | decodeInc 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. | ||
134 | decode :: String | ||
135 | -> Maybe [Word8] | ||
136 | decode = 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. | ||
142 | chop :: Int -- ^ length of individual lines | ||
143 | -> String | ||
144 | -> [String] | ||
145 | chop n "" = [] | ||
146 | chop 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. | ||
153 | unchop :: [String] | ||
154 | -> String | ||
155 | 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 @@ | |||
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>. | ||
11 | module 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 | |||
24 | import Codec.Binary.Util | ||
25 | |||
26 | import Control.Monad | ||
27 | import Data.Array | ||
28 | import Data.Bits | ||
29 | import Data.Maybe | ||
30 | import Data.Word | ||
31 | import qualified Data.Map as M | ||
32 | |||
33 | import 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 | ||
46 | encodeArray :: Array Word8 Char | ||
47 | encodeArray = array (0, 32) _encMap | ||
48 | |||
49 | -- {{{1 decodeMap | ||
50 | decodeMap :: M.Map Char Word8 | ||
51 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
52 | |||
53 | -- {{{1 encode | ||
54 | -- | Incremental encoder function. | ||
55 | encodeInc :: EncIncData -> EncIncRes String | ||
56 | encodeInc 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. | ||
88 | encode :: [Word8] -> String | ||
89 | encode = encoder encodeInc | ||
90 | |||
91 | -- {{{1 decode | ||
92 | -- | Incremental decoder function. | ||
93 | decodeInc :: DecIncData String -> DecIncRes String | ||
94 | decodeInc 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. | ||
136 | decode :: String | ||
137 | -> Maybe [Word8] | ||
138 | decode = decoder decodeInc | ||
139 | |||
140 | -- {{{1 chop | ||
141 | -- | Chop up a string in parts. | ||
142 | -- | ||
143 | -- See 'Base32.chop' in "Base32" for more details. | ||
144 | chop :: Int -- ^ length of individual lines | ||
145 | -> String | ||
146 | -> [String] | ||
147 | chop = 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. | ||
153 | unchop :: [String] | ||
154 | -> String | ||
155 | 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 @@ | |||
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>. | ||
11 | module 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 | |||
24 | import Codec.Binary.Util | ||
25 | |||
26 | import Control.Monad | ||
27 | import Data.Array | ||
28 | import Data.Bits | ||
29 | import Data.Maybe | ||
30 | import Data.Word | ||
31 | import 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 | ||
50 | encodeArray :: Array Word8 Char | ||
51 | encodeArray = array (0, 64) _encMap | ||
52 | |||
53 | -- {{{1 decodeMap | ||
54 | decodeMap :: M.Map Char Word8 | ||
55 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
56 | |||
57 | -- {{{1 encode | ||
58 | -- | Incremental encoder function. | ||
59 | encodeInc :: EncIncData -> EncIncRes String | ||
60 | encodeInc 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. | ||
81 | encode :: [Word8] -> String | ||
82 | encode = encoder encodeInc | ||
83 | |||
84 | -- {{{1 decode | ||
85 | -- | Incremental decoder function. | ||
86 | decodeInc :: DecIncData String -> DecIncRes String | ||
87 | decodeInc 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. | ||
119 | decode :: String -> Maybe [Word8] | ||
120 | decode = 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. | ||
132 | chop :: Int -- ^ length of individual lines | ||
133 | -> String | ||
134 | -> [String] | ||
135 | chop n "" = [] | ||
136 | chop 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. | ||
143 | unchop :: [String] | ||
144 | -> String | ||
145 | 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 @@ | |||
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>. | ||
10 | module 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 | |||
23 | import Codec.Binary.Util | ||
24 | |||
25 | import Data.Maybe | ||
26 | import Data.Word | ||
27 | import Data.Bits | ||
28 | import Data.Array | ||
29 | import qualified Data.Map as M | ||
30 | |||
31 | import 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 | ||
50 | encodeArray :: Array Word8 Char | ||
51 | encodeArray = array (0, 64) _encMap | ||
52 | |||
53 | -- {{{1 decodeMap | ||
54 | decodeMap :: M.Map Char Word8 | ||
55 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
56 | |||
57 | -- {{{1 encode | ||
58 | -- | Incremental encoder function. | ||
59 | encodeInc :: EncIncData -> EncIncRes String | ||
60 | encodeInc 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. | ||
81 | encode :: [Word8] -> String | ||
82 | encode = encoder encodeInc | ||
83 | |||
84 | -- {{{1 decode | ||
85 | -- | Incremental encoder function. | ||
86 | decodeInc :: DecIncData String -> DecIncRes String | ||
87 | decodeInc 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. | ||
119 | decode :: String -> Maybe [Word8] | ||
120 | decode = decoder decodeInc | ||
121 | |||
122 | -- {{{1 chop | ||
123 | -- | Chop up a string in parts. | ||
124 | -- | ||
125 | -- See 'Base64.chop' in "Base64" for more details. | ||
126 | chop :: Int -- ^ length of individual lines | ||
127 | -> String | ||
128 | -> [String] | ||
129 | chop = 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. | ||
135 | unchop :: [String] | ||
136 | -> String | ||
137 | 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 @@ | |||
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>. | ||
10 | module 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 | |||
23 | import Codec.Binary.Util | ||
24 | |||
25 | import Data.Array | ||
26 | import Data.Bits | ||
27 | import Data.Char | ||
28 | import Data.Maybe | ||
29 | import Data.Word | ||
30 | import 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 | ||
37 | encodeArray :: Array Word8 Char | ||
38 | encodeArray = array (33, 117) _encMap | ||
39 | |||
40 | -- {{{1 decodeMap | ||
41 | decodeMap :: M.Map Char Word8 | ||
42 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
43 | |||
44 | -- {{{1 encode | ||
45 | -- | Incremental encoder function. | ||
46 | encodeInc :: EncIncData -> EncIncRes String | ||
47 | encodeInc 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 \<~ ~\>. | ||
78 | encode :: [Word8] -> String | ||
79 | encode = encoder encodeInc | ||
80 | |||
81 | -- {{{1 decode | ||
82 | -- | Incremental decoder function. | ||
83 | decodeInc :: DecIncData String -> DecIncRes String | ||
84 | decodeInc 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 \<~ ~\>. | ||
122 | decode :: String -> Maybe [Word8] | ||
123 | decode = 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. | ||
129 | chop :: Int -- ^ length of individual lines | ||
130 | -> String | ||
131 | -> [String] | ||
132 | chop _ "" = [] | ||
133 | chop 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. | ||
140 | unchop :: [String] | ||
141 | -> String | ||
142 | 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 @@ | |||
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>. | ||
12 | module 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 | |||
32 | import Data.Word | ||
33 | |||
34 | import qualified Codec.Binary.Base16 as Base16 | ||
35 | import qualified Codec.Binary.Base32 as Base32 | ||
36 | import qualified Codec.Binary.Base32Hex as Base32Hex | ||
37 | import qualified Codec.Binary.Base64 as Base64 | ||
38 | import qualified Codec.Binary.Base64Url as Base64Url | ||
39 | import qualified Codec.Binary.Base85 as Base85 | ||
40 | import qualified Codec.Binary.Url as Url | ||
41 | import qualified Codec.Binary.Uu as Uu | ||
42 | import qualified Codec.Binary.Xx as Xx | ||
43 | import qualified Codec.Binary.QuotedPrintable as QP | ||
44 | import qualified Codec.Binary.PythonString as Py | ||
45 | |||
46 | -- {{{1 DataCodec | ||
47 | -- | Used to group a specific data encoding's functions. | ||
48 | data 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. | ||
58 | base16 :: DataCodec | ||
59 | base16 = 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. | ||
69 | base32 :: DataCodec | ||
70 | base32 = 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. | ||
80 | base32Hex :: DataCodec | ||
81 | base32Hex = 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. | ||
91 | base64 :: DataCodec | ||
92 | base64 = 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. | ||
102 | base64Url :: DataCodec | ||
103 | base64Url = 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. | ||
113 | base85 :: DataCodec | ||
114 | base85 = 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. | ||
124 | uu :: DataCodec | ||
125 | uu = 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. | ||
135 | xx :: DataCodec | ||
136 | xx = 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. | ||
146 | qp :: DataCodec | ||
147 | qp = 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. | ||
157 | py :: DataCodec | ||
158 | py = 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. | ||
168 | url :: DataCodec | ||
169 | url = 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>. | ||
29 | module 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 | |||
42 | import Codec.Binary.Util | ||
43 | |||
44 | import Data.Char | ||
45 | import Data.Maybe | ||
46 | import Data.Word | ||
47 | |||
48 | -- {{{1 encode | ||
49 | -- | Incremental encoder function. | ||
50 | encodeInc :: EncIncData -> EncIncRes String | ||
51 | encodeInc 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. | ||
65 | encode :: [Word8] -> String | ||
66 | encode = encoder encodeInc | ||
67 | |||
68 | -- {{{1 decode | ||
69 | -- | Incremental decoder function. | ||
70 | decodeInc :: DecIncData String -> DecIncRes String | ||
71 | decodeInc 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. | ||
91 | decode :: String -> Maybe [Word8] | ||
92 | decode = decoder decodeInc | ||
93 | |||
94 | -- {{{1 chop | ||
95 | -- | Chop up a string in parts. | ||
96 | chop :: Int -- ^ length of individual lines (values @\< 1@ are ignored) | ||
97 | -> String | ||
98 | -> [String] | ||
99 | chop 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. | ||
107 | unchop :: [String] | ||
108 | -> String | ||
109 | 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 @@ | |||
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>. | ||
16 | module 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 | |||
29 | import Codec.Binary.Util | ||
30 | |||
31 | import Data.Char | ||
32 | import Data.Maybe | ||
33 | import Data.Word | ||
34 | |||
35 | -- {{{1 encode | ||
36 | -- | Incremental encoder function. | ||
37 | encodeInc :: EncIncData -> EncIncRes String | ||
38 | encodeInc 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. | ||
49 | encode :: [Word8] -> String | ||
50 | encode = encoder encodeInc | ||
51 | |||
52 | -- {{{1 decode | ||
53 | -- | Incremental decoder function. | ||
54 | decodeInc :: DecIncData String -> DecIncRes String | ||
55 | decodeInc 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. | ||
72 | decode :: String -> Maybe [Word8] | ||
73 | decode = decoder decodeInc | ||
74 | |||
75 | -- {{{1 chop | ||
76 | -- | Chop up a string in parts. | ||
77 | chop :: Int -- ^ length of individual lines (values @\< 4@ are ignored) | ||
78 | -> String | ||
79 | -> [String] | ||
80 | chop n "" = [] | ||
81 | chop 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. | ||
94 | unchop :: [String] -> String | ||
95 | unchop [] = "" | ||
96 | unchop (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 | |||
12 | module 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 | |||
25 | import Codec.Binary.Util | ||
26 | |||
27 | import qualified Data.Map as M | ||
28 | import Data.Char(ord) | ||
29 | import Data.Word(Word8) | ||
30 | import 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 | |||
38 | encodeMap :: M.Map Word8 Char | ||
39 | encodeMap = M.fromList _unreservedChars | ||
40 | |||
41 | decodeMap :: M.Map Char Word8 | ||
42 | decodeMap = M.fromList [(b, a) | (a, b) <- _unreservedChars] | ||
43 | |||
44 | -- {{{1 encode | ||
45 | -- | Incremental decoder function. | ||
46 | encodeInc :: EncIncData -> EncIncRes String | ||
47 | encodeInc 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. | ||
58 | encode :: [Word8] -> String | ||
59 | encode = encoder encodeInc | ||
60 | |||
61 | -- {{{1 decode | ||
62 | -- | Incremental decoder function. | ||
63 | decodeInc :: DecIncData String -> DecIncRes String | ||
64 | decodeInc 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. | ||
81 | decode :: String | ||
82 | -> Maybe [Word8] | ||
83 | decode = decoder decodeInc | ||
84 | |||
85 | -- {{{1 chop | ||
86 | -- | Chop up a string in parts. | ||
87 | chop :: Int -- ^ length of individual lines | ||
88 | -> String | ||
89 | -> [String] | ||
90 | chop 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 | ||
98 | unchop :: [String] | ||
99 | -> String | ||
100 | 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 @@ | |||
1 | -- | | ||
2 | -- Module : Codec.Binary.Util | ||
3 | -- Copyright : (c) 2009 Magnus Therning | ||
4 | -- License : BSD3 | ||
5 | -- | ||
6 | -- Utility functions used in the other module. | ||
7 | module Codec.Binary.Util | ||
8 | ( toHex | ||
9 | , fromHex | ||
10 | , EncIncData(..) | ||
11 | , EncIncRes(..) | ||
12 | , DecIncData(..) | ||
13 | , DecIncRes(..) | ||
14 | , encoder | ||
15 | , decoder | ||
16 | ) where | ||
17 | |||
18 | import Data.Array | ||
19 | import Data.Bits | ||
20 | import Data.Char | ||
21 | import Data.Word | ||
22 | import qualified Data.Map as M | ||
23 | |||
24 | -- {{{1 hex enc/dec assoc list and maps | ||
25 | hexEncMap = zip [0..] "0123456789ABCDEF" | ||
26 | |||
27 | hexEncodeArray :: Array Word8 Char | ||
28 | hexEncodeArray = array (0, 16) hexEncMap | ||
29 | |||
30 | hexDecodeMap :: M.Map Char Word8 | ||
31 | hexDecodeMap = M.fromList [(b, a) | (a, b) <- hexEncMap] | ||
32 | |||
33 | -- {{{1 toHex | ||
34 | toHex :: Word8 -> String | ||
35 | toHex o = let | ||
36 | hn = o `shiftR` 4 | ||
37 | ln = o .&. 0xf | ||
38 | in [hexEncodeArray ! hn, hexEncodeArray ! ln] | ||
39 | |||
40 | -- {{{1 fromHex | ||
41 | fromHex :: String -> Maybe Word8 | ||
42 | fromHex = 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. | ||
51 | data 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. | ||
55 | data 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 | |||
58 | encoder 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. | ||
63 | data 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. | ||
67 | data 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 | |||
71 | decoder :: (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8] | ||
72 | decoder 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>. | ||
12 | module 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 | |||
25 | import Codec.Binary.Util | ||
26 | |||
27 | import Control.Monad | ||
28 | import Data.Array | ||
29 | import Data.Bits | ||
30 | import Data.Maybe | ||
31 | import Data.Word | ||
32 | import qualified Data.Map as M | ||
33 | |||
34 | -- {{{1 enc/dec map | ||
35 | _encMap = zip [0..] "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_" | ||
36 | |||
37 | -- {{{1 encodeArray | ||
38 | encodeArray :: Array Word8 Char | ||
39 | encodeArray = array (0, 64) _encMap | ||
40 | |||
41 | -- {{{1 decodeMap | ||
42 | decodeMap :: M.Map Char Word8 | ||
43 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
44 | |||
45 | -- {{{1 encode | ||
46 | -- | Incremental encoder function. | ||
47 | encodeInc :: EncIncData -> EncIncRes String | ||
48 | encodeInc 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. | ||
66 | encode :: [Word8] -> String | ||
67 | encode = encoder encodeInc | ||
68 | |||
69 | -- {{{1 decode | ||
70 | -- | Incremental decoder function. | ||
71 | decodeInc :: DecIncData String -> DecIncRes String | ||
72 | decodeInc 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. | ||
104 | decode :: String -> Maybe [Word8] | ||
105 | decode = 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. | ||
119 | chop :: Int -- ^ length (value should be in the range @[5..85]@) | ||
120 | -> String | ||
121 | -> [String] | ||
122 | chop n "" = [] | ||
123 | chop 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. | ||
138 | unchop :: [String] | ||
139 | -> String | ||
140 | unchop 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>. | ||
14 | module 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 | |||
27 | import Codec.Binary.Util | ||
28 | |||
29 | import Control.Monad | ||
30 | import Data.Array | ||
31 | import Data.Bits | ||
32 | import Data.Maybe | ||
33 | import Data.Word | ||
34 | import qualified Data.Map as M | ||
35 | |||
36 | -- {{{1 enc/dec map | ||
37 | _encMap = zip [0..] "+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" | ||
38 | |||
39 | -- {{{1 encodeArray | ||
40 | encodeArray :: Array Word8 Char | ||
41 | encodeArray = array (0, 64) _encMap | ||
42 | |||
43 | -- {{{1 decodeMap | ||
44 | decodeMap :: M.Map Char Word8 | ||
45 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
46 | |||
47 | -- {{{1 encode | ||
48 | -- | Incremental encoder function. | ||
49 | encodeInc :: EncIncData -> EncIncRes String | ||
50 | encodeInc 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. | ||
68 | encode :: [Word8] -> String | ||
69 | encode = encoder encodeInc | ||
70 | |||
71 | -- {{{1 decode | ||
72 | -- | Incremental decoder function. | ||
73 | decodeInc :: DecIncData String -> DecIncRes String | ||
74 | decodeInc 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. | ||
106 | decode :: String | ||
107 | -> Maybe [Word8] | ||
108 | decode = 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. | ||
120 | chop :: Int -- ^ length (value should be in the range @[5..85]@) | ||
121 | -> String | ||
122 | -> [String] | ||
123 | chop n "" = [] | ||
124 | chop 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. | ||
139 | unchop :: [String] | ||
140 | -> String | ||
141 | unchop 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>. | ||
11 | module 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 | |||
24 | import Codec.Binary.Util | ||
25 | |||
26 | import Data.Word | ||
27 | |||
28 | _criticalsIn = [0xd6, 0xe0, 0xe3, 0x13] | ||
29 | _equal = 0x3d | ||
30 | |||
31 | -- {{{1 encode | ||
32 | -- | Incremental encoder function. | ||
33 | encodeInc :: EncIncData -> EncIncRes [Word8] | ||
34 | encodeInc 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. | ||
45 | encode :: [Word8] -> [Word8] | ||
46 | encode = encoder encodeInc | ||
47 | |||
48 | -- {{{1 decode | ||
49 | -- | Incremental decoder function. | ||
50 | decodeInc :: DecIncData [Word8] -> DecIncRes [Word8] | ||
51 | decodeInc 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. | ||
62 | decode :: [Word8] -> Maybe [Word8] | ||
63 | decode = decoder decodeInc | ||
64 | |||
65 | -- {{{1 chop | ||
66 | -- | Chop up a string in parts. | ||
67 | chop :: Int -- ^ length of individual lines | ||
68 | -> [Word8] | ||
69 | -> [[Word8]] | ||
70 | chop _ [] = [] | ||
71 | chop 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. | ||
81 | unchop :: [[Word8]] | ||
82 | -> [Word8] | ||
83 | 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 @@ | |||
1 | {-# OPTIONS_GHC -XTemplateHaskell #-} | ||
2 | |||
3 | {- | ||
4 | - Copyright : (c) 2007 Magnus Therning | ||
5 | - License : BSD3 | ||
6 | -} | ||
7 | |||
8 | module DataencQC | ||
9 | where | ||
10 | |||
11 | import Test.Framework.TH | ||
12 | |||
13 | import Data.Maybe | ||
14 | import Data.Word | ||
15 | import Test.QuickCheck | ||
16 | import Test.Framework.Providers.QuickCheck2 | ||
17 | |||
18 | import qualified Codec.Binary.Uu as Uu | ||
19 | import qualified Codec.Binary.Uu as Xx | ||
20 | import qualified Codec.Binary.Base85 as Base85 | ||
21 | import qualified Codec.Binary.Base64 as Base64 | ||
22 | import qualified Codec.Binary.Base64Url as Base64Url | ||
23 | import qualified Codec.Binary.Base32 as Base32 | ||
24 | import qualified Codec.Binary.Base32Hex as Base32Hex | ||
25 | import qualified Codec.Binary.Base16 as Base16 | ||
26 | import qualified Codec.Binary.Yenc as Yenc | ||
27 | import qualified Codec.Binary.QuotedPrintable as QP | ||
28 | import qualified Codec.Binary.PythonString as Py | ||
29 | import qualified Codec.Binary.Url as Url | ||
30 | |||
31 | -- {{{1 uuencode properties | ||
32 | prop_uuEncode ws = ws == (fromJust . Uu.decode . Uu.encode) ws | ||
33 | where types = ws::[Word8] | ||
34 | |||
35 | prop_uuChop n ws = s == (Uu.unchop . Uu.chop n) s | ||
36 | where | ||
37 | types = (n :: Int, ws::[Word8]) | ||
38 | s = Uu.encode ws | ||
39 | |||
40 | prop_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 | ||
44 | prop_xxEncode ws = ws == (fromJust . Xx.decode . Xx.encode) ws | ||
45 | where types = ws::[Word8] | ||
46 | |||
47 | prop_xxChop n ws = s == (Xx.unchop . Xx.chop n) s | ||
48 | where | ||
49 | types = (n:: Int, ws::[Word8]) | ||
50 | s = Xx.encode ws | ||
51 | |||
52 | prop_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 | ||
56 | prop_base85Encode ws = ws == fromJust (Base85.decode $ Base85.encode ws) | ||
57 | where types = ws::[Word8] | ||
58 | |||
59 | prop_base85Chop n s = s == Base85.unchop (Base85.chop n s) | ||
60 | where types = (n::Int, s::String) | ||
61 | |||
62 | -- {{{1 base64 properties | ||
63 | prop_base64Encode ws = ws == fromJust (Base64.decode $ Base64.encode ws) | ||
64 | where types = ws::[Word8] | ||
65 | |||
66 | prop_base64Chop n s = s == Base64.unchop (Base64.chop n s) | ||
67 | where types = (n::Int, s::String) | ||
68 | |||
69 | -- {{{1 base64url properties | ||
70 | prop_base64UrlEncode ws = ws == fromJust (Base64Url.decode $ Base64Url.encode ws) | ||
71 | where types = ws::[Word8] | ||
72 | |||
73 | prop_base64UrlChop n s = s == Base64Url.unchop (Base64Url.chop n s) | ||
74 | where types = (n::Int, s::String) | ||
75 | |||
76 | -- {{{1 base32 | ||
77 | prop_base32Encode ws = ws == fromJust (Base32.decode $ Base32.encode ws) | ||
78 | where types = ws::[Word8] | ||
79 | |||
80 | prop_base32Chop n s = s == Base32.unchop (Base32.chop n s) | ||
81 | where types = (n::Int, s::String) | ||
82 | |||
83 | -- {{{1 base32hex | ||
84 | prop_base32HexEncode ws = ws == fromJust (Base32Hex.decode $ Base32Hex.encode ws) | ||
85 | where types = ws::[Word8] | ||
86 | |||
87 | prop_base32HexChop n s = s == Base32Hex.unchop (Base32Hex.chop n s) | ||
88 | where types = (n::Int, s::String) | ||
89 | |||
90 | -- {{{1 base16 | ||
91 | prop_base16Encode ws = ws == fromJust (Base16.decode $ Base16.encode ws) | ||
92 | where types = ws::[Word8] | ||
93 | |||
94 | prop_base16Chop n s = s == Base16.unchop (Base16.chop n s) | ||
95 | where types = (n::Int, s::String) | ||
96 | |||
97 | -- {{{1 yEncoding | ||
98 | prop_yencEncode ws = ws == fromJust (Yenc.decode $ Yenc.encode ws) | ||
99 | where types = ws ::[Word8] | ||
100 | |||
101 | prop_yencChop n ws = ws == Yenc.unchop (Yenc.chop n ws) | ||
102 | where types = (n::Int, ws :: [Word8]) | ||
103 | |||
104 | -- {{{1 qp | ||
105 | prop_qpEncode ws = ws == fromJust (QP.decode $ QP.encode ws) | ||
106 | where types = ws :: [Word8] | ||
107 | |||
108 | prop_qpChop n ws = s == (QP.unchop . QP.chop n) s | ||
109 | where | ||
110 | types = (n::Int, ws::[Word8]) | ||
111 | s = QP.encode ws | ||
112 | |||
113 | prop_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 | ||
117 | prop_pyEncode ws = ws == fromJust (Py.decode $ Py.encode ws) | ||
118 | where types = ws :: [Word8] | ||
119 | |||
120 | prop_pyChop n s = s == Py.unchop (Py.chop n s) | ||
121 | where types = (n :: Int, s :: String) | ||
122 | |||
123 | prop_pyCombined n ws = ws == fromJust (runAll ws) | ||
124 | where runAll = Py.decode . Py.unchop . Py.chop n . Py.encode | ||
125 | |||
126 | -- {{{1 url | ||
127 | prop_urlEncode ws = ws == fromJust (Url.decode $ Url.encode ws) | ||
128 | where types = ws :: [Word8] | ||
129 | |||
130 | prop_urlChop n s = s == Url.unchop (Url.chop n s) | ||
131 | where types = (n :: Int, s :: String) | ||
132 | |||
133 | prop_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 | ||
137 | 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 @@ | |||
1 | {-# OPTIONS_GHC -XTemplateHaskell #-} | ||
2 | {- | ||
3 | - Copyright : (c) 2007 Magnus Therning | ||
4 | - License : BSD3 | ||
5 | -} | ||
6 | |||
7 | module DataencUT | ||
8 | where | ||
9 | |||
10 | import Test.HUnit | ||
11 | import Control.Monad | ||
12 | import System.Exit | ||
13 | import Data.Maybe | ||
14 | import qualified Test.Framework.Providers.API as TFAPI | ||
15 | import Test.Framework.TH | ||
16 | import Test.Framework.Providers.HUnit | ||
17 | |||
18 | import Codec.Binary.DataEncoding | ||
19 | import qualified Codec.Binary.Yenc as Yenc | ||
20 | |||
21 | -- {{{1 checkAssertions | ||
22 | checkAssertions (suite, desc, enc, dec, codec) = do | ||
23 | enc @=? encode codec dec | ||
24 | dec @=? fromJust (decode codec enc) | ||
25 | |||
26 | -- {{{1 uuencode tests | ||
27 | uuTestData = | ||
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 | ] | ||
36 | case_uuTests = mapM_ checkAssertions uuTestData | ||
37 | |||
38 | case_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 | |||
46 | case_uuTestsFail = do | ||
47 | Nothing @=? decode uu "A" | ||
48 | Nothing @=? decode uu "aa" | ||
49 | |||
50 | -- {{{1 xxencode tests | ||
51 | xxTestData = | ||
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 | ] | ||
60 | case_xxTest = mapM_ checkAssertions xxTestData | ||
61 | |||
62 | case_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 | |||
70 | case_xxTestsFail = do | ||
71 | Nothing @=? decode xx "A" | ||
72 | Nothing @=? decode xx "''" | ||
73 | |||
74 | -- {{{1 base85 tests | ||
75 | base85TestData = | ||
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 | ] | ||
89 | case_base85Tests = mapM_ checkAssertions base85TestData | ||
90 | |||
91 | case_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 | ||
98 | base64TestData = | ||
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 | ] | ||
110 | case_base64Tests = mapM_ checkAssertions base64TestData | ||
111 | |||
112 | case_base64TestsFail = do | ||
113 | Nothing @=? decode base64 "A" | ||
114 | Nothing @=? decode base64 "!!" | ||
115 | |||
116 | -- {{{1 base64url tests | ||
117 | base64UrlTestData = | ||
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 | ] | ||
123 | case_base64UrlTests = mapM_ checkAssertions base64UrlTestData | ||
124 | |||
125 | -- {{{1 base32 tests | ||
126 | base32TestData = | ||
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 | ] | ||
135 | case_base32Tests = mapM_ checkAssertions base32TestData | ||
136 | |||
137 | case_base32TestsFail = do | ||
138 | Nothing @=? decode base32 "A" | ||
139 | Nothing @=? decode base32 "gh" | ||
140 | |||
141 | -- {{{1 base32hex tests | ||
142 | base32HexTestData = | ||
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 | ] | ||
151 | case_base32HexTests = mapM_ checkAssertions base32HexTestData | ||
152 | |||
153 | case_base32HexTestsFail = do | ||
154 | Nothing @=? decode base32Hex "A" | ||
155 | Nothing @=? decode base32Hex "gh" | ||
156 | |||
157 | -- {{{1 base16 (hex) | ||
158 | base16TestData = | ||
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 | ] | ||
167 | case_base16Tests = mapM_ checkAssertions base16TestData | ||
168 | |||
169 | case_base16TestsFail = do | ||
170 | Nothing @=? decode base16 "A" | ||
171 | Nothing @=? decode base16 "GH" | ||
172 | |||
173 | -- {{{1 yEncoding | ||
174 | case_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 | ||
188 | qpTestData = | ||
189 | [ ("qp", "empty", "", [], qp) | ||
190 | , ("qp", "foo=bar", "foo=3Dbar", [102,111,111,61,98,97,114], qp) | ||
191 | ] | ||
192 | case_qpTests = mapM_ checkAssertions qpTestData | ||
193 | |||
194 | case_qpTestsSucc = do | ||
195 | ["foo=","=3D=","bar"] @=? chop qp 4 "foo=3Dbar" | ||
196 | |||
197 | case_qpTestsFail = do | ||
198 | Nothing @=? decode qp "=4" | ||
199 | Nothing @=? decode qp "=G" | ||
200 | |||
201 | -- {{{1 python string | ||
202 | pyTestData = | ||
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 | ] | ||
207 | case_pyTests = mapM_ checkAssertions pyTestData | ||
208 | |||
209 | case_pyTestsFail = do | ||
210 | Nothing @=? decode py "\\z" | ||
211 | |||
212 | -- {{{1 url encoding | ||
213 | urlTestData = | ||
214 | [ ("url", "empty", "", [], url) | ||
215 | , ("url", "aA", "aA", [97, 65], url) | ||
216 | , ("url", "~ ", "~%20", [126, 0x20], url) | ||
217 | ] | ||
218 | case_urlTests = mapM_ checkAssertions urlTestData | ||
219 | |||
220 | case_urlTestsFail = do | ||
221 | Nothing @=? decode url "%ga" | ||
222 | Nothing @=? decode url "%%" | ||
223 | |||
224 | -- {{{1 all the tests | ||
225 | 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 @@ | |||
1 | {- | ||
2 | - Copyright : (c) 2009 Magnus Therning | ||
3 | - License : BSD3 | ||
4 | -} | ||
5 | |||
6 | module Main | ||
7 | where | ||
8 | |||
9 | import Test.Framework | ||
10 | |||
11 | import qualified DataencQC as DQC | ||
12 | import qualified DataencUT as DUT | ||
13 | |||
14 | tests = [ DQC.allTests , DUT.allTests ] | ||
15 | |||
16 | main = defaultMain tests | ||