-- |
-- Module    : Codec.Binary.Base32
-- Copyright : (c) 2007 Magnus Therning
-- License   : BSD3
--
-- Implemented as specified in RFC 4648
-- (<http://tools.ietf.org/html/rfc4648>).
--
-- Further documentation and information can be found at
-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
module Codec.Binary.Base32
    ( EncIncData(..)
    , EncIncRes(..)
    , encodeInc
    , encode
    , DecIncData(..)
    , DecIncRes(..)
    , decodeInc
    , decode
    , chop
    , unchop
    ) where

import Codec.Binary.Util

import Control.Monad
import Data.Array
import Data.Bits
import Data.Maybe
import Data.Word
import qualified Data.Map as M

-- {{{1 enc/dec map
_encMap :: [(Word8, Char)]
_encMap =
    [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E')
    , (5, 'F'), (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J')
    , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O')
    , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T')
    , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y')
    , (25, 'Z'), (26, '2'), (27, '3'), (28, '4'), (29, '5')
    , (30, '6'), (31, '7') ]

-- {{{1 encodeArray
encodeArray :: Array Word8 Char
encodeArray :: Array Word8 Char
encodeArray = (Word8, Word8) -> [(Word8, Char)] -> Array Word8 Char
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (0, 32) [(Word8, Char)]
_encMap

-- {{{1 decodeMap
decodeMap :: M.Map Char Word8
decodeMap :: Map Char Word8
decodeMap = [(Char, Word8)] -> Map Char Word8
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((Word8, Char) -> Char
forall a b. (a, b) -> b
snd (Word8, Char)
i, (Word8, Char) -> Word8
forall a b. (a, b) -> a
fst (Word8, Char)
i) | (Word8, Char)
i <- [(Word8, Char)]
_encMap]

-- {{{1 encode
-- | Incremental encoder function.
encodeInc :: EncIncData -> EncIncRes String
encodeInc :: EncIncData -> EncIncRes String
encodeInc e :: EncIncData
e = [Word8] -> EncIncData -> EncIncRes String
eI [] EncIncData
e
    where
        enc5 :: [Word8] -> String
enc5 [o1 :: Word8
o1, o2 :: Word8
o2, o3 :: Word8
o3, o4 :: Word8
o4, o5 :: Word8
o5] = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Array Word8 Char
encodeArray Array Word8 Char -> Word8 -> Char
forall i e. Ix i => Array i e -> i -> e
!) [Word8
i1, Word8
i2, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8]
            where
                i1 :: Word8
i1 = Word8
o1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 3
                i2 :: Word8
i2 = (Word8
o1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
o2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f
                i3 :: Word8
i3 = Word8
o2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f
                i4 :: Word8
i4 = (Word8
o2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
o3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f
                i5 :: Word8
i5 = (Word8
o3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
o4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 7) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f
                i6 :: Word8
i6 = Word8
o4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f
                i7 :: Word8
i7 = (Word8
o4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 3 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
o5 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f
                i8 :: Word8
i8 = Word8
o5 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f

        eI :: [Word8] -> EncIncData -> EncIncRes String
eI [] EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal []
        eI [o1 :: Word8
o1] EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal (Int -> String -> String
forall a. Int -> [a] -> [a]
take 2 String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "======")
            where
                cs :: String
cs = [Word8] -> String
enc5 [Word8
o1, 0, 0, 0, 0]
        eI [o1 :: Word8
o1, o2 :: Word8
o2] EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal (Int -> String -> String
forall a. Int -> [a] -> [a]
take 4 String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "====")
            where
                cs :: String
cs = [Word8] -> String
enc5 [Word8
o1, Word8
o2, 0, 0, 0]
        eI [o1 :: Word8
o1, o2 :: Word8
o2, o3 :: Word8
o3] EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal (Int -> String -> String
forall a. Int -> [a] -> [a]
take 5 String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "===")
            where
                cs :: String
cs = [Word8] -> String
enc5 [Word8
o1, Word8
o2, Word8
o3, 0, 0]
        eI [o1 :: Word8
o1, o2 :: Word8
o2, o3 :: Word8
o3, o4 :: Word8
o4] EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal (Int -> String -> String
forall a. Int -> [a] -> [a]
take 7 String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "=")
            where
                cs :: String
cs = [Word8] -> String
enc5 [Word8
o1, Word8
o2, Word8
o3, Word8
o4, 0]
        eI lo :: [Word8]
lo (EChunk bs :: [Word8]
bs) = String -> [Word8] -> EncIncRes String
doEnc [] ([Word8]
lo [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
bs)
            where
                doEnc :: String -> [Word8] -> EncIncRes String
doEnc acc :: String
acc (o1 :: Word8
o1:o2 :: Word8
o2:o3 :: Word8
o3:o4 :: Word8
o4:o5 :: Word8
o5:os :: [Word8]
os) = String -> [Word8] -> EncIncRes String
doEnc (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
enc5 [Word8
o1, Word8
o2, Word8
o3, Word8
o4, Word8
o5]) [Word8]
os
                doEnc acc :: String
acc os :: [Word8]
os = String -> (EncIncData -> EncIncRes String) -> EncIncRes String
forall i. i -> (EncIncData -> EncIncRes i) -> EncIncRes i
EPart String
acc ([Word8] -> EncIncData -> EncIncRes String
eI [Word8]
os)

-- | Encode data.
encode :: [Word8] -> String
encode :: [Word8] -> String
encode = (EncIncData -> EncIncRes String) -> [Word8] -> String
forall a. (EncIncData -> EncIncRes [a]) -> [Word8] -> [a]
encoder EncIncData -> EncIncRes String
encodeInc

-- {{{1 decode
-- | Incremental decoder function.
decodeInc :: DecIncData String -> DecIncRes String
decodeInc :: DecIncData String -> DecIncRes String
decodeInc d :: DecIncData String
d = String -> DecIncData String -> DecIncRes String
dI [] DecIncData String
d
    where
        dec8 :: String -> Maybe [Word8]
dec8 cs :: String
cs = let
                ds :: [Maybe Word8]
ds = (Char -> Maybe Word8) -> String -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Map Char Word8 -> Maybe Word8)
-> Map Char Word8 -> Char -> Maybe Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Map Char Word8 -> Maybe Word8
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Char Word8
decodeMap) String
cs
                es :: [Word8]
es@[e1 :: Word8
e1, e2 :: Word8
e2, e3 :: Word8
e3, e4 :: Word8
e4, e5 :: Word8
e5, e6 :: Word8
e6, e7 :: Word8
e7, e8 :: Word8
e8] = (Maybe Word8 -> Word8) -> [Maybe Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Word8 -> Word8
forall a. HasCallStack => Maybe a -> a
fromJust [Maybe Word8]
ds
                o1 :: Word8
o1 = Word8
e1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 3 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 2
                o2 :: Word8
o2 = Word8
e2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 6 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 4
                o3 :: Word8
o3 = Word8
e4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e5 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 1
                o4 :: Word8
o4 = Word8
e5 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 7 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e6 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 3
                o5 :: Word8
o5 = Word8
e7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 5 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e8
                allJust :: [Maybe a] -> Bool
allJust = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([Maybe a] -> [Bool]) -> [Maybe a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> [Maybe a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Maybe a -> Bool
forall a. Maybe a -> Bool
isJust
            in if [Maybe Word8] -> Bool
forall a. [Maybe a] -> Bool
allJust [Maybe Word8]
ds
                then [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just [Word8
o1, Word8
o2, Word8
o3, Word8
o4, Word8
o5]
                else Maybe [Word8]
forall a. Maybe a
Nothing

        dI :: String -> DecIncData String -> DecIncRes String
dI [] DDone = [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal [] []
        dI lo :: String
lo DDone = [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [] String
lo
        dI lo :: String
lo (DChunk s :: String
s) = [Word8] -> String -> DecIncRes String
doDec [] (String
lo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
            where
                doDec :: [Word8] -> String -> DecIncRes String
doDec acc :: [Word8]
acc s :: String
s@(c1 :: Char
c1:c2 :: Char
c2:'=':'=':'=':'=':'=':'=':cs :: String
cs) = DecIncRes String
-> ([Word8] -> DecIncRes String)
-> Maybe [Word8]
-> DecIncRes String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    ([Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s)
                    (\ bs :: [Word8]
bs -> [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take 1 [Word8]
bs) String
cs)
                    (String -> Maybe [Word8]
dec8 [Char
c1, Char
c2, 'A', 'A', 'A', 'A', 'A', 'A'])
                doDec acc :: [Word8]
acc s :: String
s@(c1 :: Char
c1:c2 :: Char
c2:c3 :: Char
c3:c4 :: Char
c4:'=':'=':'=':'=':cs :: String
cs) = DecIncRes String
-> ([Word8] -> DecIncRes String)
-> Maybe [Word8]
-> DecIncRes String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    ([Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s)
                    (\ bs :: [Word8]
bs -> [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take 2 [Word8]
bs) String
cs)
                    (String -> Maybe [Word8]
dec8 [Char
c1, Char
c2, Char
c3, Char
c4, 'A', 'A', 'A', 'A'])
                doDec acc :: [Word8]
acc s :: String
s@(c1 :: Char
c1:c2 :: Char
c2:c3 :: Char
c3:c4 :: Char
c4:c5 :: Char
c5:'=':'=':'=':cs :: String
cs) = DecIncRes String
-> ([Word8] -> DecIncRes String)
-> Maybe [Word8]
-> DecIncRes String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    ([Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s)
                    (\ bs :: [Word8]
bs -> [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take 3 [Word8]
bs) String
cs)
                    (String -> Maybe [Word8]
dec8 [Char
c1, Char
c2, Char
c3, Char
c4, Char
c5, 'A', 'A', 'A'])
                doDec acc :: [Word8]
acc s :: String
s@(c1 :: Char
c1:c2 :: Char
c2:c3 :: Char
c3:c4 :: Char
c4:c5 :: Char
c5:c6 :: Char
c6:c7 :: Char
c7:'=':cs :: String
cs) = DecIncRes String
-> ([Word8] -> DecIncRes String)
-> Maybe [Word8]
-> DecIncRes String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    ([Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s)
                    (\ bs :: [Word8]
bs -> [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take 4 [Word8]
bs) String
cs)
                    (String -> Maybe [Word8]
dec8 [Char
c1, Char
c2, Char
c3, Char
c4, Char
c5, Char
c6, Char
c7, 'A'])
                doDec acc :: [Word8]
acc s :: String
s@(c1 :: Char
c1:c2 :: Char
c2:c3 :: Char
c3:c4 :: Char
c4:c5 :: Char
c5:c6 :: Char
c6:c7 :: Char
c7:c8 :: Char
c8:cs :: String
cs) = DecIncRes String
-> ([Word8] -> DecIncRes String)
-> Maybe [Word8]
-> DecIncRes String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    ([Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s)
                    (\ bs :: [Word8]
bs -> [Word8] -> String -> DecIncRes String
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
bs) String
cs)
                    (String -> Maybe [Word8]
dec8 [Char
c1, Char
c2, Char
c3, Char
c4, Char
c5, Char
c6, Char
c7, Char
c8])
                doDec acc :: [Word8]
acc s :: String
s = [Word8]
-> (DecIncData String -> DecIncRes String) -> DecIncRes String
forall i. [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
DPart [Word8]
acc (String -> DecIncData String -> DecIncRes String
dI String
s)

-- | Decode data.
decode :: String
    -> Maybe [Word8]
decode :: String -> Maybe [Word8]
decode = (DecIncData String -> DecIncRes String) -> String -> Maybe [Word8]
forall i. (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]
decoder DecIncData String -> DecIncRes String
decodeInc

-- {{{1 chop
-- | Chop up a string in parts.
--
--   The length given is rounded down to the nearest multiple of 8.
chop :: Int     -- ^ length of individual lines
    -> String
    -> [String]
chop :: Int -> String -> [String]
chop n :: Int
n "" = []
chop n :: Int
n s :: String
s = let
        enc_len :: Int
enc_len | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 8 = 8
                | Bool
otherwise = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8
    in Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
enc_len String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
chop Int
n (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
enc_len String
s)

-- {{{1 unchop
-- | Concatenate the strings into one long string.
unchop :: [String]
    -> String
unchop :: [String] -> String
unchop = (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> String -> String
forall a. [a] -> [a] -> [a]
(++) ""