summaryrefslogtreecommitdiff
path: root/src/Codec
diff options
context:
space:
mode:
Diffstat (limited to 'src/Codec')
-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
14 files changed, 1782 insertions, 0 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-15 05:57:09 +0000