module Codec.MIME.Base64
( encodeRaw
, encodeRawString
, encodeRawPrim
, formatOutput
, decode
, decodeToString
, decodePrim
) where
import Data.Bits
import Data.Char
import Data.Word
import Data.Maybe
encodeRawString :: Bool -> String -> String
encodeRawString :: Bool -> String -> String
encodeRawString Bool
trail String
xs = Bool -> [Word8] -> String
encodeRaw Bool
trail ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
ord) String
xs)
formatOutput :: Int -> Maybe String -> String -> String
formatOutput :: Int -> Maybe String -> String -> String
formatOutput Int
n Maybe String
mbTerm String
str
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> String
forall a. HasCallStack => String -> a
error (String
"Codec.MIME.Base64.formatOutput: negative line length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
| Bool
otherwise = Int -> String -> String
chop Int
n String
str
where
crlf :: String
crlf :: String
crlf = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"\r\n" Maybe String
mbTerm
chop :: Int -> String -> String
chop Int
_ String
"" = String
""
chop Int
i String
xs =
case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i String
xs of
(String
as,String
"") -> String
as
(String
as,String
bs) -> String
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
crlf String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
chop Int
i String
bs
encodeRaw :: Bool -> [Word8] -> String
encodeRaw :: Bool -> [Word8] -> String
encodeRaw Bool
trail [Word8]
bs = Bool -> Char -> Char -> [Word8] -> String
encodeRawPrim Bool
trail Char
'+' Char
'/' [Word8]
bs
encodeRawPrim :: Bool -> Char -> Char -> [Word8] -> String
encodeRawPrim :: Bool -> Char -> Char -> [Word8] -> String
encodeRawPrim Bool
trail Char
ch62 Char
ch63 [Word8]
ls = [Word8] -> String
encoder [Word8]
ls
where
trailer :: [a] -> [a] -> [a]
trailer [a]
xs [a]
ys
| Bool -> Bool
not Bool
trail = [a]
xs
| Bool
otherwise = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys
f :: Word8 -> Char
f = Char -> Char -> Word8 -> Char
fromB64 Char
ch62 Char
ch63
encoder :: [Word8] -> String
encoder [] = []
encoder [Word8
x] = String -> String -> String
forall a. [a] -> [a] -> [a]
trailer (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 ((Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
encode3 Word8 -> Char
f Word8
x Word8
0 Word8
0 String
"")) String
"=="
encoder [Word8
x,Word8
y] = String -> String -> String
forall a. [a] -> [a] -> [a]
trailer (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 ((Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
encode3 Word8 -> Char
f Word8
x Word8
y Word8
0 String
"")) String
"="
encoder (Word8
x:Word8
y:Word8
z:[Word8]
ws) = (Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
encode3 Word8 -> Char
f Word8
x Word8
y Word8
z ([Word8] -> String
encoder [Word8]
ws)
encode3 :: (Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
encode3 :: (Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
encode3 Word8 -> Char
f Word8
a Word8
b Word8
c String
rs =
Word8 -> Char
f (Word32 -> Word8
low6 (Word32
w24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
18)) Char -> String -> String
forall a. a -> [a] -> [a]
:
Word8 -> Char
f (Word32 -> Word8
low6 (Word32
w24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
12)) Char -> String -> String
forall a. a -> [a] -> [a]
:
Word8 -> Char
f (Word32 -> Word8
low6 (Word32
w24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)) Char -> String -> String
forall a. a -> [a] -> [a]
:
Word8 -> Char
f (Word32 -> Word8
low6 Word32
w24) Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs
where
w24 :: Word32
w24 :: Word32
w24 = (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+
Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c
decodeToString :: String -> String
decodeToString :: String -> String
decodeToString String
str = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr(Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ String -> [Word8]
decode String
str
decode :: String -> [Word8]
decode :: String -> [Word8]
decode String
str = Char -> Char -> String -> [Word8]
decodePrim Char
'+' Char
'/' String
str
decodePrim :: Char -> Char -> String -> [Word8]
decodePrim :: Char -> Char -> String -> [Word8]
decodePrim Char
ch62 Char
ch63 String
str = [Word8] -> [Word8]
decoder ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ String -> [Word8]
takeUntilEnd String
str
where
takeUntilEnd :: String -> [Word8]
takeUntilEnd String
"" = []
takeUntilEnd (Char
'=':String
_) = []
takeUntilEnd (Char
x:String
xs) =
case Char -> Char -> Char -> Maybe Word8
toB64 Char
ch62 Char
ch63 Char
x of
Maybe Word8
Nothing -> String -> [Word8]
takeUntilEnd String
xs
Just Word8
b -> Word8
b Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: String -> [Word8]
takeUntilEnd String
xs
decoder :: [Word8] -> [Word8]
decoder :: [Word8] -> [Word8]
decoder [] = []
decoder [Word8
x] = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
1 (Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
x Word8
0 Word8
0 Word8
0 [])
decoder [Word8
x,Word8
y] = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
1 (Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
x Word8
y Word8
0 Word8
0 [])
decoder [Word8
x,Word8
y,Word8
z] = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
2 (Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
x Word8
y Word8
z Word8
0 [])
decoder (Word8
x:Word8
y:Word8
z:Word8
w:[Word8]
xs) = Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
x Word8
y Word8
z Word8
w ([Word8] -> [Word8]
decoder [Word8]
xs)
decode4 :: Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 :: Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
a Word8
b Word8
c Word8
d [Word8]
rs =
(Word32 -> Word8
lowByte (Word32
w24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:
(Word32 -> Word8
lowByte (Word32
w24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:
(Word32 -> Word8
lowByte Word32
w24) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
rs
where
w24 :: Word32
w24 :: Word32
w24 =
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
18 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
12 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
6 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d)
toB64 :: Char -> Char -> Char -> Maybe Word8
toB64 :: Char -> Char -> Char -> Maybe Word8
toB64 Char
a Char
b Char
ch
| Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A'))
| Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8
26 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'))
| Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8
52 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'))
| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
a = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
62
| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
63
| Bool
otherwise = Maybe Word8
forall a. Maybe a
Nothing
fromB64 :: Char -> Char -> Word8 -> Char
fromB64 :: Char -> Char -> Word8 -> Char
fromB64 Char
ch62 Char
ch63 Word8
x
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
26 = Int -> Char
chr (Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xi)
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
52 = Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
xiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
26))
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
62 = Int -> Char
chr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
xiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
52))
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
62 = Char
ch62
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
63 = Char
ch63
| Bool
otherwise = String -> Char
forall a. HasCallStack => String -> a
error (String
"fromB64: index out of range " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x)
where
xi :: Int
xi :: Int
xi = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
low6 :: Word32 -> Word8
low6 :: Word32 -> Word8
low6 Word32
x = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x3f)
lowByte :: Word32 -> Word8
lowByte :: Word32 -> Word8
lowByte Word32
x = (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xff