{-# LANGUAGE
    UnicodeSyntax
  #-}
{-# OPTIONS_HADDOCK prune #-}

-- |Manipulation of WWW authorization.
module Network.HTTP.Lucu.Authorization
    ( AuthChallenge(..)
    , AuthCredential(..)
    , Realm
    , UserID
    , Password

    , authCredentialP -- private
    )
    where
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C8
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
import Prelude.Unicode

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

-- |'Realm' is just a string which must not contain any non-ASCII letters.
type Realm = String

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

-- |'UserID' is just a string which must not contain colon and any
-- non-ASCII letters.
type UserID   = String

-- |'Password' is just a string which must not contain any non-ASCII
-- letters.
type Password = String

instance Show AuthChallenge where
    show (BasicAuthChallenge realm)
        = "Basic realm="  quoteStr realm

authCredentialP  Parser AuthCredential
authCredentialP
    = allowEOF $!
      do _    string "Basic"
         _    many1 lws
         b64  many1
               $ satisfy (\c  (c  'a'  c  'z') 
                               (c  'A'  c  'Z') 
                               (c  '0'  c  '9') 
                                c  '+' 
                                c  '/' 
                                c  '=')
         case break ( ':') (decode b64) of
           (uid, ':' : password)
                return (BasicAuthCredential uid password)
           _    failP
    where
      decode  String  String
      decode = C8.unpack  B64.decodeLenient  C8.pack