From 15ea23acdb00fa964d91d440274e3a78bd115083 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 30 Aug 2016 16:29:22 -0400
Subject: Added basic test suite.

---
 Storage/Local.hs | 59 ++++++++++++++++++++++++++++++--------------------------
 1 file changed, 32 insertions(+), 27 deletions(-)

(limited to 'Storage')

diff --git a/Storage/Local.hs b/Storage/Local.hs
index e8f6010..d0a1d15 100644
--- a/Storage/Local.hs
+++ b/Storage/Local.hs
@@ -3,7 +3,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Storage.Local (localStorage, uploadQueue) where
+module Storage.Local (localStorage, userStorageDir, testStorageDir, uploadQueue) where
 
 import Types
 import Types.Storage
@@ -23,25 +23,27 @@ import Control.DeepSeq
 import Control.Exception
 import Control.Monad
 
+type GetShareDir = Section -> IO FilePath
+
 newtype Section = Section String
 
-localStorage :: String -> Storage
-localStorage n = Storage
-	{ storeShare = store section
-	, retrieveShare = retrieve section
-	, obscureShares = obscure section
-	, countShares = count section
-	, moveShares = move section
+localStorage :: GetShareDir -> String -> Storage
+localStorage getsharedir n = Storage
+	{ storeShare = store section getsharedir
+	, retrieveShare = retrieve section getsharedir
+	, obscureShares = obscure section getsharedir
+	, countShares = count section getsharedir
+	, moveShares = move section getsharedir
 	}
   where
 	section = Section n
 
 uploadQueue :: Server -> Storage
-uploadQueue s = localStorage ("uploadqueue" </> serverName s)
+uploadQueue s = localStorage userStorageDir ("uploadqueue" </> serverName s)
 
-store :: Section -> StorableObjectIdent -> Share -> IO StoreResult
-store section i s = onError (StoreFailure . show) $ do
-	dir <- shareDir section
+store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult
+store section getsharedir i s = onError (StoreFailure . show) $ do
+	dir <- getsharedir section
 	createDirectoryIfMissing True dir
 	let dest = dir </> shareFile i
 	exists <- doesFileExist dest
@@ -57,9 +59,9 @@ store section i s = onError (StoreFailure . show) $ do
 			renameFile tmp dest
 			return StoreSuccess
 
-retrieve :: Section -> ShareNum -> StorableObjectIdent -> IO RetrieveResult
-retrieve section n i = onError (RetrieveFailure . show) $ do
-	dir <- shareDir section
+retrieve :: Section -> GetShareDir -> ShareNum -> StorableObjectIdent -> IO RetrieveResult
+retrieve section getsharedir n i = onError (RetrieveFailure . show) $ do
+	dir <- getsharedir section
 	fd <- openFd (dir </> shareFile i) ReadOnly Nothing defaultFileFlags
 	h <- fdToHandle fd
 	b <- B.hGetContents h
@@ -75,22 +77,22 @@ retrieve section n i = onError (RetrieveFailure . show) $ do
 --
 -- Note that the contents of shares is never changed, so it's ok to set the
 -- mtime to the epoch; backup programs won't be confused.
-obscure :: Section -> IO ObscureResult
-obscure section = onError (ObscureFailure . show) $ do
-	dir <- shareDir section
+obscure :: Section -> GetShareDir -> IO ObscureResult
+obscure section getsharedir = onError (ObscureFailure . show) $ do
+	dir <- getsharedir section
 	fs <- filter isShareFile <$> getDirectoryContents dir
 	mapM_ (\f -> setFileTimes (dir </> f) 0 0) fs
 	return ObscureSuccess
 
-count :: Section -> IO CountResult
-count section = onError (CountFailure . show) $ do
-	dir <- shareDir section
+count :: Section -> GetShareDir -> IO CountResult
+count section getsharedir = onError (CountFailure . show) $ do
+	dir <- getsharedir section
 	CountResult . genericLength . filter isShareFile
 		<$> getDirectoryContents dir
 
-move :: Section -> Storage -> IO ()
-move section storage = do
-	dir <- shareDir section
+move :: Section -> GetShareDir -> Storage -> IO ()
+move section getsharedir storage = do
+	dir <- getsharedir section
 	fs <- getDirectoryContents dir
 	forM_ fs $ \f -> case fromShareFile f of
 		Nothing -> return ()
@@ -99,7 +101,7 @@ move section storage = do
 			-- matter because we're not going to be
 			-- recombining the share, just sending its contents
 			-- on the the server.
-			r <- retrieve section 0 i
+			r <- retrieve section getsharedir 0 i
 			case r of
 				RetrieveFailure _ -> return ()
 				RetrieveSuccess share -> do
@@ -115,11 +117,14 @@ onError f a = do
 		Left e -> f e
 		Right r -> r
 
-shareDir :: Section -> IO FilePath
-shareDir (Section section) = do
+userStorageDir :: GetShareDir
+userStorageDir (Section section) = do
 	u <- getUserEntryForID =<< getEffectiveUserID
 	return $ homeDirectory u </> dotdir </> section
 
+testStorageDir :: FilePath -> GetShareDir
+testStorageDir tmpdir (Section section) = pure $ tmpdir </> section
+
 -- | The takeFileName ensures that, if the StorableObjectIdent somehow
 -- contains a path (eg starts with "../" or "/"), it is not allowed
 -- to point off outside the shareDir.
-- 
cgit v1.2.3