X-Git-Url: https://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FAuthorization.hs;h=be7f490e935b0f4e491069cbd1736e8c42298ed6;hp=0f865c3dee08b7be0baf710c5a6216d23d41a879;hb=547fd6221931c8025085db91f7424db850156129;hpb=52bafd675e7ac9d3fc9d3bf2d72e66a22efb6db9

diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs
index 0f865c3..be7f490 100644
--- a/Rakka/Authorization.hs
+++ b/Rakka/Authorization.hs
@@ -2,6 +2,9 @@ module Rakka.Authorization
     ( AuthDB
     , mkAuthDB
     , isValidPair
+    , getUserList
+    , addUser
+    , delUser
     )
     where
 
@@ -51,6 +54,36 @@ isValidPair adb name pass
                                   return (M.lookup name m == Just hash)
 
 
+getUserList :: MonadIO m => AuthDB -> m [String]
+getUserList adb
+    = liftIO $
+      atomically $
+      do m <- readTVar (adbUserMap adb)
+	 return (M.keys m)
+
+
+addUser :: MonadIO m => AuthDB -> String -> String -> m ()
+addUser adb name pass
+    = liftIO $
+      do sha1 <- return . fromJust =<< getDigestByName "SHA1"
+	 let hash = digestBS sha1 $ B.pack $ UTF8.encode pass
+	 m <- atomically $ do m <- readTVar (adbUserMap adb)
+			      let m' = M.insert name hash m
+			      writeTVar (adbUserMap adb) m'
+			      return m'
+	 saveUserMap (adbFilePath adb) m
+
+
+delUser :: MonadIO m => AuthDB -> String -> m ()
+delUser adb name
+    = liftIO $
+      do m <- atomically $ do m <- readTVar (adbUserMap adb)
+			      let m' = M.delete name m
+			      writeTVar (adbUserMap adb) m'
+			      return m'
+	 saveUserMap (adbFilePath adb) m
+
+
 loadUserMap :: FilePath -> IO UserMap
 loadUserMap path
     = do exist <- doesFileExist path
@@ -74,3 +107,12 @@ loadUserMap path
                         in
                           M.singleton name hash
           | otherwise = m
+
+
+saveUserMap :: FilePath -> UserMap -> IO ()
+saveUserMap path m
+    = writeFile path $ serializeStringPairs $ map encodePair $ M.toList m
+    where
+    encodePair :: (String, String) -> (String, String)
+    encodePair (name, hash)
+	= (UTF8.encodeString name, encodeBase64 hash)