Add the file operations to ca-store

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."

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

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
 

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)

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

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