basic authorization support

[Rakka.git] / Rakka / Resource / CheckAuth.hs

diff --git a/Rakka/Resource/CheckAuth.hs b/Rakka/Resource/CheckAuth.hs
index 8b4d54bd81cf2c4f1110c935fdd485717bb9a17c..928e90ab8f4bc36301734da08b5b264bfbd48ce4 100644 (file)
--- a/Rakka/Resource/CheckAuth.hs
+++ b/Rakka/Resource/CheckAuth.hs
@@ -4,8 +4,8 @@ module Rakka.Resource.CheckAuth
     where
 
 import           Network.HTTP.Lucu
-import           Rakka.Authorization
 import           Rakka.Environment
+import           Rakka.Resource
 
 
 resCheckAuth :: Environment -> ResourceDef
@@ -15,15 +15,10 @@ resCheckAuth env
       , resIsGreedy         = False
       , resGet
           = Just $
-            do authM <- getAuthorization
-               case authM of
-                 Just (BasicAuthCredential userID password)
-                     -> do valid <- isValidPair (envAuthDB env) userID password
-                           if valid then
-                               setStatus NoContent
-                             else
-                               setStatus Forbidden
-                 _   -> setStatus Forbidden
+            do userID <- getUserID env
+               case userID of
+                 Just _  -> setStatus NoContent
+                 Nothing -> setStatus Forbidden
       , resHead             = Nothing
       , resPost             = Nothing
       , resPut              = Nothing