-- This file is part of purebred-email
-- Copyright (C) 2017-2020  Fraser Tweedale
--
-- purebred-email is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}

{- |

Implementation of Base64 Content-Transfer-Encoding.

<https://tools.ietf.org/html/rfc2045#section-6.8>

-}
module Data.MIME.Base64
  (
    b
  , contentTransferEncodeBase64
  , contentTransferEncodingBase64
  ) where

import Control.Lens (prism')
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Base64.Lazy as L64
import Data.Word (Word8)

import Data.MIME.Types (ContentTransferEncoding)



isBase64Char :: Word8 -> Bool
isBase64Char :: Word8 -> Bool
isBase64Char Word8
c =
  (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x41 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x5a)  -- A-Z
  Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x61 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7a) -- a-z
  Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39) -- 0-9
  Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
43 -- +
  Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
47 -- /
  Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
61 -- =

{-

Notes about encoding requirements:

- The encoded output stream must be represented in lines of no more
  than 76 characters each.

-}
contentTransferEncodeBase64 :: B.ByteString -> B.ByteString
contentTransferEncodeBase64 :: ByteString -> ByteString
contentTransferEncodeBase64 = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
wrap (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L64.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
  where
  wrap :: ByteString -> ByteString
wrap ByteString
s = case Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
76 ByteString
s of
    (ByteString
l, ByteString
"") -> ByteString
l
    (ByteString
l, ByteString
s') -> ByteString
l ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
wrap ByteString
s'

{-

Notes about decoding requirements:

- 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.

-}
contentTransferDecodeBase64 :: B.ByteString -> Either String B.ByteString
contentTransferDecodeBase64 :: ByteString -> Either String ByteString
contentTransferDecodeBase64 = ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
B.filter Word8 -> Bool
isBase64Char

contentTransferEncodingBase64 :: ContentTransferEncoding
contentTransferEncodingBase64 :: ContentTransferEncoding
contentTransferEncodingBase64 = (ByteString -> ByteString)
-> (ByteString -> Maybe ByteString)
-> Prism ByteString ByteString ByteString ByteString
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
  ByteString -> ByteString
contentTransferEncodeBase64
  ((String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
contentTransferDecodeBase64)

b :: ContentTransferEncoding
b :: ContentTransferEncoding
b = (ByteString -> ByteString)
-> (ByteString -> Maybe ByteString)
-> Prism ByteString ByteString ByteString ByteString
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
  ByteString -> ByteString
B64.encode
  ((String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
contentTransferDecodeBase64)