diff --git a/src/CAStore/Command.hs b/src/CAStore/Command.hs index ddb35f1..129b5ac 100644 --- a/src/CAStore/Command.hs +++ b/src/CAStore/Command.hs @@ -6,15 +6,25 @@ module CAStore.Command where import CAStore.Command.Type (Command(..), parseCommand) -import CAStore.Program (Program, storeFile, unstoreFile) -import CAStore.Program.Storage (registerFile, unregisterFile) +import CAStore.Program (Program, storeFile, unstoreFile, getFileLocation) +import CAStore.Program.Storage (registerFiles, unregisterFiles, generateId) import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) +import System.Directory (doesFileExist) runCommand :: Command -> Program () -runCommand (FileAdd fs) = forM_ fs $ \x -> do - registerFile x >>= storeFile x -runCommand (FileRemove ss) = forM_ ss $ \x -> do - unregisterFile x *> unstoreFile x -runCommand (FileVerify ss) = forM_ ss $ \_ -> do - liftIO $ putStrLn $ "STUB" +runCommand (FileAdd fs) = do + sids <- registerFiles fs + forM_ (zip fs sids) $ \(file, sid) -> storeFile file sid +runCommand (FileRemove ss) + = unregisterFiles ss + *> forM_ ss unstoreFile +runCommand (FileVerify ss) = forM_ ss $ \sid -> do + file <- getFileLocation sid + liftIO (doesFileExist file) >>= \case + True -> do + sid' <- generateId file + case sid == sid' of + True -> liftIO $ putStrLn $ show sid ++ " is valid." + False -> liftIO $ putStrLn $ show sid ++ " has been corrupted." + False -> liftIO $ putStrLn $ show sid ++ " does not exist in the store." diff --git a/src/CAStore/Command/Type.hs b/src/CAStore/Command/Type.hs index 81f5d7d..7e3afa8 100644 --- a/src/CAStore/Command/Type.hs +++ b/src/CAStore/Command/Type.hs @@ -5,7 +5,6 @@ module CAStore.Command.Type where import CAStore.Type -import Data.ByteString.Char8 (pack) data Command = FileAdd [FilePath] @@ -17,7 +16,7 @@ parseCommand :: [String] -> Maybe Command parseCommand ("file":"add":xs) = Just $ FileAdd xs parseCommand ("file":"remove":xs) - = Just $ FileRemove $ StoreId . pack <$> xs + = Just $ FileRemove $ StoreId <$> xs parseCommand ("file":"verify":xs) - = Just $ FileVerify $ StoreId . pack <$> xs + = Just $ FileVerify $ StoreId <$> xs parseCommand _ = Nothing diff --git a/src/CAStore/Program.hs b/src/CAStore/Program.hs index a9d65f5..5ac137a 100644 --- a/src/CAStore/Program.hs +++ b/src/CAStore/Program.hs @@ -4,6 +4,7 @@ module CAStore.Program , getConnectionHandle , getStoreRoot , getCommand + , getFileLocation -- * File Operations , storeFile @@ -15,6 +16,7 @@ import CAStore.Program.Internal import CAStore.Type import Control.Monad.IO.Class (liftIO) import qualified System.Directory as D +import System.FilePath (takeDirectory) -- | Add a file to the store -- You must already have a 'StoreId' to use this function. You get one by @@ -25,6 +27,7 @@ storeFile file sid = do liftIO (D.doesFileExist fileLocation) >>= \case True -> pure () False -> liftIO $ do + D.createDirectoryIfMissing True (takeDirectory fileLocation) D.copyFile file fileLocation D.setPermissions file $ D.setOwnerReadable True D.emptyPermissions diff --git a/src/CAStore/Program/Internal.hs b/src/CAStore/Program/Internal.hs index 61552d6..0091d6a 100644 --- a/src/CAStore/Program/Internal.hs +++ b/src/CAStore/Program/Internal.hs @@ -17,8 +17,6 @@ import Control.Monad.Reader (ReaderT(..), asks) import Database.SQLite.Simple (Connection, withConnection) import qualified System.Directory as D import System.FilePath (()) -import qualified Data.ByteString as B (take) -import Data.ByteString.Char8 (unpack) import Data.Functor.Identity (Identity(..)) newtype Program a = Program (ReaderT Env IO a) @@ -60,7 +58,7 @@ getStoreRoot = Program $ asks storeRoot -- | Determine the final location for a file inside the store getFileLocation :: StoreId -> Program FilePath getFileLocation (StoreId x) - = (\root -> root "files" (unpack $ B.take 2 x) (unpack x)) + = (\root -> root "files" (take 2 x) x) <$> getStoreRoot getCommand :: Program (Maybe Command) diff --git a/src/CAStore/Program/Storage.hs b/src/CAStore/Program/Storage.hs index 725d992..c808f94 100644 --- a/src/CAStore/Program/Storage.hs +++ b/src/CAStore/Program/Storage.hs @@ -2,8 +2,9 @@ module CAStore.Program.Storage ( initialise - , registerFile - , unregisterFile + , generateId + , registerFiles + , unregisterFiles ) where @@ -11,26 +12,39 @@ import CAStore.Program.Internal import CAStore.Type (StoreId(..)) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) -import Crypto.Hash.SHA256 (hash) +import Crypto.Hash (hash, SHA256) import Data.ByteString (readFile) import Database.SQLite.Simple +import Database.SQLite.Simple.ToField (ToField) import Prelude hiding (readFile) initialise :: Program () initialise = do tables <- getAllDefinedTables unless ("file" `elem` tables) $ do - runSqlQ "CREATE TABLE file (id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, hash TEXT NOT NULL UNIQUE, insertion_date TEXT NOT NULL DEFAULT CURRENT_TIMESTAMP CHECK (insertion_date LIKE '____-__-__ __:__:__)) STRICT" + runSqlQ "CREATE TABLE file (id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, hash TEXT NOT NULL UNIQUE, insertion_date TEXT NOT NULL DEFAULT CURRENT_TIMESTAMP CHECK (insertion_date LIKE '____-__-__ __:__:__')) STRICT" -registerFile :: FilePath -> Program StoreId -registerFile file = do - sid <- fmap hash $ liftIO $ readFile file - runSqlQP "INSERT INTO file (hash) VALUES (?)" (Only sid) - pure $ StoreId sid +generateId :: FilePath -> Program StoreId +generateId = fmap (StoreId . show . hash @SHA256) . liftIO . readFile -unregisterFile :: StoreId -> Program () -unregisterFile (StoreId sid) = do - runSqlQP "DELETE FROM file WHERE hash = ?" (Only sid) +registerFiles + :: [FilePath] -> Program [StoreId] +registerFiles fs = do + sids <- traverse generateId fs + runSqlQ "CREATE TEMP TABLE t_reg_file (hash TEXT NOT NULL) STRICT" + runSqlMany "INSERT INTO t_reg_file (hash) VALUES (?)" sids + runSqlQ "INSERT INTO file (hash) SELECT hash FROM t_reg_file EXCEPT SELECT hash FROM file" + runSqlQ "DELETE FROM t_reg_file" + pure sids + +unregisterFiles + :: [StoreId] + -> Program () +unregisterFiles ss = do + runSqlQ "CREATE TEMP TABLE t_unreg_file (hash TEXT NOT NULL) STRICT" + runSqlMany "INSERT INTO t_unreg_file (hash) VALUES (?)" ss + runSqlQ "DELETE FROM file WHERE hash IN (SELECT * FROM t_unreg_file)" + runSqlQ "DELETE FROM t_unreg_file" -- runSql :: (Connection -> IO a) -> Program a -- runSql f = getConnectionHandle >>= (liftIO . f) @@ -38,8 +52,8 @@ unregisterFile (StoreId sid) = do runSqlQ :: Query -> Program () runSqlQ q = getConnectionHandle >>= (liftIO . flip execute_ q) -runSqlQP :: ToRow q => Query -> q -> Program () -runSqlQP q p = getConnectionHandle >>= \h -> (liftIO $ execute h q p) +runSqlMany :: ToField a => Query -> [a] -> Program () +runSqlMany q xs = getConnectionHandle >>= \h -> (liftIO $ executeMany h q (Only <$> xs)) getAllDefinedTables :: Program [String] getAllDefinedTables diff --git a/src/CAStore/Type.hs b/src/CAStore/Type.hs index d45e82d..a6f5096 100644 --- a/src/CAStore/Type.hs +++ b/src/CAStore/Type.hs @@ -7,13 +7,29 @@ module CAStore.Type ) where -import Data.ByteString (ByteString) +import Database.SQLite.Simple.FromField (FromField, fromField) +import Database.SQLite.Simple.ToField (ToField, toField) -newtype StoreId = StoreId ByteString - deriving (Show) +newtype StoreId = StoreId String + deriving (Eq) + +instance Show StoreId where + show (StoreId x) = show x + +instance FromField StoreId where + fromField = fmap StoreId . fromField + +instance ToField StoreId where + toField (StoreId x) = toField x newtype Tag = Tag String - deriving (Show) + deriving (Show, Eq) + +instance FromField Tag where + fromField = fmap Tag . fromField + +instance ToField Tag where + toField (Tag x) = toField x data StoreLocation = StoreShort String