-- This file is part of purebred-email
-- Copyright (C) 2018  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 #-}

module Data.MIME.Internal
  (
    hexEncode
  , parseHex
  ) where

import Data.Bits ((.&.), shiftR)
import Data.Word (Word8)

import qualified Data.ByteString as B

{-
  (1)   An "=" followed by two hexadecimal digits, one or both
        of which are lowercase letters in "abcdef", is formally
        illegal. A robust implementation might choose to
        recognize them as the corresponding uppercase letters.
-}
parseHex :: Word8 -> Maybe Word8
parseHex :: Word8 -> Maybe Word8
parseHex Word8
c = do
  let
    -- to upper
    c' :: Word8
c' = if 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 then Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x20 else Word8
c
  Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Maybe Int -> Maybe Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c') ByteString
hexAlphabet

hexAlphabet :: B.ByteString
hexAlphabet :: ByteString
hexAlphabet = ByteString
"0123456789ABCDEF"

hexEncode :: Word8 -> (Word8, Word8)
hexEncode :: Word8 -> (Word8, Word8)
hexEncode Word8
c =
  let
    lkup :: a -> Word8
lkup a
i = ByteString -> Int -> Word8
B.index ByteString
hexAlphabet (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
  in
    ( Word8 -> Word8
forall a. Integral a => a -> Word8
lkup (Word8
c Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
    , Word8 -> Word8
forall a. Integral a => a -> Word8
lkup (Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f)
    )