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

import Crypto.Hash.MD5 (hash)
import qualified Data.ByteString.Base16 as B16  (encode)
import qualified Data.ByteString.Base64 as B64  (encode)

import Data.ByteString  (ByteString)
import Data.List
import Data.Bits
import Data.Monoid
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 Eq

instance Show AuthType where
    showsPrec d at = showParen (d>app_prec) $ showString $ showMain at
        where app_prec = 10
              showMain PLAIN    = "PLAIN"
              showMain LOGIN    = "LOGIN"
              showMain CRAM_MD5 = "CRAM-MD5"

toAscii :: String -> ByteString
toAscii = B.pack . map (toEnum.fromEnum)

b64Encode :: String -> ByteString
b64Encode = B64.encode . toAscii

hmacMD5 :: ByteString -> ByteString -> ByteString
hmacMD5 text key = hash (okey <> hash (ikey <> text))
    where key' = if B.length key > 64
                 then hash key <> B.replicate 48 0
                 else key <> B.replicate (64-B.length key) 0
          ipad = B.replicate 64 0x36
          opad = B.replicate 64 0x5c
          ikey = B.pack $ B.zipWith xor key' ipad
          okey = B.pack $ B.zipWith xor key' opad

encodePlain :: UserName -> Password -> ByteString
encodePlain user pass = b64Encode $ intercalate "\0" [user, user, pass]

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

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

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