-----------------------------------------------------------------------------
-- |
-- Module      :  Codec.Binary.Base64
-- Copyright   :  (c) Dominic Steinitz 2005, Warrick Gray 2002
-- License     :  BSD-style (see the file ReadMe.tex)
--
-- Maintainer  :  dominic.steinitz@blueyonder.co.uk
-- Stability   :  experimental
-- Portability :  portable
--
-- Base64 encoding and decoding functions provided by Warwick Gray. 
-- See <http://homepages.paradise.net.nz/warrickg/haskell/http/#base64> 
-- and <http://www.faqs.org/rfcs/rfc2045.html>.
--
-----------------------------------------------------------------------------

module Network.HTTP.Base64
   ( encode
   , decode
   , chop72
   , Octet
   ) where

{------------------------------------------------------------------------
This is what RFC2045 had to say:

6.8.  Base64 Content-Transfer-Encoding

   The Base64 Content-Transfer-Encoding is designed to represent
   arbitrary sequences of octets in a form that need not be humanly
   readable.  The encoding and decoding algorithms are simple, but the
   encoded data are consistently only about 33 percent larger than the
   unencoded data.  This encoding is virtually identical to the one used
   in Privacy Enhanced Mail (PEM) applications, as defined in RFC 1421.

   A 65-character subset of US-ASCII is used, enabling 6 bits to be
   represented per printable character. (The extra 65th character, "=",
   is used to signify a special processing function.)

   NOTE:  This subset has the important property that it is represented
   identically in all versions of ISO 646, including US-ASCII, and all
   characters in the subset are also represented identically in all
   versions of EBCDIC. Other popular encodings, such as the encoding
   used by the uuencode utility, Macintosh binhex 4.0 [RFC-1741], and
   the base85 encoding specified as part of Level 2 PostScript, do not
   share these properties, and thus do not fulfill the portability
   requirements a binary transport encoding for mail must meet.

   The encoding process represents 24-bit groups of input bits as output
   strings of 4 encoded characters.  Proceeding from left to right, a
   24-bit input group is formed by concatenating 3 8bit input groups.
   These 24 bits are then treated as 4 concatenated 6-bit groups, each
   of which is translated into a single digit in the base64 alphabet.
   When encoding a bit stream via the base64 encoding, the bit stream
   must be presumed to be ordered with the most-significant-bit first.
   That is, the first bit in the stream will be the high-order bit in
   the first 8bit byte, and the eighth bit will be the low-order bit in
   the first 8bit byte, and so on.

   Each 6-bit group is used as an index into an array of 64 printable
   characters.  The character referenced by the index is placed in the
   output string.  These characters, identified in Table 1, below, are
   selected so as to be universally representable, and the set excludes
   characters with particular significance to SMTP (e.g., ".", CR, LF)
   and to the multipart boundary delimiters defined in RFC 2046 (e.g.,
   "-").



                    Table 1: The Base64 Alphabet

     Value Encoding  Value Encoding  Value Encoding  Value Encoding
         0 A            17 R            34 i            51 z
         1 B            18 S            35 j            52 0
         2 C            19 T            36 k            53 1
         3 D            20 U            37 l            54 2
         4 E            21 V            38 m            55 3
         5 F            22 W            39 n            56 4
         6 G            23 X            40 o            57 5
         7 H            24 Y            41 p            58 6
         8 I            25 Z            42 q            59 7
         9 J            26 a            43 r            60 8
        10 K            27 b            44 s            61 9
        11 L            28 c            45 t            62 +
        12 M            29 d            46 u            63 /
        13 N            30 e            47 v
        14 O            31 f            48 w         (pad) =
        15 P            32 g            49 x
        16 Q            33 h            50 y

   The encoded output stream must be represented in lines of no more
   than 76 characters each.  All line breaks or other characters not
   found in Table 1 must be ignored by decoding software.  In base64
   data, characters other than those in Table 1, line breaks, and other
   white space probably indicate a transmission error, about which a
   warning message or even a message rejection might be appropriate
   under some circumstances.

   Special processing is performed if fewer than 24 bits are available
   at the end of the data being encoded.  A full encoding quantum is
   always completed at the end of a body.  When fewer than 24 input bits
   are available in an input group, zero bits are added (on the right)
   to form an integral number of 6-bit groups.  Padding at the end of
   the data is performed using the "=" character.  Since all base64
   input is an integral number of octets, only the following cases can
   arise: (1) the final quantum of encoding input is an integral
   multiple of 24 bits; here, the final unit of encoded output will be
   an integral multiple of 4 characters with no "=" padding, (2) the
   final quantum of encoding input is exactly 8 bits; here, the final
   unit of encoded output will be two characters followed by two "="
   padding characters, or (3) the final quantum of encoding input is
   exactly 16 bits; here, the final unit of encoded output will be three
   characters followed by one "=" padding character.

   Because it is used only for padding at the end of the data, the
   occurrence of any "=" characters may be taken as evidence that the
   end of the data has been reached (without truncation in transit).  No
   such assurance is possible, however, when the number of octets
   transmitted was a multiple of three and no "=" characters are
   present.

   Any characters outside of the base64 alphabet are to be ignored in
   base64-encoded data.

   Care must be taken to use the proper octets for line breaks if base64
   encoding is applied directly to text material that has not been
   converted to canonical form.  In particular, text line breaks must be
   converted into CRLF sequences prior to base64 encoding.  The
   important thing to note is that this may be done directly by the
   encoder rather than in a prior canonicalization step in some
   implementations.

   NOTE: There is no need to worry about quoting potential boundary
   delimiters within base64-encoded bodies within multipart entities
   because no hyphen characters are used in the base64 encoding.

----------------------------------------------------------------------------}

{-

The following properties should hold:

  decode . encode = id
  decode . chop72 . encode = id

I.E. Both "encode" and "chop72 . encode" are valid methods of encoding input,
the second variation corresponds better with the RFC above, but outside of
MIME applications might be undesireable.


But: The Haskell98 Char type is at least 16bits (and often 32), these implementations assume only 
     8 significant bits, which is more than enough for US-ASCII.  
-}


import Data.Array (Array, array, (!))
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.Char (chr, ord)
import Data.Word (Word8)

type Octet = Word8

encodeArray :: Array Int Char
encodeArray :: Array Int Char
encodeArray = (Int, Int) -> [(Int, Char)] -> Array Int Char
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,Int
64) 
          [ (Int
0,Char
'A'),  (Int
1,Char
'B'),  (Int
2,Char
'C'),  (Int
3,Char
'D'),  (Int
4,Char
'E'),  (Int
5,Char
'F')                    
          , (Int
6,Char
'G'),  (Int
7,Char
'H'),  (Int
8,Char
'I'),  (Int
9,Char
'J'),  (Int
10,Char
'K'), (Int
11,Char
'L')                    
          , (Int
12,Char
'M'), (Int
13,Char
'N'), (Int
14,Char
'O'), (Int
15,Char
'P'), (Int
16,Char
'Q'), (Int
17,Char
'R')
          , (Int
18,Char
'S'), (Int
19,Char
'T'), (Int
20,Char
'U'), (Int
21,Char
'V'), (Int
22,Char
'W'), (Int
23,Char
'X')
          , (Int
24,Char
'Y'), (Int
25,Char
'Z'), (Int
26,Char
'a'), (Int
27,Char
'b'), (Int
28,Char
'c'), (Int
29,Char
'd')
          , (Int
30,Char
'e'), (Int
31,Char
'f'), (Int
32,Char
'g'), (Int
33,Char
'h'), (Int
34,Char
'i'), (Int
35,Char
'j')
          , (Int
36,Char
'k'), (Int
37,Char
'l'), (Int
38,Char
'm'), (Int
39,Char
'n'), (Int
40,Char
'o'), (Int
41,Char
'p')
          , (Int
42,Char
'q'), (Int
43,Char
'r'), (Int
44,Char
's'), (Int
45,Char
't'), (Int
46,Char
'u'), (Int
47,Char
'v')
          , (Int
48,Char
'w'), (Int
49,Char
'x'), (Int
50,Char
'y'), (Int
51,Char
'z'), (Int
52,Char
'0'), (Int
53,Char
'1')
          , (Int
54,Char
'2'), (Int
55,Char
'3'), (Int
56,Char
'4'), (Int
57,Char
'5'), (Int
58,Char
'6'), (Int
59,Char
'7')
          , (Int
60,Char
'8'), (Int
61,Char
'9'), (Int
62,Char
'+'), (Int
63,Char
'/') ]


-- Convert between 4 base64 (6bits ea) integers and 1 ordinary integer (32 bits)
-- clearly the upmost/leftmost 8 bits of the answer are 0.
-- Hack Alert: In the last entry of the answer, the upper 8 bits encode 
-- the integer number of 6bit groups encoded in that integer, ie 1, 2, 3.
-- 0 represents a 4 :(
int4_char3 :: [Int] -> [Char]
int4_char3 :: [Int] -> [Char]
int4_char3 (Int
a:Int
b:Int
c:Int
d:[Int]
t) = 
    let n :: Int
n = (Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
d)
    in (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff))
     Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff))
     Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Int] -> [Char]
int4_char3 [Int]
t

int4_char3 [Int
a,Int
b,Int
c] =
    let n :: Int
n = (Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6)
    in [ (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff))
       , (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)) ]

int4_char3 [Int
a,Int
b] = 
    let n :: Int
n = (Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
12)
    in [ (Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)) ]

int4_char3 [Int
_] = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Network.HTTP.Base64.int4_char3: impossible number of Ints."

int4_char3 [] = []




-- Convert triplets of characters to
-- 4 base64 integers.  The last entries
-- in the list may not produce 4 integers,
-- a trailing 2 character group gives 3 integers,
-- while a trailing single character gives 2 integers.
char3_int4 :: [Char] -> [Int]
char3_int4 :: [Char] -> [Int]
char3_int4 (Char
a:Char
b:Char
c:[Char]
t) 
    = let n :: Int
n = (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
ord Char
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
ord Char
c)
      in (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6  Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
char3_int4 [Char]
t

char3_int4 [Char
a,Char
b]
    = let n :: Int
n = (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
ord Char
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      in [ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)
         , (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)
         , (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6  Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f) ]
    
char3_int4 [Char
a]
    = let n :: Int
n = (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      in [(Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f),(Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)]

char3_int4 [] = []


-- Retrieve base64 char, given an array index integer in the range [0..63]
enc1 :: Int -> Char
enc1 :: Int -> Char
enc1 Int
ch = Array Int Char
encodeArrayArray Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
!Int
ch


-- | Cut up a string into 72 char lines, each line terminated by CRLF.

chop72 :: String -> String
chop72 :: [Char] -> [Char]
chop72 [Char]
str =  let ([Char]
bgn,[Char]
end) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
70 [Char]
str
              in if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
end then [Char]
bgn else [Char]
"\r\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
chop72 [Char]
end


-- Pads a base64 code to a multiple of 4 characters, using the special
-- '=' character.
quadruplets :: [Char] -> [Char]
quadruplets :: [Char] -> [Char]
quadruplets (Char
a:Char
b:Char
c:Char
d:[Char]
t) = Char
aChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
bChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
dChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char] -> [Char]
quadruplets [Char]
t
quadruplets [Char
a,Char
b,Char
c]     = [Char
a,Char
b,Char
c,Char
'=']      -- 16bit tail unit
quadruplets [Char
a,Char
b]       = [Char
a,Char
b,Char
'=',Char
'=']    -- 8bit tail unit
quadruplets [Char
_]         = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Network.HTTP.Base64.quadruplets: impossible number of characters."
quadruplets []          = []               -- 24bit tail unit


enc :: [Int] -> [Char]
enc :: [Int] -> [Char]
enc = [Char] -> [Char]
quadruplets ([Char] -> [Char]) -> ([Int] -> [Char]) -> [Int] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
enc1


dcd :: String -> [Int]
dcd :: [Char] -> [Int]
dcd [] = []
dcd (Char
h:[Char]
t)
    | Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' Bool -> Bool -> Bool
&& Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A'  =  Char -> Int
ord Char
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A'      Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
    | Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'  =  Char -> Int
ord Char
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
52 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
    | Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'  =  Char -> Int
ord Char
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
26 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
    | Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'  = Int
62 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
    | Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'  = Int
63 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Char] -> [Int]
dcd [Char]
t
    | Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'='  = []  -- terminate data stream
    | Bool
otherwise = [Char] -> [Int]
dcd [Char]
t


-- Principal encoding and decoding functions.

encode :: [Octet] -> String
encode :: [Octet] -> [Char]
encode = [Int] -> [Char]
enc ([Int] -> [Char]) -> ([Octet] -> [Int]) -> [Octet] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Int]
char3_int4 ([Char] -> [Int]) -> ([Octet] -> [Char]) -> [Octet] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Octet -> Char) -> [Octet] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Octet -> Int) -> Octet -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Octet -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral))

{-
prop_base64 os =
   os == (f . g . h) os
      where types = (os :: [Word8])
            f = map (fromIntegral. ord)
            g = decode . encode
            h = map (chr . fromIntegral)
-}

decode :: String -> [Octet]
decode :: [Char] -> [Octet]
decode = ((Char -> Octet) -> [Char] -> [Octet]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Octet
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Octet) -> (Char -> Int) -> Char -> Octet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)) ([Char] -> [Octet]) -> ([Char] -> [Char]) -> [Char] -> [Octet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Char]
int4_char3 ([Int] -> [Char]) -> ([Char] -> [Int]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Int]
dcd