hashed-storage 0.3.4 → 0.3.5

raw patch · 5 files changed

+98/−25 lines, 5 filesdep +test-framework-quickcheck2dep +zip-archivedep −test-framework-quickcheckdep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: test-framework-quickcheck2, zip-archive

Dependencies removed: test-framework-quickcheck

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• Storage/Hashed/Index.hs +31/−14
• Storage/Hashed/Test.hs +40/−6
• Storage/Hashed/Tree.hs +14/−1
• hashed-storage.cabal +3/−3
• test.hs +10/−1

@@ -1,8 +1,15 @@ {-# LANGUAGE ScopedTypeVariables, NoMonomorphismRestriction #-} --- | This module contains plain tree indexing code. +-- | This module contains plain tree indexing code. The index itself is a+-- CACHE: you should only ever use it as an optimisation and never as a primary+-- storage. In practice, this means that when we change index format, the+-- application is expected to throw the old index away and build a fresh+-- index. Please note that tracking index validity is out of scope for this+-- library: this is responsibility of your application. It is advisable that in+-- your validity tracking code, you also check for format validity (see+-- "indexFormatValid") and scrap and re-create index when needed. ----- The index is a binary file, that overlays a hashed tree over the working+-- The index is a binary file that overlays a hashed tree over the working -- copy. This means that every working file and directory has an entry in the -- index, that contains its path and hash and validity data. The validity data -- is a "last seen" timestamp plus the file size. The file hashes are sha256's@@ -29,7 +36,8 @@ -- recomputation of all of its parent directory hashes; moreover this is done -- efficiently -- each directory is updated at most once during a run. -module Storage.Hashed.Index( readIndex, updateIndexFrom, readOrUpgradeIndex )+module Storage.Hashed.Index( readIndex, updateIndexFrom, readOrUpgradeIndex+                           , indexFormatValid )     where  import Prelude hiding ( lookup, readFile, writeFile, catch )@@ -308,17 +316,26 @@        create (SubTree reference) (AnchoredPath []) 4        readIndex indexpath hashtree --- | Read index (just like readIndex). However, also check that the index--- version matches our expectations and if not, rebuild it from the reference--- (which is provided in form of un-executed action; we will only execute it--- when needed).-readOrUpgradeIndex :: FilePath -> (Tree -> Hash) -> IO Tree -> IO Tree-readOrUpgradeIndex path hashtree getref = do+-- | Check that a given file is an index file with a format we can handle. You+-- should remove and re-create the index whenever this is not true.+indexFormatValid :: FilePath -> IO Bool+indexFormatValid path = do   fd <- openBinaryFile path ReadMode   magic <- sequence [ hGetChar fd | _ <- [1..4] :: [Int] ]   hClose fd-  case magic of-    "HSI0" -> readIndex path hashtree-    _ -> do ref <- getref >>= expand-            removeFile path-            updateIndexFrom path hashtree ref+  return $ case magic of+             "HSI0" -> True+             _ -> False++-- | DEPRECATED! Read index (just like readIndex). However, also check that the+-- index version matches our expectations and if not, rebuild it from the+-- reference (which is provided in form of un-executed action; we will only+-- execute it when needed).+readOrUpgradeIndex :: FilePath -> (Tree -> Hash) -> IO Tree -> IO Tree+readOrUpgradeIndex path hashtree getref = do+  valid <- indexFormatValid path+  if valid then readIndex path hashtree+           else do ref <- getref >>= expand+                   removeFile path+                   updateIndexFrom path hashtree ref+

@@ -1,6 +1,6 @@ module Storage.Hashed.Test( tests ) where -import Prelude hiding ( read )+import Prelude hiding ( read, filter ) import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.ByteString.Char8 as BS import System.Process@@ -16,21 +16,23 @@ import Storage.Hashed.Index import Storage.Hashed.Utils import Storage.Hashed.Darcs+import System.IO.Unsafe( unsafePerformIO )  import Test.HUnit import Test.Framework( testGroup ) import Test.QuickCheck  import Test.Framework.Providers.HUnit-import Test.Framework.Providers.QuickCheck+import Test.Framework.Providers.QuickCheck2  ------------------------ -- Test Data -- -files = [ floatPath "hashed-storage.cabal"-        , floatPath "Storage/Hashed.hs"-        , floatPath "Storage/Hashed/Index.hs" ]+files = [ floatPath "foo_a"+        , floatPath "foo_dir/foo_a"+        , floatPath "foo_dir/foo_b"+        , floatPath "foo_dir/foo_subdir/foo_a" ]  emptyStub = Stub (return emptyTree) Nothing @@ -120,7 +122,11 @@ tree = [ testCase "modifyTree" check_modify        , testCase "complex modifyTree" check_modify_complex        , testCase "expand" check_expand-       , testCase "expandPath" check_expand_path ]+       , testCase "expandPath" check_expand_path+       , testProperty "treeEq" check_tree_eq+       , testProperty "expand is identity" check_expand_id+       , testProperty "filter True is identity" check_filter_id+       , testProperty "filter False is empty" check_filter_empty ]     where blob x = File $ Blob (return (BL.pack x)) (Just $ sha256 $ BL.pack x)           name = Name . BS.pack           check_modify =@@ -160,6 +166,10 @@             assertBool "path reachable" $ path `elem` (map fst $ list t)             assertBool "badpath not reachable" $                        badpath `notElem` (map fst $ list t)+          check_tree_eq x = x `treeEq` x+          check_expand_id x = unsafePerformIO (expand x) `treeEq` x+          check_filter_id x = filter (\_ _ -> True) x `treeEq` x+          check_filter_empty x = filter (\_ _ -> False) x `treeEq` emptyTree  utils = [ testProperty "xlate32" prop_xlate32         , testProperty "xlate64" prop_xlate64 ]@@ -176,3 +186,27 @@                    let x' = fromIntegral x                        y' = fromIntegral y                    return $ x' .|. (y' `shift` 32)++instance Arbitrary TreeItem where+  arbitrary = sized tree'+    where tree' 0 = oneof [ return (File emptyBlob), return (SubTree emptyTree) ]+          tree' n = do branches <- choose (1, n)+                       let subtree name = do t <- tree' ((n - 1) `div` branches)+                                             return (makeName $ show name, t)+                       sublist <- mapM subtree [0..branches]+                       oneof [ tree' 0+                             , return (SubTree $ makeTree sublist) ]++instance Arbitrary Tree where+  arbitrary = do item <- arbitrary+                 case item of+                   File _ -> arbitrary+                   SubTree t -> return t++treeItemEq (File _) (File _) = True+treeItemEq (SubTree s) (SubTree p) = s `treeEq` p+treeItemEq _ _ = False++treeEq t r = and $ zipTrees cmp t r+    where cmp _ (Just a) (Just b) = a `treeItemEq` b+          cmp _ _ _ = False

@@ -30,7 +30,7 @@ import qualified Data.Map as M  import Data.Maybe( catMaybes )-import Data.List( union, sort )+import Data.List( union, sort, intersperse )  -------------------------------- -- Tree, Blob and friends@@ -69,6 +69,19 @@                  -- given to the user by expand. (Used to implement Index                  -- updates, eg.)                  , finish :: Tree -> IO Tree }++instance Show Blob where+    show (Blob _ h) = "Blob " ++ show h++instance Show TreeItem where+    show (File f) = "File (" ++ show f ++ ")"+    show (Stub _ h) = "Stub _ " ++ show h+    show (SubTree s) = "SubTree (" ++ show s ++ ")"++instance Show Tree where+    show t = "Tree " ++ show (treeHash t) ++ " { " +++             (concat . intersperse ", " $ itemstrs) ++ " }"+        where itemstrs = map show $ listImmediate t  -- | Get a hash of a TreeItem. May be Nothing. itemHash :: TreeItem -> Maybe Hash

@@ -1,5 +1,5 @@ name:          hashed-storage-version:       0.3.4+version:       0.3.5 synopsis:      Hashed file storage support code.  description:   Support code for reading and manipulating hashed file storage@@ -74,8 +74,8 @@     if flag(test)       build-depends: test-framework,                      test-framework-hunit,-                     test-framework-quickcheck,-                     QuickCheck, HUnit, process >= 1.0.1+                     test-framework-quickcheck2,+                     QuickCheck >= 2, HUnit, process >= 1.0.1, zip-archive     else       buildable: False 

@@ -1,5 +1,14 @@ import Storage.Hashed.Test( tests ) import Test.Framework( defaultMain )+import System.Directory( createDirectory, removeDirectoryRecursive+                       , setCurrentDirectory )+import Codec.Archive.Zip( extractFilesFromArchive, toArchive )+import qualified Data.ByteString.Lazy as BL  main :: IO ()-main = defaultMain tests+main = do zip <- toArchive `fmap` BL.readFile "testdata.zip"+          removeDirectoryRecursive "_test_playground" `catch` \_ -> return ()+          createDirectory "_test_playground"+          setCurrentDirectory "_test_playground"+          extractFilesFromArchive [] zip+          defaultMain tests