- = let hash = toOctets $ sha256 $ UTF8.encode pass
- in
- liftIO $ atomically $ do m <- readTVar (adbUserMap adb)
- return (M.lookup name m == Just hash)
+ = liftIO $ do sha1 <- return . fromJust =<< getDigestByName "SHA1"
+ let hash = digestBS sha1 $ B.pack $ UTF8.encode pass
+ atomically $ do m <- readTVar (adbUserMap adb)
+ 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