module Network.Mail.SMTP.Auth (
    UserName,
    Password,
    AuthType(..),
    encodeLogin,
    auth,
) where

import Crypto.MAC.HMAC (hmac, HMAC)
import Crypto.Hash.Algorithms (MD5)
import Data.ByteArray (copyAndFreeze)
import qualified Data.ByteString.Base16 as B16  (encode)
import qualified Data.ByteString.Base64 as B64  (encode)

import Data.ByteString  (ByteString)
import Data.List
import qualified Data.ByteString       as B
import qualified Data.ByteString.Char8 as B8    (unwords)

type UserName = String
type Password = String

data AuthType
    = PLAIN
    | LOGIN
    | CRAM_MD5
    deriving AuthType -> AuthType -> Bool
(AuthType -> AuthType -> Bool)
-> (AuthType -> AuthType -> Bool) -> Eq AuthType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthType -> AuthType -> Bool
$c/= :: AuthType -> AuthType -> Bool
== :: AuthType -> AuthType -> Bool
$c== :: AuthType -> AuthType -> Bool
Eq

instance Show AuthType where
    showsPrec :: Int -> AuthType -> ShowS
showsPrec d :: Int
d at :: AuthType
at = Bool -> ShowS -> ShowS
showParen (Int
dInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ AuthType -> String
showMain AuthType
at
        where app_prec :: Int
app_prec = 10
              showMain :: AuthType -> String
showMain PLAIN    = "PLAIN"
              showMain LOGIN    = "LOGIN"
              showMain CRAM_MD5 = "CRAM-MD5"

toAscii :: String -> ByteString
toAscii :: String -> ByteString
toAscii = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a. Enum a => Int -> a
toEnum(Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
forall a. Enum a => a -> Int
fromEnum)

b64Encode :: String -> ByteString
b64Encode :: String -> ByteString
b64Encode = ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
toAscii

hmacMD5 :: ByteString -> ByteString -> ByteString
hmacMD5 :: ByteString -> ByteString -> ByteString
hmacMD5 text :: ByteString
text key :: ByteString
key =
    let mac :: HMAC MD5
mac = ByteString -> ByteString -> HMAC MD5
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
key ByteString
text :: HMAC MD5
    in HMAC MD5 -> (Ptr Any -> IO ()) -> ByteString
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
copyAndFreeze HMAC MD5
mac (IO () -> Ptr Any -> IO ()
forall a b. a -> b -> a
const (IO () -> Ptr Any -> IO ()) -> IO () -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

encodePlain :: UserName -> Password -> ByteString
encodePlain :: String -> String -> ByteString
encodePlain user :: String
user pass :: String
pass = String -> ByteString
b64Encode (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\0" [String
user, String
user, String
pass]

encodeLogin :: UserName -> Password -> (ByteString, ByteString)
encodeLogin :: String -> String -> (ByteString, ByteString)
encodeLogin user :: String
user pass :: String
pass = (String -> ByteString
b64Encode String
user, String -> ByteString
b64Encode String
pass)

cramMD5 :: String -> UserName -> Password -> ByteString
cramMD5 :: String -> String -> String -> ByteString
cramMD5 challenge :: String
challenge user :: String
user pass :: String
pass =
    ByteString -> ByteString
B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B8.unwords [ByteString
user', ByteString -> ByteString
B16.encode (ByteString -> ByteString -> ByteString
hmacMD5 ByteString
challenge' ByteString
pass')]
  where
    challenge' :: ByteString
challenge' = String -> ByteString
toAscii String
challenge
    user' :: ByteString
user'      = String -> ByteString
toAscii String
user
    pass' :: ByteString
pass'      = String -> ByteString
toAscii String
pass

auth :: AuthType -> String -> UserName -> Password -> ByteString
auth :: AuthType -> String -> String -> String -> ByteString
auth PLAIN    _ u :: String
u p :: String
p = String -> String -> ByteString
encodePlain String
u String
p
auth LOGIN    _ u :: String
u p :: String
p = let (u' :: ByteString
u', p' :: ByteString
p') = String -> String -> (ByteString, ByteString)
encodeLogin String
u String
p in [ByteString] -> ByteString
B8.unwords [ByteString
u', ByteString
p']
auth CRAM_MD5 c :: String
c u :: String
u p :: String
p = String -> String -> String -> ByteString
cramMD5 String
c String
u String
p