BkrLocalMeta.hs

{-# LANGUAGE ScopedTypeVariables #-}

module System.Bkr.BkrLocalMeta ( getLocalMeta
                        , insertBkrMeta
                        , deleteBkrMeta
                        ) where

import System.Bkr.BkrLogging
import System.Bkr.BkrFundare
import System.Bkr.BkrConfig (FileUpdateCheckType(..))
--import Bkr.Hasher (getHashForString)

import Database.HDBC
import Database.HDBC.Sqlite3 as SL

import Prelude hiding (catch)
import Control.Exception (catch)
import System.Random (getStdRandom, randomR)
import Control.Monad (filterM)

--import System.Time (ClockTime(..))

-- db convenience functions --

{-| Convenience function for getting a db connection. -}
getConn :: FilePath -> IO SL.Connection
getConn path = do
     logDebug $ "getSqliteConnection: getting conn for path: " ++ path
     
     -- Try usong connectSqlite3 and connectSqlite3Raw if that fails (file system unicode support workaround for OS X)
     SL.connectSqlite3 path `catch` \ (_ :: SqlError) -> SL.connectSqlite3Raw path

{-| Convenience function for disconnection a db connection. -}
doDisconnect :: IConnection conn => conn -> IO ()
doDisconnect conn = logDebug "doDisconnect called" >> disconnect conn

{-| Convenience function for committing a ongoing transaction. -}
doCommit :: IConnection conn => conn -> IO ()
doCommit conn = logDebug "doCommit called" >> commit conn

{-| Convenience function for rolling back a transaction. -}
doRollback :: IConnection conn => conn -> IO ()
doRollback conn = logDebug "doRollback called" >> rollback conn

{-| Convenience function for db insert. Takes file path to the db file and commits the transaction automatically.

Use as:
@
set \"/path/to/db/file.db\" \"INSERT INTO table VALUES (?, ?)\" [[toSql (1 :: Int), toSql (\"text\" :: String)], [toSql (2 :: Int), SqlNull]]
@
-}
set :: FilePath -> String -> [[SqlValue]] -> IO ()
set dbFilePath query values = do 
     logDebug $ "set: called with query: " ++ query -- ++ "\nvalues: " ++ (show values)
     conn <- getConn dbFilePath
     catch (do 
               stmt <- prepare conn query
               executeMany stmt values
               doCommit conn)
               --doDisconnect conn)
           (\e -> do 
                     let err = show (e :: SqlError)
                     logCritical $ "set: got SqlError: " ++ err ++ ", will rollback the transaction"
                     doRollback conn
                     doDisconnect conn)

-- End db convenience functions --

{-| Created a .bkrmeta db file and inserts the bkrmeta table. -}
setTable :: FilePath -> IO ()
setTable dbFilePath = do
     logDebug $ "setTable: called for path: " ++ dbFilePath
     
     let query = "CREATE TABLE IF NOT EXISTS bkrmeta (pathchecksum TEXT PRIMARY KEY, fullpath TEXT NOT NULL, filechecksum TEXT NOT NULL, filemodtimechecksum TEXT NOT NULL, filemodtime TEXT, nogets INTEGER)"
     set dbFilePath query [[]]

{-| Filter function that gets a random number between 0-9 and checks if the number is larger then noGets. If larger returns IO True (object is read from the local db) and if smaller the object is deleted from the local db (insertBkrMeta will insert the object). -}
objUpdateFilter :: IConnection conn => conn -> [SqlValue] -> IO Bool
--objUpdateFilter conn [pathChecksum, fullPath, fileChecksum, fileModTime, fileModChecksum, noGets] = do
objUpdateFilter conn [pathChecksum_, fullPath_, _, _, _, noGets_] = do
     randomNo <- getStdRandom (randomR (0,9))
     if randomNo > noGets_'
        then return True
        else do
             print $ "objUpdateFilter: will delete obj: " ++ show fullPath_
             let query = "DELETE FROM bkrmeta WHERE pathchecksum = ?"
             _ <- quickQuery' conn query [pathChecksum_] `catch` \ (err :: SqlError) -> do
                                                               logCritical $ "objUpdateFilter: got sql error: " ++ show err
                                                               return []
             return False

     where noGets_' = fromSql noGets_ :: Int
objUpdateFilter _ _ = error "Failed to match expected pattern"

{-| Gets BkrMeta objects from a .bkrmeta db file. getLocalMeta increments nogets every time it's called and it filters objects with objUpdateFilter. -}
getLocalMeta :: FileUpdateCheckType -> FilePath -> IO [BkrMeta]
getLocalMeta fileUpdateCheckType dbFilePath = do
     logDebug $ "getLocalMeta: called for path: " ++ dbFilePath
     
     conn <- getConn dbFilePath
     let query = "SELECT pathchecksum, fullpath, filechecksum, filemodtime, filemodtimechecksum, nogets FROM bkrmeta"
     result <- quickQuery' conn query [] `catch` \ (err :: SqlError) -> do
                                                                         logCritical $ "getLocalMeta: got sql error: " ++ show err ++ ", will disconnect conn"
                                                                         doDisconnect conn
                                                                         return []
     -- Increment nogets
     let query_ = "UPDATE bkrmeta SET nogets = nogets + 1"
     _ <- quickQuery' conn query_ [] `catch` \ (err :: SqlError) -> do
                                                               logCritical $ "getLocalMeta: got sql error when incrementing nogets: " ++ show err ++ ", will disconnect conn"
                                                               doDisconnect conn
                                                               return []
     -- Use smart update or check by date only
     if fileUpdateCheckType == FUCSmart
        then do
           --filteredObjects <- filterM (\x -> objUpdateFilter conn x) result
           filteredObjects <- filterM (objUpdateFilter conn) result
           doCommit conn
           doDisconnect conn
           return $ map convRow filteredObjects
        else do
           doCommit conn
           doDisconnect conn
           return $ map convRow result

     where convRow :: [SqlValue] -> BkrMeta
           --convRow [pathChecksum, fullPath, fileChecksum, fileModTime, fileModChecksum, noGets] = 
           convRow [pathChecksum_, fullPath_, fileChecksum_, fileModTime_, fileModChecksum_, _] = 
                   BkrMeta path fileHash pathHash fileMod fileModHash
                   where path        = fromSql fullPath_ :: String
                         fileHash    = fromSql fileChecksum_ :: String
                         pathHash    = fromSql pathChecksum_ :: String
                         fileMod     = fromSql fileModTime_ :: String
                         fileModHash = fromSql fileModChecksum_ :: String
           convRow _ = error "Failed to match expected pattern"

{-| Checks if bkrmeta table exists and inserts it if it doesn't. -}
setTableIfNeeded :: FilePath -> IO ()
setTableIfNeeded dbFilePath = do
     logDebug $ "setTableIfNeeded: called for path: " ++ dbFilePath
     conn <- getConn dbFilePath
     catch (do
             --result <- quickQuery' conn "SELECT * FROM bkrmeta LIMIT 1" []
             _ <- quickQuery' conn "SELECT * FROM bkrmeta LIMIT 1" []
             doDisconnect conn
             logDebug "setTableIfNeeded: table exists"
             return ())
           (\e -> do 
                   let err = show (e :: SqlError)
                   logDebug $ "setTableIfNeeded: got sql error: " ++ err ++ ", will set table"
                   doDisconnect conn
                   setTable dbFilePath)

{-| Inserts BkrMeta objects into a .bkrmeta db file. -}
insertBkrMeta :: FilePath -> [BkrMeta] -> IO ()
insertBkrMeta dbFilePath bkrMetaList = do
     logDebug $ "insertBkrMeta: called for path: " ++ dbFilePath
     
     let valuesList = map getValList bkrMetaList
     let query = "INSERT INTO bkrmeta (pathchecksum, fullpath, filechecksum, filemodtimechecksum, filemodtime, nogets) VALUES (?,?,?,?,?,?)"

     setTableIfNeeded dbFilePath
     set dbFilePath query valuesList

     where getValList :: BkrMeta -> [SqlValue]
           getValList bkrMeta = [toSql (pathChecksum bkrMeta :: String),
                                 toSql (fullPath bkrMeta :: String),
                                 toSql (fileChecksum bkrMeta :: String),
                                 toSql (modificationTimeChecksum bkrMeta :: String),
                                 toSql (modificationTime bkrMeta :: String), 
                                 toSql (0 :: Int)]

{-| Delete BkrMeta objects from a .bkrmeta file. -}
deleteBkrMeta :: FilePath -> [BkrMeta] -> IO ()
deleteBkrMeta dbFilePath bkrMetaList = do
     logDebug $ "deleteBkrMeta: called for path: " ++ show dbFilePath
     
     let valuesList = map getValList bkrMetaList
     let query = "DELETE FROM bkrmeta WHERE pathchecksum = ?"
     
     setTableIfNeeded dbFilePath
     
     set dbFilePath query valuesList

     where  getValList :: BkrMeta -> [SqlValue]
            getValList bkrMeta = [toSql (pathChecksum bkrMeta :: String)]

{-
{-| Convenience function for db insert, same as set but takes an established db connection instead. You need to create the connection and commit the query manually.

Use as:
@
conn <- getSqliteConnection "pathToDBFile.db"
set' conn "INSERT INTO table VALUES (?, ?)" [[toSql (1 :: Int), toSql ("text" :: String)],[toSql (2 :: Int), SqlNull]]
doCommit conn
doDisconnect conn
@
|-}
set' :: IConnection conn => conn -> String -> [[SqlValue]] -> IO ()
set' conn query values = do 
     logDebug $ "set': called with query: " ++ query
     catch (do 
               stmt <- prepare conn query
               executeMany stmt values)
           (\e -> do 
                     let err = show (e :: SqlError)
                     logCritical $ "set': got SqlError: " ++ err ++ ", will rollback the transaction"
                     doRollback conn)
-}

{-
setSimple :: IConnection conn => conn -> String -> [SqlValue] -> IO Integer
setSimple conn query values = do
     logDebug $ "setSimple: called with query: " ++ query
     run conn query values `catch` (\e -> do 
                                             let err = show (e :: SqlError)
                                             logCritical $ "setSimple: got SqlError: " ++ err ++ ", will rollback the transaction"
                                             doRollback conn
                                             return 0)
-}

{-
getValuesList :: FilePath -> String -> ClockTime -> Int -> [SqlValue]
getValuesList fullPath fileChecksum fileModTime noGets = [toSql ((show $ getHashForString fullPath) :: String), toSql (fullPath :: String), toSql (fileChecksum :: String), toSql ((show $ getHashForString $ show fileModTime) :: String), toSql (fileModTime :: ClockTime), toSql (noGets :: Int)]


insertBkrMeta :: FilePath -> String -> String -> ClockTime -> IO ()
insertBkrMeta dbFilePath fullPath fileChecksum fileModTime = do
     --logDebug $ "insertBkrMeta: called for path: " ++ dbFilePath
     --conn <- getConn dbFilePath
     let query = "INSERT INTO bkrmeta (pathchecksum, fullpath, filechecksum, filemodtimechecksum, filemodtime, nogets) VALUES (?,?,?,?,?,?)"
     --set conn query [getValuesList fullPath fileChecksum fileModTime 0]
     --doCommit conn
     --doDisconnect conn
     set dbFilePath query [getValuesList fullPath fileChecksum fileModTime 0]
-}