{-# LANGUAGE
    OverloadedStrings
  , UnicodeSyntax
  #-}
-- |An internal module for HTTP authentication.
module Network.HTTP.Lucu.Authentication
    ( AuthChallenge(..)
    , AuthCredential(..)
    , Realm
    , UserID
    , Password

    , printAuthChallenge
    , authCredential
    )
    where
import Control.Monad
import Data.Ascii (Ascii)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C8
import Data.Monoid.Unicode
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
import Prelude.Unicode

-- |Authentication challenge to be sent to clients with
-- \"WWW-Authenticate\" header field. See
-- 'Network.HTTP.Lucu.setWWWAuthenticate'.
data AuthChallenge
    = BasicAuthChallenge !Realm
      deriving (Eq)

-- |'Realm' is just an 'Ascii' string.
type Realm = Ascii

-- |Authorization credential to be sent by client with
-- \"Authorization\" header. See 'Network.HTTP.Lucu.getAuthorization'.
data AuthCredential
    = BasicAuthCredential !UserID !Password
      deriving (Show, Eq)

-- |'UserID' is just an 'Ascii' string containing no colons (\':\').
type UserID = Ascii

-- |'Password' is just an 'Ascii' string.
type Password = Ascii

-- |Convert an 'AuthChallenge' to 'Ascii'.
printAuthChallenge ∷ AuthChallenge → Ascii
printAuthChallenge (BasicAuthChallenge realm)
    = A.fromAsciiBuilder $
      A.toAsciiBuilder "Basic realm=" ⊕ quoteStr realm

-- |'Parser' for an 'AuthCredential'.
authCredential ∷ Parser AuthCredential
authCredential
    = do void $ string "Basic"
         skipMany1 lws
         b64 ← takeWhile1 base64
         case C8.break (≡ ':') (B64.decodeLenient b64) of
           (user, cPassword)
               | C8.null cPassword
                   → fail "no colons in the basic auth credential"
               | otherwise
                   → do u ← asc user
                        p ← asc (C8.tail cPassword)
                        return (BasicAuthCredential u p)
    where
      base64 ∷ Char → Bool
      base64 = inClass "a-zA-Z0-9+/="

      asc ∷ C8.ByteString → Parser Ascii
      asc bs = case A.fromByteString bs of
                 Just as → return as
                 Nothing → fail "Non-ascii character in auth credential"