hsec-sync 0.2.0.2 → 0.2.0.3

raw patch · 4 files changed

+89/−30 lines, 4 filesdep −aesondep −hsec-coredep −timedep ~optparse-applicativedep ~tardep ~textPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies removed: aeson, hsec-core, time

Dependency ranges changed: optparse-applicative, tar, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• hsec-sync.cabal +14/−18
• src/Security/Advisories/Sync/Snapshot.hs +23/−11
• test/Spec/SyncSpec.hs +44/−1

@@ -1,3 +1,11 @@+## 0.2.0.3++* Update GHC support to GHC 9.6.7, 9.8.4, 9.10.3, 9.12.4, and 9.14.1+* Relax dependency bounds for `tar` and `optparse-applicative`+* Detect and heal stale `.git` left by pre-snapshot git clones: such+  snapshot directories now report as incoherent, and `sync` resets the+  whole snapshot directory instead of only `advisories/` and `snapshot-etag`+ ## 0.2.0.2  * Update `tasty` dependency bounds

@@ -1,6 +1,6 @@ cabal-version:   2.4 name:            hsec-sync-version:         0.2.0.2+version:         0.2.0.3  -- A short (one-line) description of the package. synopsis:        Synchronize with the Haskell security advisory database@@ -19,31 +19,33 @@ -- A copyright notice. -- copyright: category:        Data-extra-doc-files: CHANGELOG.md, overview.png, recommended-workflow.png, README.md+extra-doc-files:+  CHANGELOG.md+  overview.png+  README.md+  recommended-workflow.png+ tested-with:-  GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.3 || ==9.10.1 || ==9.12.1+  GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.4 || ==9.14.1  library-  exposed-modules:  Security.Advisories.Sync-  other-modules:+  exposed-modules:+    Security.Advisories.Sync     Security.Advisories.Sync.Snapshot-    Security.Advisories.Sync.Url +  other-modules:    Security.Advisories.Sync.Url   build-depends:-    , aeson         >=2.0   && <3     , base          >=4.14  && <5     , bytestring    >=0.10  && <0.13     , directory     >=1.3   && <1.4     , either        >=5.0   && <5.1     , extra         >=1.7   && <1.9     , filepath      >=1.4   && <1.6-    , hsec-core     ^>=0.2     , http-client   >=0.7.0 && <0.8     , lens          >=5.1   && <5.4-    , tar           >=0.5   && <0.7+    , tar           >=0.5   && <0.8     , temporary     >=1     && <2     , text          >=1.2   && <3-    , time          >=1.9   && <1.15     , transformers  >=0.5   && <0.7     , wreq          >=0.5   && <0.6     , zlib          >=0.6   && <0.8@@ -63,13 +65,9 @@   -- LANGUAGE extensions used by modules in this package.   -- other-extensions:   build-depends:-    , aeson                 >=2.0.1.0 && <3-    , base                  >=4.14    && <5-    , bytestring            >=0.10    && <0.13-    , filepath              >=1.4     && <1.6+    , base                  >=4.14 && <5     , hsec-sync-    , optparse-applicative  >=0.17    && <0.19-    , text                  >=1.2     && <3+    , optparse-applicative  >=0.17 && <0.20    hs-source-dirs:   app   default-language: Haskell2010@@ -90,8 +88,6 @@     , tasty        <2     , tasty-hunit  <0.11     , temporary    >=1   && <2-    , text-    , time    default-language: Haskell2010   ghc-options:

@@ -15,6 +15,7 @@     ensureSnapshot,     getDirectorySnapshotInfo,     overwriteSnapshot,+    ensureEmptyRoot,     SnapshotRepositoryStatus (..),     snapshotRepositoryStatus,     latestUpdate,@@ -26,7 +27,7 @@ import qualified Codec.Compression.GZip as GZip import Control.Exception (Exception (displayException), IOException, try) import Control.Lens-import Control.Monad.Extra (unlessM, whenM)+import Control.Monad.Extra (unlessM) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE, withExceptT) import qualified Data.ByteString.Lazy as BL@@ -69,7 +70,10 @@ data SnapshotRepositoryStatus   = SnapshotDirectoryMissing   | SnapshotDirectoryInitialized+  -- | Includes stray content from a pre-snapshot git clone (e.g. a stale+  -- @.git@), which must be healed by a full overwrite.   | SnapshotDirectoryIncoherent+  deriving stock (Eq, Show)  snapshotRepositoryStatus :: FilePath -> IO SnapshotRepositoryStatus snapshotRepositoryStatus root = do@@ -78,8 +82,12 @@     then do       dirAdvisoriesExists <- D.doesDirectoryExist $ root </> "advisories"       etagMetadataExists <- D.doesFileExist $ root </> "snapshot-etag"+      staleGitExists <-+        (||)+          <$> D.doesFileExist (root </> ".git")+          <*> D.doesDirectoryExist (root </> ".git")       return $-        if dirAdvisoriesExists && etagMetadataExists+        if dirAdvisoriesExists && etagMetadataExists && not staleGitExists           then SnapshotDirectoryInitialized           else SnapshotDirectoryIncoherent     else return SnapshotDirectoryMissing@@ -162,17 +170,21 @@         whenLeft etagWritten $           throwE . ExtractSnapshotArchive +-- | Delete the entire tree at @root@ (if it exists) and recreate it as an+-- empty directory. Destructive: only for use on snapshot-owned roots+-- (as done by 'overwriteSnapshot'). ensureEmptyRoot :: FilePath -> IO () ensureEmptyRoot root = do-  D.createDirectoryIfMissing False root--  whenM (D.doesDirectoryExist $ root </> "advisories") $-    D.removeDirectoryRecursive $-      root </> "advisories"--  whenM (D.doesFileExist $ root </> "snapshot-etag") $-    D.removeFile $-      root </> "snapshot-etag"+  rootExists <- D.doesDirectoryExist root+  if rootExists+    then do+      -- If root itself is a symlink, remove only the link, never the target.+      isSymlink <- D.pathIsSymbolicLink root+      if isSymlink+        then D.removeDirectoryLink root+        else D.removeDirectoryRecursive root+    else pure ()+  D.createDirectoryIfMissing True root  newtype SnapshotDirectoryInfo = SnapshotDirectoryInfo   { etag :: ETag

@@ -5,6 +5,7 @@ import Control.Monad (unless) import Data.Bifunctor (first) import Security.Advisories.Sync+import Security.Advisories.Sync.Snapshot import qualified System.Directory as D import System.Environment (lookupEnv) import System.FilePath ((</>))@@ -13,7 +14,49 @@ import Test.Tasty.HUnit  spec :: TestTree-spec = testGroup "Sync" []+spec =+  testGroup+    "Sync"+    [ testGroup+        "snapshotRepositoryStatus"+        [ testCase "Stale .git directory makes an initialized directory incoherent" $+            withSystemTempDirectory "hsec-sync" $ \p -> do+              D.createDirectoryIfMissing True (p </> "advisories")+              writeFile (p </> "snapshot-etag") "W/\"etag\""+              D.createDirectory (p </> ".git")+              snapshotRepositoryStatus p >>= (@?= SnapshotDirectoryIncoherent),+          testCase "Stale .git file (worktree-style) makes an initialized directory incoherent" $+            withSystemTempDirectory "hsec-sync" $ \p -> do+              D.createDirectoryIfMissing True (p </> "advisories")+              writeFile (p </> "snapshot-etag") "W/\"etag\""+              writeFile (p </> ".git") "gitdir: /somewhere/else"+              snapshotRepositoryStatus p >>= (@?= SnapshotDirectoryIncoherent),+          testCase "Initialized directory without .git stays initialized" $+            withSystemTempDirectory "hsec-sync" $ \p -> do+              D.createDirectoryIfMissing True (p </> "advisories")+              writeFile (p </> "snapshot-etag") "W/\"etag\""+              snapshotRepositoryStatus p >>= (@?= SnapshotDirectoryInitialized)+        ],+      testGroup+        "ensureEmptyRoot"+        [ testCase "Wipes stale git clone content from the snapshot root" $+            withSystemTempDirectory "hsec-sync" $ \p -> do+              D.createDirectoryIfMissing True (p </> ".git" </> "objects")+              D.createDirectoryIfMissing True (p </> "advisories")+              writeFile (p </> "snapshot-etag") "W/\"etag\""+              writeFile (p </> "README.md") "stale clone readme"+              ensureEmptyRoot p+              D.doesDirectoryExist p >>= (@?= True)+              mapM_+                ( \e ->+                    (||)+                      <$> D.doesFileExist (p </> e)+                      <*> D.doesDirectoryExist (p </> e)+                      >>= (@?= False)+                )+                [".git", "advisories", "snapshot-etag", "README.md"]+        ]+    ]  _spec :: TestTree _spec =