    -----------------------------------------------------------------------------
    -- |
    -- 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 a. [a] -> 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