X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FAuthorization.hs;h=8f32ddfc613420e005e898e24ac08be920cbee0e;hb=4e428cf86da68b72ef8fdff87990e7c953c8f12e;hp=8da8afe95a590ca44552084ee92f9a95672d17db;hpb=bc8616eec0bcac3102860c76f93ebfd0da24c2d6;p=Rakka.git

diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs
index 8da8afe..8f32ddf 100644
--- a/Rakka/Authorization.hs
+++ b/Rakka/Authorization.hs
@@ -8,6 +8,7 @@ module Rakka.Authorization
 import qualified Codec.Binary.Base64 as B64
 import qualified Codec.Binary.UTF8.String as UTF8
 import           Control.Concurrent.STM
+import           Control.Monad.Trans
 import qualified Data.Digest.SHA1 as SHA1
 import           Data.Map (Map)
 import qualified Data.Map as M hiding (Map)
@@ -42,23 +43,24 @@ mkAuthDB lsdir
                     }
 
 
-isValidPair :: AuthDB -> String -> String -> IO Bool
+isValidPair :: MonadIO m => AuthDB -> String -> String -> m Bool
 isValidPair adb name pass
     = let hash = SHA1.hash (UTF8.encode pass)
       in
-        atomically $ do m <- readTVar (adbUserMap adb)
-                        return (M.lookup name m == Just hash)
+        liftIO $ atomically $ do m <- readTVar (adbUserMap adb)
+                                 return (M.lookup name m == Just hash)
 
 
 loadUserMap :: FilePath -> IO UserMap
 loadUserMap path
     = do exist <- doesFileExist path
-         if exist then
-             readFile path
-                >>=
-                return . initMap . M.fromList . map decodePair . fromJust . deserializeStringPairs
-           else
-             return M.empty
+         m     <- if exist then
+                      readFile path
+                      >>=
+                      return . M.fromList . map decodePair . fromJust . deserializeStringPairs
+                  else
+                      return M.empty
+         return (initMap m)
     where
       decodePair :: (String, String) -> (String, [Word8])
       decodePair (name, b64Hash)