X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FResource.hs;h=26d73897e544cc1ec13d3553913bff5bf214da15;hp=8448ea11d137d53dae3866bdd4ea9f11994602ba;hb=443af4d3304139bb2187a0c726327b9c05829810;hpb=89c3c6ff37517012b5a799014c5a6d05d3e2e902 diff --git a/Rakka/Resource.hs b/Rakka/Resource.hs index 8448ea1..26d7389 100644 --- a/Rakka/Resource.hs +++ b/Rakka/Resource.hs @@ -3,6 +3,7 @@ module Rakka.Resource , runXmlA , getEntityType , outputXmlPage + , getUserID ) where @@ -13,6 +14,7 @@ import Control.Monad.Trans import Network.HTTP.Lucu import Network.HTTP.Lucu.Utils import Network.URI hiding (path) +import Rakka.Authorization import Rakka.Environment import Rakka.Validation import System.Log.Logger @@ -145,4 +147,17 @@ outputXmlPage tree toXHTML >>> writeDocumentToString [ (a_indent, v_1) ] ) - output resultStr \ No newline at end of file + output resultStr + + +getUserID :: Environment -> Resource (Maybe String) +getUserID env + = do auth <- getAuthorization + case auth of + Just (BasicAuthCredential userID password) + -> do valid <- isValidPair (envAuthDB env) userID password + if valid then + return (Just userID) + else + return Nothing + _ -> return Nothing