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 trail :: Bool
trail xs :: 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 n :: Int
n mbTerm :: Maybe String
mbTerm str :: String
str
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = String -> String
forall a. HasCallStack => String -> a
error ("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 "\r\n" Maybe String
mbTerm
chop :: Int -> String -> String
chop _ "" = ""
chop i :: Int
i xs :: String
xs =
case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i String
xs of
(as :: String
as,"") -> String
as
(as :: String
as,bs :: 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 trail :: Bool
trail bs :: [Word8]
bs = Bool -> Char -> Char -> [Word8] -> String
encodeRawPrim Bool
trail '+' '/' [Word8]
bs
encodeRawPrim :: Bool -> Char -> Char -> [Word8] -> String
encodeRawPrim :: Bool -> Char -> Char -> [Word8] -> String
encodeRawPrim trail :: Bool
trail ch62 :: Char
ch62 ch63 :: Char
ch63 ls :: [Word8]
ls = [Word8] -> String
encoder [Word8]
ls
where
trailer :: [a] -> [a] -> [a]
trailer xs :: [a]
xs ys :: [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 [x :: Word8
x] = String -> String -> String
forall a. [a] -> [a] -> [a]
trailer (Int -> String -> String
forall a. Int -> [a] -> [a]
take 2 ((Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
encode3 Word8 -> Char
f Word8
x 0 0 "")) "=="
encoder [x :: Word8
x,y :: Word8
y] = String -> String -> String
forall a. [a] -> [a] -> [a]
trailer (Int -> String -> String
forall a. Int -> [a] -> [a]
take 3 ((Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
encode3 Word8 -> Char
f Word8
x Word8
y 0 "")) "="
encoder (x :: Word8
x:y :: Word8
y:z :: Word8
z:ws :: [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 f :: Word8 -> Char
f a :: Word8
a b :: Word8
b c :: Word8
c rs :: String
rs =
Word8 -> Char
f (Word32 -> Word8
low6 (Word32
w24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 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` 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` 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` 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` 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 str :: 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 str :: String
str = Char -> Char -> String -> [Word8]
decodePrim '+' '/' String
str
decodePrim :: Char -> Char -> String -> [Word8]
decodePrim :: Char -> Char -> String -> [Word8]
decodePrim ch62 :: Char
ch62 ch63 :: Char
ch63 str :: 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 "" = []
takeUntilEnd ('=':_) = []
takeUntilEnd (x :: Char
x:xs :: String
xs) =
case Char -> Char -> Char -> Maybe Word8
toB64 Char
ch62 Char
ch63 Char
x of
Nothing -> String -> [Word8]
takeUntilEnd String
xs
Just b :: 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 [x :: Word8
x] = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take 1 (Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
x 0 0 0 [])
decoder [x :: Word8
x,y :: Word8
y] = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take 1 (Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
x Word8
y 0 0 [])
decoder [x :: Word8
x,y :: Word8
y,z :: Word8
z] = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take 2 (Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
decode4 Word8
x Word8
y Word8
z 0 [])
decoder (x :: Word8
x:y :: Word8
y:z :: Word8
z:w :: Word8
w:xs :: [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 a :: Word8
a b :: Word8
b c :: Word8
c d :: Word8
d rs :: [Word8]
rs =
(Word32 -> Word8
lowByte (Word32
w24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 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` 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` 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` 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` 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 a :: Char
a b :: Char
b ch :: Char
ch
| Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'A' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '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 'A'))
| Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'a' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z' = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (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 'a'))
| Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9' = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (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 '0'))
| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
a = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 62
| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 63
| Bool
otherwise = Maybe Word8
forall a. Maybe a
Nothing
fromB64 :: Char -> Char -> Word8 -> Char
fromB64 :: Char -> Char -> Word8 -> Char
fromB64 ch62 :: Char
ch62 ch63 :: Char
ch63 x :: Word8
x
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 26 = Int -> Char
chr (Char -> Int
ord '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
< 52 = Int -> Char
chr (Char -> Int
ord 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
xiInt -> Int -> Int
forall a. Num a => a -> a -> a
-26))
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 62 = Int -> Char
chr (Char -> Int
ord '0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
xiInt -> Int -> Int
forall a. Num a => a -> a -> a
-52))
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 62 = Char
ch62
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 63 = Char
ch63
| Bool
otherwise = String -> Char
forall a. HasCallStack => String -> a
error ("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 x :: 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
.&. 0x3f)
lowByte :: Word32 -> Word8
lowByte :: Word32 -> Word8
lowByte x :: 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
.&. 0xff