diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index 3638842..64bb45e 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -14,6 +14,10 @@ jobs: YAML_VER: 0.0.6 strategy: matrix: + ghc: + - '8.10.7' + cabal: + - '3.6.2.0' os: - ubuntu-latest steps: @@ -22,8 +26,22 @@ jobs: - uses: haskell/actions/setup@v1.2 with: - ghc-version: 8.10.7 - cabal-version: 3.6.2.0 + ghc-version: ${{ matrix.ghc }} + cabal-version: ${{ matrix.cabal }} + + - name: Cache Cabal + uses: actions/cache@v2 + env: + cache-name: cache-cabal + with: + path: | + ~/.cabal/store + ~/.cabal/packages + key: v2-${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.cabal }}-build-${{ hashFiles('cabal.project') }} + restore-keys: | + v2-${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.cabal }}-build-${{ hashFiles('cabal.project') }} + v2-${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.cabal }}-build- + v2-${{ runner.os }}-${{ matrix.ghc }} - name: create ~/.local/bin run: mkdir -p "$HOME/.local/bin" @@ -39,7 +57,7 @@ jobs: - name: Install ghcup-gen run: | - cabal install --installdir="$HOME/.local/bin" --overwrite-policy=always --install-method=copy ghcup + cabal install --installdir="$HOME/.local/bin" --overwrite-policy=always --install-method=copy ghcup-gen shell: bash - name: Check diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..a1e3592 --- /dev/null +++ b/.gitignore @@ -0,0 +1,17 @@ +.ghci +.vim +codex.tags +dist-newstyle/ +cabal.project.local +.stack-work/ +bin/ +/*.prof +/*.ps +/*.hp +tags +TAGS +/tmp/ +.entangled +release/ +releases/ +site/ diff --git a/README.md b/README.md index 3fd7234..56c32e0 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,6 @@ 3. copy-paste it 4. adjust the version, tags, changelog, source url 5. adjust the various bindist urls (make sure to also change the yaml anchors) -6. build the `ghcup-gen` binary from the [ghcup repo](https://gitlab.haskell.org/haskell/ghcup-hs) -7. run `ghcup-gen -- check -f ghcup-.yaml` -8. run `ghcup-gen -- check-tarballs -f ghcup-.yaml -u 'ghc-8\.10\.8'` +6. run `cabal run ghcup-gen -- check -f ghcup-.yaml` +7. run `cabal run ghcup-gen -- check-tarballs -f ghcup-.yaml -u 'ghc-8\.10\.8'` diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..6e6f749 --- /dev/null +++ b/cabal.project @@ -0,0 +1,29 @@ +packages: ./ghcup-gen/ghcup-gen.cabal + +package ghcup + tests: False + flags: -tui +no-exe + +source-repository-package + type: git + location: https://gitlab.haskell.org/haskell/ghcup-hs.git + tag: v0.1.17.3 + +constraints: http-io-streams -brotli, + any.Cabal ==3.6.2.0, + any.aeson >= 2.0.1.0 + +package libarchive + flags: -system-libarchive + +package aeson-pretty + flags: +lib-only + +package cabal-plan + flags: -exe + +package aeson + flags: +ordered-keymap + +allow-newer: base, ghc-prim, template-haskell, language-c + diff --git a/ghcup-gen/CHANGELOG.md b/ghcup-gen/CHANGELOG.md new file mode 100644 index 0000000..4c53fb0 --- /dev/null +++ b/ghcup-gen/CHANGELOG.md @@ -0,0 +1,6 @@ +# Revision history for ghcup-gen + +## 0.1.17.3 -- 2021-10-27 + +* First release (split from ghcup) + diff --git a/ghcup-gen/LICENSE b/ghcup-gen/LICENSE new file mode 100644 index 0000000..31afd6d --- /dev/null +++ b/ghcup-gen/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/ghcup-gen/Main.hs b/ghcup-gen/Main.hs new file mode 100644 index 0000000..8242d6c --- /dev/null +++ b/ghcup-gen/Main.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + + +module Main where + +import GHCup.Types +import GHCup.Errors +import GHCup.Platform +import GHCup.Utils.Dirs +import GHCup.Utils.Logger +import GHCup.Types.JSON ( ) + +import Control.Exception ( displayException ) +import Control.Monad.Trans.Reader ( runReaderT ) +import Control.Monad.IO.Class +import Data.Char ( toLower ) +import Data.Maybe +#if !MIN_VERSION_base(4,13,0) +import Data.Semigroup ( (<>) ) +#endif +import Options.Applicative hiding ( style ) +import Haskus.Utils.Variant.Excepts +import System.Console.Pretty +import System.Environment +import System.Exit +import System.IO ( stderr ) +import Text.Regex.Posix +import Validate +import Text.PrettyPrint.HughesPJClass ( prettyShow ) + +import qualified Data.Text.IO as T +import qualified Data.Text as T +import qualified Data.ByteString as B +import qualified Data.Yaml.Aeson as Y + + +data Options = Options + { optCommand :: Command + } + +data Command = ValidateYAML ValidateYAMLOpts + | ValidateTarballs ValidateYAMLOpts TarballFilter + + +data Input + = FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway + | StdInput + +fileInput :: Parser Input +fileInput = + FileInput + <$> strOption + (long "file" <> short 'f' <> metavar "FILENAME" <> help + "Input file to validate" + ) + +stdInput :: Parser Input +stdInput = flag' + StdInput + (short 'i' <> long "stdin" <> help "Validate from stdin (default)") + +inputP :: Parser Input +inputP = fileInput <|> stdInput + +data ValidateYAMLOpts = ValidateYAMLOpts + { vInput :: Maybe Input + } + +validateYAMLOpts :: Parser ValidateYAMLOpts +validateYAMLOpts = ValidateYAMLOpts <$> optional inputP + +tarballFilterP :: Parser TarballFilter +tarballFilterP = option readm $ + long "tarball-filter" <> short 'u' <> metavar "-" <> value def + <> help "Only check certain tarballs (format: -)" + where + def = TarballFilter (Right Nothing) (makeRegex ("" :: String)) + readm = do + s <- str + case span (/= '-') s of + (_, []) -> fail "invalid format, missing '-' after the tool name" + (t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] -> + pure (TarballFilter $ Right $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v) + (t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] -> + pure (TarballFilter $ Left tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v) + _ -> fail "invalid tool" + low = fmap toLower + + +opts :: Parser Options +opts = Options <$> com + +com :: Parser Command +com = subparser + ( command + "check" + ( ValidateYAML + <$> info (validateYAMLOpts <**> helper) + (progDesc "Validate the YAML") + ) + <> command + "check-tarballs" + (info + ((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper) + (progDesc "Validate all tarballs (download and checksum)") + ) + ) + + + +main :: IO () +main = do + no_color <- isJust <$> lookupEnv "NO_COLOR" + let loggerConfig = LoggerConfig { lcPrintDebug = True + , consoleOutter = T.hPutStr stderr + , fileOutter = \_ -> pure () + , fancyColors = not no_color + } + dirs <- liftIO getAllDirs + let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings loggerConfig + + pfreq <- ( + flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest + ) >>= \case + VRight r -> pure r + VLeft e -> do + flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e + liftIO $ exitWith (ExitFailure 2) + + let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig + + _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) + >>= \Options {..} -> case optCommand of + ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m) + ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m) + pure () + + where + withValidateYamlOpts vopts f = case vopts of + ValidateYAMLOpts { vInput = Nothing } -> + B.getContents >>= valAndExit f + ValidateYAMLOpts { vInput = Just StdInput } -> + B.getContents >>= valAndExit f + ValidateYAMLOpts { vInput = Just (FileInput file) } -> + B.readFile file >>= valAndExit f + valAndExit f contents = do + (GHCupInfo _ av gt) <- case Y.decodeEither' contents of + Right r -> pure r + Left e -> die (color Red $ displayException e) + f av gt + >>= exitWith diff --git a/ghcup-gen/Validate.hs b/ghcup-gen/Validate.hs new file mode 100644 index 0000000..91bb612 --- /dev/null +++ b/ghcup-gen/Validate.hs @@ -0,0 +1,280 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Validate where + +import GHCup +import GHCup.Download +import GHCup.Errors +import GHCup.Types +import GHCup.Types.Optics +import GHCup.Utils +import GHCup.Utils.Logger +import GHCup.Utils.Version.QQ + +import Codec.Archive +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Reader.Class +import Control.Monad.Trans.Class ( lift ) +import Control.Monad.Trans.Reader ( runReaderT ) +import Control.Monad.Trans.Resource ( runResourceT + , MonadUnliftIO + ) +import Data.Containers.ListUtils ( nubOrd ) +import Data.IORef +import Data.List +import Data.Versions +import Haskus.Utils.Variant.Excepts +import Optics +import System.FilePath +import System.Exit +import Text.ParserCombinators.ReadP +import Text.PrettyPrint.HughesPJClass ( prettyShow ) +import Text.Regex.Posix + +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import qualified Data.Version as V + + +data ValidationError = InternalError String + deriving Show + +instance Exception ValidationError + + +addError :: (MonadReader (IORef Int) m, MonadIO m, Monad m) => m () +addError = do + ref <- ask + liftIO $ modifyIORef ref (+ 1) + + +validate :: (Monad m, MonadReader env m, HasLog env, MonadThrow m, MonadIO m, MonadUnliftIO m) + => GHCupDownloads + -> M.Map GlobalTool DownloadInfo + -> m ExitCode +validate dls _ = do + ref <- liftIO $ newIORef 0 + + -- verify binary downloads -- + flip runReaderT ref $ do + -- unique tags + forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t + + -- required platforms + forM_ (M.toList dls) $ \(t, versions) -> + forM_ (M.toList versions) $ \(v, vi) -> + forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do + checkHasRequiredPlatforms t v (_viTags vi) arch (M.keys pspecs) + + checkGHCVerIsValid + forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t + _ <- checkGHCHasBaseVersion + + -- exit + e <- liftIO $ readIORef ref + if e > 0 + then pure $ ExitFailure e + else do + lift $ logInfo "All good" + pure ExitSuccess + where + checkHasRequiredPlatforms t v tags arch pspecs = do + let v' = prettyVer v + arch' = prettyShow arch + when (Linux UnknownLinux `notElem` pspecs) $ do + lift $ logError $ + "Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' + addError + when ((Darwin `notElem` pspecs) && arch == A_64) $ do + lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' + addError + when ((FreeBSD `notElem` pspecs) && arch == A_64) $ lift $ logWarn $ + "FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' + when (Windows `notElem` pspecs && arch == A_64) $ do + lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' + addError + + -- alpine needs to be set explicitly, because + -- we cannot assume that "Linux UnknownLinux" runs on Alpine + -- (although it could be static) + when (Linux Alpine `notElem` pspecs) $ + case t of + GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError + Cabal | v > [vver|2.4.1.0|] + , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError + GHC | Latest `elem` tags || Recommended `elem` tags + , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) + _ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch) + + checkUniqueTags tool = do + let allTags = _viTags =<< M.elems (availableToolVersions dls tool) + let nonUnique = + fmap fst + . filter (\(_, b) -> not b) + <$> ( mapM + (\case + [] -> throwM $ InternalError "empty inner list" + (t : ts) -> + pure $ (t, ) (not (isUniqueTag t) || null ts) + ) + . group + . sort + $ allTags + ) + case join nonUnique of + [] -> pure () + xs -> do + lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs) + addError + where + isUniqueTag Latest = True + isUniqueTag Recommended = True + isUniqueTag Old = False + isUniqueTag Prerelease = False + isUniqueTag (Base _) = False + isUniqueTag (UnknownTag _) = False + + checkGHCVerIsValid = do + let ghcVers = toListOf (ix GHC % to M.keys % folded) dls + forM_ ghcVers $ \v -> + case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of + [_] -> pure () + _ -> do + lift $ logError $ "GHC version " <> prettyVer v <> " is not valid" + addError + + -- a tool must have at least one of each mandatory tags + checkMandatoryTags tool = do + let allTags = _viTags =<< M.elems (availableToolVersions dls tool) + forM_ [Latest, Recommended] $ \t -> case t `elem` allTags of + False -> do + lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool) + addError + True -> pure () + + -- all GHC versions must have a base tag + checkGHCHasBaseVersion = do + let allTags = M.toList $ availableToolVersions dls GHC + forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of + False -> do + lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver + addError + True -> pure () + + isBase (Base _) = True + isBase _ = False + +data TarballFilter = TarballFilter + { tfTool :: Either GlobalTool (Maybe Tool) + , tfVersion :: Regex + } + +validateTarballs :: ( Monad m + , MonadReader env m + , HasLog env + , HasDirs env + , HasSettings env + , MonadThrow m + , MonadIO m + , MonadUnliftIO m + , MonadMask m + , Alternative m + , MonadFail m + ) + => TarballFilter + -> GHCupDownloads + -> M.Map GlobalTool DownloadInfo + -> m ExitCode +validateTarballs (TarballFilter etool versionRegex) dls gt = do + ref <- liftIO $ newIORef 0 + + -- download/verify all tarballs + let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool + let gdlis = nubOrd $ gt ^.. each + let allDls = either (const gdlis) (const dlis) etool + when (null allDls) $ logError "no tarballs selected by filter" *> runReaderT addError ref + forM_ allDls (downloadAll ref) + + -- exit + e <- liftIO $ readIORef ref + if e > 0 + then pure $ ExitFailure e + else do + logInfo "All good" + pure ExitSuccess + + where + downloadAll :: ( MonadUnliftIO m + , MonadIO m + , MonadReader env m + , HasLog env + , HasDirs env + , HasSettings env + , MonadCatch m + , MonadMask m + , MonadThrow m + ) + => IORef Int + -> DownloadInfo + -> m () + downloadAll ref dli = do + r <- runResourceT + . runE @'[DigestError + , GPGError + , DownloadFailed + , UnknownArchive + , ArchiveResult + ] + $ do + case etool of + Right (Just GHCup) -> do + tmpUnpack <- lift mkGhcupTmpDir + _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False + pure Nothing + Right _ -> do + p <- liftE $ downloadCached dli Nothing + fmap (Just . head . splitDirectories . head) + . liftE + . getArchiveFiles + $ p + Left ShimGen -> do + tmpUnpack <- lift mkGhcupTmpDir + _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False + pure Nothing + case r of + VRight (Just basePath) -> do + case _dlSubdir dli of + Just (RealDir prel) -> do + logInfo + $ " verifying subdir: " <> T.pack prel + when (basePath /= prel) $ do + logError $ + "Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath + runReaderT addError ref + Just (RegexDir regexString) -> do + logInfo $ + "verifying subdir (regex): " <> T.pack regexString + let regex = makeRegexOpts + compIgnoreCase + execBlank + regexString + unless (match regex basePath) $ do + logError $ + "Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath + runReaderT addError ref + Nothing -> pure () + VRight Nothing -> pure () + VLeft e -> do + logError $ + "Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e) + runReaderT addError ref diff --git a/ghcup-gen/ghcup-gen.cabal b/ghcup-gen/ghcup-gen.cabal new file mode 100644 index 0000000..6b9ee7c --- /dev/null +++ b/ghcup-gen/ghcup-gen.cabal @@ -0,0 +1,65 @@ +cabal-version: 3.0 +name: ghcup-gen +version: 0.1.17.3 +license: LGPL-3.0-only +license-file: LICENSE +copyright: Julian Ospald 2020 +maintainer: hasufell@posteo.de +author: Julian Ospald +homepage: https://github.com/haskell/ghcup-metadata +bug-reports: https://github.com/haskell/ghcup-metadata/issues +synopsis: ghcup-gen dev tool +description: Dev tool for handling ghcup metadata + +category: System +build-type: Simple +extra-doc-files: + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/haskell/ghcup-metadata.git + +executable ghcup-gen + main-is: Main.hs + other-modules: Validate + default-language: Haskell2010 + default-extensions: + DeriveGeneric + LambdaCase + MultiWayIf + NamedFieldPuns + PackageImports + QuasiQuotes + RecordWildCards + ScopedTypeVariables + StrictData + TupleSections + TypeApplications + TypeFamilies + ViewPatterns + + ghc-options: + -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns + -fwarn-incomplete-record-updates -threaded + + build-depends: + , base >=4.13 && <5 + , bytestring ^>=0.10 + , containers ^>=0.6 + , filepath ^>=1.4.2.1 + , ghcup ^>=0.1.17.3 + , haskus-utils-variant >=3.0 && <3.2 + , libarchive ^>=3.0.3.0 + , mtl ^>=2.2 + , optics ^>=0.4 + , optparse-applicative >=0.15.1.0 && <0.17 + , pretty ^>=1.1.3.1 + , pretty-terminal ^>=0.1.0.0 + , regex-posix ^>=0.96 + , resourcet ^>=1.2.2 + , safe-exceptions ^>=0.1 + , text ^>=1.2.4.0 + , transformers ^>=0.5 + , versions >=4.0.1 && <5.1 + , yaml-streamly ^>=0.12.0