]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/Authorization.hs
Cosmetic changes suggested by hlint.
[Lucu.git] / Network / HTTP / Lucu / Authorization.hs
1 {-# LANGUAGE
2     OverloadedStrings
3   , UnicodeSyntax
4   #-}
5
6 -- |Manipulation of WWW authorization.
7 module Network.HTTP.Lucu.Authorization
8     ( AuthChallenge(..)
9     , AuthCredential(..)
10     , Realm
11     , UserID
12     , Password
13
14     , printAuthChallenge
15     , authCredentialP
16     )
17     where
18 import Data.Ascii (Ascii)
19 import qualified Data.Ascii as A
20 import Data.Attoparsec.Char8
21 import qualified Data.ByteString.Base64 as B64
22 import qualified Data.ByteString.Char8 as C8
23 import Data.Monoid.Unicode
24 import Network.HTTP.Lucu.Parser.Http
25 import Network.HTTP.Lucu.Utils
26 import Prelude.Unicode
27
28 -- |Authorization challenge to be sent to client with
29 -- \"WWW-Authenticate\" header. See
30 -- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'.
31 data AuthChallenge
32     = BasicAuthChallenge !Realm
33       deriving (Eq)
34
35 -- |'Realm' is just a string which must not contain any non-ASCII letters.
36 type Realm = Ascii
37
38 -- |Authorization credential to be sent by client with
39 -- \"Authorization\" header. See
40 -- 'Network.HTTP.Lucu.Resource.getAuthorization'.
41 data AuthCredential
42     = BasicAuthCredential !UserID !Password
43       deriving (Show, Eq)
44
45 -- |'UserID' is just a string which must not contain colon and any
46 -- non-ASCII letters.
47 type UserID   = Ascii
48
49 -- |'Password' is just a string which must not contain any non-ASCII
50 -- letters.
51 type Password = Ascii
52
53 -- |Convert an 'AuthChallenge' to 'Ascii'.
54 printAuthChallenge ∷ AuthChallenge → Ascii
55 printAuthChallenge (BasicAuthChallenge realm)
56     = A.fromAsciiBuilder $
57       A.toAsciiBuilder "Basic realm=" ⊕ quoteStr realm
58
59 authCredentialP ∷ Parser AuthCredential
60 authCredentialP
61     = do _ ← string "Basic"
62          skipMany1 lws
63          b64 ← takeWhile1 base64
64          case C8.break (≡ ':') (B64.decodeLenient b64) of
65            (user, cPassword)
66                | C8.null cPassword
67                    → fail "no colons in the basic auth credential"
68                | otherwise
69                    → do u ← asc user
70                         p ← asc (C8.tail cPassword)
71                         return (BasicAuthCredential u p)
72     where
73       base64 ∷ Char → Bool
74       base64 = inClass "a-zA-Z0-9+/="
75
76       asc ∷ C8.ByteString → Parser Ascii
77       asc bs = case A.fromByteString bs of
78                  Just as → return as
79                  Nothing → fail "Non-ascii character in auth credential"