1 module Rakka.Authorization
10 import Control.Concurrent.STM
12 import Control.Monad.Trans
13 import qualified Data.ByteString as B
15 import qualified Data.Map as M hiding (Map)
17 import Rakka.SystemConfig
18 import System.Directory
19 import System.FilePath
24 adbFilePath :: !FilePath
25 , adbUserMap :: !(TVar UserMap)
29 type UserMap = Map String String
32 mkAuthDB :: FilePath -> IO AuthDB
34 = do let path = lsdir </> "authDB"
35 m <- newTVarIO =<< loadUserMap path
42 isValidPair :: MonadIO m => AuthDB -> String -> String -> m Bool
43 isValidPair adb name pass
44 = liftIO $ do sha1 <- return . fromJust =<< getDigestByName "SHA1"
45 let hash = digestBS sha1 $ B.pack $ UTF8.encode pass
46 atomically $ do m <- readTVar (adbUserMap adb)
47 return (M.lookup name m == Just hash)
50 getUserList :: MonadIO m => AuthDB -> m [String]
54 do m <- readTVar (adbUserMap adb)
58 addUser :: MonadIO m => AuthDB -> String -> String -> m ()
61 do sha1 <- return . fromJust =<< getDigestByName "SHA1"
62 let hash = digestBS sha1 $ B.pack $ UTF8.encode pass
63 m <- atomically $ do m <- readTVar (adbUserMap adb)
64 let m' = M.insert name hash m
65 writeTVar (adbUserMap adb) m'
67 saveUserMap (adbFilePath adb) m
70 delUser :: MonadIO m => AuthDB -> String -> m ()
73 do m <- atomically $ do m <- readTVar (adbUserMap adb)
74 let m' = M.delete name m
75 writeTVar (adbUserMap adb) m'
77 saveUserMap (adbFilePath adb) m
80 loadUserMap :: FilePath -> IO UserMap
82 = do exist <- doesFileExist path
84 liftM (M.fromList . map decodePair . fromJust . deserializeStringPairs)
88 sha1 <- return . fromJust =<< getDigestByName "SHA1"
89 return (initMap sha1 m)
91 decodePair :: (String, String) -> (String, String)
92 decodePair (name, b64Hash)
93 = (UTF8.decodeString name, decodeBase64 b64Hash)
95 initMap :: Digest -> UserMap -> UserMap
97 | M.null m = let name = "root"
100 M.singleton name hash
104 saveUserMap :: FilePath -> UserMap -> IO ()
106 = writeFile path $ serializeStringPairs $ map encodePair $ M.toList m
108 encodePair :: (String, String) -> (String, String)
109 encodePair (name, hash)
110 = (UTF8.encodeString name, encodeBase64 hash)