1 module Rakka.Authorization
8 import qualified Codec.Binary.Base64 as B64
9 import qualified Codec.Binary.UTF8.String as UTF8
10 import Control.Concurrent.STM
11 import qualified Data.Digest.SHA1 as SHA1
13 import qualified Data.Map as M hiding (Map)
16 import Rakka.SystemConfig
17 import System.Directory
18 import System.FilePath
24 adbFilePath :: !FilePath
25 , adbUserMap :: !(TVar UserMap)
26 , adbSyncRequest :: !(TVar Bool)
30 type UserMap = Map String [Word8]
33 mkAuthDB :: FilePath -> IO AuthDB
35 = do let path = lsdir </> "authDB"
36 m <- newTVarIO =<< loadUserMap path
37 req <- newTVarIO False
41 , adbSyncRequest = req
45 isValidPair :: AuthDB -> String -> String -> IO Bool
46 isValidPair adb name pass
47 = let hash = SHA1.hash (UTF8.encode pass)
49 atomically $ do m <- readTVar (adbUserMap adb)
50 return (M.lookup name m == Just hash)
53 loadUserMap :: FilePath -> IO UserMap
55 = do exist <- doesFileExist path
59 return . initMap . M.fromList . map decodePair . fromJust . deserializeStringPairs
63 decodePair :: (String, String) -> (String, [Word8])
64 decodePair (name, b64Hash)
65 = (UTF8.decodeString name, B64.decode b64Hash)
67 initMap :: UserMap -> UserMap
69 | M.null m = let name = "root"