diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-01-11 15:52:11 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-01-11 15:52:11 -0400 |
commit | fcdf8b0475b39d5132e74978479cb541c276ccfe (patch) | |
tree | 549108078585b2a095fb544aa3503b038bcf2d69 /Database/Keys/SQL.hs | |
parent | 98df0b3ab024c6df2256003d4b3165a44e61df7d (diff) |
split out raw sql interface
Diffstat (limited to 'Database/Keys/SQL.hs')
-rw-r--r-- | Database/Keys/SQL.hs | 100 |
1 files changed, 100 insertions, 0 deletions
diff --git a/Database/Keys/SQL.hs b/Database/Keys/SQL.hs new file mode 100644 index 000000000..22bcb86a1 --- /dev/null +++ b/Database/Keys/SQL.hs @@ -0,0 +1,100 @@ +{- Sqlite database of information about Keys + - + - Copyright 2015-2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} + +module Database.Keys.SQL where + +import Database.Types +import qualified Database.Queue as H +import Utility.InodeCache +import Git.FilePath + +import Database.Persist.TH +import Database.Esqueleto hiding (Key) +import Data.Time.Clock +import Control.Monad + +share [mkPersist sqlSettings, mkMigrate "migrateKeysDb"] [persistLowerCase| +Associated + key SKey + file FilePath + KeyFileIndex key file +Content + key SKey + cache SInodeCache + KeyCacheIndex key cache +|] + +newtype ReadHandle = ReadHandle H.DbQueue + +readDb :: SqlPersistM a -> ReadHandle -> IO a +readDb a (ReadHandle h) = H.queryDbQueue h a + +newtype WriteHandle = WriteHandle H.DbQueue + +queueDb :: SqlPersistM () -> WriteHandle -> IO () +queueDb a (WriteHandle h) = H.queueDb h checkcommit a + where + -- commit queue after 1000 changes or 5 minutes, whichever comes first + checkcommit sz lastcommittime + | sz > 1000 = return True + | otherwise = do + now <- getCurrentTime + return $ diffUTCTime lastcommittime now > 300 + +addAssociatedFile :: SKey -> TopFilePath -> WriteHandle -> IO () +addAssociatedFile sk f = queueDb $ do + -- If the same file was associated with a different key before, + -- remove that. + delete $ from $ \r -> do + where_ (r ^. AssociatedFile ==. val (getTopFilePath f) &&. not_ (r ^. AssociatedKey ==. val sk)) + void $ insertUnique $ Associated sk (getTopFilePath f) + +{- Note that the files returned were once associated with the key, but + - some of them may not be any longer. -} +getAssociatedFiles :: SKey -> ReadHandle -> IO [TopFilePath] +getAssociatedFiles sk = readDb $ do + l <- select $ from $ \r -> do + where_ (r ^. AssociatedKey ==. val sk) + return (r ^. AssociatedFile) + return $ map (asTopFilePath . unValue) l + +{- Gets any keys that are on record as having a particular associated file. + - (Should be one or none but the database doesn't enforce that.) -} +getAssociatedKey :: TopFilePath -> ReadHandle -> IO [SKey] +getAssociatedKey f = readDb $ do + l <- select $ from $ \r -> do + where_ (r ^. AssociatedFile ==. val (getTopFilePath f)) + return (r ^. AssociatedKey) + return $ map unValue l + +removeAssociatedFile :: SKey -> TopFilePath -> WriteHandle -> IO () +removeAssociatedFile sk f = queueDb $ + delete $ from $ \r -> do + where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val (getTopFilePath f)) + +addInodeCaches :: SKey -> [InodeCache] -> WriteHandle -> IO () +addInodeCaches sk is = queueDb $ + forM_ is $ \i -> insertUnique $ Content sk (toSInodeCache i) + +{- A key may have multiple InodeCaches; one for the annex object, and one + - for each pointer file that is a copy of it. -} +getInodeCaches :: SKey -> ReadHandle -> IO [InodeCache] +getInodeCaches sk = readDb $ do + l <- select $ from $ \r -> do + where_ (r ^. ContentKey ==. val sk) + return (r ^. ContentCache) + return $ map (fromSInodeCache . unValue) l + +removeInodeCaches :: SKey -> WriteHandle -> IO () +removeInodeCaches sk = queueDb $ + delete $ from $ \r -> do + where_ (r ^. ContentKey ==. val sk) |