module Rakka.Authorization
    ( AuthDB
    , mkAuthDB
    , isValidPair
    )
    where

import qualified Codec.Binary.Base64 as B64
import qualified Codec.Binary.UTF8.String as UTF8
import           Control.Concurrent.STM
import           Control.Monad.Trans
import qualified Data.Digest.SHA1 as SHA1
import           Data.Map (Map)
import qualified Data.Map as M hiding (Map)
import           Data.Maybe
import           Data.Word
import           Rakka.SystemConfig
import           System.Directory
import           System.FilePath
import           System.IO


data AuthDB
    = AuthDB {
        adbFilePath    :: !FilePath
      , adbUserMap     :: !(TVar UserMap)
      , adbSyncRequest :: !(TVar Bool)
      }


type UserMap = Map String [Word8]


mkAuthDB :: FilePath -> IO AuthDB
mkAuthDB lsdir
    = do let path = lsdir </> "authDB"
         m   <- newTVarIO =<< loadUserMap path
         req <- newTVarIO False
         return AuthDB {
                      adbFilePath    = path
                    , adbUserMap     = m
                    , adbSyncRequest = req
                    }


isValidPair :: MonadIO m => AuthDB -> String -> String -> m Bool
isValidPair adb name pass
    = let hash = SHA1.hash (UTF8.encode pass)
      in
        liftIO $ atomically $ do m <- readTVar (adbUserMap adb)
                                 return (M.lookup name m == Just hash)


loadUserMap :: FilePath -> IO UserMap
loadUserMap path
    = do exist <- doesFileExist path
         m     <- if exist then
                      readFile path
                      >>=
                      return . M.fromList . map decodePair . fromJust . deserializeStringPairs
                  else
                      return M.empty
         return (initMap m)
    where
      decodePair :: (String, String) -> (String, [Word8])
      decodePair (name, b64Hash)
          = (UTF8.decodeString name, B64.decode b64Hash)

      initMap :: UserMap -> UserMap
      initMap m
          | M.null m  = let name = "root"
                            hash = SHA1.hash []
                        in
                          M.singleton name hash
          | otherwise = m