Hello community,
here is the log from the commit of package ghc-hackage-security for
openSUSE:Factory checked in at 2020-05-11 13:37:30
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hackage-security (Old)
and /work/SRC/openSUSE:Factory/.ghc-hackage-security.new.2738 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hackage-security"
Mon May 11 13:37:30 2020 rev:16 rq:801077 version:0.6.0.1
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-hackage-security/ghc-hackage-security.changes
2020-03-09 14:17:24.554665815 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-hackage-security.new.2738/ghc-hackage-security.changes
2020-05-11 13:37:34.116641498 +0200
@@ -1,0 +2,18 @@
+Wed May 6 06:54:16 UTC 2020 - [email protected]
+
+- Update hackage-security to version 0.6.0.1.
+ * Fix bug in non-default `-lukko` build-configuration (#242)
+ * Add support for `template-haskell-2.16.0.0` (#240)
+ * Remove `Hackage.Security.TUF.FileMap.lookupM`
+ * Don't expose `Hackage.Security.Util.IO` module
+ * Don't expose `Hackage.Security.Util.Lens` module
+ * Report missing keys in `.meta` objects more appropriately as
+ `ReportSchemaErrors(expected)` instead of via `Monad(fail)`
+ * Add support for GHC 8.8 / base-4.13
+ * Use `lukko` for file-locking
+ * Extend `LogMessage` to signal events for cache lock acquiring and release
+ * New `lockCacheWithLogger` operation
+
+- Remove obsolete patch "fix-ghc-8.8.x-build.patch".
+
+-------------------------------------------------------------------
Old:
----
fix-ghc-8.8.x-build.patch
hackage-security-0.5.3.0.tar.gz
hackage-security.cabal
New:
----
hackage-security-0.6.0.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hackage-security.spec ++++++
--- /var/tmp/diff_new_pack.MUuVyu/_old 2020-05-11 13:37:35.064643485 +0200
+++ /var/tmp/diff_new_pack.MUuVyu/_new 2020-05-11 13:37:35.064643485 +0200
@@ -19,14 +19,12 @@
%global pkg_name hackage-security
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.5.3.0
+Version: 0.6.0.1
Release: 0
Summary: Hackage security library
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/6.cabal#/%{pkg_name}.cabal
-Patch01:
https://raw.githubusercontent.com/hvr/head.hackage/master/patches/hackage-security-0.5.3.0.patch#/fix-ghc-8.8.x-build.patch
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-base16-bytestring-devel
BuildRequires: ghc-base64-bytestring-devel
@@ -36,6 +34,7 @@
BuildRequires: ghc-directory-devel
BuildRequires: ghc-ed25519-devel
BuildRequires: ghc-filepath-devel
+BuildRequires: ghc-lukko-devel
BuildRequires: ghc-mtl-devel
BuildRequires: ghc-network-devel
BuildRequires: ghc-network-uri-devel
@@ -49,10 +48,13 @@
BuildRequires: ghc-zlib-devel
%if %{with tests}
BuildRequires: ghc-QuickCheck-devel
+BuildRequires: ghc-aeson-devel
BuildRequires: ghc-tasty-devel
BuildRequires: ghc-tasty-hunit-devel
BuildRequires: ghc-tasty-quickcheck-devel
BuildRequires: ghc-temporary-devel
+BuildRequires: ghc-unordered-containers-devel
+BuildRequires: ghc-vector-devel
%endif
%description
@@ -85,13 +87,9 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
-%patch01 -p1
-cabal-tweak-dep-ver base '< 4.13' '< 5'
-cabal-tweak-dep-ver network-uri '< 2.7' '< 3'
+cabal-tweak-dep-ver base64-bytestring '< 1.1' '< 2'
%build
-%define cabal_configure_options -fbase48 -fuse-network-uri
%ghc_lib_build
%install
++++++ hackage-security-0.5.3.0.tar.gz -> hackage-security-0.6.0.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hackage-security-0.5.3.0/ChangeLog.md
new/hackage-security-0.6.0.1/ChangeLog.md
--- old/hackage-security-0.5.3.0/ChangeLog.md 2018-03-26 01:39:07.000000000
+0200
+++ new/hackage-security-0.6.0.1/ChangeLog.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,3 +1,24 @@
+See also http://pvp.haskell.org/faq
+
+0.6.0.1
+-------
+
+* Fix bug in non-default `-lukko` build-configuration (#242)
+* Add support for `template-haskell-2.16.0.0` (#240)
+
+0.6.0.0
+-------
+
+* Remove `Hackage.Security.TUF.FileMap.lookupM`
+* Don't expose `Hackage.Security.Util.IO` module
+* Don't expose `Hackage.Security.Util.Lens` module
+* Report missing keys in `.meta` objects more appropriately as
+ `ReportSchemaErrors(expected)` instead of via `Monad(fail)`
+* Add support for GHC 8.8 / base-4.13
+* Use `lukko` for file-locking
+* Extend `LogMessage` to signal events for cache lock acquiring and release
+* New `lockCacheWithLogger` operation
+
0.5.3.0
-------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hackage-security-0.5.3.0/hackage-security.cabal
new/hackage-security-0.6.0.1/hackage-security.cabal
--- old/hackage-security-0.5.3.0/hackage-security.cabal 2018-03-26
01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/hackage-security.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
cabal-version: 1.12
name: hackage-security
-version: 0.5.3.0
+version: 0.6.0.1
synopsis: Hackage security library
description: The hackage security library provides both server and
@@ -29,6 +29,9 @@
homepage: https://github.com/haskell/hackage-security
bug-reports: https://github.com/haskell/hackage-security/issues
build-type: Simple
+tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4,
GHC==8.2.2, GHC==8.0.2,
+ GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2
+
extra-source-files:
ChangeLog.md
@@ -50,6 +53,16 @@
manual: False
default: False
+flag mtl21
+ description: Use @mtl@ < 2.2 and @mtl-compat@
+ manual: False
+ default: False
+
+flag lukko
+ description: Use @lukko@ for file-locking, otherwise use @GHC.IO.Handle.Lock@
+ manual: True
+ default: True
+
library
-- Most functionality is exported through the top-level entry points .Client
-- and .Server; the other exported modules are intended for qualified
imports.
@@ -67,8 +80,6 @@
Hackage.Security.Trusted
Hackage.Security.TUF.FileMap
Hackage.Security.Util.Checked
- Hackage.Security.Util.IO
- Hackage.Security.Util.Lens
Hackage.Security.Util.Path
Hackage.Security.Util.Pretty
Hackage.Security.Util.Some
@@ -92,39 +103,51 @@
Hackage.Security.TUF.Timestamp
Hackage.Security.Util.Base64
Hackage.Security.Util.Exit
- Hackage.Security.Util.FileLock
+ Hackage.Security.Util.IO
Hackage.Security.Util.JSON
+ Hackage.Security.Util.Lens
Hackage.Security.Util.Stack
Hackage.Security.Util.TypedEmbedded
Prelude
-- We support ghc 7.4 (bundled with Cabal 1.14) and up
- build-depends: base >= 4.5 && < 4.12,
+ build-depends: base >= 4.5 && < 4.15,
base16-bytestring >= 0.1.1 && < 0.2,
base64-bytestring >= 1.0 && < 1.1,
bytestring >= 0.9 && < 0.11,
- Cabal >= 1.14 && < 2.4,
- containers >= 0.4 && < 0.6,
+ Cabal >= 1.14 && < 1.26
+ || >= 2.0 && < 2.6
+ || >= 3.0 && < 3.4,
+ containers >= 0.4 && < 0.7,
ed25519 >= 0.0 && < 0.1,
filepath >= 1.2 && < 1.5,
- mtl >= 2.2 && < 2.3,
parsec >= 3.1 && < 3.2,
pretty >= 1.0 && < 1.2,
cryptohash-sha256 >= 0.11 && < 0.12,
-- 0.4.2 introduces TarIndex, 0.4.4 introduces more
-- functionality, 0.5.0 changes type of serialise
tar >= 0.5 && < 0.6,
- time >= 1.2 && < 1.9,
- transformers >= 0.4 && < 0.6,
+ template-haskell >= 2.7 && < 2.17,
+ time >= 1.2 && < 1.10,
+ transformers >= 0.3 && < 0.6,
zlib >= 0.5 && < 0.7,
-- whatever versions are bundled with ghc:
- template-haskell,
ghc-prim
if flag(old-directory)
- build-depends: directory >= 1.1.0.2 && < 1.2,
- old-time >= 1 && < 1.2
+ build-depends: directory >= 1.1.0.2 && < 1.2,
+ old-time >= 1 && < 1.2
+ else
+ build-depends: directory >= 1.2 && < 1.4
+
+ if flag(mtl21)
+ build-depends: mtl >= 2.1 && < 2.2,
+ mtl-compat >= 0.2 && < 0.3
+ else
+ build-depends: mtl >= 2.2 && < 2.3
+
+ if flag(lukko)
+ build-depends: lukko >= 0.1 && < 0.2
else
- build-depends: directory >= 1.2 && < 1.4
- build-tool-depends: hsc2hs:hsc2hs >= 0.67 && <0.69
+ build-depends: base >= 4.10
hs-source-dirs: src
default-language: Haskell2010
@@ -153,9 +176,9 @@
PackageImports
UndecidableInstances
- -- use the new stage1/cross-compile-friendly Quotes subset of TH for new GHCs
+ -- use the new stage1/cross-compile-friendly DeriveLift extension for GHC
8.0+
if impl(ghc >= 8.0)
- other-extensions: TemplateHaskellQuotes
+ other-extensions: DeriveLift
else
other-extensions: TemplateHaskell
@@ -200,7 +223,8 @@
-- dependency in network is not redundant.)
if flag(use-network-uri)
build-depends: network-uri >= 2.6 && < 2.7,
- network >= 2.6 && < 2.7
+ network >= 2.6 && < 2.9
+ || >= 3.0 && < 3.2
else
build-depends: network >= 2.5 && < 2.6
@@ -234,11 +258,14 @@
zlib
-- dependencies exclusive to test-suite
- build-depends: tasty == 1.0.*,
+ build-depends: tasty == 1.2.*,
tasty-hunit == 0.10.*,
tasty-quickcheck == 0.10.*,
- QuickCheck == 2.9.*,
- temporary == 1.2.*
+ QuickCheck >= 2.11 && <2.14,
+ aeson == 1.4.*,
+ vector == 0.12.*,
+ unordered-containers >=0.2.8.0 && <0.3,
+ temporary >= 1.2 && < 1.4
hs-source-dirs: tests
default-language: Haskell2010
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository/Cache.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository/Cache.hs
---
old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository/Cache.hs
2018-03-26 01:39:07.000000000 +0200
+++
new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository/Cache.hs
2001-09-09 03:46:40.000000000 +0200
@@ -12,6 +12,7 @@
, getIndexIdx
, cacheRemoteFile
, lockCache
+ , lockCacheWithLogger
) where
import Control.Exception
@@ -214,7 +215,18 @@
-- This avoids two concurrent processes updating the cache at the same time,
-- provided they both take the lock.
lockCache :: Cache -> IO () -> IO ()
-lockCache Cache{..} = withDirLock cacheRoot
+lockCache Cache{..} = withDirLock (\_ -> return ()) cacheRoot
+
+-- | Variant of 'lockCache' which emits 'LogMessage's before and after
+-- a possibly blocking file-locking system call
+--
+-- @since 0.6.0
+lockCacheWithLogger :: (LogMessage -> IO ()) -> Cache -> IO () -> IO ()
+lockCacheWithLogger logger Cache{..} = withDirLock logger' cacheRoot
+ where
+ logger' (WithDirLockEventPre fn) = logger (LogLockWait fn)
+ logger' (WithDirLockEventPost fn) = logger (LogLockWaitDone fn)
+ logger' (WithDirLockEventUnlock fn) = logger (LogUnlock fn)
{-------------------------------------------------------------------------------
Auxiliary: tar
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository/Local.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository/Local.hs
---
old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository/Local.hs
2018-03-26 01:39:07.000000000 +0200
+++
new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository/Local.hs
2001-09-09 03:46:40.000000000 +0200
@@ -51,7 +51,7 @@
, repClearCache = clearCache cache
, repWithIndex = withIndex cache
, repGetIndexIdx = getIndexIdx cache
- , repLockCache = lockCache cache
+ , repLockCache = lockCacheWithLogger logger cache
, repWithMirror = mirrorsUnsupported
, repLog = logger
, repLayout = repLayout
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository/Remote.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository/Remote.hs
---
old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository/Remote.hs
2018-03-26 01:39:07.000000000 +0200
+++
new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository/Remote.hs
2001-09-09 03:46:40.000000000 +0200
@@ -178,7 +178,7 @@
, repClearCache = Cache.clearCache cache
, repWithIndex = Cache.withIndex cache
, repGetIndexIdx = Cache.getIndexIdx cache
- , repLockCache = Cache.lockCache cache
+ , repLockCache = Cache.lockCacheWithLogger logger cache
, repWithMirror = withMirror httpLib
selectedMirror
logger
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository.hs
--- old/hackage-security-0.5.3.0/src/Hackage/Security/Client/Repository.hs
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/Client/Repository.hs
2001-09-09 03:46:40.000000000 +0200
@@ -316,6 +316,27 @@
-- (we will try with a different mirror if any are available)
| LogMirrorFailed MirrorDescription SomeException
+ -- | This log event is triggered before invoking a filesystem lock
+ -- operation that may block for a significant amount of time; once
+ -- the possibly blocking call completes successfully,
+ -- 'LogLockWaitDone' will be emitted.
+ --
+ -- @since 0.6.0
+ | LogLockWait (Path Absolute)
+
+ -- | Denotes completion of the operation that advertised a
+ -- 'LogLockWait' event
+ --
+ -- @since 0.6.0
+ | LogLockWaitDone (Path Absolute)
+
+ -- | Denotes the filesystem lock previously acquired (signaled by
+ -- 'LogLockWait') has been released.
+ --
+ -- @since 0.6.0
+ | LogUnlock (Path Absolute)
+
+
-- | Records why we are downloading a file rather than updating it.
data UpdateFailure =
-- | Server does not support incremental downloads
@@ -451,6 +472,12 @@
"Cannot update " ++ pretty file ++ " (" ++ pretty ex ++ ")"
pretty (LogMirrorFailed mirror ex) =
"Exception " ++ displayException ex ++ " when using mirror " ++ mirror
+ pretty (LogLockWait file) =
+ "Waiting to acquire cache lock on " ++ pretty file
+ pretty (LogLockWaitDone file) =
+ "Acquired cache lock on " ++ pretty file
+ pretty (LogUnlock file) =
+ "Released cache lock on " ++ pretty file
instance Pretty UpdateFailure where
pretty UpdateImpossibleUnsupported =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/FileMap.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/FileMap.hs
--- old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/FileMap.hs
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/FileMap.hs
2001-09-09 03:46:40.000000000 +0200
@@ -13,8 +13,6 @@
, (!)
, insert
, fromList
- -- * Convenience accessors
- , lookupM
-- * Comparing file maps
, FileChange(..)
, fileMapChanges
@@ -72,16 +70,6 @@
fromList = FileMap . Map.fromList
{-------------------------------------------------------------------------------
- Convenience accessors
--------------------------------------------------------------------------------}
-
-lookupM :: Monad m => FileMap -> TargetPath -> m FileInfo
-lookupM m fp =
- case lookup fp m of
- Nothing -> fail $ "No entry for " ++ pretty fp ++ " in filemap"
- Just nfo -> return nfo
-
-{-------------------------------------------------------------------------------
Comparing filemaps
-------------------------------------------------------------------------------}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/Patterns.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/Patterns.hs
--- old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/Patterns.hs
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/Patterns.hs
2001-09-09 03:46:40.000000000 +0200
@@ -4,7 +4,8 @@
-- It is currently unusued.
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
-{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE StandaloneDeriving #-}
#else
{-# LANGUAGE TemplateHaskell #-}
#endif
@@ -272,6 +273,11 @@
Left err -> fail $ "Invalid delegation: " ++ err
Right del -> TH.lift del
+#if __GLASGOW_HASKELL__ >= 800
+deriving instance TH.Lift (Pattern a)
+deriving instance TH.Lift (Replacement a)
+deriving instance TH.Lift Delegation
+#else
instance TH.Lift (Pattern a) where
lift (PatFileConst fn) = [| PatFileConst fn |]
lift (PatFileExt e) = [| PatFileExt e |]
@@ -288,6 +294,7 @@
instance TH.Lift Delegation where
lift (Delegation pat repl) = [| Delegation pat repl |]
+#endif
{-------------------------------------------------------------------------------
JSON
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/Snapshot.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/Snapshot.hs
--- old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/Snapshot.hs
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/Snapshot.hs
2001-09-09 03:46:40.000000000 +0200
@@ -13,6 +13,7 @@
import Hackage.Security.TUF.Layout.Repo
import Hackage.Security.TUF.Signed
import qualified Hackage.Security.TUF.FileMap as FileMap
+import Hackage.Security.Util.Pretty (pretty)
{-------------------------------------------------------------------------------
Datatypes
@@ -76,9 +77,12 @@
snapshotVersion <- fromJSField enc "version"
snapshotExpires <- fromJSField enc "expires"
snapshotMeta <- fromJSField enc "meta"
- snapshotInfoRoot <- FileMap.lookupM snapshotMeta (pathRoot
repoLayout)
- snapshotInfoMirrors <- FileMap.lookupM snapshotMeta (pathMirrors
repoLayout)
- snapshotInfoTarGz <- FileMap.lookupM snapshotMeta (pathIndexTarGz
repoLayout)
+ let lookupMeta k = case FileMap.lookup k snapshotMeta of
+ Nothing -> expected ("\"" ++ pretty k ++ "\" entry in .meta object")
Nothing
+ Just v -> pure v
+ snapshotInfoRoot <- lookupMeta (pathRoot repoLayout)
+ snapshotInfoMirrors <- lookupMeta (pathMirrors repoLayout)
+ snapshotInfoTarGz <- lookupMeta (pathIndexTarGz repoLayout)
let snapshotInfoTar = FileMap.lookup (pathIndexTar repoLayout) snapshotMeta
return Snapshot{..}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/Timestamp.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/Timestamp.hs
--- old/hackage-security-0.5.3.0/src/Hackage/Security/TUF/Timestamp.hs
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/TUF/Timestamp.hs
2001-09-09 03:46:40.000000000 +0200
@@ -13,6 +13,7 @@
import Hackage.Security.TUF.Layout.Repo
import Hackage.Security.TUF.Signed
import qualified Hackage.Security.TUF.FileMap as FileMap
+import Hackage.Security.Util.Pretty (pretty)
{-------------------------------------------------------------------------------
Datatypes
@@ -56,7 +57,10 @@
timestampVersion <- fromJSField enc "version"
timestampExpires <- fromJSField enc "expires"
timestampMeta <- fromJSField enc "meta"
- timestampInfoSnapshot <- FileMap.lookupM timestampMeta (pathSnapshot
repoLayout)
+ let lookupMeta k = case FileMap.lookup k timestampMeta of
+ Nothing -> expected ("\"" ++ pretty k ++ "\" entry in .meta object")
Nothing
+ Just v -> pure v
+ timestampInfoSnapshot <- lookupMeta (pathSnapshot repoLayout)
return Timestamp{..}
instance (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed
Timestamp) where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/Util/FileLock.hsc
new/hackage-security-0.6.0.1/src/Hackage/Security/Util/FileLock.hsc
--- old/hackage-security-0.5.3.0/src/Hackage/Security/Util/FileLock.hsc
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/Util/FileLock.hsc
1970-01-01 01:00:00.000000000 +0100
@@ -1,202 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE InterruptibleFFI #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | This compat module can be removed once base-4.10 (ghc-8.2) is the minimum
--- required version. Though note that the locking functionality is not in
--- public modules in base-4.10, just in the "GHC.IO.Handle.Lock" module.
---
--- Copied from @cabal-install@ codebase "Distribution.Client.Compat.FileLock".
-module Hackage.Security.Util.FileLock (
- FileLockingNotSupported(..)
- , LockMode(..)
- , hLock
- , hTryLock
- ) where
-
-#if MIN_VERSION_base(4,10,0)
-
-import GHC.IO.Handle.Lock
-
-#else
-
--- The remainder of this file is a modified copy
--- of GHC.IO.Handle.Lock from ghc-8.2.x
---
--- The modifications were just to the imports and the CPP, since we do not have
--- access to the HAVE_FLOCK from the ./configure script. We approximate the
--- lack of HAVE_FLOCK with @defined(solaris2_HOST_OS) || defined(aix_HOST_OS)@
--- instead since those are known major Unix platforms lacking @flock()@ or
--- having broken one.
-
-import Control.Exception (Exception)
-import Data.Typeable
-
-#if defined(solaris2_HOST_OS) || defined(aix_HOST_OS)
-
-import Control.Exception (throwIO)
-import System.IO (Handle)
-
-#else
-
-import Data.Bits
-import Data.Function
-import Control.Concurrent.MVar
-
-import Foreign.C.Error
-import Foreign.C.Types
-
-import GHC.IO.Handle.Types
-import GHC.IO.FD
-import GHC.IO.Exception
-
-#if defined(mingw32_HOST_OS)
-
-#if defined(i386_HOST_ARCH)
-## define WINDOWS_CCONV stdcall
-#elif defined(x86_64_HOST_ARCH)
-## define WINDOWS_CCONV ccall
-#else
-# error Unknown mingw32 arch
-#endif
-
-#include <windows.h>
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import GHC.Windows
-
-#else /* !defined(mingw32_HOST_OS), so assume unix with flock() */
-
-#include <sys/file.h>
-
-#endif /* !defined(mingw32_HOST_OS) */
-
-#endif /* !(defined(solaris2_HOST_OS) || defined(aix_HOST_OS)) */
-
-
--- | Exception thrown by 'hLock' on non-Windows platforms that don't support
--- 'flock'.
-data FileLockingNotSupported = FileLockingNotSupported
- deriving (Typeable, Show)
-
-instance Exception FileLockingNotSupported
-
-
--- | Indicates a mode in which a file should be locked.
-data LockMode = SharedLock | ExclusiveLock
-
--- | If a 'Handle' references a file descriptor, attempt to lock contents of
the
--- underlying file in appropriate mode. If the file is already locked in
--- incompatible mode, this function blocks until the lock is established. The
--- lock is automatically released upon closing a 'Handle'.
---
--- Things to be aware of:
---
--- 1) This function may block inside a C call. If it does, in order to be able
--- to interrupt it with asynchronous exceptions and/or for other threads to
--- continue working, you MUST use threaded version of the runtime system.
---
--- 2) The implementation uses 'LockFileEx' on Windows and 'flock' otherwise,
--- hence all of their caveats also apply here.
---
--- 3) On non-Windows plaftorms that don't support 'flock' (e.g. Solaris) this
--- function throws 'FileLockingNotImplemented'. We deliberately choose to not
--- provide fcntl based locking instead because of its broken semantics.
---
--- @since 4.10.0.0
-hLock :: Handle -> LockMode -> IO ()
-hLock h mode = lockImpl h "hLock" mode True >> return ()
-
--- | Non-blocking version of 'hLock'.
---
--- @since 4.10.0.0
-hTryLock :: Handle -> LockMode -> IO Bool
-hTryLock h mode = lockImpl h "hTryLock" mode False
-
-----------------------------------------
-
-#if defined(solaris2_HOST_OS) || defined(aix_HOST_OS)
-
--- | No-op implementation.
-lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
-lockImpl _ _ _ _ = throwIO FileLockingNotSupported
-
-#else /* !(defined(solaris2_HOST_OS) || defined(aix_HOST_OS)) */
-
-#if defined(mingw32_HOST_OS)
-
-lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
-lockImpl h ctx mode block = do
- FD{fdFD = fd} <- handleToFd h
- wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) ctx $ c_get_osfhandle fd
- allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do
- fillBytes ovrlpd (fromIntegral sizeof_OVERLAPPED) 0
- let flags = cmode .|. (if block then 0 else #{const
LOCKFILE_FAIL_IMMEDIATELY})
- -- We want to lock the whole file without looking up its size to be
- -- consistent with what flock does. According to documentation of
LockFileEx
- -- "locking a region that goes beyond the current end-of-file position is
- -- not an error", however e.g. Windows 10 doesn't accept maximum possible
- -- value (a pair of MAXDWORDs) for mysterious reasons. Work around that by
- -- trying 2^32-1.
- fix $ \retry -> c_LockFileEx wh flags 0 0xffffffff 0x0 ovrlpd >>= \b ->
case b of
- True -> return True
- False -> getLastError >>= \err -> case () of
- () | not block && err == #{const ERROR_LOCK_VIOLATION} -> return False
- | err == #{const ERROR_OPERATION_ABORTED} -> retry
- | otherwise -> failWith ctx err
- where
- sizeof_OVERLAPPED = #{size OVERLAPPED}
-
- cmode = case mode of
- SharedLock -> 0
- ExclusiveLock -> #{const LOCKFILE_EXCLUSIVE_LOCK}
-
--- https://msdn.microsoft.com/en-us/library/aa297958.aspx
-foreign import ccall unsafe "_get_osfhandle"
- c_get_osfhandle :: CInt -> IO HANDLE
-
--- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365203.aspx
-foreign import WINDOWS_CCONV interruptible "LockFileEx"
- c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> Ptr () -> IO
BOOL
-
-#else /* !defined(mingw32_HOST_OS), so assume unix with flock() */
-
-lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
-lockImpl h ctx mode block = do
- FD{fdFD = fd} <- handleToFd h
- let flags = cmode .|. (if block then 0 else #{const LOCK_NB})
- fix $ \retry -> c_flock fd flags >>= \n -> case n of
- 0 -> return True
- _ -> getErrno >>= \errno -> case () of
- () | not block && errno == eWOULDBLOCK -> return False
- | errno == eINTR -> retry
- | otherwise -> ioException $ errnoToIOError ctx errno (Just h) Nothing
- where
- cmode = case mode of
- SharedLock -> #{const LOCK_SH}
- ExclusiveLock -> #{const LOCK_EX}
-
-foreign import ccall interruptible "flock"
- c_flock :: CInt -> CInt -> IO CInt
-
-#endif /* !defined(mingw32_HOST_OS) */
-
--- | Turn an existing Handle into a file descriptor. This function throws an
--- IOError if the Handle does not reference a file descriptor.
-handleToFd :: Handle -> IO FD
-handleToFd h = case h of
- FileHandle _ mv -> do
- Handle__{haDevice = dev} <- readMVar mv
- case cast dev of
- Just fd -> return fd
- Nothing -> throwErr "not a file descriptor"
- DuplexHandle{} -> throwErr "not a file handle"
- where
- throwErr msg = ioException $ IOError (Just h)
- InappropriateType "handleToFd" msg Nothing Nothing
-
-#endif /* defined(solaris2_HOST_OS) || defined(aix_HOST_OS) */
-
-#endif /* MIN_VERSION_base */
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/Util/IO.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/Util/IO.hs
--- old/hackage-security-0.5.3.0/src/Hackage/Security/Util/IO.hs
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/Util/IO.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,20 +1,30 @@
+{-# LANGUAGE CPP #-}
module Hackage.Security.Util.IO (
-- * Miscelleneous
getFileSize
, handleDoesNotExist
+ , WithDirLockEvent(..)
, withDirLock
-- * Debugging
, timedIO
) where
-import Control.Monad (unless)
+import Control.Concurrent (threadDelay)
import Control.Exception
import Data.Time
import System.IO hiding (openTempFile, withFile)
import System.IO.Error
import Hackage.Security.Util.Path
-import Hackage.Security.Util.FileLock (hTryLock, LockMode(ExclusiveLock),
FileLockingNotSupported)
+
+#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
{-------------------------------------------------------------------------------
Miscelleneous
@@ -32,12 +42,21 @@
then return Nothing
else throwIO e
+
+data WithDirLockEvent
+ = WithDirLockEventPre (Path Absolute)
+ | WithDirLockEventPost (Path Absolute)
+ | WithDirLockEventUnlock (Path Absolute)
+
-- | Attempt to create a filesystem lock in the specified directory.
--
-- This will use OS-specific file locking primitives: "GHC.IO.Handle.Lock" with
-- @base-4.10" and later or a shim for @base@ versions.
--
--- Throws an exception if the lock is already present.
+-- Blocks if the lock is already present.
+--
+-- The logger callback passed as first argument is invoked before and
+-- after acquiring a lock, and after unlocking.
--
-- May fallback to locking via creating a directory:
-- Given a file @/path/to@, we do this by attempting to create the directory
@@ -45,8 +64,10 @@
-- afterwards. Creating a directory that already exists will throw an exception
-- on most OSs (certainly Linux, OSX and Windows) and is a reasonably common
way
-- to implement a lock file.
-withDirLock :: Path Absolute -> IO a -> IO a
-withDirLock dir = bracket takeLock releaseLock . const
+withDirLock :: (WithDirLockEvent -> IO ()) -> Path Absolute -> IO a -> IO a
+withDirLock logger dir
+ = bracket takeLock (\h -> releaseLock h >> logger (WithDirLockEventUnlock
lock))
+ . const
where
lock :: Path Absolute
lock = dir </> fragment "hackage-security-lock"
@@ -54,29 +75,78 @@
lock' :: FilePath
lock' = toFilePath lock
+ me = "Hackage.Security.Util.IO.withDirLock: "
+
+ wrapLog :: IO a -> IO a
+ wrapLog op = do
+ logger (WithDirLockEventPre lock)
+ h <- op
+ 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
- handle (takeDirLock h) $ do
- gotlock <- hTryLock h ExclusiveLock
- unless gotlock $
- fail $ "hTryLock: lock already exists: " ++ lock'
+ wrapLog $ handle (fallbackToDirLock h) $ do
+ hLock h ExclusiveLock
return (Just h)
- takeDirLock :: Handle -> FileLockingNotSupported -> IO (Maybe Handle)
- takeDirLock h _ = do
- -- We fallback to directory locking
- -- so we need to cleanup lock file first: close and remove
- hClose h
- handle onIOError (removeFile lock)
- createDirectory lock
- return Nothing
-
- onIOError :: IOError -> IO ()
- onIOError _ = hPutStrLn stderr
- "withDirLock: cannot remove lock file before directory lock fallback"
- releaseLock (Just h) = hClose h
+ -- If file locking isn't supported then we fallback to directory locking,
+ -- polling if necessary.
+ fallbackToDirLock :: Handle -> FileLockingNotSupported -> IO (Maybe Handle)
+ fallbackToDirLock h _ = takeDirLock >> return Nothing
+ where
+ takeDirLock :: IO ()
+ takeDirLock = do
+ -- We fallback to directory locking
+ -- so we need to cleanup lock file first: close and remove
+ hClose h
+ handle onIOError (removeFile lock)
+ handle onCreateDirError (createDirectory lock)
+
+ onCreateDirError :: IOError -> IO ()
+ onCreateDirError ioe
+ | isAlreadyExistsError ioe = threadDelay (1*1000*1000) >> takeDirLock
+ | otherwise = fail (me++"error creating directory lock: "++show ioe)
+
+ onIOError :: IOError -> IO ()
+ onIOError _ = hPutStrLn stderr
+ (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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hackage-security-0.5.3.0/src/Hackage/Security/Util/Lens.hs
new/hackage-security-0.6.0.1/src/Hackage/Security/Util/Lens.hs
--- old/hackage-security-0.5.3.0/src/Hackage/Security/Util/Lens.hs
2018-03-26 01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/src/Hackage/Security/Util/Lens.hs
2001-09-09 03:46:40.000000000 +0200
@@ -7,11 +7,11 @@
-- * Generic definitions
Lens
, Lens'
+ , Traversal
+ , Traversal'
, get
- , modify
+ , over
, set
- -- * Specific lenses
- , lookupM
) where
import Control.Applicative
@@ -22,27 +22,25 @@
-------------------------------------------------------------------------------}
-- | Polymorphic lens
-type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
+type Lens s t a b = forall f. Functor f => LensLike f s t a b
-- | Monomorphic lens
type Lens' s a = Lens s s a a
-get :: Lens' s a -> s -> a
-get l = getConst . l Const
+-- | Polymorphic traversal
+type Traversal s t a b = forall f. Applicative f => LensLike f s t a b
-modify :: Lens s t a b -> (a -> b) -> s -> t
-modify l f = runIdentity . l (Identity . f)
+-- | Monomorphic traversal
+type Traversal' s a = Traversal s s a a
-set :: Lens s t a b -> b -> s -> t
-set l = modify l . const
+type LensLike f s t a b = (a -> f b) -> s -> f t
+type LensLike' f s a = LensLike f s s a a
-{-------------------------------------------------------------------------------
- Specific lenses
--------------------------------------------------------------------------------}
+get :: LensLike' (Const a) s a -> s -> a
+get l = getConst . l Const
+
+over :: LensLike Identity s t a b -> (a -> b) -> s -> t
+over l f = runIdentity . l (Identity . f)
-lookupM :: forall a b. (Eq a, Monoid b) => a -> Lens' [(a, b)] b
-lookupM a f = go
- where
- go [] = (\b' -> [(a, b')] ) <$> f mempty
- go ((a', b):xs) | a == a' = (\b' -> (a, b'):xs ) <$> f b
- | otherwise = (\xs' -> (a', b):xs') <$> go xs
+set :: LensLike Identity s t a b -> b -> s -> t
+set l = over l . const
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hackage-security-0.5.3.0/tests/TestSuite/JSON.hs
new/hackage-security-0.6.0.1/tests/TestSuite/JSON.hs
--- old/hackage-security-0.5.3.0/tests/TestSuite/JSON.hs 2018-03-26
01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/tests/TestSuite/JSON.hs 2001-09-09
03:46:40.000000000 +0200
@@ -3,6 +3,7 @@
prop_roundtrip_canonical,
prop_roundtrip_pretty,
prop_canonical_pretty,
+ prop_aeson_canonical,
) where
-- stdlib
@@ -16,8 +17,13 @@
-- hackage-security
import Text.JSON.Canonical
+-- aeson
+import Data.Aeson (Value (..), eitherDecode)
+import Data.String (fromString)
+import qualified Data.Vector as V
+import qualified Data.HashMap.Strict as HM
-prop_roundtrip_canonical, prop_roundtrip_pretty, prop_canonical_pretty
+prop_aeson_canonical, prop_roundtrip_canonical, prop_roundtrip_pretty,
prop_canonical_pretty
:: JSValue -> Bool
prop_roundtrip_canonical jsval =
@@ -30,6 +36,9 @@
parseCanonicalJSON (renderCanonicalJSON jsval) ==
fmap canonicalise (parseCanonicalJSON (BS.pack (prettyCanonicalJSON
jsval)))
+prop_aeson_canonical jsval =
+ eitherDecode (renderCanonicalJSON jsval) == Right (toAeson (canonicalise
jsval))
+
canonicalise :: JSValue -> JSValue
canonicalise v@JSNull = v
canonicalise v@(JSBool _) = v
@@ -46,12 +55,13 @@
[ (1, pure JSNull)
, (1, JSBool <$> arbitrary)
, (2, JSNum <$> arbitrary)
- , (2, JSString <$> arbitrary)
+ , (2, JSString . getASCIIString <$> arbitrary)
, (3, JSArray <$> resize (sz `div` 2) arbitrary)
- , (3, JSObject . noDupFields <$> resize (sz `div` 2) arbitrary)
+ , (3, JSObject . mapFirst getASCIIString . noDupFields <$> resize (sz
`div` 2) arbitrary)
]
where
noDupFields = nubBy (\(x,_) (y,_) -> x==y)
+ mapFirst f = map (\(x, y) -> (f x, y))
shrink JSNull = []
shrink (JSBool _) = []
@@ -62,6 +72,13 @@
where
shrinkSnd (a,b) = [ (a,b') | b' <- shrink b ]
+toAeson :: JSValue -> Value
+toAeson JSNull = Null
+toAeson (JSBool b) = Bool b
+toAeson (JSNum n) = Number (fromIntegral n)
+toAeson (JSString s) = String (fromString s)
+toAeson (JSArray xs) = Array $ V.fromList [ toAeson x | x <- xs ]
+toAeson (JSObject xs) = Object $ HM.fromList [ (fromString k, toAeson v) | (k,
v) <- xs ]
instance Arbitrary Int54 where
arbitrary = fromIntegral <$>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hackage-security-0.5.3.0/tests/TestSuite.hs
new/hackage-security-0.6.0.1/tests/TestSuite.hs
--- old/hackage-security-0.5.3.0/tests/TestSuite.hs 2018-03-26
01:39:07.000000000 +0200
+++ new/hackage-security-0.6.0.1/tests/TestSuite.hs 2001-09-09
03:46:40.000000000 +0200
@@ -70,6 +70,7 @@
testProperty "prop_roundtrip_canonical" JSON.prop_roundtrip_canonical
, testProperty "prop_roundtrip_pretty" JSON.prop_roundtrip_pretty
, testProperty "prop_canonical_pretty" JSON.prop_canonical_pretty
+ , testProperty "prop_aeson_canonical" JSON.prop_aeson_canonical
]
]
@@ -283,6 +284,9 @@
, downloading isMirrors
, noLocalCopy
, downloading isIndex
+ , lockingWait
+ , lockingWaitDone
+ , lockingRelease
]
-- | Log messages when we do a check for updates and there are no changes
@@ -290,6 +294,9 @@
msgsNoUpdates = [
selectedMirror inMemURI
, downloading isTimestamp
+ , lockingWait
+ , lockingWaitDone
+ , lockingRelease
]
-- | Log messages we expect when the timestamp and snapshot have been resigned
@@ -298,6 +305,9 @@
selectedMirror inMemURI
, downloading isTimestamp
, downloading isSnapshot
+ , lockingWait
+ , lockingWaitDone
+ , lockingRelease
]
-- | Log messages we expect when the timestamp key has been rolled over
@@ -307,12 +317,18 @@
, downloading isTimestamp
, verificationError $ unknownKeyError timestampPath
, downloading isRoot
+ , lockingWait
+ , lockingWaitDone
+ , lockingRelease
, downloading isTimestamp
, downloading isSnapshot
-- Since we delete the timestamp and snapshot on a root info change,
-- we will then conclude that we need to update the mirrors and the index.
, downloading isMirrors
, updating isIndex
+ , lockingWait
+ , lockingWaitDone
+ , lockingRelease
]
{-------------------------------------------------------------------------------
@@ -335,6 +351,14 @@
updating isFile (LogUpdating file) = isFile file
updating _ _ = False
+lockingWait, lockingWaitDone, lockingRelease :: LogMessage -> Bool
+lockingWait (LogLockWait _) = True
+lockingWait _ = False
+lockingWaitDone (LogLockWaitDone _) = True
+lockingWaitDone _ = False
+lockingRelease (LogUnlock _) = True
+lockingRelease _ = False
+
expired :: TargetPath -> VerificationError -> Bool
expired f (VerificationErrorExpired f') = f == f'
expired _ _ = False
@@ -493,6 +517,9 @@
bootstrapMsgs :: [LogMessage -> Bool]
bootstrapMsgs = [ selectedMirror inMemURI
, downloading isRoot
+ , lockingWait
+ , lockingWaitDone
+ , lockingRelease
]
layout :: RepoLayout
