content: {-# language CPP #-}
  
  module Network.HaskellNet.Auth
  where
  
  import Crypto.Hash.MD5
  import Data.Text.Encoding.Base64 as B64
  
  #if MIN_VERSION_base64(0,5,0)
  import Data.Base64.Types as B64
  #endif
  
  import Data.Word
  import Data.List
  import Data.Bits
  import Data.Array
  import qualified Data.ByteString as B
  import qualified Data.Text as T
  
  type UserName = String
  type Password = String
  
  -- | Authorization types supported by the <https://www.ietf.org/rfc/rfc4954.txt RFC5954>
  data AuthType = PLAIN
                | LOGIN
                | CRAM_MD5
                | XOAUTH2
                  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"
                showMain XOAUTH2  = "XOAUTH2"
  
  b64Encode :: String -> String
  b64Encode = T.unpack . encode . T.pack
      where encode =
  #if MIN_VERSION_base64(0,5,0)
                B64.extractBase64 . B64.encodeBase64
  #else
                B64.encodeBase64
  #endif
  
  
  
  b64Decode :: String -> String
  b64Decode = T.unpack . decode . T.pack
      where decode = B64.decodeBase64Lenient
  
  showOctet :: [Word8] -> String
  showOctet = concatMap hexChars
      where hexChars c = [arr ! (c `div` 16), arr ! (c `mod` 16)]
            arr = listArray (0, 15) "0123456789abcdef"
  
  hashMD5 :: [Word8] -> [Word8]
  hashMD5 = B.unpack . hash . B.pack
  
  hmacMD5 :: String -> String -> [Word8]
  hmacMD5 text key = hashMD5 $ okey ++ hashMD5 (ikey ++ map (toEnum.fromEnum) text)
      where koc = map (toEnum.fromEnum) key
            key' = if length koc > 64
                   then hashMD5 $ koc ++ replicate 48 0
                   else koc ++ replicate (64-length koc) 0
            ipad = replicate 64 0x36
            opad = replicate 64 0x5c
            ikey = zipWith xor key' ipad
            okey = zipWith xor key' opad
  
  plain :: UserName -> Password -> String
  plain user pass = b64Encode $ intercalate "\0" ["", user, pass]
  
  login :: UserName -> Password -> (String, String)
  login user pass = (b64Encode user, b64Encode pass)
  
  cramMD5 :: String -> UserName -> Password -> String
  cramMD5 challenge user pass =
      b64Encode (user ++ " " ++ showOctet (hmacMD5 challenge pass))
  
  auth :: AuthType -> String -> UserName -> Password -> String
  auth PLAIN    _ u p = plain u p
  auth LOGIN    _ u p = let (u', p') = login u p in unwords [u', p']
  auth CRAM_MD5 c u p = cramMD5 c u p
  auth XOAUTH2  _ u p = b64Encode $ "user=" ++ u ++ "\001auth=" ++ p ++ "\001\001"
  