content: {-# OPTIONS_HADDOCK hide                #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  -- | Base 64 encoding of objects.
  module Raaz.Core.Encode.Base64( Base64 ) where
  
  import Data.Char
  
  import Data.ByteString as B
  import Data.ByteString.Char8 as C8
  import Data.ByteString.Internal (c2w, w2c)
  import Data.ByteString.Unsafe   (unsafeIndex)
  
  import Raaz.Core.Prelude
  import Raaz.Core.Encode.Internal
  
  
  -- | The type corresponding to the standard padded base-64 binary
  -- encoding.
  newtype Base64 = Base64 {unBase64 :: ByteString} deriving (Eq, Semigroup, Monoid)
  
  -- Developers note: Internally base16 just stores the bytestring as
  -- is. The conversion happens when we do an encode and decode of
  -- actual base16.
  
  instance Encodable Base64 where
    toByteString          = toB64 . unBase64
  
    fromByteString bs
      | B.null bs                = Just $ Base64 B.empty
      | B.length bs `rem` 4 /= 0 = Nothing
      | okeyPad                  = Just $ Base64 $ unsafeFromB64 bs
      | otherwise                = Nothing
      where padPart     = C8.dropWhile isB64Char bs
            okeyPad     = padPart == C8.empty || padPart == C8.singleton '=' || padPart == C8.pack "=="
            isB64Char c = isAlpha c || isDigit c || c == '+' || c == '/'
  
  
    unsafeFromByteString bs | B.null bs = Base64 B.empty
                            | otherwise = Base64 $ unsafeFromB64 bs
  
  
  instance Show Base64 where
    show = C8.unpack . toByteString
  
  -- | Ignores spaces and newlines.
  instance IsString Base64 where
    fromString = unsafeFromByteString . C8.filter (not . isSpace) . fromString
  
  instance Format Base64 where
    encodeByteString = Base64
    {-# INLINE encodeByteString #-}
  
    decodeFormat     = unBase64
    {-# INLINE decodeFormat #-}
  
  
  
  ------------- Base 64 encoding -------------------------
  
  -- NOTE: The topN functions ensure that the top N bits of a word are present
  -- in the least N significant bits. The botN ensures that there
  
  top6 :: Word8 -> Word8; bot2 :: Word8 -> Word8
  top4 :: Word8 -> Word8; bot4 :: Word8 -> Word8
  top2 :: Word8 -> Word8; bot6 :: Word8 -> Word8
  
  top6 w = w `shiftR` 2; bot2 w = w .&. 0x03
  top4 w = w `shiftR` 4; bot4 w = w .&. 0x0F
  top2 w = w `shiftR` 6; bot6 w = w .&. 0x3F
  
  --------------- Combining bytes -----------------------------------
  
  byte0 :: Word8 -> Word8
  byte1 :: Word8 -> Word8 -> Word8
  byte2 :: Word8 -> Word8 -> Word8
  byte3 :: Word8 -> Word8
  pad   :: Word8
  
  
  byte0     = b64 . top6
  byte1 t p = b64 $ shiftL (bot2 p) 4 .|. top4 t
  byte2 t p = b64 $ shiftL (bot4 p) 2 .|. top2 t
  byte3     = b64 . bot6
  pad       = c2w '='
  
  -- | Encoding word.
  b64 :: Word8 -> Word8
  b64 w | 0  <= w  && w <= 25 = c2w 'A' + w
        | 26 <= w  && w <= 51 = c2w 'a' + w - 26
        | 52 <= w  && w <= 61 = c2w '0' + w - 52
        | w == 62             = c2w '+'
        | w == 63             = c2w '/'
        | otherwise           = error "oops: b64"
  
  
  unB64 :: Word8 -> Word8
  unB64 w | c2w 'A' <= w && w <= c2w 'Z' = w - c2w 'A'
          | c2w 'a' <= w && w <= c2w 'z' = w - c2w 'a' + 26
          | c2w '0' <= w && w <= c2w '9' = w - c2w '0' + 52
          | w == c2w '+'                 = 62
          | w == c2w '/'                 = 63
          | otherwise                    = error $ "oops unB64:" ++ [w2c w]
  
  
  
  
  -- Since the encoding to base16 is usually used for user interaction
  -- we can afford to be slower here.
  
  -- TODO (Liquid Haskell)
  --
  {--@ toB64 :: ByteString -> { bs : ByteString | (bslen bs) mod 4 == 0 @-}
  --
  toB64 :: ByteString -> ByteString
  toB64 bs = fst (B.unfoldrN (4*n) gen 0) <> padding
      where gen i    = Just (byte i, i + 1)
            at blk i = unsafeIndex bs $ 3 * blk + i
  
            byte i = case r of
              0 -> byte0          $ at q 0
              1 -> byte1 (at q 1) $ at q 0
              2 -> byte2 (at q 2) $ at q 1
              3 -> byte3          $ at q 2
              _ -> error "base64 bad index"
              where (q, r) = quotRem i 4
  
            (n,p) = B.length bs `quotRem` 3
  
            padding = case p of
              0 -> mempty
              1 -> B.pack [ byte0   $ at n 0
                          , byte1 0 $ at n 0
                          , pad, pad
                          ]
              2 -> B.pack [ byte0          $ at n 0
                          , byte1 (at n 1) $ at n 0
                          , byte2 0        $ at n 1
                          , pad
                          ]
              _ -> error "base64 pad bad index"
  
  -- Notes: Merge is used to convert from base64 digits, which are
  -- words of 6-bits.
  merg0 :: Word8 -> Word8 -> Word8
  merg1 :: Word8 -> Word8 -> Word8
  merg2 :: Word8 -> Word8 -> Word8
  merg0 a b = (unB64 a `shiftL` 2) .|. top4 (unB64 b)
  merg1 a b = (unB64 a `shiftL` 4) .|. top6 (unB64 b)
  merg2 a b = (unB64 a `shiftL` 6) .|. unB64 b
  
  
  unsafeFromB64 :: ByteString -> ByteString
  unsafeFromB64 bs = fst (B.unfoldrN (3*n) gen 0) <> unPad
    where n         = B.length bs `quot` 4 - 1
          gen i     = Just (byte i, i + 1)
          at blk i  = unsafeIndex bs $ 4 * blk + i
  
          byte i    = case r of
            0 -> merg0 (at q 0) $ at q 1
            1 -> merg1 (at q 1) $ at q 2
            2 -> merg2 (at q 2) $ at q 3
            _ -> error "base64 bad index"
            where (q, r) = quotRem i 3
  
          unPad
            | at n 2 == c2w '=' = B.singleton $ merg0 (at n 0) $ at n 1
            | at n 3 == c2w '=' = B.pack [ merg0 (at n 0) $ at n 1
                                         , merg1 (at n 1) $ at n 2
                                         ]
            | otherwise         = B.pack [ merg0 (at n 0) $ at n 1
                                         , merg1 (at n 1) $ at n 2
                                         , merg2 (at n 2) $ at n 3
                                         ]
  