{- Sqlite database of information about Keys
 -
 - Copyright 2015-2019 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

module Database.Keys.SQL where

import Database.Types
import Database.Handle
import qualified Database.Queue as H
import Utility.InodeCache
import Git.FilePath

import Database.Persist.Sql hiding (Key)
import Database.Persist.TH
import Data.Time.Clock
import Control.Monad
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Conduit.List as CL

share [mkPersist sqlSettings, mkMigrate "migrateKeysDb"] [persistLowerCase|
Associated
  key Key
  file SFilePath
  KeyFileIndex key file
  FileKeyIndex file key
Content
  key Key
  cache InodeCache
  KeyCacheIndex key cache
|]

containedTable :: TableName
containedTable = "content"

createTables :: SqlPersistM ()
createTables = void $ runMigrationSilent migrateKeysDb

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 now lastcommittime > 300

addAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO ()
addAssociatedFile k f = queueDb $ do
	-- If the same file was associated with a different key before,
	-- remove that.
	deleteWhere [AssociatedFile ==. af, AssociatedKey !=. k]
	void $ insertUnique $ Associated k af
  where
	af = toSFilePath (getTopFilePath f)

-- Does not remove any old association for a file, but less expensive
-- than addAssociatedFile. Calling dropAllAssociatedFiles first and then
-- this is an efficient way to update all associated files.
addAssociatedFileFast :: Key -> TopFilePath -> WriteHandle -> IO ()
addAssociatedFileFast k f = queueDb $ void $ insertUnique $ Associated k af
  where
	af = toSFilePath (getTopFilePath f)

dropAllAssociatedFiles :: WriteHandle -> IO ()
dropAllAssociatedFiles = queueDb $
	deleteWhere ([] :: [Filter Associated])

{- Note that the files returned were once associated with the key, but
 - some of them may not be any longer. -}
getAssociatedFiles :: Key -> ReadHandle -> IO [TopFilePath]
getAssociatedFiles k = readDb $ do
	l <- selectList [AssociatedKey ==. k] []
	return $ map (asTopFilePath . fromSFilePath . associatedFile . entityVal) 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 [Key]
getAssociatedKey f = readDb $ do
	l <- selectList [AssociatedFile ==. af] []
	return $ map (associatedKey . entityVal) l
  where
	af = toSFilePath (getTopFilePath f)

removeAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO ()
removeAssociatedFile k f = queueDb $
	deleteWhere [AssociatedKey ==. k, AssociatedFile ==. af]
  where
	af = toSFilePath (getTopFilePath f)

addInodeCaches :: Key -> [InodeCache] -> WriteHandle -> IO ()
addInodeCaches k is = queueDb $
	forM_ is $ \i -> insertUnique $ Content k 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 :: Key -> ReadHandle -> IO [InodeCache]
getInodeCaches k = readDb $ do
	l <- selectList [ContentKey ==. k] []
	return $ map (contentCache . entityVal) l

removeInodeCaches :: Key -> WriteHandle -> IO ()
removeInodeCaches k = queueDb $
	deleteWhere [ContentKey ==. k]

{- Check if the inode is known to be used for an annexed file.
 -
 - This is currently slow due to the lack of indexes.
 -}
isInodeKnown :: InodeCache -> SentinalStatus -> ReadHandle -> IO Bool
isInodeKnown i s = readDb query
  where
	query 
		| sentinalInodesChanged s =
			withRawQuery likesql [] $ isJust <$> CL.head
		| otherwise =
			isJust <$> selectFirst [ContentCache ==. i] []
			
	likesql = T.concat
		[ "SELECT key FROM content WHERE "
		, T.intercalate " OR " $ map mklike (likeInodeCacheWeak i)
		, " LIMIT 1"
		]

	mklike p = T.concat
		[ "cache LIKE "
		, "'" 
		, T.pack p
		, "'"
		]