--------------------------------------------------------------------
-- |
-- Module    : Codec.MIME.Base64
-- Copyright : (c) 2006-2009, Galois, Inc. 
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
-- Stability : provisional
-- Portability: portable
--
-- 
-- Base64 decoding and encoding routines, multiple entry
-- points for either depending on use and level of control
-- wanted over the encoded output (and its input form on the
-- decoding side.)
-- 
--------------------------------------------------------------------
module Codec.MIME.Base64 
        ( encodeRaw         -- :: Bool -> String -> [Word8]
        , encodeRawString   -- :: Bool -> String -> String
        , encodeRawPrim     -- :: Bool -> Char -> Char -> [Word8] -> String

        , formatOutput      -- :: Int    -> Maybe String -> String -> String

        , decode            -- :: String -> [Word8]
        , decodeToString    -- :: String -> String
        , decodePrim        -- :: Char -> Char -> String -> [Word8]
        ) 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 n mbLT str@ formats @str@, splitting it
-- into lines of length @n@. The optional value lets you control what
-- line terminator sequence to use; the default is CRLF (as per MIME.)
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@ lets you control what non-alphanum characters to use
-- (The base64url variation uses @*@ and @-@, for instance.)
-- No support for mapping these to multiple characters in the output though.
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 []) -- upper 4 bits of second val are known to be 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