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 Control.Monad.Trans
12 import Data.Digest.SHA2
14 import qualified Data.Map as M hiding (Map)
17 import Rakka.SystemConfig
18 import System.Directory
19 import System.FilePath
25 adbFilePath :: !FilePath
26 , adbUserMap :: !(TVar UserMap)
27 , adbSyncRequest :: !(TVar Bool)
31 type UserMap = Map String [Word8]
34 mkAuthDB :: FilePath -> IO AuthDB
36 = do let path = lsdir </> "authDB"
37 m <- newTVarIO =<< loadUserMap path
38 req <- newTVarIO False
42 , adbSyncRequest = req
46 isValidPair :: MonadIO m => AuthDB -> String -> String -> m Bool
47 isValidPair adb name pass
48 = let hash = toOctets $ sha256 $ UTF8.encode pass
50 liftIO $ atomically $ do m <- readTVar (adbUserMap adb)
51 return (M.lookup name m == Just hash)
54 loadUserMap :: FilePath -> IO UserMap
56 = do exist <- doesFileExist path
60 return . M.fromList . map decodePair . fromJust . deserializeStringPairs
65 decodePair :: (String, String) -> (String, [Word8])
66 decodePair (name, b64Hash)
67 = (UTF8.decodeString name, fromJust $ B64.decode b64Hash)
69 initMap :: UserMap -> UserMap
71 | M.null m = let name = "root"
72 hash = toOctets $ sha256 ([] :: [Word8])