{-# 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