X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAuthorization.hs;h=6b0e1c268323150607da4f5ea2be37a92ea9ff58;hp=8e1be587e9c4f25c93f2e581db594e249972d96f;hb=70bf5bd248aa426ca4e410b3fb9a0529354aedaf;hpb=dc74878dd76a8ba6ff99c7ee0a480e6b942ce2db

diff --git a/Network/HTTP/Lucu/Authorization.hs b/Network/HTTP/Lucu/Authorization.hs
index 8e1be58..6b0e1c2 100644
--- a/Network/HTTP/Lucu/Authorization.hs
+++ b/Network/HTTP/Lucu/Authorization.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- |Manipulation of WWW authorization.
@@ -11,12 +14,12 @@ module Network.HTTP.Lucu.Authorization
     , authCredentialP -- private
     )
     where
-
-import qualified Codec.Binary.Base64 as B64
-import           Data.Maybe
-import           Network.HTTP.Lucu.Parser
-import           Network.HTTP.Lucu.Parser.Http
-import           Network.HTTP.Lucu.Utils
+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
@@ -26,7 +29,7 @@ data AuthChallenge
       deriving (Eq)
 
 -- |'Realm' is just a string which must not contain any non-ASCII letters.
-type Realm = String    
+type Realm = String
 
 -- |Authorization credential to be sent by client with
 -- \"Authorization\" header. See
@@ -43,25 +46,26 @@ type UserID   = String
 -- letters.
 type Password = String
 
-
 instance Show AuthChallenge where
     show (BasicAuthChallenge realm)
-        = "Basic realm=" ++ quoteStr 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 == '=')
-                     let decoded = map (toEnum . fromEnum) (fromJust $ B64.decode b64)
-                     case break (== ':') decoded of
-                       (uid, ':' : password)
-                           -> return (BasicAuthCredential uid password)
-                       _   -> failP
+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