diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,14 @@ See also http://pvp.haskell.org/faq +0.6.3.3 +------- + +* Remove `lukko` package flag. Now we unconditionally use `GHC.IO.Handle.Lock` + instead of the [`lukko` package](https://hackage.haskell.org/package/lukko). +* Allow `Cabal-3.18` and `Cabal-syntax-3.18`. +* Allow building against newer releases of other dependencies. +* Tested with GHC 8.4 - 9.14. + 0.6.3.2 ------- diff --git a/hackage-security.cabal b/hackage-security.cabal --- a/hackage-security.cabal +++ b/hackage-security.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: hackage-security -version: 0.6.3.2 +version: 0.6.3.3 synopsis: Hackage security library description: The hackage security library provides both server and @@ -32,8 +32,8 @@ tested-with: GHC == 9.14.1 - GHC == 9.12.2 - GHC == 9.10.2 + GHC == 9.12.4 + GHC == 9.10.3 GHC == 9.8.4 GHC == 9.6.7 GHC == 9.4.8 @@ -56,11 +56,6 @@ manual: False default: False -flag lukko - description: Use @lukko@ for file-locking, otherwise use @GHC.IO.Handle.Lock@ - manual: False - default: False - library -- Most functionality is exported through the top-level entry points .Client -- and .Server; the other exported modules are intended for qualified imports. @@ -131,13 +126,8 @@ -- whatever versions are bundled with ghc: ghc-prim >= 0.5.2 && < 0.14 - if flag(lukko) - build-depends: lukko >= 0.1 && < 0.2 - else - build-depends: base >= 4.11 - if flag(Cabal-syntax) - build-depends: Cabal-syntax >= 3.7 && < 3.18 + build-depends: Cabal-syntax >= 3.7 && < 3.20 else build-depends: Cabal >= 2.2.0.1 && < 2.6 || >= 3.0 && < 3.7, @@ -202,8 +192,8 @@ zlib if flag(Cabal-syntax) - build-depends: Cabal >= 3.7 && < 3.18, - Cabal-syntax >= 3.7 && < 3.18 + build-depends: Cabal >= 3.7 && < 3.20, + Cabal-syntax >= 3.7 && < 3.20 else build-depends: Cabal >= 2.2.0.1 && < 2.6 || >= 3.0 && < 3.7, @@ -214,7 +204,7 @@ -- tasty-1.1.0.4 is the version in Stackage LTS 12.26 (GHC 8.4) tasty-hunit == 0.10.*, tasty-quickcheck >= 0.10 && < 1, - QuickCheck >= 2.11 && < 2.17, + QuickCheck >= 2.11 && < 2.19, aeson >= 1.4 && < 1.6 || >= 2.0 && < 2.3, vector >= 0.12 && < 0.14, unordered-containers >= 0.2.8.0 && < 0.3, diff --git a/src/Hackage/Security/Util/IO.hs b/src/Hackage/Security/Util/IO.hs --- a/src/Hackage/Security/Util/IO.hs +++ b/src/Hackage/Security/Util/IO.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module Hackage.Security.Util.IO ( -- * Miscelleneous getFileSize @@ -18,14 +17,7 @@ import Hackage.Security.Util.Path -#ifdef MIN_VERSION_lukko -import Lukko (FD, fileLockingSupported, fdOpen, fdClose, fdLock, fdUnlock, LockMode(ExclusiveLock)) -#else -import GHC.IO.Handle.Lock (hLock, LockMode(ExclusiveLock), FileLockingNotSupported) -#if MIN_VERSION_base(4,11,0) -import GHC.IO.Handle.Lock (hUnlock) -#endif -#endif +import GHC.IO.Handle.Lock (hLock, hUnlock, LockMode(ExclusiveLock), FileLockingNotSupported) {------------------------------------------------------------------------------- Miscelleneous @@ -85,33 +77,6 @@ logger (WithDirLockEventPost lock) return h -#ifdef MIN_VERSION_lukko - takeLock :: IO FD - takeLock - | fileLockingSupported = do - h <- fdOpen lock' - wrapLog (fdLock h ExclusiveLock `onException` fdClose h) - return h - | otherwise = wrapLog takeDirLock - where - takeDirLock :: IO FD - takeDirLock = handle onCreateDirError $ do - createDirectory lock - return (undefined :: FD) - - onCreateDirError :: IOError -> IO FD - onCreateDirError ioe - | isAlreadyExistsError ioe = threadDelay (1*1000*1000) >> takeDirLock - | otherwise = fail (me++"error creating directory lock: "++show ioe) - - releaseLock h - | fileLockingSupported = do - fdUnlock h - fdClose h - | otherwise = - removeDirectory lock - -#else takeLock = do h <- openFile lock' ReadWriteMode wrapLog $ handle (fallbackToDirLock h) $ do @@ -142,12 +107,9 @@ (me++"cannot remove lock file before directory lock fallback") releaseLock (Just h) = -#if MIN_VERSION_base(4,11,0) hUnlock h >> -#endif hClose h releaseLock Nothing = removeDirectory lock -#endif {------------------------------------------------------------------------------- Debugging diff --git a/src/Hackage/Security/Util/Path.hs b/src/Hackage/Security/Util/Path.hs --- a/src/Hackage/Security/Util/Path.hs +++ b/src/Hackage/Security/Util/Path.hs @@ -71,6 +71,9 @@ , fromURIPath , uriPath , modifyUriPath + -- * Internals + , mkPathNative + , unPathNative -- * Re-exports , IOMode(..) , BufferMode(..) @@ -118,10 +121,17 @@ deriving (Show, Eq, Ord) mkPathNative :: FilePath -> Path a -mkPathNative = Path . FP.Posix.joinPath . FP.Native.splitDirectories +mkPathNative = Path . canonicalizePathSeparator unPathNative :: Path a -> FilePath -unPathNative (Path fp) = FP.Native.joinPath . FP.Posix.splitDirectories $ fp +unPathNative (Path fp) = fp + +canonicalizePathSeparator :: FilePath -> FilePath +canonicalizePathSeparator = map (replaceSeparator) + where + replaceSeparator c + | FP.Native.isPathSeparator c = '/' + | otherwise = c mkPathPosix :: FilePath -> Path a mkPathPosix = Path diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -9,7 +9,7 @@ import Network.URI ( URI, parseURI ) import Test.Tasty ( defaultMain, testGroup, TestTree ) import Test.Tasty.HUnit ( testCase, (@?=), assertEqual, assertFailure, Assertion ) -import Test.Tasty.QuickCheck ( testProperty ) +import Test.Tasty.QuickCheck ( testProperty, Property, (===), property ) import System.IO.Temp (withSystemTempDirectory) import qualified Codec.Archive.Tar.Entry as Tar import qualified Data.ByteString.Lazy.Char8 as BS @@ -72,6 +72,9 @@ , testProperty "prop_canonical_pretty" JSON.prop_canonical_pretty , testProperty "prop_aeson_canonical" JSON.prop_aeson_canonical ] + , testGroup "Path" [ + testProperty "Hackage.Security.Util.Path.mkPathNative" prop_mkPathNative + ] ] {------------------------------------------------------------------------------- @@ -547,3 +550,16 @@ mkPackageName :: String -> PackageName mkPackageName = PackageName #endif + +{------------------------------------------------------------------------------- + Path tests +-------------------------------------------------------------------------------} + +-- | Disclaimer: This test uses the vanilla generator for @type 'FilePath' = String@ +-- and may thus been ineffective in establishing the desired round-trip property for +-- 'mkPathNative' and 'unPathNative' with sufficient probability. +-- +-- Discussion at + +prop_mkPathNative :: Property +prop_mkPathNative = property $ \(fp :: FilePath) -> (mkPathNative . unPathNative . mkPathNative) fp === mkPathNative fp