diff --git a/.gitignore b/.gitignore index d2645e022c..af5d767bea 100644 --- a/.gitignore +++ b/.gitignore @@ -29,3 +29,4 @@ tags /etc/scripts/stack-scripts.cabal .hspec-failures better-cache/ +/subs/*/*.cabal diff --git a/subs/pantry/.hindent.yaml b/subs/pantry/.hindent.yaml new file mode 100644 index 0000000000..5e5e32ff0f --- /dev/null +++ b/subs/pantry/.hindent.yaml @@ -0,0 +1 @@ +indent-size: 2 diff --git a/subs/pantry/package.yaml b/subs/pantry/package.yaml index bbbd842967..57ad825507 100644 --- a/subs/pantry/package.yaml +++ b/subs/pantry/package.yaml @@ -86,6 +86,9 @@ dependencies: - directory - filepath +ghc-options: + - -Wall + library: source-dirs: src/ when: @@ -104,6 +107,8 @@ library: # For testing - Pantry.Internal - Pantry.Internal.StaticBytes + # For stackage-server + - Pantry.Internal.Stackage # FIXME must be removed from pantry! - Data.Aeson.Extended diff --git a/subs/pantry/src/Pantry.hs b/subs/pantry/src/Pantry.hs index c5cbb7f6da..cef5a9ecc0 100644 --- a/subs/pantry/src/Pantry.hs +++ b/subs/pantry/src/Pantry.hs @@ -1,7 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} -- | Content addressable Haskell package management, providing for -- secure, reproducible acquisition of Haskell package contents and -- metadata. @@ -179,7 +178,7 @@ import qualified RIO.FilePath as FilePath import Pantry.Archive import Pantry.Repo import qualified Pantry.SHA256 as SHA256 -import Pantry.Storage +import Pantry.Storage hiding (TreeEntry, PackageName, Version) import Pantry.Tree import Pantry.Types import Pantry.Hackage @@ -300,8 +299,8 @@ getLatestHackageLocation req name preferred = do forM mVerCfKey $ \(version, cfKey@(BlobKey sha size)) -> do let pir = PackageIdentifierRevision name version (CFIHash sha (Just size)) - treeKey <- getHackageTarballKey pir - pure $ PLIHackage (PackageIdentifier name version) cfKey treeKey + treeKey' <- getHackageTarballKey pir + pure $ PLIHackage (PackageIdentifier name version) cfKey treeKey' -- | Returns the latest revision of the given package version available from -- Hackage. @@ -319,8 +318,8 @@ getLatestHackageRevision req name version = do Nothing -> pure Nothing Just (revision, cfKey@(BlobKey sha size)) -> do let cfi = CFIHash sha (Just size) - treeKey <- getHackageTarballKey (PackageIdentifierRevision name version cfi) - return $ Just (revision, cfKey, treeKey) + treeKey' <- getHackageTarballKey (PackageIdentifierRevision name version cfi) + return $ Just (revision, cfKey, treeKey') fetchTreeKeys :: (HasPantryConfig env, HasLogFunc env, Foldable f) @@ -703,7 +702,8 @@ loadPackage :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => PackageLocationImmutable -> RIO env Package -loadPackage (PLIHackage ident cfHash tree) = getHackageTarball (pirForHash ident cfHash) (Just tree) +loadPackage (PLIHackage ident cfHash tree) = + htrPackage <$> getHackageTarball (pirForHash ident cfHash) (Just tree) loadPackage pli@(PLIArchive archive pm) = getArchivePackage (toRawPLI pli) (toRawArchive archive) (toRawPM pm) loadPackage (PLIRepo repo pm) = getRepo repo (toRawPM pm) @@ -714,7 +714,7 @@ loadPackageRaw :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => RawPackageLocationImmutable -> RIO env Package -loadPackageRaw (RPLIHackage pir mtree) = getHackageTarball pir mtree +loadPackageRaw (RPLIHackage pir mtree) = htrPackage <$> getHackageTarball pir mtree loadPackageRaw rpli@(RPLIArchive archive pm) = getArchivePackage rpli archive pm loadPackageRaw (RPLIRepo repo rpm) = getRepo repo rpm @@ -740,8 +740,8 @@ completePackageLocation (RPLIHackage pir0@(PackageIdentifierRevision name versio pir = PackageIdentifierRevision name version cfi logDebug $ "Added in cabal file hash: " <> display pir pure (pir, BlobKey sha size) - treeKey <- getHackageTarballKey pir - pure $ PLIHackage (PackageIdentifier name version) cfKey treeKey + treeKey' <- getHackageTarballKey pir + pure $ PLIHackage (PackageIdentifier name version) cfKey treeKey' completePackageLocation pl@(RPLIArchive archive rpm) = do -- getArchive checks archive and package metadata (sha, size, package) <- getArchive pl archive rpm @@ -1345,7 +1345,7 @@ getRawPackageLocationTreeKey -> RIO env TreeKey getRawPackageLocationTreeKey pl = case getRawTreeKey pl of - Just treeKey -> pure treeKey + Just treeKey' -> pure treeKey' Nothing -> case pl of RPLIHackage pir _ -> getHackageTarballKey pir diff --git a/subs/pantry/src/Pantry/Archive.hs b/subs/pantry/src/Pantry/Archive.hs index 4549445792..574ba660e2 100644 --- a/subs/pantry/src/Pantry/Archive.hs +++ b/subs/pantry/src/Pantry/Archive.hs @@ -13,7 +13,7 @@ module Pantry.Archive import RIO import qualified Pantry.SHA256 as SHA256 -import Pantry.Storage +import Pantry.Storage hiding (Tree, TreeEntry) import Pantry.Tree import Pantry.Types import RIO.Process @@ -447,7 +447,7 @@ parseArchive rpli archive fp = do BFCabal _ _ -> when (buildFilePath /= cabalFileName name) $ throwIO $ WrongCabalFileName rpli buildFilePath name _ -> return () -- It's good! Store the tree, let's bounce - (tid, treeKey) <- withStorage $ storeTree rpli ident tree buildFile + (tid, treeKey') <- withStorage $ storeTree rpli ident tree buildFile packageCabal <- case buildFile of BFCabal _ _ -> pure $ PCCabalFile buildFileEntry BFHpack _ -> do @@ -458,7 +458,7 @@ parseArchive rpli archive fp = do let cabalTreeEntry = TreeEntry cabalKey (teType buildFileEntry) pure $ PCHpack $ PHpack { phOriginal = buildFileEntry, phGenerated = cabalTreeEntry, phVersion = hpackSoftwareVersion} pure Package - { packageTreeKey = treeKey + { packageTreeKey = treeKey' , packageTree = tree , packageCabalEntry = packageCabal , packageIdent = ident diff --git a/subs/pantry/src/Pantry/Hackage.hs b/subs/pantry/src/Pantry/Hackage.hs index 7eaad0fb60..fc02529ad0 100644 --- a/subs/pantry/src/Pantry/Hackage.hs +++ b/subs/pantry/src/Pantry/Hackage.hs @@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Pantry.Hackage ( updateHackageIndex + , forceUpdateHackageIndex , DidUpdateOccur (..) , RequireHackageIndex (..) , hackageIndexTarballL @@ -14,6 +15,7 @@ module Pantry.Hackage , getHackagePackageVersionRevisions , getHackageTypoCorrections , UsePreferredVersions (..) + , HackageTarballResult(..) ) where import RIO @@ -28,7 +30,7 @@ import qualified RIO.ByteString as B import qualified RIO.ByteString.Lazy as BL import Pantry.Archive import Pantry.Types hiding (FileType (..)) -import Pantry.Storage +import Pantry.Storage hiding (TreeEntry, PackageName, Version) import Pantry.Tree import qualified Pantry.SHA256 as SHA256 import Network.URI (parseURI) @@ -39,6 +41,7 @@ import qualified Distribution.PackageDescription as Cabal import System.IO (SeekMode (..)) import qualified Data.List.NonEmpty as NE import Data.Text.Metrics (damerauLevenshtein) +import Distribution.PackageDescription (GenericPackageDescription) import Distribution.Types.Version (versionNumbers) import Distribution.Types.VersionRange (withinRange) @@ -69,6 +72,17 @@ hackageIndexTarballL = hackageDirL.to ( indexRelFile) -- @since 0.1.0.0 data DidUpdateOccur = UpdateOccurred | NoUpdateOccurred + +-- | Information returned by `getHackageTarball` +-- +-- @since 0.1.0.0 +data HackageTarballResult = HackageTarballResult + { htrPackage :: !Package + -- ^ Package that was loaded from Hackage tarball + , htrFreshPackageInfo :: !(Maybe (GenericPackageDescription, TreeId)) + -- ^ This information is only available whenever package was just loaded into pantry. + } + -- | Download the most recent 01-index.tar file from Hackage and -- update the database tables. -- @@ -80,7 +94,26 @@ updateHackageIndex :: (HasPantryConfig env, HasLogFunc env) => Maybe Utf8Builder -- ^ reason for updating, if any -> RIO env DidUpdateOccur -updateHackageIndex mreason = do +updateHackageIndex = updateHackageIndexInternal False + +-- | Same as `updateHackageIndex`, but force the database update even if hackage +-- security tells that there is no change. This can be useful in order to make +-- sure the database is in sync with the locally downloaded tarball +-- +-- @since 0.1.0.0 +forceUpdateHackageIndex + :: (HasPantryConfig env, HasLogFunc env) + => Maybe Utf8Builder + -> RIO env DidUpdateOccur +forceUpdateHackageIndex = updateHackageIndexInternal True + + +updateHackageIndexInternal + :: (HasPantryConfig env, HasLogFunc env) + => Bool -- ^ Force the database update. + -> Maybe Utf8Builder -- ^ reason for updating, if any + -> RIO env DidUpdateOccur +updateHackageIndexInternal forceUpdate mreason = do storage <- view $ pantryConfigL.to pcStorage gateUpdate $ withWriteLock_ storage $ do for_ mreason logInfo @@ -118,6 +151,9 @@ updateHackageIndex mreason = do HS.checkForUpdates repo maybeNow case didUpdate of + _ | forceUpdate -> do + logInfo "Forced package update is initialized" + updateCache tarball HS.NoUpdates -> do x <- needsCacheUpdate tarball if x @@ -200,11 +236,13 @@ updateHackageIndex mreason = do if oldHash == oldHashCheck then oldSize <$ logInfo "Updating preexisting cache, should be quick" else 0 <$ do - logInfo "Package index change detected, that's pretty unusual" - logInfo $ "Old size: " <> display oldSize - logInfo $ "Old hash (orig) : " <> display oldHash - logInfo $ "New hash (check): " <> display oldHashCheck - logInfo "Forcing a recache" + logWarn $ mconcat [ + "Package index change detected, that's pretty unusual: " + , "\n Old size: " <> display oldSize + , "\n Old hash (orig) : " <> display oldHash + , "\n New hash (check): " <> display oldHashCheck + , "\n Forcing a recache" + ] pure (offset, newHash, newSize) lift $ logInfo $ "Populating cache from file size " <> display newSize <> ", hash " <> display newHash @@ -476,16 +514,17 @@ withCachedTree -> PackageName -> Version -> BlobId -- ^ cabal file contents - -> RIO env Package - -> RIO env Package + -> RIO env HackageTarballResult + -> RIO env HackageTarballResult withCachedTree rpli name ver bid inner = do mres <- withStorage $ loadHackageTree rpli name ver bid case mres of - Just package -> pure package + Just package -> pure $ HackageTarballResult package Nothing Nothing -> do - package <- inner - withStorage $ storeHackageTree name ver bid $ packageTreeKey package - pure package + htr <- inner + withStorage $ + storeHackageTree name ver bid $ packageTreeKey $ htrPackage htr + pure htr getHackageTarballKey :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) @@ -494,20 +533,21 @@ getHackageTarballKey getHackageTarballKey pir@(PackageIdentifierRevision name ver (CFIHash sha _msize)) = do mres <- withStorage $ loadHackageTreeKey name ver sha case mres of - Nothing -> packageTreeKey <$> getHackageTarball pir Nothing + Nothing -> packageTreeKey . htrPackage <$> getHackageTarball pir Nothing Just key -> pure key -getHackageTarballKey pir = packageTreeKey <$> getHackageTarball pir Nothing +getHackageTarballKey pir = packageTreeKey . htrPackage <$> getHackageTarball pir Nothing getHackageTarball :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => PackageIdentifierRevision -> Maybe TreeKey - -> RIO env Package -getHackageTarball pir@(PackageIdentifierRevision name ver _cfi) mtreeKey = do + -> RIO env HackageTarballResult +getHackageTarball pir mtreeKey = do + let PackageIdentifierRevision name ver _cfi = pir cabalFile <- resolveCabalFileInfo pir - cabalFileKey <- withStorage $ getBlobKey cabalFile let rpli = RPLIHackage pir mtreeKey withCachedTree rpli name ver cabalFile $ do + cabalFileKey <- withStorage $ getBlobKey cabalFile mpair <- withStorage $ loadHackageTarballInfo name ver (sha, size) <- case mpair of @@ -524,55 +564,66 @@ getHackageTarball pir@(PackageIdentifierRevision name ver _cfi) mtreeKey = do Just pair2 -> pure pair2 pc <- view pantryConfigL let urlPrefix = hscDownloadPrefix $ pcHackageSecurity pc - url = mconcat - [ urlPrefix - , "package/" - , T.pack $ Distribution.Text.display name - , "-" - , T.pack $ Distribution.Text.display ver - , ".tar.gz" - ] - package <- getArchivePackage - rpli - RawArchive - { raLocation = ALUrl url - , raHash = Just sha - , raSize = Just size - , raSubdir = T.empty -- no subdirs on Hackage - } - RawPackageMetadata - { rpmName = Just name - , rpmVersion = Just ver - , rpmTreeKey = Nothing -- with a revision cabal file will differ giving a different tree - , rpmCabal = Nothing -- cabal file in the tarball may be different! - } - + url = + mconcat + [ urlPrefix + , "package/" + , T.pack $ Distribution.Text.display name + , "-" + , T.pack $ Distribution.Text.display ver + , ".tar.gz" + ] + package <- + getArchivePackage + rpli + RawArchive + { raLocation = ALUrl url + , raHash = Just sha + , raSize = Just size + , raSubdir = T.empty -- no subdirs on Hackage + } + RawPackageMetadata + { rpmName = Just name + , rpmVersion = Just ver + , rpmTreeKey = Nothing -- with a revision cabal file will differ giving a different tree + , rpmCabal = Nothing -- cabal file in the tarball may be different! + } case packageTree package of TreeMap m -> do - let (PCCabalFile (TreeEntry _ ft)) = packageCabalEntry package + let ft = + case packageCabalEntry package of + PCCabalFile (TreeEntry _ ft') -> ft' + _ -> error "Impossible: Hackage does not support hpack" cabalEntry = TreeEntry cabalFileKey ft tree' = TreeMap $ Map.insert (cabalFileName name) cabalEntry m ident = PackageIdentifier name ver - - cabalBS <- withStorage $ do - let BlobKey sha' _ = cabalFileKey - mcabalBS <- loadBlobBySHA sha' - case mcabalBS of - Nothing -> error $ "Invariant violated, cabal file key: " ++ show cabalFileKey - Just bid -> loadBlobById bid - + cabalBS <- + withStorage $ do + let BlobKey sha' _ = cabalFileKey + mcabalBS <- loadBlobBySHA sha' + case mcabalBS of + Nothing -> + error $ + "Invariant violated, cabal file key: " ++ show cabalFileKey + Just bid -> loadBlobById bid (_warnings, gpd) <- rawParseGPD (Left rpli) cabalBS let gpdIdent = Cabal.package $ Cabal.packageDescription gpd - when (ident /= gpdIdent) $ throwIO $ - MismatchedCabalFileForHackage pir Mismatch - { mismatchExpected = ident - , mismatchActual = gpdIdent + when (ident /= gpdIdent) $ + throwIO $ + MismatchedCabalFileForHackage + pir + Mismatch {mismatchExpected = ident, mismatchActual = gpdIdent} + (tid, treeKey') <- + withStorage $ + storeTree rpli ident tree' (BFCabal (cabalFileName name) cabalEntry) + pure + HackageTarballResult + { htrPackage = + Package + { packageTreeKey = treeKey' + , packageTree = tree' + , packageIdent = ident + , packageCabalEntry = PCCabalFile cabalEntry + } + , htrFreshPackageInfo = Just (gpd, tid) } - - (_tid, treeKey') <- withStorage $ storeTree rpli ident tree' (BFCabal (cabalFileName name) cabalEntry) - pure Package - { packageTreeKey = treeKey' - , packageTree = tree' - , packageIdent = ident - , packageCabalEntry = PCCabalFile cabalEntry - } diff --git a/subs/pantry/src/Pantry/Internal/Stackage.hs b/subs/pantry/src/Pantry/Internal/Stackage.hs new file mode 100644 index 0000000000..1a76a2c5d9 --- /dev/null +++ b/subs/pantry/src/Pantry/Internal/Stackage.hs @@ -0,0 +1,51 @@ +-- | All types and functions exported from this module are for advanced usage +-- only. They are needed for stackage-server integration with pantry. +module Pantry.Internal.Stackage + ( module X + ) where + +import Pantry.Hackage as X + ( forceUpdateHackageIndex + , getHackageTarball + , HackageTarballResult(..) + ) +import Pantry.Storage as X + ( BlobId + , EntityField(..) + , HackageCabalId + , ModuleNameId + , PackageName + , PackageNameId + , Tree(..) + , TreeEntry(..) + , TreeEntryId + , TreeId + , Unique(..) + , Version + , VersionId + , getBlobKey + , getPackageNameById + , getPackageNameId + , getTreeForKey + , getVersionId + , loadBlobById + , migrateAll + , treeCabal + , Key(unBlobKey) + ) +import Pantry.Types as X + ( ModuleNameP(..) + , PackageNameP(..) + , PantryConfig(..) + , SafeFilePath + , Storage(..) + , VersionP(..) + , mkSafeFilePath + , packageNameString + , packageTreeKey + , parsePackageName + , parseVersion + , parseVersionThrowing + , unSafeFilePath + , versionString + ) diff --git a/subs/pantry/src/Pantry/Storage.hs b/subs/pantry/src/Pantry/Storage.hs index 539d28c5df..eeecb8d75f 100644 --- a/subs/pantry/src/Pantry/Storage.hs +++ b/subs/pantry/src/Pantry/Storage.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TemplateHaskell #-} @@ -9,10 +10,12 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} module Pantry.Storage ( SqlBackend , initStorage , withStorage + , migrateAll , storeBlob , loadBlob , loadBlobById @@ -33,6 +36,9 @@ module Pantry.Storage , loadTree , storeHPack , loadPackageById + , getPackageNameById + , getPackageNameId + , getVersionId , getTreeForKey , storeHackageTree , loadHackageTree @@ -51,14 +57,24 @@ module Pantry.Storage , getSnapshotCacheId , storeSnapshotModuleCache , loadExposedModulePackages - + , PackageNameId + , PackageName + , VersionId + , ModuleNameId + , Version + , Unique(..) + , EntityField(..) -- avoid warnings , BlobId + , Key(unBlobKey) , HackageCabalId + , HackageCabal(..) , HackageTarballId , CacheUpdateId , FilePathId + , Tree(..) , TreeId + , TreeEntry(..) , TreeEntryId , ArchiveCacheId , RepoCacheId @@ -243,27 +259,46 @@ withStorage withStorage action = flip SQLite.withStorage_ action =<< view (P.pantryConfigL.to P.pcStorage) +-- | This is a helper type to distinguish db queries between different rdbms backends. The important +-- part is that the affects described in this data type should be semantically equivalent between +-- the supported engines. +data RdbmsActions env a = RdbmsActions + { raSqlite :: !(ReaderT SqlBackend (RIO env) a) + -- ^ A query that is specific to SQLite + , raPostgres :: !(ReaderT SqlBackend (RIO env) a) + -- ^ A query that is specific to PostgreSQL + } + +-- | This function provides a way to create queries supported by multiple sql backends. +rdbmsAwareQuery + :: RdbmsActions env a + -> ReaderT SqlBackend (RIO env) a +rdbmsAwareQuery RdbmsActions {raSqlite, raPostgres} = do + rdbms <- connRDBMS <$> ask + case rdbms of + "postgresql" -> raPostgres + "sqlite" -> raSqlite + _ -> error $ "rdbmsAwareQuery: unsupported rdbms '" ++ T.unpack rdbms ++ "'" + + +getPackageNameById + :: PackageNameId + -> ReaderT SqlBackend (RIO env) (Maybe P.PackageName) +getPackageNameById = fmap (unPackageNameP . packageNameName <$>) . get + + getPackageNameId - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName + :: P.PackageName -> ReaderT SqlBackend (RIO env) PackageNameId getPackageNameId = fmap (either entityKey id) . insertBy . PackageName . PackageNameP getVersionId - :: (HasPantryConfig env, HasLogFunc env) - => P.Version + :: P.Version -> ReaderT SqlBackend (RIO env) VersionId getVersionId = fmap (either entityKey id) . insertBy . Version . VersionP -getFilePathId - :: (HasPantryConfig env, HasLogFunc env) - => SafeFilePath - -> ReaderT SqlBackend (RIO env) FilePathId -getFilePathId = fmap (either entityKey id) . insertBy . FilePath - storeBlob - :: (HasPantryConfig env, HasLogFunc env) - => ByteString + :: ByteString -> ReaderT SqlBackend (RIO env) (BlobId, BlobKey) storeBlob bs = do let sha = SHA256.hashBytes bs @@ -271,16 +306,31 @@ storeBlob bs = do keys <- selectKeysList [BlobSha ==. sha] [] key <- case keys of - [] -> insert Blob - { blobSha = sha - , blobSize = size - , blobContents = bs - } + [] -> + rdbmsAwareQuery + RdbmsActions + { raSqlite = + insert Blob {blobSha = sha, blobSize = size, blobContents = bs} + , raPostgres = + do rawExecute + "INSERT INTO blob(sha, size, contents) VALUES (?, ?, ?) ON CONFLICT DO NOTHING" + [ toPersistValue sha + , toPersistValue size + , toPersistValue bs + ] + rawSql + "SELECT blob.id FROM blob WHERE blob.sha = ?" + [toPersistValue sha] >>= \case + [Single key] -> pure key + _ -> + error + "soreBlob: there was a critical problem storing a blob." + } key:rest -> assert (null rest) (pure key) pure (key, P.BlobKey sha size) -loadBlob - :: (HasPantryConfig env, HasLogFunc env) +loadBlob :: + HasLogFunc env => BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString) loadBlob (P.BlobKey sha size) = do @@ -295,27 +345,17 @@ loadBlob (P.BlobKey sha size) = do ". Expected size: " <> display size <> ". Actual size: " <> display (blobSize bt)) -loadBlobBySHA - :: (HasPantryConfig env, HasLogFunc env) - => SHA256 - -> ReaderT SqlBackend (RIO env) (Maybe BlobId) +loadBlobBySHA :: SHA256 -> ReaderT SqlBackend (RIO env) (Maybe BlobId) loadBlobBySHA sha = listToMaybe <$> selectKeysList [BlobSha ==. sha] [] -loadBlobById - :: (HasPantryConfig env, HasLogFunc env) - => BlobId - -> ReaderT SqlBackend (RIO env) ByteString +loadBlobById :: BlobId -> ReaderT SqlBackend (RIO env) ByteString loadBlobById bid = do mbt <- get bid case mbt of Nothing -> error "loadBlobById: ID doesn't exist in database" Just bt -> pure $ blobContents bt - -getBlobKey - :: (HasPantryConfig env, HasLogFunc env) - => BlobId - -> ReaderT SqlBackend (RIO env) BlobKey +getBlobKey :: BlobId -> ReaderT SqlBackend (RIO env) BlobKey getBlobKey bid = do res <- rawSql "SELECT sha, size FROM blob WHERE id=?" [toPersistValue bid] case res of @@ -323,19 +363,13 @@ getBlobKey bid = do [(Single sha, Single size)] -> pure $ P.BlobKey sha size _ -> error $ "getBlobKey failed due to non-unique ID: " ++ show (bid, res) -getBlobId - :: (HasPantryConfig env, HasLogFunc env) - => BlobKey - -> ReaderT SqlBackend (RIO env) (Maybe BlobId) +getBlobId :: BlobKey -> ReaderT SqlBackend (RIO env) (Maybe BlobId) getBlobId (P.BlobKey sha size) = do res <- rawSql "SELECT id FROM blob WHERE sha=? AND size=?" [toPersistValue sha, toPersistValue size] pure $ listToMaybe $ map unSingle res -loadURLBlob - :: (HasPantryConfig env, HasLogFunc env) - => Text - -> ReaderT SqlBackend (RIO env) (Maybe ByteString) +loadURLBlob :: Text -> ReaderT SqlBackend (RIO env) (Maybe ByteString) loadURLBlob url = do ment <- rawSql "SELECT blob.contents\n\ @@ -348,11 +382,7 @@ loadURLBlob url = do [] -> pure Nothing (Single bs) : _ -> pure $ Just bs -storeURLBlob - :: (HasPantryConfig env, HasLogFunc env) - => Text - -> ByteString - -> ReaderT SqlBackend (RIO env) () +storeURLBlob :: Text -> ByteString -> ReaderT SqlBackend (RIO env) () storeURLBlob url blob = do (blobId, _) <- storeBlob blob now <- getCurrentTime @@ -362,17 +392,11 @@ storeURLBlob url blob = do , urlBlobTime = now } -clearHackageRevisions - :: (HasPantryConfig env, HasLogFunc env) - => ReaderT SqlBackend (RIO env) () +clearHackageRevisions :: ReaderT SqlBackend (RIO env) () clearHackageRevisions = deleteWhere ([] :: [Filter HackageCabal]) -storeHackageRevision - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName - -> P.Version - -> BlobId - -> ReaderT SqlBackend (RIO env) () +storeHackageRevision :: + P.PackageName -> P.Version -> BlobId -> ReaderT SqlBackend (RIO env) () storeHackageRevision name version key = do nameid <- getPackageNameId name versionid <- getVersionId version @@ -389,8 +413,7 @@ storeHackageRevision name version key = do } loadHackagePackageVersions - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName + :: P.PackageName -> ReaderT SqlBackend (RIO env) (Map P.Version (Map Revision BlobKey)) loadHackagePackageVersions name = do nameid <- getPackageNameId name @@ -407,8 +430,7 @@ loadHackagePackageVersions name = do (version, Map.singleton revision (P.BlobKey key size)) loadHackagePackageVersion - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName + :: P.PackageName -> P.Version -> ReaderT SqlBackend (RIO env) (Map Revision (BlobId, P.BlobKey)) loadHackagePackageVersion name version = do @@ -427,18 +449,13 @@ loadHackagePackageVersion name version = do (revision, (bid, P.BlobKey sha size)) loadLatestCacheUpdate - :: (HasPantryConfig env, HasLogFunc env) - => ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256)) + :: ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256)) loadLatestCacheUpdate = fmap go <$> selectFirst [] [Desc CacheUpdateTime] where go (Entity _ cu) = (cacheUpdateSize cu, cacheUpdateSha cu) -storeCacheUpdate - :: (HasPantryConfig env, HasLogFunc env) - => FileSize - -> SHA256 - -> ReaderT SqlBackend (RIO env) () +storeCacheUpdate :: FileSize -> SHA256 -> ReaderT SqlBackend (RIO env) () storeCacheUpdate size sha = do now <- getCurrentTime insert_ CacheUpdate @@ -448,8 +465,7 @@ storeCacheUpdate size sha = do } storeHackageTarballInfo - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName + :: P.PackageName -> P.Version -> SHA256 -> FileSize @@ -465,8 +481,7 @@ storeHackageTarballInfo name version sha size = do } loadHackageTarballInfo - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName + :: P.PackageName -> P.Version -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize)) loadHackageTarballInfo name version = do @@ -477,8 +492,7 @@ loadHackageTarballInfo name version = do go (Entity _ ht) = (hackageTarballSha ht, hackageTarballSize ht) storeCabalFile :: - (HasPantryConfig env, HasLogFunc env, HasProcessContext env) - => ByteString + ByteString -> P.PackageName -> ReaderT SqlBackend (RIO env) BlobId storeCabalFile cabalBS pkgName = do @@ -488,8 +502,7 @@ storeCabalFile cabalBS pkgName = do return bid loadFilePath :: - (HasPantryConfig env, HasLogFunc env) - => SafeFilePath + SafeFilePath -> ReaderT SqlBackend (RIO env) (Entity FilePath) loadFilePath path = do fp <- getBy $ UniqueSfp path @@ -500,18 +513,18 @@ loadFilePath path = do (T.unpack $ P.unSafeFilePath path) Just record -> return record -loadHPackTreeEntity :: (HasPantryConfig env, HasLogFunc env) => TreeId -> ReaderT SqlBackend (RIO env) (Entity TreeEntry) +loadHPackTreeEntity :: TreeId -> ReaderT SqlBackend (RIO env) (Entity TreeEntry) loadHPackTreeEntity tid = do filepath <- loadFilePath P.hpackSafeFilePath let filePathId :: FilePathId = entityKey filepath hpackTreeEntry <- - selectFirst [TreeEntryTree ==. tid, TreeEntryPath ==. filePathId] [] - hpackEntity <- - case hpackTreeEntry of - Nothing -> - error $ "loadHPackTreeEntity: No package.yaml file found in TreeEntry for TreeId: " ++ (show tid) - Just record -> return record - return hpackEntity + selectFirst [TreeEntryTree ==. tid, TreeEntryPath ==. filePathId] [] + case hpackTreeEntry of + Nothing -> + error $ + "loadHPackTreeEntity: No package.yaml file found in TreeEntry for TreeId: " ++ + show tid + Just record -> return record storeHPack :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) @@ -525,7 +538,7 @@ storeHPack rpli tid = do Nothing -> generateHPack rpli tid vid Just record -> return $ entityKey record -loadCabalBlobKey :: (HasPantryConfig env, HasLogFunc env) => HPackId -> ReaderT SqlBackend (RIO env) BlobKey +loadCabalBlobKey :: HPackId -> ReaderT SqlBackend (RIO env) BlobKey loadCabalBlobKey hpackId = do hpackRecord <- getJust hpackId getBlobKey $ hPackCabalBlob hpackRecord @@ -556,11 +569,39 @@ hpackVersionId :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => ReaderT SqlBackend (RIO env) VersionId hpackVersionId = do - hpackSoftwareVersion <- lift $ hpackVersion + hpackSoftwareVersion <- lift hpackVersion fmap (either entityKey id) $ insertBy $ Version {versionVersion = P.VersionP hpackSoftwareVersion} + +getFilePathId :: SafeFilePath -> ReaderT SqlBackend (RIO env) FilePathId +getFilePathId sfp = + selectKeysList [FilePathPath ==. sfp] [] >>= \case + [fpId] -> pure fpId + [] -> + rdbmsAwareQuery + RdbmsActions + { raSqlite = insert $ FilePath sfp + , raPostgres = + do rawExecute + "INSERT INTO file_path(path) VALUES (?) ON CONFLICT DO NOTHING" + [toPersistValue sfp] + rawSql + "SELECT id FROM file_path WHERE path = ?" + [toPersistValue sfp] >>= \case + [Single key] -> pure key + _ -> + error + "getFilePathId: there was a critical problem storing a blob." + } + _ -> + error $ + "getFilePathId: FilePath unique constraint key is violated for: " ++ fp + where + fp = T.unpack (P.unSafeFilePath sfp) + + storeTree :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => P.RawPackageLocationImmutable -- ^ for exceptions @@ -611,9 +652,7 @@ storeTree rpli (P.PackageIdentifier name version) tree@(P.TreeMap m) buildFile = P.BFCabal _ _ -> return () return (tid, pTreeKey) -getTree :: (HasPantryConfig env, HasLogFunc env) - => TreeId - -> ReaderT SqlBackend (RIO env) P.Tree +getTree :: TreeId -> ReaderT SqlBackend (RIO env) P.Tree getTree tid = do (mts :: Maybe Tree) <- get tid ts <- @@ -623,10 +662,7 @@ getTree tid = do Just ts -> pure ts loadTreeByEnt $ Entity tid ts -loadTree - :: (HasPantryConfig env, HasLogFunc env) - => P.TreeKey - -> ReaderT SqlBackend (RIO env) (Maybe P.Tree) +loadTree :: P.TreeKey -> ReaderT SqlBackend (RIO env) (Maybe P.Tree) loadTree key = do ment <- getTreeForKey key case ment of @@ -634,8 +670,7 @@ loadTree key = do Just ent -> Just <$> loadTreeByEnt ent getTreeForKey - :: (HasPantryConfig env, HasLogFunc env) - => TreeKey + :: TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)) getTreeForKey (P.TreeKey key) = do mbid <- getBlobId key @@ -672,8 +707,8 @@ loadPackageById rpli tid = do "loadPackageByid: invalid foreign key " ++ show (treeVersion ts) Just (Version (P.VersionP version)) -> pure version let ident = P.PackageIdentifier name version - (pentry, mtree) <- - case (treeCabal ts) of + (packageEntry, mtree) <- + case treeCabal ts of Just keyBlob -> do cabalKey <- getBlobKey keyBlob return @@ -700,17 +735,17 @@ loadPackageById rpli tid = do Package { packageTreeKey = P.TreeKey blobKey , packageTree = mtree - , packageCabalEntry = pentry + , packageCabalEntry = packageEntry , packageIdent = ident } -getHPackBlobKey :: (HasPantryConfig env, HasLogFunc env) => HPack -> ReaderT SqlBackend (RIO env) BlobKey +getHPackBlobKey :: HPack -> ReaderT SqlBackend (RIO env) BlobKey getHPackBlobKey hpackRecord = do let treeId = hPackTree hpackRecord hpackEntity <- loadHPackTreeEntity treeId getBlobKey (treeEntryBlob $ entityVal hpackEntity) -getHPackBlobKeyById :: (HasPantryConfig env, HasLogFunc env) => HPackId -> ReaderT SqlBackend (RIO env) BlobKey +getHPackBlobKeyById :: HPackId -> ReaderT SqlBackend (RIO env) BlobKey getHPackBlobKeyById hpackId = do hpackRecord <- getJust hpackId getHPackBlobKey hpackRecord @@ -731,7 +766,7 @@ getHPackCabalFile hpackRecord ts tmap cabalFile = do cbTreeEntry = P.TreeEntry cabalKey fileType hpackTreeEntry = P.TreeEntry hpackKey fileType tree = P.TreeMap $ Map.insert cabalFile cbTreeEntry tmap - return $ + return ( P.PCHpack $ P.PHpack { P.phOriginal = hpackTreeEntry @@ -740,10 +775,7 @@ getHPackCabalFile hpackRecord ts tmap cabalFile = do } , tree) -loadTreeByEnt - :: (HasPantryConfig env, HasLogFunc env) - => Entity Tree - -> ReaderT SqlBackend (RIO env) P.Tree +loadTreeByEnt :: Entity Tree -> ReaderT SqlBackend (RIO env) P.Tree loadTreeByEnt (Entity tid _t) = do entries <- rawSql "SELECT file_path.path, blob.sha, blob.size, tree_entry.type\n\ @@ -758,8 +790,7 @@ loadTreeByEnt (Entity tid _t) = do entries storeHackageTree - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName + :: P.PackageName -> P.Version -> BlobId -> P.TreeKey @@ -776,8 +807,7 @@ storeHackageTree name version cabal treeKey' = do [HackageCabalTree =. Just (entityKey ent)] loadHackageTreeKey - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName + :: P.PackageName -> P.Version -> SHA256 -> ReaderT SqlBackend (RIO env) (Maybe TreeKey) @@ -827,8 +857,7 @@ loadHackageTree rpli name ver bid = do Just tid -> Just <$> loadPackageById rpli tid storeArchiveCache - :: (HasPantryConfig env, HasLogFunc env) - => Text -- ^ URL + :: Text -- ^ URL -> Text -- ^ subdir -> SHA256 -> FileSize @@ -847,8 +876,7 @@ storeArchiveCache url subdir sha size treeKey' = do } loadArchiveCache - :: (HasPantryConfig env, HasLogFunc env) - => Text -- ^ URL + :: Text -- ^ URL -> Text -- ^ subdir -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, TreeId)] loadArchiveCache url subdir = map go <$> selectList @@ -860,8 +888,7 @@ loadArchiveCache url subdir = map go <$> selectList go (Entity _ ac) = (archiveCacheSha ac, archiveCacheSize ac, archiveCacheTree ac) storeRepoCache - :: (HasPantryConfig env, HasLogFunc env) - => Repo + :: Repo -> Text -- ^ subdir -> TreeId -> ReaderT SqlBackend (RIO env) () @@ -877,8 +904,7 @@ storeRepoCache repo subdir tid = do } loadRepoCache - :: (HasPantryConfig env, HasLogFunc env) - => Repo + :: Repo -> Text -- ^ subdir -> ReaderT SqlBackend (RIO env) (Maybe TreeId) loadRepoCache repo subdir = fmap (repoCacheTree . entityVal) <$> selectFirst @@ -889,11 +915,8 @@ loadRepoCache repo subdir = fmap (repoCacheTree . entityVal) <$> selectFirst ] [Desc RepoCacheTime] -storePreferredVersion - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName - -> Text - -> ReaderT SqlBackend (RIO env) () +storePreferredVersion :: + P.PackageName -> Text -> ReaderT SqlBackend (RIO env) () storePreferredVersion name p = do nameid <- getPackageNameId name ment <- getBy $ UniquePreferred nameid @@ -904,17 +927,14 @@ storePreferredVersion name p = do } Just (Entity pid _) -> update pid [PreferredVersionsPreferred =. p] -loadPreferredVersion - :: (HasPantryConfig env, HasLogFunc env) - => P.PackageName - -> ReaderT SqlBackend (RIO env) (Maybe Text) +loadPreferredVersion :: + P.PackageName -> ReaderT SqlBackend (RIO env) (Maybe Text) loadPreferredVersion name = do nameid <- getPackageNameId name fmap (preferredVersionsPreferred . entityVal) <$> getBy (UniquePreferred nameid) sinkHackagePackageNames - :: (HasPantryConfig env, HasLogFunc env) - => (P.PackageName -> Bool) + :: (P.PackageName -> Bool) -> ConduitT P.PackageName Void (ReaderT SqlBackend (RIO env)) a -> ReaderT SqlBackend (RIO env) a sinkHackagePackageNames predicate sink = do @@ -1018,9 +1038,7 @@ unpackTreeToDir rpli (toFilePath -> dir) (P.TreeMap m) = do perms <- getPermissions dest setPermissions dest $ setOwnerExecutable True perms -countHackageCabals - :: (HasPantryConfig env, HasLogFunc env) - => ReaderT SqlBackend (RIO env) Int +countHackageCabals :: ReaderT SqlBackend (RIO env) Int countHackageCabals = do res <- rawSql "SELECT COUNT(*)\n\ @@ -1032,29 +1050,25 @@ countHackageCabals = do pure n getSnapshotCacheByHash - :: (HasPantryConfig env, HasLogFunc env) - => SnapshotCacheHash + :: SnapshotCacheHash -> ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId) getSnapshotCacheByHash = fmap (fmap entityKey) . getBy . UniqueSnapshotCache . unSnapshotCacheHash getSnapshotCacheId - :: (HasPantryConfig env, HasLogFunc env) - => SnapshotCacheHash + :: SnapshotCacheHash -> ReaderT SqlBackend (RIO env) SnapshotCacheId getSnapshotCacheId = fmap (either entityKey id) . insertBy . SnapshotCache . unSnapshotCacheHash getModuleNameId - :: (HasPantryConfig env, HasLogFunc env) - => P.ModuleName + :: P.ModuleName -> ReaderT SqlBackend (RIO env) ModuleNameId getModuleNameId = fmap (either entityKey id) . insertBy . ModuleName . P.ModuleNameP storeSnapshotModuleCache - :: (HasPantryConfig env, HasLogFunc env) - => SnapshotCacheId + :: SnapshotCacheId -> Map P.PackageName (Set P.ModuleName) -> ReaderT SqlBackend (RIO env) () storeSnapshotModuleCache cache packageModules = @@ -1069,8 +1083,7 @@ storeSnapshotModuleCache cache packageModules = } loadExposedModulePackages - :: (HasPantryConfig env, HasLogFunc env) - => SnapshotCacheId + :: SnapshotCacheId -> P.ModuleName -> ReaderT SqlBackend (RIO env) [P.PackageName] loadExposedModulePackages cacheId mName = diff --git a/subs/pantry/src/Pantry/Tree.hs b/subs/pantry/src/Pantry/Tree.hs index 63625280bc..63f2e25808 100644 --- a/subs/pantry/src/Pantry/Tree.hs +++ b/subs/pantry/src/Pantry/Tree.hs @@ -10,7 +10,7 @@ import RIO import qualified RIO.Map as Map import qualified RIO.Text as T import qualified RIO.ByteString as B -import Pantry.Storage +import Pantry.Storage hiding (Tree, TreeEntry) import Pantry.Types import RIO.FilePath ((), takeDirectory) import RIO.Directory (createDirectoryIfMissing, setPermissions, getPermissions, setOwnerExecutable) diff --git a/subs/pantry/src/Pantry/Types.hs b/subs/pantry/src/Pantry/Types.hs index 43d66e5faf..15e97f7489 100644 --- a/subs/pantry/src/Pantry/Types.hs +++ b/subs/pantry/src/Pantry/Types.hs @@ -10,7 +10,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE MultiWayIf #-} module Pantry.Types ( PantryConfig (..) @@ -123,6 +122,7 @@ import qualified RIO.Set as Set import Data.Aeson (ToJSON (..), FromJSON (..), withText, FromJSONKey (..)) import Data.Aeson.Types (ToJSONKey (..) ,toJSONKeyText, Parser) import Data.Aeson.Extended +import Data.Aeson.Encoding.Internal (unsafeToEncoding) import Data.ByteString.Builder (toLazyByteString, byteString, wordDec) import Database.Persist import Database.Persist.Sql @@ -131,7 +131,7 @@ import qualified Pantry.SHA256 as SHA256 import qualified Distribution.Compat.ReadP as Parse import Distribution.CabalSpecVersion (CabalSpecVersion (..), cabalSpecLatest) import Distribution.Parsec.Common (PError (..), PWarning (..), showPos) -import Distribution.Types.PackageName (PackageName, unPackageName) +import Distribution.Types.PackageName (PackageName, unPackageName, mkPackageName) import Distribution.Types.VersionRange (VersionRange) import Distribution.PackageDescription (FlagName, unFlagName, GenericPackageDescription) import Distribution.Types.PackageId (PackageIdentifier (..)) @@ -206,8 +206,8 @@ newtype Revision = Revision Word -- whether a pool is used, and the default implementation in -- "Pantry.Storage" does not use a pool. data Storage = Storage - { withStorage_ :: (forall env a. HasLogFunc env => ReaderT SqlBackend (RIO env) a -> RIO env a) - , withWriteLock_ :: (forall env a. HasLogFunc env => RIO env a -> RIO env a) + { withStorage_ :: forall env a. HasLogFunc env => ReaderT SqlBackend (RIO env) a -> RIO env a + , withWriteLock_ :: forall env a. HasLogFunc env => RIO env a -> RIO env a } -- | Configuration value used by the entire pantry package. Create one @@ -484,9 +484,9 @@ data Repo = Repo -- -- @since 0.1.0.0 , repoSubdir :: !Text - -- ^ Subdirectory within the archive to get the package from. - -- - -- @since 0.1.0.0 + -- ^ Subdirectory within the archive to get the package from. + -- + -- @since 0.1.0.0 } deriving (Generic, Eq, Ord, Typeable) instance NFData Repo @@ -541,6 +541,7 @@ instance FromJSON (WithJSONWarnings HackageSecurityConfig) where hscIgnoreExpiry <- o ..:? "ignore-expiry" ..!= False pure HackageSecurityConfig {..} + -- | An environment which contains a 'PantryConfig'. -- -- @since 0.1.0.0 @@ -550,6 +551,7 @@ class HasPantryConfig env where -- @since 0.1.0.0 pantryConfigL :: Lens' env PantryConfig + -- | File size in bytes -- -- @since 0.1.0.0 @@ -588,7 +590,9 @@ instance FromJSON BlobKey where <*> o .: "size" newtype PackageNameP = PackageNameP { unPackageNameP :: PackageName } - deriving (Show) + deriving (Eq, Ord, Show, Read, NFData) +instance Display PackageNameP where + display = fromString . packageNameString . unPackageNameP instance PersistField PackageNameP where toPersistValue (PackageNameP pn) = PersistText $ T.pack $ packageNameString pn fromPersistValue v = do @@ -598,9 +602,20 @@ instance PersistField PackageNameP where Just pn -> Right $ PackageNameP pn instance PersistFieldSql PackageNameP where sqlType _ = SqlString - -newtype VersionP = VersionP Version - deriving (Show) +instance ToJSON PackageNameP where + toJSON (PackageNameP pn) = String $ T.pack $ packageNameString pn +instance FromJSON PackageNameP where + parseJSON = withText "PackageNameP" $ pure . PackageNameP . mkPackageName . T.unpack +instance ToJSONKey PackageNameP where + toJSONKey = + ToJSONKeyText + (T.pack . packageNameString . unPackageNameP) + (unsafeToEncoding . getUtf8Builder . display) +instance FromJSONKey PackageNameP where + fromJSONKey = FromJSONKeyText $ PackageNameP . mkPackageName . T.unpack + +newtype VersionP = VersionP { unVersionP :: Version } + deriving (Eq, Ord, Show, Read, NFData) instance PersistField VersionP where toPersistValue (VersionP v) = PersistText $ T.pack $ versionString v fromPersistValue v = do @@ -610,9 +625,20 @@ instance PersistField VersionP where Just ver -> Right $ VersionP ver instance PersistFieldSql VersionP where sqlType _ = SqlString - -newtype ModuleNameP = ModuleNameP ModuleName - deriving (Show) +instance Display VersionP where + display (VersionP v) = fromString $ versionString v +instance ToJSON VersionP where + toJSON (VersionP v) = String $ T.pack $ versionString v +instance FromJSON VersionP where + parseJSON = + withText "VersionP" $ + either (fail . displayException) (pure . VersionP) . parseVersionThrowing . T.unpack + +newtype ModuleNameP = ModuleNameP + { unModuleNameP :: ModuleName + } deriving (Eq, Ord, Show, NFData) +instance Display ModuleNameP where + display = fromString . moduleNameString . unModuleNameP instance PersistField ModuleNameP where toPersistValue (ModuleNameP mn) = PersistText $ T.pack $ moduleNameString mn fromPersistValue v = do @@ -1625,6 +1651,7 @@ data HpackExecutable -- ^ Executable at the provided path deriving (Show, Read, Eq, Ord) + -- | Which compiler a snapshot wants to use. The build tool may elect -- to do some fuzzy matching of versions (e.g., allowing different -- patch versions). @@ -1638,6 +1665,7 @@ data WantedCompiler !Version -- ^ GHCJS version followed by GHC version deriving (Show, Eq, Ord, Generic) + instance NFData WantedCompiler instance Display WantedCompiler where display (WCGhc vghc) = "ghc-" <> fromString (versionString vghc)