Skip to content

Update hackage-security to GHC 8.8 #234

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 2 commits into from
Closed

Update hackage-security to GHC 8.8 #234

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
61e86a0
Update hackage-security to GHC 8.8
Avi-D-coder Oct 28, 2019
98166d7
Remove some MonadFails
Avi-D-coder Nov 2, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 5 additions & 5 deletions hackage-security/hackage-security.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This line here makes me suspect this is against some fairly ancient state of the master branch

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,
Expand All @@ -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:
Expand Down Expand Up @@ -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

Expand Down
7 changes: 6 additions & 1 deletion hackage-security/src/Hackage/Security/Client.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Indeed this seems rather odd. I haven't looked at the surrounding code but it does seem suspicious that you would need to add a constraint of this form. Are you sure this is necessary?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not clear how MonadFail can be replaced, it seems to come from getCachedInfo:347 and ReadJSON_Keys_Layout comes from readLocalFile : 367.

Should I try to replace MonadFail with a Throws _?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

My mtl foo is not good enough to remove MonadFail ReadJSON_Keys_Layout.

@edsko I see you wrote the ReadJSON_Keys_Layout code, do you have any advice?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

THe cloest I have gotten is MonadError DeserializationError IO, but this produces the warning:

Security/Client.hs:211:18: warning:
    • Couldn't match type ‘IOException’ with ‘DeserializationError’
        arising from a functional dependency between:
          constraint ‘MonadError DeserializationError IO’
            arising from the type signature for:
                           checkForUpdates :: forall (down :: * -> *).
                                              (MonadError DeserializationError IO,
                                               Throws VerificationError, Throws SomeRemoteError) =>
                                              Repository down -> Maybe UTCTime -> IO HasUpdates
          instance ‘MonadError IOException IO’ at <no location info>
      Inaccessible code in
        a pattern with constructor: FGz :: Format FormatGz,
        in a case alternative
    • In the pattern: FGz
      In the pattern: Some FGz
      In a case alternative:
          Some FGz -> verifyFileInfo' (Just newInfoTarGz) targetPath tempPath

#else
MonadIO m
#endif
Expand Down
9 changes: 8 additions & 1 deletion hackage-security/src/Hackage/Security/TUF/FileMap.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,15 @@ module Hackage.Security.TUF.FileMap (
, fromList
-- * Convenience accessors
, lookupM
, lookupErr
-- * Comparing file maps
, FileChange(..)
, fileMapChanges
) where

import Prelude hiding (lookup)
import Control.Arrow (second)
import Control.Monad.Except
import Data.Map (Map)
import qualified Data.Map as Map

Expand Down Expand Up @@ -75,12 +77,17 @@ 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"
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
-------------------------------------------------------------------------------}
Expand Down
8 changes: 4 additions & 4 deletions hackage-security/src/Hackage/Security/TUF/Snapshot.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -76,13 +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 (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Snapshot) where
instance ( MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Snapshot) where
fromJSON = signedFromJSON

{-------------------------------------------------------------------------------
Expand Down
2 changes: 1 addition & 1 deletion hackage-security/src/Hackage/Security/TUF/Timestamp.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ 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 (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where
Expand Down
1 change: 1 addition & 0 deletions hackage-security/src/Text/JSON/Canonical.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down