-- 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 BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

{- |

Implementation of Quoted-Printable Content-Transfer-Encoding.

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

-}
module Data.MIME.QuotedPrintable
  (
    contentTransferEncodingQuotedPrintable
  , q
  , QuotedPrintableMode(..)
  , encodingRequiredEOL
  , encodingRequiredNonEOL
  ) where

import Control.Lens (APrism', prism')
import Data.Bool (bool)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import Data.Word (Word8)
import Foreign
  ( Ptr, withForeignPtr, nullPtr, plusPtr, minusPtr
  , peek, peekByteOff, poke
  )
import System.IO.Unsafe (unsafeDupablePerformIO)

import Data.MIME.Internal
import Data.MIME.Types

data QuotedPrintableMode = QuotedPrintable | Q
  deriving (QuotedPrintableMode -> QuotedPrintableMode -> Bool
(QuotedPrintableMode -> QuotedPrintableMode -> Bool)
-> (QuotedPrintableMode -> QuotedPrintableMode -> Bool)
-> Eq QuotedPrintableMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
$c/= :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
== :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
$c== :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
Eq)

-- | Whether it is required to encode a character
-- (where that character does not precede EOL).
encodingRequiredNonEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredNonEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredNonEOL QuotedPrintableMode
mode Word8
c =
  (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32 {- ' ' -} Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
9 {- \t -})
  Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
61 {- = -}
  Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
127
  Bool -> Bool -> Bool
|| QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q Bool -> Bool -> Bool
&& (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
95 {- _ -} Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9 {- \t -} Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
63 {- ? -})


-- | Whether it is required to encode a character
-- (where that character does precede EOL).
encodingRequiredEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredEOL QuotedPrintableMode
mode Word8
c = Bool -> Bool
not (
  (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
33 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
60)
  Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
62 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
126)
  ) Bool -> Bool -> Bool
|| (QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
95 {- underscore -})

-- | Two-pass solution: first determine output length, then
-- do the copy.
-- output length.
encodeQuotedPrintable :: QuotedPrintableMode -> B.ByteString -> B.ByteString
encodeQuotedPrintable :: QuotedPrintableMode -> ByteString -> ByteString
encodeQuotedPrintable QuotedPrintableMode
mode ByteString
s = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  Int
l <- QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> Int)
-> Ptr Word8
-> ByteString
-> IO Int
forall r.
QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> r)
-> Ptr Word8
-> ByteString
-> IO r
encodeQuotedPrintable' QuotedPrintableMode
mode
        (\Ptr Word8
_ Word8
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Int -> Int
forall a. a -> a
id Ptr Word8
forall a. Ptr a
nullPtr ByteString
s
  ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
l
  ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
    QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> ByteString)
-> Ptr Word8
-> ByteString
-> IO ByteString
forall r.
QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> r)
-> Ptr Word8
-> ByteString
-> IO r
encodeQuotedPrintable' QuotedPrintableMode
mode
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0) Ptr Word8
dptr ByteString
s

encodeQuotedPrintable'
  :: QuotedPrintableMode
  -> (Ptr Word8 -> Word8 -> IO ()) -- "poke" function
  -> (Int -> r)                    -- "return" function
  -> Ptr Word8
  -- ^ dest pointer; **assumed to be big enough to hold output**.
  -- Can pass a bogus pointer (e.g. nullPtr) if the poke function
  -- ignores its argument; this can be used for a first pass that
  -- just computes the required length.
  -> B.ByteString
  -- ^ input string
  -> IO r
encodeQuotedPrintable' :: QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> r)
-> Ptr Word8
-> ByteString
-> IO r
encodeQuotedPrintable' QuotedPrintableMode
mode Ptr Word8 -> Word8 -> IO ()
poke' Int -> r
mkResult Ptr Word8
dptr (B.PS ForeignPtr Word8
sfp Int
soff Int
slen) =
  (Int -> r) -> IO Int -> IO r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> r
mkResult (IO Int -> IO r) -> IO Int -> IO r
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
    let
      slimit :: Ptr b
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen)

      -- is there a crlf at this location?
      crlf :: Ptr Word8 -> IO Bool
      crlf :: Ptr Word8 -> IO Bool
crlf Ptr Word8
ptr
        | QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q = Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False  -- always encode CRLF in 'Q' mode
        | Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall a. Ptr a
slimit = Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        | Bool
otherwise = do
          Word8
c1 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
          Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr Int
1
          Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Word8
c1 :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 Bool -> Bool -> Bool
&& (Word8
c2 :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10

      pokeHardLineBreak :: Ptr Word8 -> IO ()
pokeHardLineBreak Ptr Word8
ptr =
        Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
ptr Word8
13 IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
10

      pokeSoftLineBreak :: Ptr Word8 -> IO ()
pokeSoftLineBreak Ptr Word8
ptr =
        Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
ptr Word8
61 {- = -} IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> IO ()
pokeHardLineBreak (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)

      pokeEncoded :: Ptr Word8 -> Word8 -> IO ()
pokeEncoded Ptr Word8
ptr Word8
c =
        let (Word8
hi, Word8
lo) = Word8 -> (Word8, Word8)
hexEncode Word8
c
        in Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
ptr Word8
61 {- = -}
          IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
hi
          IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
lo

      mapChar :: p -> p
mapChar p
32 {- ' ' -} | QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q = p
95 {- _ -}
      mapChar p
c = p
c

      -- Do not wrap lines in Q mode.  This is not correct,
      -- but encoded-word wrapping needs separate encoded-words
      -- including the leading =?... and trailing ?=
      wrapLimit :: Int
wrapLimit = if QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q then Int
forall a. Bounded a => a
maxBound else Int
76

      fill :: Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
col !Ptr Word8
dp !Ptr Word8
sp
        | Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall a. Ptr a
slimit = Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr
        | Bool
otherwise = do
            Bool
atEOL <- Ptr Word8 -> IO Bool
crlf Ptr Word8
sp
            if Bool
atEOL
              then Ptr Word8 -> IO ()
pokeHardLineBreak Ptr Word8
dp
                    IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
0 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
              else do
                Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp
                Bool
cAtEOL <- Ptr Word8 -> IO Bool
crlf (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
                let
                  encodingRequired :: Bool
encodingRequired =
                    (Bool
cAtEOL Bool -> Bool -> Bool
&& QuotedPrintableMode -> Word8 -> Bool
encodingRequiredEOL QuotedPrintableMode
mode Word8
c)
                    Bool -> Bool -> Bool
|| QuotedPrintableMode -> Word8 -> Bool
encodingRequiredNonEOL QuotedPrintableMode
mode Word8
c
                  bytesNeeded :: Int
bytesNeeded = Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
1 Int
3 Bool
encodingRequired
                  c' :: Word8
c' = Word8 -> Word8
forall p. (Eq p, Num p) => p -> p
mapChar Word8
c
                case (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bytesNeeded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
wrapLimit, Bool
encodingRequired) of
                  (Bool
False, Bool
False) ->
                    Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
dp Word8
c'
                    IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bytesNeeded) (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bytesNeeded) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
                  (Bool
False, Bool
True) ->
                    Ptr Word8 -> Word8 -> IO ()
pokeEncoded Ptr Word8
dp Word8
c'
                    IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bytesNeeded) (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bytesNeeded) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
                  (Bool
True, Bool
False) ->
                    Ptr Word8 -> IO ()
pokeSoftLineBreak Ptr Word8
dp
                    IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) Word8
c'
                    IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
1 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
                  (Bool
True, Bool
True) ->
                    Ptr Word8 -> IO ()
pokeSoftLineBreak Ptr Word8
dp
                    IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
pokeEncoded (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) Word8
c'
                    IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
3 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
6) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
    Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
0 Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)

decodeQuotedPrintable :: QuotedPrintableMode -> B.ByteString -> Either String B.ByteString
decodeQuotedPrintable :: QuotedPrintableMode -> ByteString -> Either String ByteString
decodeQuotedPrintable QuotedPrintableMode
mode (B.PS ForeignPtr Word8
sfp Int
soff Int
slen) = IO (Either String ByteString) -> Either String ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String ByteString) -> Either String ByteString)
-> IO (Either String ByteString) -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ do
  -- Precise length of decoded string is not yet known, but
  -- it cannot be longer than input, and is likely to be not
  -- much shorter.  Therefore allocate slen bytes and only
  -- use as much as we need.
  ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
slen

  Either String Int
result <- ForeignPtr Word8
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int))
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
    ForeignPtr Word8
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int))
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
      let
        slimit :: Ptr b
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen)
        fill :: Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill !Ptr Word8
dp !Ptr Word8
sp
          | Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall a. Ptr a
slimit = Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either a Int
forall a b. b -> Either a b
Right (Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
          | Bool
otherwise = do
            Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp
            case (Word8
c :: Word8) of
              Word8
61 {- = -} ->
                -- NOTE: strictly, only =\r\n is a valid soft line
                -- break, but we accept =\n as well.
                if Ptr Word8
sp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall a. Ptr a
slimit
                  then Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"reached end of input during '=' decoding"
                  else do
                    Word8
c1 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
1
                    case Word8
c1 of
                      Word8
10 -> Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill Ptr Word8
dp (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) -- soft line break (=\n)
                      Word8
_ ->
                        if Ptr Word8
sp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall a. Ptr a
slimit
                          then Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"reached end of input during '=' decoding"
                          else do
                            Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
2
                            case (Word8
c1, Word8
c2) of
                              (Word8
13, Word8
10) {- CRLF -} ->
                                -- Soft Line Break (=\r\n)
                                Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill Ptr Word8
dp (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
                              (Word8, Word8)
_ ->
                                IO (Either a Int)
-> ((Word8, Word8) -> IO (Either a Int))
-> Maybe (Word8, Word8)
-> IO (Either a Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                  (Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"invalid hex sequence")
                                  (\(Word8
hi,Word8
lo) -> do
                                    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp (Word8
hi Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
lo)
                                    Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) )
                                  ((,) (Word8 -> Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8 -> (Word8, Word8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Maybe Word8
parseHex Word8
c1 Maybe (Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8, Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Maybe Word8
parseHex Word8
c2)

              -- otherwise assume that the char is valid and copy it to dst

              Word8
95 {- _ -} | QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q ->
                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp Word8
32 {- ' ' -} IO () -> IO (Either a Int) -> IO (Either a Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)

              Word8
32 {- ' ' -} | QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q ->
                Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"space cannot appear in 'Q' encoding"

              Word8
_ ->
                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp Word8
c IO () -> IO (Either a Int) -> IO (Either a Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)

      Ptr Word8 -> Ptr Word8 -> IO (Either String Int)
forall a. IsString a => Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)
  Either String ByteString -> IO (Either String ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> IO (Either String ByteString))
-> Either String ByteString -> IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 (Int -> ByteString)
-> Either String Int -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String Int
result

mkPrism :: QuotedPrintableMode -> APrism' B.ByteString B.ByteString
mkPrism :: QuotedPrintableMode -> APrism' ByteString ByteString
mkPrism QuotedPrintableMode
mode = (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'
  (QuotedPrintableMode -> ByteString -> ByteString
encodeQuotedPrintable QuotedPrintableMode
mode)
  ((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
. QuotedPrintableMode -> ByteString -> Either String ByteString
decodeQuotedPrintable QuotedPrintableMode
mode)

contentTransferEncodingQuotedPrintable :: ContentTransferEncoding
contentTransferEncodingQuotedPrintable :: APrism' ByteString ByteString
contentTransferEncodingQuotedPrintable = QuotedPrintableMode -> APrism' ByteString ByteString
mkPrism QuotedPrintableMode
QuotedPrintable

q :: EncodedWordEncoding
q :: APrism' ByteString ByteString
q = QuotedPrintableMode -> APrism' ByteString ByteString
mkPrism QuotedPrintableMode
Q