module WASH.Utility.Base32 (encode, decode) where
import Bits
import Char
import List
encode :: String -> String
encode = encBase32
decode :: String -> String
decode = decBase32
makeGroups :: Int -> [a] -> [[a]]
makeGroups 0 lst = error "makeGroups: Invalid group length"
makeGroups n [] = []
makeGroups n lst = take n lst : makeGroups n (drop n lst)
makeBits charLength ordFunc str = foldr (+) 0 bitValues
where
bitValues = zipWith (\a b -> intVal a `shiftL` b) (reverse str) [0,charLength..]
intVal a = toInteger (ordFunc a)
makeBitsASCII = makeBits 8 ord
makeBitsBase32 = makeBits 5 b32Ord
makeMultipleOfNBits bitFunc charSize n str
| len `mod` n == 0 = bitFunc str
| otherwise = (bitFunc str) `shiftL` (remBitCount len)
where
remBitCount m = (0 (m `mod` n) + n) `mod` n
len = length str * charSize;
makeMultipleOfNBitsASCII = makeMultipleOfNBits (makeBits 8 ord) 8
makeMultipleOfNBitsBase32 = makeMultipleOfNBits (makeBits 5 b32Ord) 5
b32Chr n = b32tab !! (fromEnum n)
where
b32tab = ['A'..'Z'] ++ ['2'..'7']
b32Ord c
| c >= 'A' && c <= 'Z' = ord(c) 65
| c >= '2' && c <= '7' = ord(c) 24
| otherwise = error "b32Ord: No Base character"
encBase32Block str
| len == 0 = ""
| len == 1 = concat (b32Map [5,0]) ++ "======"
| len == 2 = concat (b32Map [15,10..0]) ++ "===="
| len == 3 = concat (b32Map [20,15..0]) ++ "==="
| len == 4 = concat (b32Map [30,25..0]) ++ "="
| len == 5 = concat (b32Map [35,30..0])
| otherwise = error "encBase32Block: Invalid block length"
where
b32Map = map (\x -> [b32Chr(bitStr `shiftR` x .&. 31)])
bitStr = makeMultipleOfNBitsASCII 5 str
len = length str
decBase32Block str
| len == 0 = ""
| len == 2 = concat . (shiftAndMap [0] 2) . makeBitsBase32 $ code
| len == 4 = concat . (shiftAndMap [8,0] 4) . makeBitsBase32 $ code
| len == 5 = concat . (shiftAndMap [16,8,0] 1) . makeBitsBase32 $ code
| len == 7 = concat . (shiftAndMap [24,16..0] 3) . makeBitsBase32 $ code
| len == 8 = concat . (shiftAndMap [32,24..0] 0) . makeBitsBase32 $ code
| otherwise = error "decBase32Block: Invalid block length"
where
shiftAndMap sf n = (asciiMap sf) . (`shiftR` n)
asciiMap sf c = map (\x -> [chr . fromEnum $ (c `shiftR` x .&. 255)]) sf
len = length code
code = filter (/= '=') str
encBase32 :: String -> String
encBase32 = concat . map encBase32Block . makeGroups 5
decBase32 :: String -> String
decBase32 = concat . map decBase32Block . makeGroups 8