From 61e86a0d83552c3862e776c3a28a7effbe417b4f Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Mon, 28 Oct 2019 17:30:00 -0400 Subject: [PATCH 1/2] Update hackage-security to GHC 8.8 --- hackage-security/hackage-security.cabal | 10 +++++----- hackage-security/src/Hackage/Security/Client.hs | 7 ++++++- hackage-security/src/Hackage/Security/TUF/FileMap.hs | 2 +- hackage-security/src/Hackage/Security/TUF/Snapshot.hs | 6 +++++- hackage-security/src/Hackage/Security/TUF/Timestamp.hs | 3 ++- hackage-security/src/Text/JSON/Canonical.hs | 1 + 6 files changed, 20 insertions(+), 9 deletions(-) diff --git a/hackage-security/hackage-security.cabal b/hackage-security/hackage-security.cabal index 943ef8ee..b2853836 100644 --- a/hackage-security/hackage-security.cabal +++ b/hackage-security/hackage-security.cabal @@ -99,8 +99,8 @@ library base16-bytestring >= 0.1.1 && < 0.2, base64-bytestring >= 1.0 && < 1.1, bytestring >= 0.9 && < 0.11, - Cabal >= 1.14 && < 1.26, - containers >= 0.4 && < 0.6, + Cabal >= 1.14 && < 4, + containers >= 0.4 && < 0.7, ed25519 >= 0.0 && < 0.1, filepath >= 1.2 && < 1.5, mtl >= 2.2 && < 2.3, @@ -110,7 +110,7 @@ library -- 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.7, + time >= 1.2 && < 1.10, transformers >= 0.4 && < 0.6, zlib >= 0.5 && < 0.7, -- whatever versions are bundled with ghc: @@ -195,8 +195,8 @@ library -- (Note that the HTTP library does the same thing, though in this case the -- dependency in network is not redundant.) if flag(use-network-uri) - build-depends: network-uri >= 2.6 && < 2.7, - network >= 2.6 && < 2.7 + build-depends: network-uri >= 2.6 && < 3.2, + network >= 2.6 && < 3.2 else build-depends: network >= 2.5 && < 2.6 diff --git a/hackage-security/src/Hackage/Security/Client.hs b/hackage-security/src/Hackage/Security/Client.hs index 3bf84401..3f193ec3 100644 --- a/hackage-security/src/Hackage/Security/Client.hs +++ b/hackage-security/src/Hackage/Security/Client.hs @@ -94,7 +94,10 @@ data HasUpdates = HasUpdates | NoUpdates -- You should pass @Nothing@ for the UTCTime _only_ under exceptional -- circumstances (such as when the main server is down for longer than the -- expiry dates used in the timestamp files on mirrors). -checkForUpdates :: (Throws VerificationError, Throws SomeRemoteError) +checkForUpdates :: ( MonadFail ReadJSON_Keys_Layout + , Throws VerificationError + , Throws SomeRemoteError + ) => Repository down -> Maybe UTCTime -- ^ To check expiry times against (if using) -> IO HasUpdates @@ -335,6 +338,8 @@ cachedVersion CachedInfo{..} remoteFile = getCachedInfo :: #if __GLASGOW_HASKELL__ < 800 (Applicative m, MonadIO m) +#elif __GLASGOW_HASKELL__ >= 807 + (MonadFail ReadJSON_Keys_Layout, MonadIO m) #else MonadIO m #endif diff --git a/hackage-security/src/Hackage/Security/TUF/FileMap.hs b/hackage-security/src/Hackage/Security/TUF/FileMap.hs index a5d6c85e..245267d2 100644 --- a/hackage-security/src/Hackage/Security/TUF/FileMap.hs +++ b/hackage-security/src/Hackage/Security/TUF/FileMap.hs @@ -75,7 +75,7 @@ fromList = FileMap . Map.fromList Convenience accessors -------------------------------------------------------------------------------} -lookupM :: Monad m => FileMap -> TargetPath -> m FileInfo +lookupM :: MonadFail m => FileMap -> TargetPath -> m FileInfo lookupM m fp = case lookup fp m of Nothing -> fail $ "No entry for " ++ pretty fp ++ " in filemap" diff --git a/hackage-security/src/Hackage/Security/TUF/Snapshot.hs b/hackage-security/src/Hackage/Security/TUF/Snapshot.hs index e31bf7a2..d031bdea 100644 --- a/hackage-security/src/Hackage/Security/TUF/Snapshot.hs +++ b/hackage-security/src/Hackage/Security/TUF/Snapshot.hs @@ -68,6 +68,7 @@ instance MonadReader RepoLayout m => ToJSON m Snapshot where instance ( MonadReader RepoLayout m , MonadError DeserializationError m + , MonadFail m , ReportSchemaErrors m ) => FromJSON m Snapshot where fromJSON enc = do @@ -82,7 +83,10 @@ instance ( MonadReader RepoLayout m let snapshotInfoTar = FileMap.lookup (pathIndexTar repoLayout) snapshotMeta return Snapshot{..} -instance (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Snapshot) where +instance ( MonadFail m + , MonadKeys m + , MonadReader RepoLayout m + ) => FromJSON m (Signed Snapshot) where fromJSON = signedFromJSON {------------------------------------------------------------------------------- diff --git a/hackage-security/src/Hackage/Security/TUF/Timestamp.hs b/hackage-security/src/Hackage/Security/TUF/Timestamp.hs index 175725a4..566dd7dd 100644 --- a/hackage-security/src/Hackage/Security/TUF/Timestamp.hs +++ b/hackage-security/src/Hackage/Security/TUF/Timestamp.hs @@ -48,6 +48,7 @@ instance MonadReader RepoLayout m => ToJSON m Timestamp where instance ( MonadReader RepoLayout m , MonadError DeserializationError m + , MonadFail m , ReportSchemaErrors m ) => FromJSON m Timestamp where fromJSON enc = do @@ -59,7 +60,7 @@ instance ( MonadReader RepoLayout m timestampInfoSnapshot <- FileMap.lookupM timestampMeta (pathSnapshot repoLayout) return Timestamp{..} -instance (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where +instance (MonadFail m, MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where fromJSON = signedFromJSON {------------------------------------------------------------------------------- diff --git a/hackage-security/src/Text/JSON/Canonical.hs b/hackage-security/src/Text/JSON/Canonical.hs index 114f346f..5b8d68b5 100644 --- a/hackage-security/src/Text/JSON/Canonical.hs +++ b/hackage-security/src/Text/JSON/Canonical.hs @@ -30,6 +30,7 @@ module Text.JSON.Canonical , prettyCanonicalJSON ) where +import Prelude hiding ((<>)) import Text.ParserCombinators.Parsec ( CharParser, (<|>), (), many, between, sepBy , satisfy, char, string, digit, spaces From 98166d79b3d918acd2f50a9b47f35d7c5fe133a4 Mon Sep 17 00:00:00 2001 From: Avi Dessauer Date: Sat, 2 Nov 2019 08:34:53 -0400 Subject: [PATCH 2/2] Remove some MonadFails --- hackage-security/src/Hackage/Security/TUF/FileMap.hs | 7 +++++++ .../src/Hackage/Security/TUF/Snapshot.hs | 12 ++++-------- .../src/Hackage/Security/TUF/Timestamp.hs | 5 ++--- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/hackage-security/src/Hackage/Security/TUF/FileMap.hs b/hackage-security/src/Hackage/Security/TUF/FileMap.hs index 245267d2..9ec95c7c 100644 --- a/hackage-security/src/Hackage/Security/TUF/FileMap.hs +++ b/hackage-security/src/Hackage/Security/TUF/FileMap.hs @@ -15,6 +15,7 @@ module Hackage.Security.TUF.FileMap ( , fromList -- * Convenience accessors , lookupM + , lookupErr -- * Comparing file maps , FileChange(..) , fileMapChanges @@ -22,6 +23,7 @@ module Hackage.Security.TUF.FileMap ( import Prelude hiding (lookup) import Control.Arrow (second) +import Control.Monad.Except import Data.Map (Map) import qualified Data.Map as Map @@ -81,6 +83,11 @@ lookupM m fp = Nothing -> fail $ "No entry for " ++ pretty fp ++ " in filemap" Just nfo -> return nfo +lookupErr :: MonadError e m => (String -> e) -> FileMap -> TargetPath -> m FileInfo +lookupErr e m fp = + case lookup fp m of + Nothing -> throwError $ e $ "No entry for " ++ pretty fp ++ " in filemap" + Just nfo -> return nfo {------------------------------------------------------------------------------- Comparing filemaps -------------------------------------------------------------------------------} diff --git a/hackage-security/src/Hackage/Security/TUF/Snapshot.hs b/hackage-security/src/Hackage/Security/TUF/Snapshot.hs index d031bdea..f4f44c34 100644 --- a/hackage-security/src/Hackage/Security/TUF/Snapshot.hs +++ b/hackage-security/src/Hackage/Security/TUF/Snapshot.hs @@ -68,7 +68,6 @@ instance MonadReader RepoLayout m => ToJSON m Snapshot where instance ( MonadReader RepoLayout m , MonadError DeserializationError m - , MonadFail m , ReportSchemaErrors m ) => FromJSON m Snapshot where fromJSON enc = do @@ -77,16 +76,13 @@ instance ( MonadReader RepoLayout m 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) + snapshotInfoRoot <- FileMap.lookupErr DeserializationErrorSchema snapshotMeta (pathRoot repoLayout) + snapshotInfoMirrors <- FileMap.lookupErr DeserializationErrorSchema snapshotMeta (pathMirrors repoLayout) + snapshotInfoTarGz <- FileMap.lookupErr DeserializationErrorSchema snapshotMeta (pathIndexTarGz repoLayout) let snapshotInfoTar = FileMap.lookup (pathIndexTar repoLayout) snapshotMeta return Snapshot{..} -instance ( MonadFail m - , MonadKeys m - , MonadReader RepoLayout m - ) => FromJSON m (Signed Snapshot) where +instance ( MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Snapshot) where fromJSON = signedFromJSON {------------------------------------------------------------------------------- diff --git a/hackage-security/src/Hackage/Security/TUF/Timestamp.hs b/hackage-security/src/Hackage/Security/TUF/Timestamp.hs index 566dd7dd..49d1090d 100644 --- a/hackage-security/src/Hackage/Security/TUF/Timestamp.hs +++ b/hackage-security/src/Hackage/Security/TUF/Timestamp.hs @@ -48,7 +48,6 @@ instance MonadReader RepoLayout m => ToJSON m Timestamp where instance ( MonadReader RepoLayout m , MonadError DeserializationError m - , MonadFail m , ReportSchemaErrors m ) => FromJSON m Timestamp where fromJSON enc = do @@ -57,10 +56,10 @@ instance ( MonadReader RepoLayout m timestampVersion <- fromJSField enc "version" timestampExpires <- fromJSField enc "expires" timestampMeta <- fromJSField enc "meta" - timestampInfoSnapshot <- FileMap.lookupM timestampMeta (pathSnapshot repoLayout) + timestampInfoSnapshot <- FileMap.lookupErr DeserializationErrorSchema timestampMeta (pathSnapshot repoLayout) return Timestamp{..} -instance (MonadFail m, MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where +instance (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where fromJSON = signedFromJSON {-------------------------------------------------------------------------------