1747

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 
( encode


13 
, decode


14 
, decode'


15 
, chop


16 
, unchop


17 
) where


18 


19 
import Control.Monad


20 
import Data.Array


21 
import Data.Bits


22 
import Data.Maybe


23 
import Data.Word


24 
import qualified Data.Map as M


25 


26 
 {{{1 enc/dec map


27 
_encMap =


28 
[ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E')


29 
, (5, 'F') , (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J')


30 
, (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O')


31 
, (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T')


32 
, (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y')


33 
, (25, 'Z'), (26, 'a'), (27, 'b'), (28, 'c'), (29, 'd')


34 
, (30, 'e'), (31, 'f'), (32, 'g'), (33, 'h'), (34, 'i')


35 
, (35, 'j'), (36, 'k'), (37, 'l'), (38, 'm'), (39, 'n')


36 
, (40, 'o'), (41, 'p'), (42, 'q'), (43, 'r'), (44, 's')


37 
, (45, 't'), (46, 'u'), (47, 'v'), (48, 'w'), (49, 'x')


38 
, (50, 'y'), (51, 'z'), (52, '0'), (53, '1'), (54, '2')


39 
, (55, '3'), (56, '4'), (57, '5'), (58, '6'), (59, '7')


40 
, (60, '8'), (61, '9'), (62, '+'), (63, '/') ]


41 


42 
 {{{1 encodeArray


43 
encodeArray :: Array Word8 Char


44 
encodeArray = array (0, 64) _encMap


45 


46 
 {{{1 decodeMap


47 
decodeMap :: M.Map Char Word8


48 
decodeMap = M.fromList [(snd i, fst i)  i < _encMap]


49 


50 
 {{{1 encode


51 
  Encode data.


52 
encode :: [Word8]


53 
> String


54 
encode = let


55 
pad n = take n $ repeat 0


56 
enc [] = ""


57 
enc l@[o] = (++ "==") . take 2 .enc $ l ++ pad 2


58 
enc l@[o1, o2] = (++ "=") . take 3 . enc $ l ++ pad 1


59 
enc (o1:o2:o3:os) = let


60 
i1 = o1 `shiftR` 2


61 
i2 = (o1 `shiftL` 4 .. o2 `shiftR` 4) .&. 0x3f


62 
i3 = (o2 `shiftL` 2 .. o3 `shiftR` 6) .&. 0x3f


63 
i4 = o3 .&. 0x3f


64 
in (foldr (\ i s > (encodeArray ! i) : s) "" [i1, i2, i3, i4]) ++ enc os


65 
in enc


66 


67 
 {{{1 decode


68 
  Decode data (lazy).


69 
decode' :: String


70 
> [Maybe Word8]


71 
decode' = let


72 
pad n = take n $ repeat $ Just 0


73 
dec [] = []


74 
dec l@[Just eo1, Just eo2] = take 1 . dec $ l ++ pad 2


75 
dec l@[Just eo1, Just eo2, Just eo3] = take 2 . dec $ l ++ pad 1


76 
dec (Just eo1:Just eo2:Just eo3:Just eo4:eos) = let


77 
o1 = eo1 `shiftL` 2 .. eo2 `shiftR` 4


78 
o2 = eo2 `shiftL` 4 .. eo3 `shiftR` 2


79 
o3 = eo3 `shiftL` 6 .. eo4


80 
in Just o1:Just o2:Just o3:(dec eos)


81 
dec _ = [Nothing]


82 
in


83 
dec . map (flip M.lookup decodeMap) . takeWhile (/= '=')


84 


85 
  Decode data (strict).


86 
decode :: String


87 
> Maybe [Word8]


88 
decode = sequence . decode'


89 


90 
 {{{1 chop


91 
  Chop up a string in parts.


92 



93 
 The length given is rounded down to the nearest multiple of 4.


94 



95 
 /Notes:/


96 



97 
 * PEM requires lines that are 64 characters long.


98 



99 
 * MIME requires lines that are at most 76 characters long.


100 
chop :: Int  ^ length of individual lines


101 
> String


102 
> [String]


103 
chop n "" = []


104 
chop n s = let


105 
enc_len  n < 4 = 4


106 
 otherwise = n `div` 4 * 4


107 
in (take enc_len s) : chop n (drop enc_len s)


108 


109 
 {{{1 unchop


110 
  Concatenate the strings into one long string.


111 
unchop :: [String]


112 
> String


113 
unchop = foldr (++) ""
