Bump to 0.1.17.2

Fixes #253

.gitlab-ci.yml

@@ -49,6 +49,7 @@ variables:
     OS: "LINUX"
     ARCH: "ARM"
     CABAL_DIR: "$CI_PROJECT_DIR/cabal"
+  retry: 2
 
 .linux:aarch64:
   image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV"
@@ -75,9 +76,17 @@ variables:
     ARCH: "ARM64"
     CABAL_DIR: "$CI_PROJECT_DIR/cabal"
 
-.freebsd:
+.freebsd13:
   tags:
-    - x86_64-freebsd
+    - x86_64-freebsd13
+  variables:
+    OS: "FREEBSD"
+    ARCH: "64"
+    CABAL_DIR: "$CI_PROJECT_DIR/cabal"
+
+.freebsd12:
+  tags:
+    - x86_64-freebsd12
   variables:
     OS: "FREEBSD"
     ARCH: "64"
@@ -90,6 +99,7 @@ variables:
     OS: "WINDOWS"
     ARCH: "64"
     CABAL_DIR: "$CI_PROJECT_DIR/cabal"
+  retry: 2
 
 .root_cleanup:
   after_script:
@@ -99,7 +109,7 @@ variables:
   script:
     - bash ./.gitlab/script/ghcup_version.sh
   variables:
-    JSON_VERSION: "0.0.7"
+    JSON_VERSION: "0.0.6"
   artifacts:
     expire_in: 2 week
     paths:
@@ -173,10 +183,18 @@ variables:
     runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
     runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1
 
-.test_ghcup_version:freebsd:
+.test_ghcup_version:freebsd12:
   extends:
     - .test_ghcup_version
-    - .freebsd
+    - .freebsd12
+    - .root_cleanup
+  before_script:
+    - ./.gitlab/before_script/freebsd/install_deps.sh
+
+.test_ghcup_version:freebsd13:
+  extends:
+    - .test_ghcup_version
+    - .freebsd13
     - .root_cleanup
   before_script:
     - ./.gitlab/before_script/freebsd/install_deps.sh
@@ -207,7 +225,7 @@ variables:
   only:
     - tags
   variables:
-    JSON_VERSION: "0.0.7"
+    JSON_VERSION: "0.0.6"
 
 ######## stack test ########
 
@@ -263,6 +281,23 @@ test:linux:
     CABAL_VERSION: "3.4.0.0"
   needs: []
 
+test:linux:hls:
+  stage: test
+  extends:
+    - .test_ghcup_version
+    - .debian
+  variables:
+    GHC_VERSION: "8.10.7"
+    HLS_TARGET_VERSION: "1.4.0"
+    CABAL_VERSION: "3.6.0.0"
+  needs: []
+  when: manual
+  allow_failure: true
+  before_script:
+    - ./.gitlab/before_script/linux/install_deps.sh
+  script:
+    - ./.gitlab/script/ghcup_hls.sh
+
 test:linux:cross-armv7:
   stage: test
   extends:
@@ -355,9 +390,19 @@ test:mac:aarch64:
 
 ######## freebsd test ########
 
-test:freebsd:
+test:freebsd12:
   stage: test
-  extends: .test_ghcup_version:freebsd
+  extends: .test_ghcup_version:freebsd12
+  variables:
+    GHC_VERSION: "8.10.4"
+    CABAL_VERSION: "3.4.0.0"
+  allow_failure: true # freebsd runners are unreliable
+  when: manual
+  needs: []
+
+test:freebsd13:
+  stage: test
+  extends: .test_ghcup_version:freebsd13
   variables:
     GHC_VERSION: "8.10.4"
     CABAL_VERSION: "3.4.0.0"
@@ -491,11 +536,26 @@ release:darwin:aarch64:
 
 ######## freebsd release ########
 
-release:freebsd:
+release:freebsd12:
   stage: release
-  needs: ["test:freebsd"]
+  needs: ["test:freebsd12"]
   extends:
-    - .freebsd
+    - .freebsd12
+    - .release_ghcup
+    - .root_cleanup
+  before_script:
+    - ./.gitlab/before_script/freebsd/install_deps.sh
+  variables:
+    ARTIFACT: "x86_64-portbld-freebsd-ghcup"
+    GHC_VERSION: "8.10.6"
+    CABAL_VERSION: "3.4.0.0"
+  allow_failure: true
+
+release:freebsd13:
+  stage: release
+  needs: ["test:freebsd13"]
+  extends:
+    - .freebsd13
     - .release_ghcup
     - .root_cleanup
   before_script:

.gitlab/before_script/freebsd/install_deps.sh

@@ -11,9 +11,9 @@ mkdir -p "${TMPDIR}"
 curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
 chmod +x ghcup-bin
 
-./ghcup-bin upgrade -i -f
+./ghcup-bin -v upgrade -i -f
-./ghcup-bin install ${GHC_VERSION}
+./ghcup-bin -v install ${GHC_VERSION}
-./ghcup-bin set ${GHC_VERSION}
+./ghcup-bin -v set ${GHC_VERSION}
-./ghcup-bin install-cabal ${CABAL_VERSION}
+./ghcup-bin -v install-cabal ${CABAL_VERSION}
 
 exit 0

.gitlab/before_script/linux/install_deps.sh

@@ -7,67 +7,21 @@ set -eux
 mkdir -p "${TMPDIR}"
 
 sudo apt-get update -y
-sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https
+sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential
 
 if [ "${CROSS}" = "arm-linux-gnueabihf" ] ; then
-	sudo apt-get install -y autoconf build-essential gcc-arm-linux-gnueabihf
+	sudo apt-get install -y gcc-arm-linux-gnueabihf
 	sudo dpkg --add-architecture armhf
 	sudo apt-get update -y
 	sudo apt-get install -y libncurses-dev:armhf
 fi
 
-case "${ARCH}" in
+export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
-	ARM*)
+export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
-		case "${ARCH}" in
+export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
-			"ARM")
+export BOOTSTRAP_HASKELL_VERBOSE=1
-				ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-armv7-deb10-linux.tar.xz
-				cabal_url=home.smart-cactus.org/~ben/cabal-install-${CABAL_VERSION}-armv7-linux-bootstrapped.tar.xz
-				;;
-			"ARM64")
-				ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-aarch64-deb10-linux.tar.xz
-				cabal_url=https://downloads.haskell.org/~cabal/cabal-install-${CABAL_VERSION}/cabal-install-${CABAL_VERSION}-aarch64-ubuntu-18.04.tar.xz
-				;;
-			*)
-				exit 1 ;;
-		esac
 
-		mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
+curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
 
-		curl -O "${ghc_url}"
+rm "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
-		tar -xf ghc-*.tar.*
-		cd ghc-${GHC_VERSION}
-		./configure --prefix="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}
-		make install
-		for i in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}/bin/*-${GHC_VERSION} ; do
-			ln -s "${i}" "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/${i##*/}
-		done
-		for x in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/*-${GHC_VERSION} ; do
-			ln -s ${x##*/} ${x%-${GHC_VERSION}}
-		done
-		cd ..
-		rm -rf ghc-${GHC_VERSION} ghc-*.tar.*
-		unset x i
-
-		mkdir cabal-install
-		cd cabal-install
-		curl -O "${cabal_url}"
-		tar -xf cabal-install-*
-		mv cabal "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/cabal
-		cd ..
-		rm -rf cabal-install
-
-		;;
-	*) 
-		url=https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup
-
-		curl -sSfL "${url}" > ./ghcup-bin
-		chmod +x ghcup-bin
-
-		./ghcup-bin upgrade -i -f
-		./ghcup-bin install ghc ${GHC_VERSION}
-		./ghcup-bin set ghc ${GHC_VERSION}
-		./ghcup-bin install cabal ${CABAL_VERSION}
-
-		;;
-esac
 

.gitlab/ghcup_env

@@ -1,9 +1,11 @@
 if [ "${OS}" = "WINDOWS" ] ; then
 	export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
-	export PATH="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin:$CI_PROJECT_DIR/.local/bin:$PATH"
+	export GHCUP_BIN="$CI_PROJECT_DIR/ghcup/bin"
+	export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
 	export TMPDIR="$CI_PROJECT_DIR/tmp"
 else
 	export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
-	export PATH="$CI_PROJECT_DIR/.ghcup/bin:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
+	export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
+	export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
 	export TMPDIR="$CI_PROJECT_DIR/tmp"
 fi

.gitlab/script/ghcup_hls.sh

@@ -0,0 +1,51 @@
+#!/bin/sh
+
+set -eux
+
+. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
+
+mkdir -p "$CI_PROJECT_DIR"/.local/bin
+
+CI_PROJECT_DIR=$(pwd)
+
+ecabal() {
+	cabal "$@"
+}
+
+eghcup() {
+	ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
+}
+
+git describe --always
+
+### build
+
+ecabal update
+
+ecabal build -w ghc-${GHC_VERSION}
+cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
+
+### cleanup
+
+rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
+
+### manual cli based testing
+
+eghcup --numeric-version
+
+eghcup install ghc ${GHC_VERSION}
+eghcup set ghc ${GHC_VERSION}
+eghcup install cabal ${CABAL_VERSION}
+
+cabal --version
+
+eghcup debug-info
+
+eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
+
+[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
+
+# nuke
+eghcup nuke
+[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
+

.gitlab/script/ghcup_version.sh

@@ -101,6 +101,10 @@ eghcup install ghc ${GHC_VERSION}
 eghcup set ghc ${GHC_VERSION}
 eghcup install cabal ${CABAL_VERSION}
 [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
+eghcup unset cabal
+"$GHCUP_BIN"/cabal --version && exit || echo yes
+eghcup set cabal ${CABAL_VERSION}
+[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
 
 cabal --version
 
@@ -151,9 +155,13 @@ else
 	[ "$(ghc --numeric-version)" = "8.10.3" ]
 	eghcup set ${GHC_VERSION}
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
+	eghcup unset ghc
+    "$GHCUP_BIN"/ghc --numeric-version && exit || echo yes
+	eghcup set ${GHC_VERSION}
 	eghcup --offline rm 8.10.3
 	[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 
+
 	if [ "${OS}" = "DARWIN" ] ; then
 		eghcup install hls
 		$(eghcup whereis hls) --version
@@ -164,9 +172,13 @@ else
 		if [ "${ARCH}" = "64" ] ; then
 			eghcup install hls
 			haskell-language-server-wrapper --version
+			eghcup unset hls
+			"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit || echo yes
 
 			eghcup install stack
 			stack --version
+			eghcup unset hls
+			"$GHCUP_BIN"/stack --version && exit || echo yes
 		fi
 	fi
 fi

README.md

@@ -10,16 +10,18 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
 [![Join the chat at Matrix.org](https://img.shields.io/matrix/haskell-tooling:matrix.org?label=chat%20on%20matrix.org)](https://app.element.io/#/room/#haskell-tooling:matrix.org)
 [![Join the chat at Discord](https://img.shields.io/discord/280033776820813825?label=chat%20on%20discord)](https://discord.gg/pKYf3zDQU7)
 [![Join the chat at https://gitter.im/haskell/ghcup](https://badges.gitter.im/haskell/ghcup.svg)](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
+<a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a>
 
    * [Installation](#installation)
-     * [Simple bootstrap](#simple-bootstrap)
+     * [Supported platforms](#supported-platforms)
      * [Manual install](#manual-install)
      * [Vim integration](#vim-integration)
    * [Usage](#usage)
      * [Configuration](#configuration)
+     * [GPG verification](#gpg-verification)
      * [Manpages](#manpages)
      * [Shell-completion](#shell-completion)
-     * [Compiling from sourc](#compiling-from-source)
+     * [Compiling GHC from source](#compiling-ghc-from-source)
      * [XDG support](#xdg-support)
      * [Env variables](#env-variables)
      * [Installing custom bindists](#installing-custom-bindists)
@@ -34,9 +36,59 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
 
 ## Installation
 
-### Simple bootstrap
+Most users should follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/).
+Advanced users may want to perform a [manual installation](#manual-install).
 
-Follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/)
+### Supported platforms
+
+This list may not be exhaustive and specifies support for bindists only.
+
+| Platform | Architecture | ghcup | GHC | cabal | HLS | stack | 
+| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
+| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
+| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| Windows Server 2022 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| Windows WSL1 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
+| Windows WSL2 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| MacOS >=13 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| MacOS <13 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
+| MacOS | aarch64 | ✅ | ✅ | ✅ | ⚠️ | ❌ |
+| FreeBSD | amd64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
+| Linux generic | x86 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| Linux generic | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
+| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
+| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
+
+#### Windows 7
+
+May or may not work, several issues:
+
+* https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140
+* https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197
+
+#### WSL1
+
+Unsupported. GHC may or may not work. Upgrade to WSL2.
+
+#### MacOS <13
+
+Not supported. Would require separate binaries, since >=13 binaries are incompatible.
+Please upgrade.
+
+#### MacOS aarch64
+
+HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet.
+
+#### FreeBSD
+
+Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
+HLS bindists are experimental.
+
+#### Linux ARMv7/AARCH64
+
+Lower availability of bindists. HLS only has experimental ones. Stack not supported currently.
 
 ### Manual install
 
@@ -95,6 +147,34 @@ explaining all possible configurations can be found in this repo: [config.yaml](
 
 Partial configuration is fine. Command line options always override the config file settings.
 
+### GPG verification
+
+GHCup supports verifying the GPG signature of the metadata file. The metadata file then contains SHA256 hashes of all downloads, so
+this is cryptographically secure.
+
+First, obtain the gpg key:
+
+```sh
+gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
+```
+
+Then verify the gpg key in one of these ways:
+
+1. find out where I live and visit me to do offline key signing
+2. figure out my mobile phone number and call me to verify the fingerprint
+3. more boring: contact me on Libera IRC (`maerwald`) and verify the fingerprint
+
+Once you've verified the key, you have to figure out if you trust me.
+
+If you trust me, then you can configure gpg in `~/.ghcup/config.yaml`:
+
+```yml
+gpg-setting: GPGLax # GPGStrict | GPGLax | GPGNone
+```
+
+In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning.
+You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
+
 ### Manpages
 
 For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
@@ -109,7 +189,7 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
 and make sure your bashrc sources the startup script
 (`/usr/share/bash-completion/bash_completion` on some distros).
 
-### Compiling from source
+### Compiling GHC from source
 
 Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
 for a list of all available options.
@@ -155,6 +235,7 @@ This is the complete list of env variables that change GHCup behavior:
 * `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
 * `GHCUP_CURL_OPTS`: additional options that can be passed to curl
 * `GHCUP_WGET_OPTS`: additional options that can be passed to wget
+* `GHCUP_GPG_OPTS`: additional options that can be passed to gpg
 * `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command
 * `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup
 

app/ghcup-gen/Main.hs

@@ -11,21 +11,23 @@
 module Main where
 
 import           GHCup.Types
-import           GHCup.Types.Optics
 import           GHCup.Errors
 import           GHCup.Platform
 import           GHCup.Utils.Dirs
+import           GHCup.Utils.Logger
 import           GHCup.Types.JSON               ( )
 
 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
@@ -114,12 +116,14 @@ com = subparser
 
 main :: IO ()
 main = do
-  let loggerConfig = LoggerConfig { lcPrintDebug = True
+  no_color <- isJust <$> lookupEnv "NO_COLOR"
-                                  , colorOutter  = T.hPutStr stderr
+  let loggerConfig = LoggerConfig { lcPrintDebug  = True
-                                  , rawOutter    = \_ -> pure ()
+                                  , consoleOutter = T.hPutStr stderr
+                                  , fileOutter    = \_ -> pure ()
+                                  , fancyColors   = not no_color
                                   }
   dirs <- liftIO getAllDirs
-  let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings loggerConfig
+  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
@@ -129,7 +133,7 @@ main = do
               flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
               liftIO $ exitWith (ExitFailure 2)
 
-  let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
+  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

app/ghcup-gen/Validate.hs

@@ -15,6 +15,7 @@ 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
@@ -229,6 +230,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
   downloadAll ref dli = do
     r <- runResourceT
       . runE @'[DigestError
+               , GPGError
                , DownloadFailed
                , UnknownArchive
                , ArchiveResult
@@ -237,7 +239,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
         case etool of
           Right (Just GHCup) -> do
             tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
+            _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
             pure Nothing
           Right _ -> do
             p <- liftE $ downloadCached dli Nothing
@@ -247,7 +249,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
               $ p
           Left ShimGen -> do
             tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
+            _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
             pure Nothing
     case r of
       VRight (Just basePath) -> do

app/ghcup/BrickMain.hs

@@ -13,9 +13,9 @@ module BrickMain where
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
-import           GHCup.Types.Optics  hiding ( getGHCupInfo )
 import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude ( decUTF8Safe )
 import           GHCup.Utils.File
 
@@ -43,7 +43,6 @@ import           Data.Vector                    ( Vector
 import           Data.Versions           hiding ( str )
 import           Haskus.Utils.Variant.Excepts
 import           Prelude                 hiding ( appendFile )
-import           System.Environment
 import           System.Exit
 import           System.IO.Unsafe
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -429,6 +428,7 @@ install' _ (_, ListResult {..}) = do
               , BuildFailed
               , TagNotFound
               , DigestError
+              , GPGError
               , DownloadFailed
               , DirNotEmpty
               , NoUpdate
@@ -440,19 +440,19 @@ install' _ (_, ListResult {..}) = do
       case lTool of
         GHC   -> do
           let vi = getVersionInfo lVer GHC dls
-          liftE $ installGHCBin lVer Nothing $> vi
+          liftE $ installGHCBin lVer Nothing False $> vi
         Cabal -> do
           let vi = getVersionInfo lVer Cabal dls
-          liftE $ installCabalBin lVer Nothing $> vi
+          liftE $ installCabalBin lVer Nothing False $> vi
         GHCup -> do
           let vi = snd <$> getLatest dls GHCup
           liftE $ upgradeGHCup Nothing False $> vi
         HLS   -> do
           let vi = getVersionInfo lVer HLS dls
-          liftE $ installHLSBin lVer Nothing $> vi
+          liftE $ installHLSBin lVer Nothing False $> vi
         Stack -> do
           let vi = getVersionInfo lVer Stack dls
-          liftE $ installStackBin lVer Nothing $> vi
+          liftE $ installStackBin lVer Nothing False $> vi
     )
     >>= \case
           VRight vi                         -> do
@@ -536,9 +536,10 @@ settings' :: IORef AppState
 {-# NOINLINE settings' #-}
 settings' = unsafePerformIO $ do
   dirs <- getAllDirs
-  let loggerConfig = LoggerConfig { lcPrintDebug = False
+  let loggerConfig = LoggerConfig { lcPrintDebug  = False
-                                  , colorOutter  = \_ -> pure ()
+                                  , consoleOutter = \_ -> pure ()
-                                  , rawOutter    = \_ -> pure ()
+                                  , fileOutter    = \_ -> pure ()
+                                  , fancyColors   = True
                                   }
   newIORef $ AppState (Settings { cache      = True
                                 , noVerify   = False
@@ -547,6 +548,8 @@ settings' = unsafePerformIO $ do
                                 , verbose    = False
                                 , urlSource  = GHCupURL
                                 , noNetwork  = False
+                                , gpgSetting = GPGNone
+                                , noColor    = False
                                 , ..
                                 })
                       dirs
@@ -562,13 +565,11 @@ brickMain :: AppState
 brickMain s = do
   writeIORef settings' s
 
-  no_color <- isJust <$> lookupEnv "NO_COLOR"
-
   eAppData <- getAppData (Just $ ghcupInfo s)
   case eAppData of
     Right ad ->
       defaultMain
-          (app (defaultAttributes no_color) (dimAttributes no_color))
+          (app (defaultAttributes (noColor $ settings s)) (dimAttributes (noColor $ settings s)))
           (BrickState ad
                     defaultAppSettings
                     (constructList ad defaultAppSettings Nothing)
@@ -591,7 +592,7 @@ getGHCupInfo = do
 
   r <-
     flip runReaderT settings
-    . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
+    . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
     $ liftE
     $ getDownloadsF
 

cabal.project

@@ -8,11 +8,6 @@ package ghcup
     tests: True
     flags: +tui
 
-source-repository-package
-    type: git
-    location: https://github.com/bgamari/terminal-size
-    tag: 34ea816bd63f75f800eedac12c6908c6f3736036
-
 source-repository-package
     type: git
     location: https://github.com/hasufell/libarchive

data/config.yaml

@@ -8,6 +8,10 @@ verbose: False
 keep-dirs: Errors  # Always | Never | Errors
 # Which downloader to use
 downloader: Curl   # Curl | Wget | Internal
+# whether to run in offline mode
+no-network: False
+# whether/how to do gpg verification
+gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
 
 # TUI key bindings,
 # see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key

data/metadata/ghcup-0.0.6.yaml

@@ -72,7 +72,6 @@ toolRequirements:
         '( >= 7 && < 8 )':
           distroPKGs:
           - gcc
-          - gcc-c++
           - gmp
           - gmp-devel
           - make
@@ -83,7 +82,6 @@ toolRequirements:
         unknown_versioning:
           distroPKGs:
           - gcc
-          - gcc-c++
           - gmp
           - gmp-devel
           - make
@@ -96,7 +94,6 @@ toolRequirements:
         unknown_versioning:
           distroPKGs:
           - gcc
-          - gcc-c++
           - gmp
           - gmp-devel
           - make
@@ -111,14 +108,15 @@ toolRequirements:
           - binutils-gold
           - curl
           - gcc
-          - g++
           - gmp-dev
-          - ncurses-dev
+          - libc-dev
           - libffi-dev
           - make
-          - xz
+          - musl-dev
-          - tar
+          - ncurses-dev
           - perl
+          - tar
+          - xz
           notes: ''
       Linux_UnknownLinux:
         unknown_versioning:
@@ -1495,6 +1493,7 @@ ghcupDownloads:
               dlHash: b823b58cae36fbac0741680ca7605180fa4cf4c6ae439123d282184b94d32fd6
     8.10.4:
       viTags:
+      - old
       - base-4.14.1.0
       viChangeLog: https://downloads.haskell.org/~ghc/8.10.4/docs/html/users_guide/8.10.4-notes.html
       viSourceDL:
@@ -1590,6 +1589,7 @@ ghcupDownloads:
               dlHash: 0d18ef83593272f6196a41cc3abdc48dfe5e14372db75d71ea19fe35320c4e81
     8.10.5:
       viTags:
+      - old
       - base-4.14.2.0
       viChangeLog: https://downloads.haskell.org/~ghc/8.10.5/docs/html/users_guide/8.10.5-notes.html
       viSourceDL:
@@ -1598,6 +1598,11 @@ ghcupDownloads:
         dlHash: f10941f16e4fbd98580ab5241b9271bb0851304560c4d5ca127e3b0e20e3076f
       viPostRemove: *ghc-post-remove
       viPreCompile: *ghc-pre-compile
+      viPostInstall: &ghc-8105-post-install |
+        GHC 8.10.5 and 8.10.6 have several issues on Darwin, e.g.
+          https://gitlab.haskell.org/ghc/ghc/-/issues/19950
+        Consider upgrading to 8.10.7 via
+          ghcup install ghc --set 8.10.7
       viArch:
         A_64:
           Linux_Debian:
@@ -1690,6 +1695,7 @@ ghcupDownloads:
               dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
     8.10.6:
       viTags:
+      - old
       - base-4.14.3.0
       viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
       viSourceDL:
@@ -1698,6 +1704,7 @@ ghcupDownloads:
         dlHash: 43afba72a533408b42c1492bd047b5e37e5f7204e41a5cedd3182cc841610ce9
       viPostRemove: *ghc-post-remove
       viPreCompile: *ghc-pre-compile
+      viPostInstall: *ghc-8105-post-install
       viArch:
         A_64:
           Linux_Debian:
@@ -2053,6 +2060,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/9.2.1-rc1/ghc-9.2.0.20210821-aarch64-deb10-linux.tar.xz
               dlSubdir: ghc-9.2.0.20210821
               dlHash: 289fc361be4a3199ac15449e30405a9831454811dd454e81eab73bfcdd2c4088
+          Darwin:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/9.2.1-rc1/ghc-9.2.0.20210821-aarch64-apple-darwin.tar.xz
+              dlSubdir: ghc-9.2.0.20210821-aarch64-apple-darwin
+              dlHash: 0d763fb619cfa32fa37c113c446e13bebc2215db5946e5fa8fd8400559cf4152
         A_ARM:
           Linux_UnknownLinux:
             unknown_versioning:
@@ -2170,9 +2182,7 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz
               dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93
     3.4.0.0:
-      viTags:
+      viTags: []
-      - Recommended
-      - Latest
       viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
       viArch:
         A_64:
@@ -2221,8 +2231,53 @@ ghcupDownloads:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
               dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
+    3.6.0.0:
+      viTags:
+      - Recommended
+      - Latest
+      viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.0.0.md
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux.tar.xz
+              dlHash: bfcb7350966dafe95051b5fc9fcb989c5708ab9e78191e71fc04647061668a11
+          Linux_Alpine:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux-alpine.tar.xz
+              dlHash: 3203d71b7ee87fc9dce74b452ae07f420afe8817b5e6f84e54798442f4ccdda8
+          Darwin:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-darwin.tar.xz
+              dlHash: 8e1367a4a1fc86ff0fd82ee057320a7b974595ba7999457b42035467ba06190c
+          FreeBSD:
+            '( >= 12 && < 13 )':
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd.tar.xz
+              dlHash: 56b5b37396c16a29f164a6963f24bd88f09e1d37448542ed61a683325f0a868b
+            '( >= 13 )':
+              dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd13.tar.xz
+              dlHash: a283aa498702a3e286aa08e004c2a389538cbb47ec7096a25682fb7d57f6bb7f
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-windows.zip
+              dlSubdir:
+              dlHash: 8222b49b6eac3d06aaa390bc688f467e8f949a38943567f46246f8320fd72ded
+        A_ARM64:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-aarch64-linux-deb10.tar.xz
+              dlHash: 534f71cd4e1d9758dc73066cc5733c5838874710aeb3aa88541de6c6d042d9ec
+          Darwin:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-aarch64-darwin-big-sur.tar.xz
+              dlHash: 7acf740946d996ede835edf68887e6b2f1e16d1b95e94054d266463f38d136d9
+        A_ARM:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz
+              dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e
   GHCup:
-    0.1.16.2:
+    0.1.17.1:
       viTags:
       - Recommended
       - Latest
@@ -2232,46 +2287,47 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-linux-ghcup-0.1.17.1
-              dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
+              dlHash: 2824687fe3965374f463ae49f9d8abd9d3d556a0f63880bc78b5ee02098ba142
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-apple-darwin-ghcup-0.1.17.1
-              dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
+              dlHash: 0dd4e5afc7d93bdef20ba16085ae9f2aa5e4acd6b34e75a3b31b1fcc8ea451a9
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-freebsd-ghcup-0.1.17.1
-              dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
+              dlHash: a480ba827c07ed50d9ab724bd80198722a85b7bb683c5bcc1e8b1df2be7ad0e5
           Windows:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-mingw64-ghcup-0.1.16.2.exe
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-mingw64-ghcup-0.1.17.1.exe
-              dlHash: ec78872a84213968c490675127b9aad2285980b747c68207801ae824b98c7948
+              dlHash: dabd8c545401b038407a01168a9fda977f17cb326f43c6b3129e76bee3b113d6
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/i386-linux-ghcup-0.1.17.1
-              dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
+              dlHash: 04ec4ffd8fab1931e53f70beb3497770b42f4d37d7469c1973a0eeeccd5e8989
           Linux_Alpine:
             unknown_versioning: *ghcup-32
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/aarch64-linux-ghcup-0.1.17.1
-              dlHash: 0bdbfc724e0ddabb266156eea83c2c4e19c6ed79dd06db0c29b7d69df8d9fa8c
+              dlHash: d14539dbbbb2269b6c3e105b83fa7dac744c1cfaf39f7eb2760293fec856e738
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-apple-darwin-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/aarch64-apple-darwin-ghcup-0.1.17.1
-              dlHash: 8854e991a2ba1350abda59dab96ce50ae7729d1ce99399d67929ef31e90f1da5
+              dlHash: 80cb12af6eaeab2839e13f9cd428c0152fcb38fffc62954a3f5eccca7b06b6d9
         A_ARM:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/armv7-linux-ghcup-0.1.16.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/armv7-linux-ghcup-0.1.17.1
-              dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
+              dlHash: 2b1e63cbd62cce1a15c7cf0635f85b6bc7de880563cdf4b3a20422c9c30a616c
   HLS:
     1.1.0:
-      viTags: []
+      viTags:
+        - old
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
       viPostInstall: &hls-post-install |
         This is just the server part of your LSP configuration. Consult the README on how to
@@ -2294,7 +2350,8 @@ ghcupDownloads:
           Linux_Alpine:
             unknown_versioning: *hls-110-64
     1.2.0:
-      viTags: []
+      viTags:
+        - old
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
       viPostInstall: *hls-post-install
       viArch:
@@ -2314,9 +2371,7 @@ ghcupDownloads:
           Linux_Alpine:
             unknown_versioning: *hls-120-64
     1.3.0:
-      viTags:
+      viTags: []
-        - Recommended
-        - Latest
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
       viPostInstall: *hls-post-install
       viArch:
@@ -2335,6 +2390,50 @@ ghcupDownloads:
               dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
           Linux_Alpine:
             unknown_versioning: *hls-130-64
+    1.4.0:
+      viTags:
+        - Recommended
+        - Latest
+      viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
+      viPostInstall: *hls-post-install
+      viSourceDL:
+        dlUri: https://downloads.haskell.org/ghcup/src/haskell-language-server/1.4.0/haskell-language-server-1.4.0.tar.gz
+        dlSubdir: haskell-language-server-1.4.0
+        dlHash: c5d7dbf7fae9aa3ed2c1184b49e82d8ac623ca786494ef6602cfe11735d28db0
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning: &hls-140-64
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Linux-1.4.0.tar.gz
+              dlHash: f93c114441911ccce55649702adc9553cb4c9f953c37878321d2806a3525fee8
+          Darwin:
+            unknown_versioning:
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-macOS-1.4.0.tar.gz
+              dlHash: a7f0ac6be93ffb08cc239e5f5fead99b061061825f99566c1be33ee60cab62a4
+          FreeBSD:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-freebsd-1.4.0.tar.gz
+              dlHash: 6b2ad2398ed8c3964dea017e3d5e553b54c10ba1373d7653d2edd019854f4da2
+          Windows:
+            unknown_versioning:
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Windows-1.4.0.tar.gz
+              dlHash: 0ec77cee750037b7a0ede817b46a913a702821f4098c6a858bcb686cb30f7efd
+          Linux_Alpine:
+            unknown_versioning: *hls-140-64
+        A_ARM64:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-aarch64-1.4.0.tar.gz
+              dlHash: 8ad97e2bf1c538e637edec194e1cd9939019955bb749cb470f34bbe5a067b001
+          Darwin:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-macOS-aarch64-1.4.0.tar.gz
+              dlHash: 70c6fe38e987ba44c1e19173486c01f666ffb30a74cd5a7968296a5aba4c2dd0
+        A_ARM:
+          Linux_UnknownLinux:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-armv7-1.4.0.tar.gz
+              dlHash: 4a921fbca06b02f3b1c0930cec5e65e9362b603e7715680ec7b150f18bd703d6
   Stack:
     2.5.1:
       viTags:

docs/CHANGELOG.md

@@ -1,5 +1,35 @@
 # Revision history for ghcup
 
+## 0.1.17.2 -- 2021-09-30
+
+* Honour GHC bootstrap compiler during git clone stages wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/250)
+* Speed up `unset` command
+* Fix `--overwrite-version` for `ghcup compile ghc` wrt [#253](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/253)
+* Apply patches before bootstrap
+
+## 0.1.17.1 -- 2021-09-26
+
+* Fix `NO_COLOR`
+* Fix `ghcup list -t` for hls/stack, wrt [#244](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/244)
+* Get rid of concurrent-output
+* Improve cli interface with partial versions (e.g. `ghcup install ghc 8`)
+* Fix HLS compilation builds
+* Implement `ghcup gc` (garbage collection) command
+
+## 0.1.17 -- 2021-09-20
+
+* Add `--force` option to install/compile wrt [#210](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/210) by Arjun Kathuria
+* Implement compiling HLS from source wrt [#201](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/201)
+* Implement experimental GPG verification of the metadata file (see README) wrt [#263](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/236)
+* Add `ghcup unset` command wrt [#145](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/145)
+* Add `ghcup whereis bindir` etc wrt [#221](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/221)
+* Greatly reduce dependency footprint wrt [#212](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/212)
+* Add `ghcup --plan-json`
+* Improve `--patchdir` option for GHC compilation wrt [#226](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/226)
+* Try to improve logging and failure modes, especially during downloads
+* Add descriptive warnings when HLS and GHC versions are incompatible
+* Improve curl header parsing wrt [#213](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/213)
+
 ## 0.1.16.2 -- 2021-08-12
 
 * Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria

ghcup.cabal

@@ -1,34 +1,33 @@
-cabal-version:   3.0
+cabal-version:      3.0
-name:            ghcup
+name:               ghcup
-version:         0.1.16.2
+version:            0.1.17.2
-license:         LGPL-3.0-only
+license:            LGPL-3.0-only
-license-file:    LICENSE
+license-file:       LICENSE
-copyright:       Julian Ospald 2020
+copyright:          Julian Ospald 2020
-maintainer:      hasufell@posteo.de
+maintainer:         hasufell@posteo.de
-author:          Julian Ospald
+author:             Julian Ospald
-homepage:        https://gitlab.haskell.org/haskell/ghcup-hs
+homepage:           https://gitlab.haskell.org/haskell/ghcup-hs
-bug-reports:     https://gitlab.haskell.org/haskell/ghcup-hs/issues
+bug-reports:        https://gitlab.haskell.org/haskell/ghcup-hs/issues
-synopsis:        ghc toolchain installer
+synopsis:           ghc toolchain installer
 description:
   A rewrite of the shell script ghcup, for providing
   a more stable user experience and exposing an API.
 
-category:        System
+category:           System
-build-type:      Simple
+build-type:         Simple
 extra-doc-files:
-  README.md
-  docs/CHANGELOG.md
-  docs/HACKING.md
-  docs/RELEASING.md
   data/config.yaml
   data/metadata/ghcup-0.0.4.yaml
   data/metadata/ghcup-0.0.5.yaml
   data/metadata/ghcup-0.0.6.yaml
-  data/metadata/ghcup-0.0.7.yaml
+  docs/CHANGELOG.md
+  docs/HACKING.md
+  docs/RELEASING.md
+  README.md
 
 extra-source-files:
-  data/build_mk/default
   data/build_mk/cross
+  data/build_mk/default
 
 source-repository head
   type:     git
@@ -100,9 +99,9 @@ library
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            ^>=0.10
+    , Cabal
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
-    , concurrent-output     ^>=1.10.11
     , containers            ^>=0.6
     , cryptohash-sha256     ^>=0.11.101.0
     , deepseq               ^>=1.4.4.0
@@ -111,6 +110,7 @@ library
     , filepath              ^>=1.4.2.1
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  >=3.0        && <3.2
+    , HsYAML-aeson          ^>=0.2.0.0
     , libarchive            ^>=3.0.0.0
     , lzma-static           ^>=5.2.5.3
     , megaparsec            >=8.0.0      && <9.1
@@ -136,7 +136,6 @@ library
     , vector                ^>=0.12
     , versions              >=4.0.1      && <5.1
     , word8                 ^>=0.1.3
-    , HsYAML-aeson          ^>=0.2.0.0
     , zlib                  ^>=0.6.2.2
 
   if (flag(internal-downloader) && !os(windows))
@@ -158,7 +157,11 @@ library
       , Win32    ^>=2.10
 
   else
-    other-modules: GHCup.Utils.File.Posix
+    other-modules:
+      GHCup.Utils.File.Posix
+      System.Console.Terminal.Common
+      System.Console.Terminal.Posix
+
     build-depends:
       , bz2              >=0.5.0.5 && <1.1
       , unix             ^>=2.7
@@ -198,6 +201,7 @@ executable ghcup
     , filepath              ^>=1.4.2.1
     , ghcup
     , haskus-utils-variant  >=3.0      && <3.2
+    , HsYAML-aeson          ^>=0.2.0.0
     , libarchive            ^>=3.0.0.0
     , megaparsec            >=8.0.0    && <9.1
     , mtl                   ^>=2.2
@@ -212,7 +216,6 @@ executable ghcup
     , uri-bytestring        ^>=0.3.2.2
     , utf8-string           ^>=1.0
     , versions              >=4.0.1    && <5.1
-    , HsYAML-aeson          ^>=0.2.0.0
 
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
@@ -260,6 +263,7 @@ executable ghcup-gen
     , filepath              ^>=1.4.2.1
     , ghcup
     , haskus-utils-variant  >=3.0      && <3.2
+    , HsYAML-aeson          ^>=0.2.0.0
     , libarchive            ^>=3.0.0.0
     , mtl                   ^>=2.2
     , optics                ^>=0.4
@@ -272,7 +276,6 @@ executable ghcup-gen
     , text                  ^>=1.2.4.0
     , transformers          ^>=0.5
     , versions              >=4.0.1    && <5.1
-    , HsYAML-aeson          ^>=0.2.0.0
 
 test-suite ghcup-test
   type:               exitcode-stdio-1.0

lib/GHCup/Download.hs

@@ -35,6 +35,7 @@ import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 import           GHCup.Version
 
@@ -114,7 +115,7 @@ getDownloadsF :: ( FromJSONKey Tool
                  , MonadMask m
                  )
               => Excepts
-                   '[JSONError , DownloadFailed , FileDoesNotExistError]
+                   '[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
                    m
                    GHCupInfo
 getDownloadsF = do
@@ -165,25 +166,24 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[JSONError] m GHCupInfo
+        -> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
 getBase uri = do
-  Settings { noNetwork } <- lift getSettings
+  Settings { noNetwork, downloader } <- lift getSettings
 
   -- try to download yaml... usually this writes it into cache dir,
   -- but in some cases not (e.g. when using file://), so we honour
   -- the return filepath, if any
   mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
            then pure Nothing
-           else handleIO (\e -> warnCache (displayException e) >> pure Nothing)
+           else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
-               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing)
+               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
-               . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
                . fmap Just
                . smartDl
                $ uri
 
   -- if we didn't get a filepath from the download, use the cached yaml
   actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
-  yamlContents <- liftIO $ L.readFile actualYaml
+  yamlContents <- liftIOException doesNotExistErrorType (FileDoesNotExistError actualYaml) $ liftIO $ L.readFile actualYaml
   lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
 
   liftE
@@ -201,9 +201,19 @@ getBase uri = do
     handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
       (hideError doesNotExistErrorType $ rmFile efp)
     liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
-  warnCache s = do
+
-    lift $ logWarn "Could not get download info, trying cached version (this may not be recent!)"
+  warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
-    lift $ logDebug $ "Error was: " <> T.pack s
+  warnCache s downloader' = do
+    let tryDownloder = case downloader' of
+                         Curl -> "Wget"
+                         Wget -> "Curl"
+#if defined(INTERNAL_DOWNLOADER)
+                         Internal -> "Curl"
+#endif
+    logWarn $ "Could not get download info, trying cached version (this may not be recent!)" <> "\n" <>
+      "If this problem persists, consider switching downloader via: " <> "\n    " <>
+      "ghcup config set downloader " <> tryDownloder
+    logDebug $ "Error was: " <> T.pack s
 
   -- First check if the json file is in the ~/.ghcup/cache dir
   -- and check it's access time. If it has been accessed within the
@@ -224,6 +234,7 @@ getBase uri = do
           -> Excepts
                '[ DownloadFailed
                 , DigestError
+                , GPGError
                 ]
                m1
                FilePath
@@ -235,7 +246,7 @@ getBase uri = do
     Dirs { cacheDir } <- lift getDirs
 
        -- for local files, let's short-circuit and ignore access time
-    if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
+    if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
        | e -> do
           accessTime <- liftIO $ getAccessTime json_file
 
@@ -248,7 +259,7 @@ getBase uri = do
    where
     dlWithMod modTime json_file = do
       let (dir, fn) = splitFileName json_file
-      f <- liftE $ download uri' Nothing dir (Just fn) True
+      f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing dir (Just fn) True
       liftIO $ setModificationTime f modTime
       liftIO $ setAccessTime f modTime
       pure f
@@ -312,16 +323,17 @@ download :: ( MonadReader env m
             , MonadIO m
             )
          => URI
+         -> Maybe URI         -- ^ URI for gpg sig
          -> Maybe T.Text      -- ^ expected hash
          -> FilePath          -- ^ destination dir (ignored for file:// scheme)
          -> Maybe FilePath    -- ^ optional filename
          -> Bool              -- ^ whether to read an write etags
-         -> Excepts '[DigestError , DownloadFailed] m FilePath
+         -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
-download uri eDigest dest mfn etags
+download uri gpgUri eDigest dest mfn etags
   | scheme == "https" = dl
   | scheme == "http"  = dl
   | scheme == "file"  = do
-      let destFile' = T.unpack . decUTF8Safe $ path
+      let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
       forM_ eDigest (liftE . flip checkDigest destFile')
       pure destFile'
@@ -330,115 +342,179 @@ download uri eDigest dest mfn etags
  where
   scheme = view (uriSchemeL' % schemeBSL') uri
   dl = do
-    destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
+    baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
-    lift $ logInfo $ "downloading: " <> uri' <> " as file " <> T.pack destFile
+    lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
 
     -- destination dir must exist
     liftIO $ createDirRecursive' dest
 
+
     -- download
     flip onException
-         (lift $ hideError doesNotExistErrorType $ recycleFile destFile)
+         (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile))
-     $ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
+     $ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError] @'[DigestError, DownloadFailed, GPGError]
-          (\e ->
+          (\e' -> do
-            lift (hideError doesNotExistErrorType $ recycleFile destFile)
+            lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile)
-              >> (throwE . DownloadFailed $ e)
+            case e' of
+              V e@GPGError {} -> throwE e
+              V e@DigestError {} -> throwE e
+              _ -> throwE (DownloadFailed e')
           ) $ do
-              Settings{ downloader, noNetwork } <- lift getSettings
+              Settings{ downloader, noNetwork, gpgSetting } <- lift getSettings
               when noNetwork $ throwE (DownloadFailed (V NoNetwork :: V '[NoNetwork]))
-              case downloader of
+              downloadAction <- case downloader of
-                Curl -> do
+                    Curl -> do
-                  o' <- liftIO getCurlOpts
+                      o' <- liftIO getCurlOpts
-                  if etags
+                      if etags
-                    then do
+                        then pure $ curlEtagsDL o'
-                      dh <- liftIO $ emptySystemTempFile "curl-header"
+                        else pure $ curlDL o'
-                      flip finally (try @_ @SomeException $ rmFile dh) $
+                    Wget -> do
-                        flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
+                      o' <- liftIO getWgetOpts
-                          metag <- lift $ readETag destFile
+                      if etags
-                          liftE $ lEM @_ @'[ProcessError] $ exec "curl"
+                        then pure $ wgetEtagsDL o'
-                              (o' ++ (if etags then ["--dump-header", dh] else [])
+                        else pure $ wgetDL o'
-                                  ++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
-                                  ++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
-                          headers <- liftIO $ T.readFile dh
-
-                          -- this nonsense is necessary, because some older versions of curl would overwrite
-                          -- the destination file when 304 is returned
-                          case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
-                            Just (http':sc:_)
-                              | sc == "304"
-                              , T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
-                              | T.pack "HTTP" `T.isPrefixOf` http' -> do
-                                  lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
-                                  liftIO $ copyFile (destFile <.> "tmp") destFile
-                            _ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
-                              :: V '[MalformedHeaders]))
-
-                          lift $ writeEtags destFile (parseEtags headers)
-                    else
-                      liftE $ lEM @_ @'[ProcessError] $ exec "curl" 
-                        (o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
-                Wget -> do
-                  destFileTemp <- liftIO $ emptySystemTempFile "wget-tmp"
-                  flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
-                    o' <- liftIO getWgetOpts
-                    if etags
-                      then do
-                        metag <- lift $ readETag destFile
-                        let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
-                                      ++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
-                        CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
-                        case _exitCode of
-                          ExitSuccess -> do
-                            liftIO $ copyFile destFileTemp destFile
-                            lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
-                          ExitFailure i'
-                            | i' == 8
-                            , Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
-                                     -> do
-                                          lift $ logDebug "Not modified, skipping download"
-                                          lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
-                            | otherwise -> throwE (NonZeroExit i' "wget" opts)
-                      else do
-                        let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
-                        liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
-                        liftIO $ copyFile destFileTemp destFile
 #if defined(INTERNAL_DOWNLOADER)
-                Internal -> do
+                    Internal -> do
-                  (https, host, fullPath, port) <- liftE $ uriToQuadruple uri
+                      if etags
-                  if etags
+                        then pure (\fp -> liftE . internalEtagsDL fp)
-                    then do
+                        else pure (\fp -> liftE . internalDL fp)
-                      metag <- lift $ readETag destFile
-                      let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
-                                                                         , E.encodeUtf8 etag)]) metag
-                      liftE
-                        $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
-                        $ do
-                          r <- downloadToFile https host fullPath port destFile addHeaders
-                          lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
-                    else void $ liftE $ catchE @HTTPNotModified
-                                        @'[DownloadFailed]
-                                   (\e@(HTTPNotModified _) ->
-                                     throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
-                               $ downloadToFile https host fullPath port destFile mempty
 #endif
+              liftE $ downloadAction baseDestFile uri
+              case (gpgUri, gpgSetting) of
+                (_, GPGNone) -> pure ()
+                (Just gpgUri', _) -> do
+                  gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile gpgUri' Nothing
+                  liftE $ flip onException
+                       (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
+                   $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
+                        (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyShow (GPGError e))
+                        ) $ do
+                      o' <- liftIO getGpgOpts
+                      lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
+                      liftE $ downloadAction gpgDestFile gpgUri'
+                      lift $ logInfo $ "verifying signature of: " <> T.pack baseDestFile
+                      let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, baseDestFile]
+                      cp <- lift $ executeOut "gpg" args Nothing
+                      case cp of
+                        CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
+                          lift $ logDebug $ decUTF8Safe' _stdErr
+                          throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
+                        CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
+                _ -> pure ()
 
-    forM_ eDigest (liftE . flip checkDigest destFile)
+              forM_ eDigest (liftE . flip checkDigest baseDestFile)
-    pure destFile
+    pure baseDestFile
+
+  curlDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  curlDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
+    let destFileTemp = tmpFile destFile
+    flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
+      liftE $ lEM @_ @'[ProcessError] $ exec "curl"
+        (o' ++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
+      liftIO $ renameFile destFileTemp destFile
+
+  curlEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
+              => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  curlEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
+    let destFileTemp = tmpFile destFile
+    dh <- liftIO $ emptySystemTempFile "curl-header"
+    flip finally (try @_ @SomeException $ rmFile dh) $
+      flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
+        metag <- lift $ readETag destFile
+        liftE $ lEM @_ @'[ProcessError] $ exec "curl"
+            (o' ++ (if etags then ["--dump-header", dh] else [])
+                ++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
+                ++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
+        headers <- liftIO $ T.readFile dh
+
+        -- this nonsense is necessary, because some older versions of curl would overwrite
+        -- the destination file when 304 is returned
+        case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
+          Just (http':sc:_)
+            | sc == "304"
+            , T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
+            | T.pack "HTTP" `T.isPrefixOf` http' -> do
+                lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
+                liftIO $ renameFile destFileTemp destFile
+          _ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
+            :: V '[MalformedHeaders]))
+
+        lift $ writeEtags destFile (parseEtags headers)
+
+  wgetDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  wgetDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
+    let destFileTemp = tmpFile destFile
+    flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
+      let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
+      liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
+      liftIO $ renameFile destFileTemp destFile
+
+
+  wgetEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
+              => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
+  wgetEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
+    let destFileTemp = tmpFile destFile
+    flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
+      metag <- lift $ readETag destFile
+      let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
+                    ++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
+      CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
+      case _exitCode of
+        ExitSuccess -> do
+          liftIO $ renameFile destFileTemp destFile
+          lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
+        ExitFailure i'
+          | i' == 8
+          , Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
+                   -> do
+                        lift $ logDebug "Not modified, skipping download"
+                        lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
+          | otherwise -> throwE (NonZeroExit i' "wget" opts)
+
+#if defined(INTERNAL_DOWNLOADER)
+  internalDL :: (MonadCatch m, MonadMask m, MonadIO m)
+             => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
+  internalDL destFile uri' = do
+    let destFileTemp = tmpFile destFile
+    flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
+      (https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
+      void $ liftE $ catchE @HTTPNotModified
+                 @'[DownloadFailed]
+            (\e@(HTTPNotModified _) ->
+              throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
+        $ downloadToFile https host fullPath port destFileTemp mempty
+      liftIO $ renameFile destFileTemp destFile
+
+
+  internalEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
+                  => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
+  internalEtagsDL destFile uri' = do
+    let destFileTemp = tmpFile destFile
+    flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
+      (https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
+      metag <- lift $ readETag destFile
+      let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
+                                                         , E.encodeUtf8 etag)]) metag
+      liftE
+        $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
+        $ do
+          r <- downloadToFile https host fullPath port destFileTemp addHeaders
+          liftIO $ renameFile destFileTemp destFile
+          lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
+#endif
 
 
   -- Manage to find a file we can write the body into.
-  getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath
+  getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
-  getDestFile = 
+  getDestFile uri' mfn' = 
-    case mfn of
+    let path = view pathL' uri'
+    in case mfn' of
         Just fn -> pure (dest </> fn)
         Nothing
           | let urlBase = T.unpack (decUTF8Safe (urlBaseName path))
           , not (null urlBase) -> pure (dest </> urlBase)
           -- TODO: remove this once we use hpath again
-          | otherwise -> throwE $ NoUrlBase uri'
+          | otherwise -> throwE $ NoUrlBase (decUTF8Safe . serializeURIRef' $ uri')
-
-  path = view pathL' uri
-  uri' = decUTF8Safe (serializeURIRef' uri)
 
   parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
   parseEtags stderr = do
@@ -499,14 +575,14 @@ downloadCached :: ( MonadReader env m
                   )
                => DownloadInfo
                -> Maybe FilePath  -- ^ optional filename
-               -> Excepts '[DigestError , DownloadFailed] m FilePath
+               -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
 downloadCached dli mfn = do
   Settings{ cache } <- lift getSettings
   case cache of
     True -> downloadCached' dli mfn Nothing
     False -> do
       tmp <- lift withGHCupTmpDir
-      liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp mfn False
+      liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmp mfn False
 
 
 downloadCached' :: ( MonadReader env m
@@ -521,7 +597,7 @@ downloadCached' :: ( MonadReader env m
                 => DownloadInfo
                 -> Maybe FilePath  -- ^ optional filename
                 -> Maybe FilePath  -- ^ optional destination dir (default: cacheDir)
-                -> Excepts '[DigestError , DownloadFailed] m FilePath
+                -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
 downloadCached' dli mfn mDestDir = do
   Dirs { cacheDir } <- lift getDirs
   let destDir = fromMaybe cacheDir mDestDir
@@ -532,7 +608,7 @@ downloadCached' dli mfn mDestDir = do
     | fileExists -> do
       liftE $ checkDigest (view dlHash dli) cachfile
       pure cachfile
-    | otherwise -> liftE $ download (_dlUri dli) (Just (_dlHash dli)) destDir mfn False
+    | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) destDir mfn False
 
 
 
@@ -561,7 +637,7 @@ checkDigest eDigest file = do
     lift $ logInfo $ "verifying digest of: " <> T.pack p'
     c <- liftIO $ L.readFile file
     cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
-    when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
+    when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest)
 
 
 -- | Get additional curl args from env. This is an undocumented option.
@@ -579,6 +655,12 @@ getWgetOpts =
     Just r  -> pure $ splitOn " " r
     Nothing -> pure []
 
+-- | Get additional gpg args from env. This is an undocumented option.
+getGpgOpts :: IO [String]
+getGpgOpts =
+  lookupEnv "GHCUP_GPG_OPTS" >>= \case
+    Just r  -> pure $ splitOn " " r
+    Nothing -> pure []
 
 -- | Get the url base name.
 --
@@ -600,3 +682,7 @@ urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
 -- "HTTP/1.1 304 Not Modified\n"
 getLastHeader :: T.Text -> T.Text
 getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [""] . fmap T.stripEnd . T.lines
+
+
+tmpFile :: FilePath -> FilePath
+tmpFile = (<.> "tmp")

lib/GHCup/Errors.hs

@@ -188,12 +188,22 @@ instance Pretty TarDirDoesNotExist where
     text "Tar directory does not exist:" <+> pPrint dir
 
 -- | File digest verification failed.
-data DigestError = DigestError Text Text
+data DigestError = DigestError FilePath Text Text
   deriving Show
 
 instance Pretty DigestError where
-  pPrint (DigestError currentDigest expectedDigest) =
+  pPrint (DigestError fp currentDigest expectedDigest) =
-    text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
+    text "Digest error for" <+> text (fp <> ": expected")
+      <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
+      "\nConsider removing the file in case it's cached and try again."
+
+-- | File digest verification failed.
+data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)
+
+deriving instance Show GPGError
+
+instance Pretty GPGError where
+  pPrint (GPGError reason) = text "GPG verify failed:" <+> pPrint reason
 
 -- | Unexpected HTTP status.
 data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
@@ -285,31 +295,37 @@ instance Pretty HadrianNotFound where
     -------------------------
 
 -- | A download failed. The underlying error is encapsulated.
-data DownloadFailed = forall x xs . (Show x, Show (V xs), Pretty x, Pretty (V xs)) => DownloadFailed (V (x ': xs))
+data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
 
 instance Pretty DownloadFailed where
   pPrint (DownloadFailed reason) =
-    text "Download failed:" <+> pPrint reason
+    case reason of
+      VMaybe (_ :: DownloadFailed) -> pPrint reason
+      _ -> text "Download failed:" <+> pPrint reason
 
 deriving instance Show DownloadFailed
 
 
 -- | A build failed.
-data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
+data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
 
 instance Pretty BuildFailed where
   pPrint (BuildFailed path reason) =
-    text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
+    case reason of
+      VMaybe (_ :: BuildFailed) -> pPrint reason
+      _ -> text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
 
 deriving instance Show BuildFailed
 
 
 -- | Setting the current GHC version failed.
-data GHCupSetError = forall es . (Show (V es), Pretty (V es)) => GHCupSetError (V es)
+data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)
 
 instance Pretty GHCupSetError where
   pPrint (GHCupSetError reason) =
-    text "Setting the current GHC version failed:" <+> pPrint reason
+    case reason of
+      VMaybe (_ :: GHCupSetError) -> pPrint reason
+      _ -> text "Setting the current GHC version failed:" <+> pPrint reason
 
 deriving instance Show GHCupSetError
 

lib/GHCup/Platform.hs

@@ -23,6 +23,7 @@ import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.File
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 
@@ -138,7 +139,6 @@ getLinuxDistro = do
         | hasWord name ["exherbo"] -> Exherbo
         | hasWord name ["gentoo"]  -> Gentoo
         | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
-        | hasWord name ["solus"]   -> Solus
         | otherwise                -> UnknownLinux
   pure (distro, parsedVer)
  where

lib/GHCup/Requirements.hs

@@ -60,9 +60,10 @@ getCommonRequirements pr tr =
 prettyRequirements :: Requirements -> T.Text
 prettyRequirements Requirements {..} =
   let d = if not . null $ _distroPKGs
-        then
+        then "\n  Please ensure the following distro packages "
-          "\n  Please install the following distro packages: "
+          <> "are installed before continuing (you can exit ghcup "
-            <> T.intercalate " " _distroPKGs
+          <> "and return at any time): "
+          <> T.intercalate " " _distroPKGs
         else ""
       n = if not . T.null $ _notes then "\n  Note: " <> _notes else ""
   in  "System requirements " <> d <> n

lib/GHCup/Types.hs

@@ -223,7 +223,6 @@ data LinuxDistro = Debian
                  | RedHat
                  | Alpine
                  | AmazonLinux
-                 | Solus
                  -- rolling
                  | Gentoo
                  | Exherbo
@@ -243,7 +242,6 @@ distroToString CentOS = "centos"
 distroToString RedHat = "redhat"
 distroToString Alpine = "alpine"
 distroToString AmazonLinux = "amazon"
-distroToString Solus = "solus"
 distroToString Gentoo = "gentoo"
 distroToString Exherbo = "exherbo"
 distroToString UnknownLinux = "unknown"
@@ -303,11 +301,12 @@ data UserSettings = UserSettings
   , uKeyBindings :: Maybe UserKeyBindings
   , uUrlSource   :: Maybe URLSource
   , uNoNetwork   :: Maybe Bool
+  , uGPGSetting  :: Maybe GPGSetting
   }
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
@@ -320,6 +319,7 @@ fromSettings Settings{..} Nothing =
     , uNoNetwork = Just noNetwork
     , uKeyBindings = Nothing
     , uUrlSource = Just urlSource
+    , uGPGSetting = Just gpgSetting
   }
 fromSettings Settings{..} (Just KeyBindings{..}) =
   let ukb = UserKeyBindings
@@ -342,6 +342,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
     , uNoNetwork = Just noNetwork
     , uKeyBindings = Just ukb
     , uUrlSource = Just urlSource
+    , uGPGSetting = Just gpgSetting
   }
 
 data UserKeyBindings = UserKeyBindings
@@ -415,6 +416,8 @@ data Settings = Settings
   , verbose    :: Bool
   , urlSource  :: URLSource
   , noNetwork  :: Bool
+  , gpgSetting :: GPGSetting
+  , noColor    :: Bool -- this also exists in LoggerConfig
   }
   deriving (Show, GHC.Generic)
 
@@ -448,6 +451,13 @@ data Downloader = Curl
 
 instance NFData Downloader
 
+data GPGSetting = GPGStrict
+                | GPGLax
+                | GPGNone
+  deriving (Eq, Show, Ord, GHC.Generic)
+
+instance NFData GPGSetting
+
 data DebugInfo = DebugInfo
   { diBaseDir  :: FilePath
   , diBinDir   :: FilePath
@@ -567,11 +577,12 @@ data LogLevel = Warn
   deriving (Eq, Ord, Show)
 
 data LoggerConfig = LoggerConfig
-  { lcPrintDebug :: Bool                  -- ^ whether to print debug in colorOutter
+  { lcPrintDebug   :: Bool            -- ^ whether to print debug in colorOutter
-  , colorOutter  :: T.Text -> IO () -- ^ how to write the color output
+  , consoleOutter  :: T.Text -> IO () -- ^ how to write the console output
-  , rawOutter    :: T.Text -> IO () -- ^ how to write the full raw output
+  , fileOutter     :: T.Text -> IO () -- ^ how to write the file output
+  , fancyColors    :: Bool
   }
   deriving Show
 
 instance NFData LoggerConfig where
-  rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug
+  rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)

lib/GHCup/Types/JSON.hs

@@ -24,6 +24,8 @@ module GHCup.Types.JSON where
 import           GHCup.Types
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
+import           GHCup.Utils.Logger             () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
+                                                   -- This is due to the boot file.
 
 import           Control.Applicative            ( (<|>) )
 import           Data.Aeson
@@ -54,6 +56,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
 
 instance ToJSON Tag where
   toJSON Latest             = String "Latest"

lib/GHCup/Types/Optics.hs

@@ -23,12 +23,9 @@ import           GHCup.Types
 
 import           Control.Monad.Reader
 import           Data.ByteString         ( ByteString )
-import           Data.Text               ( Text )
 import           Optics
 import           URI.ByteString
-import           System.Console.Pretty
 
-import qualified Data.Text                     as T
 
 makePrisms ''Tool
 makePrisms ''Architecture
@@ -117,80 +114,6 @@ getDirs :: ( MonadReader env m
 getDirs = gets @"dirs"
 
 
-logInfo :: ( MonadReader env m
-           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
-           , MonadIO m
-           )
-        => Text
-        -> m ()
-logInfo = logInternal Info
-
-logWarn :: ( MonadReader env m
-           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
-           , MonadIO m
-           )
-        => Text
-        -> m ()
-logWarn = logInternal Warn
-
-logDebug :: ( MonadReader env m
-            , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
-            , MonadIO m
-            )
-         => Text
-         -> m ()
-logDebug = logInternal Debug
-
-logError :: ( MonadReader env m
-            , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
-            , MonadIO m
-            )
-         => Text
-         -> m ()
-logError = logInternal Error
-
-
-logInternal :: ( MonadReader env m
-               , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
-               , MonadIO m
-               ) => LogLevel
-                 -> Text
-                 -> m ()
-logInternal logLevel msg = do
-  LoggerConfig {..} <- gets @"loggerConfig"
-  let style' = case logLevel of
-        Debug   -> style Bold . color Blue
-        Info    -> style Bold . color Green
-        Warn    -> style Bold . color Yellow
-        Error   -> style Bold . color Red
-  let l = case logLevel of
-        Debug   -> style' "[ Debug ]"
-        Info    -> style' "[ Info  ]"
-        Warn    -> style' "[ Warn  ]"
-        Error   -> style' "[ Error ]"
-  let strs = T.split (== '\n') msg
-  let out = case strs of
-              [] -> T.empty
-              (x:xs) -> 
-                  foldr (\a b -> a <> "\n" <> b) mempty
-                . ((l <> " " <> x) :)
-                . fmap (\line' -> style' "[ ...   ] " <> line' )
-                $ xs
-
-  when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
-    $ liftIO $ colorOutter out
-
-  -- raw output
-  let lr = case logLevel of
-        Debug   -> "Debug:"
-        Info    -> "Info:"
-        Warn    -> "Warn:"
-        Error   -> "Error:"
-  let outr = lr <> " " <> msg <> "\n"
-  liftIO $ rawOutter outr
-
-
-
 getLogCleanup :: ( MonadReader env m
                  , LabelOptic' "logCleanup" A_Lens env (IO ())
                  )

lib/GHCup/Utils.hs

@@ -35,6 +35,7 @@ import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File
+import           GHCup.Utils.Logger
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
@@ -85,8 +86,37 @@ import qualified Data.Map.Strict               as Map
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
+import qualified Data.List.NonEmpty            as NE
 
 
+-- $setup
+-- >>> :set -XOverloadedStrings
+-- >>> :set -XDataKinds
+-- >>> :set -XTypeApplications
+-- >>> :set -XQuasiQuotes
+-- >>> import System.Directory
+-- >>> import URI.ByteString
+-- >>> import qualified Data.Text as T
+-- >>> import GHCup.Utils.Prelude
+-- >>> import GHCup.Download
+-- >>> import GHCup.Version
+-- >>> import GHCup.Errors
+-- >>> import GHCup.Types
+-- >>> import GHCup.Types.Optics
+-- >>> import Optics
+-- >>> import GHCup.Utils.Version.QQ
+-- >>> import qualified Data.Text.Encoding as E
+-- >>> import Control.Monad.Reader
+-- >>> import Haskus.Utils.Variant.Excepts
+-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
+-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
+-- >>> dirs' <- getAllDirs
+-- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ]
+-- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False
+-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
+-- >>> cwd <- getCurrentDirectory
+-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
+-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
 
 
 
@@ -250,7 +280,6 @@ getInstalledGHCs = do
 -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
 getInstalledCabals :: ( MonadReader env m
                       , HasDirs env
-                      , HasLog env
                       , MonadIO m
                       , MonadCatch m
                       )
@@ -268,7 +297,7 @@ getInstalledCabals = do
 
 
 -- | Whether the given cabal version is installed.
-cabalInstalled :: (HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
+cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 cabalInstalled ver = do
   vers <- fmap rights getInstalledCabals
   pure $ elem ver vers
@@ -463,33 +492,50 @@ hlsGHCVersions :: ( MonadReader env m
                   )
                => m [Version]
 hlsGHCVersions = do
-  h                             <- hlsSet
+  h <- hlsSet
-  vers                          <- forM h $ \h' -> do
+  fromMaybe [] <$> forM h hlsGHCVersions'
-    bins <- hlsServerBinaries h'
+
-    pure $ fmap
+
-      (version
+hlsGHCVersions' :: ( MonadReader env m
-        . T.pack
+                   , HasDirs env
-        . fromJust
+                   , MonadIO m
-        . stripPrefix "haskell-language-server-"
+                   , MonadThrow m
-        . head
+                   , MonadCatch m
-        . splitOn "~"
+                   )
-        )
+                => Version
-      bins
+                -> m [Version]
-  pure . rights . concat . maybeToList $ vers
+hlsGHCVersions' v' = do
+  bins <- hlsServerBinaries v' Nothing
+  let vers = fmap
+        (version
+          . T.pack
+          . fromJust
+          . stripPrefix "haskell-language-server-"
+          . head
+          . splitOn "~"
+          )
+        bins
+  pure . sortBy (flip compare) . rights $ vers
 
 
 -- | Get all server binaries for an hls version, if any.
 hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
                   => Version
+                  -> Maybe Version   -- ^ optional GHC version
                   -> m [FilePath]
-hlsServerBinaries ver = do
+hlsServerBinaries ver mghcVer = do
   Dirs {..}  <- getDirs
   liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
     (makeRegexOpts
       compExtended
       execBlank
-      ([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
+      ([s|^haskell-language-server-|]
+        <> maybe [s|.*|] escapeVerRex mghcVer
+        <> [s|~|]
+        <> escapeVerRex ver
+        <> E.encodeUtf8 (T.pack exeExt)
+        <> [s|$|] :: ByteString
       )
     )
 
@@ -518,7 +564,7 @@ hlsWrapperBinary ver = do
 -- | Get all binaries for an hls version, if any.
 hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
 hlsAllBinaries ver = do
-  hls     <- hlsServerBinaries ver
+  hls     <- hlsServerBinaries ver Nothing
   wrapper <- hlsWrapperBinary ver
   pure (maybeToList wrapper ++ hls)
 
@@ -559,34 +605,83 @@ matchMajor v' major' minor' = case getMajorMinorV v' of
   Just (x, y) -> x == major' && y == minor'
   Nothing     -> False
 
+-- | Match PVP prefix.
+--
+-- >>> matchPVPrefix [pver|8.8|] [pver|8.8.4|]
+-- True
+-- >>> matchPVPrefix [pver|8|] [pver|8.8.4|]
+-- True
+-- >>> matchPVPrefix [pver|8.10|] [pver|8.8.4|]
+-- False
+-- >>> matchPVPrefix [pver|8.10|] [pver|8.10.7|]
+-- True
+matchPVPrefix :: PVP -> PVP -> Bool
+matchPVPrefix (toL -> prefix) (toL -> full) = and $ zipWith (==) prefix full
 
--- | Get the latest installed full GHC version that satisfies X.Y.
+toL :: PVP -> [Int]
--- This reads `ghcupGHCBaseDir`.
+toL (PVP inner) = fmap fromIntegral $ NE.toList inner
-getGHCForMajor :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
+
-               => Int        -- ^ major version component
+
-               -> Int        -- ^ minor version component
+-- | Get the latest installed full GHC version that satisfies the given (possibly partial)
-               -> Maybe Text -- ^ the target triple
+-- PVP version.
-               -> m (Maybe GHCTargetVersion)
+getGHCForPVP :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
-getGHCForMajor major' minor' mt = do
+             => PVP
+             -> Maybe Text -- ^ the target triple
+             -> m (Maybe GHCTargetVersion)
+getGHCForPVP pvpIn mt = do
   ghcs <- rights <$> getInstalledGHCs
+  -- we're permissive here... failed parse just means we have no match anyway
+  let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
+        pvp_ <- versionToPVP _tvVersion
+        pure (pvp_, _tvTarget)
 
-  pure
+  getGHCForPVP' pvpIn ghcs' mt
-    . lastMay
+
-    . sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
+-- | Like 'getGHCForPVP', except with explicit input parameter.
-    . filter
+--
-        (\GHCTargetVersion {..} ->
+-- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing
-          _tvTarget == mt && matchMajor _tvVersion major' minor'
+-- "Just 8.10.7"
-        )
+-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-    $ ghcs
+-- "Just 8.8.4"
+-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
+-- "Just 8.10.4"
+getGHCForPVP' :: MonadThrow m
+             => PVP
+             -> [(PVP, Maybe Text)] -- ^ installed GHCs
+             -> Maybe Text          -- ^ the target triple
+             -> m (Maybe GHCTargetVersion)
+getGHCForPVP' pvpIn ghcs' mt = do
+  let mResult = lastMay
+                  . sortBy (\(x, _) (y, _) -> compare x y)
+                  . filter
+                      (\(pvp_, target) ->
+                        target == mt && matchPVPrefix pvp_ pvpIn
+                      )
+                  $ ghcs'
+  forM mResult $ \(pvp_, target) -> do
+    ver' <- pvpToVersion pvp_
+    pure (GHCTargetVersion target ver')
 
 
--- | Get the latest available ghc for X.Y major version.
+-- | Get the latest available ghc for the given PVP version, which
-getLatestGHCFor :: Int -- ^ major version component
+-- may only contain parts.
-                -> Int -- ^ minor version component
+--
-                -> GHCupDownloads
+-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
-                -> Maybe (Version, VersionInfo)
+-- Just (PVP {_pComponents = 8 :| [10,7]})
-getLatestGHCFor major' minor' dls =
+-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
-  preview (ix GHC % to Map.toDescList) dls >>= lastMay . filter (\(v, _) -> matchMajor v major' minor')
+-- Just (PVP {_pComponents = 8 :| [8,4]})
+-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
+-- Just (PVP {_pComponents = 8 :| [8,4]})
+getLatestToolFor :: MonadThrow m
+                 => Tool
+                 -> PVP
+                 -> GHCupDownloads
+                 -> m (Maybe (PVP, VersionInfo))
+getLatestToolFor tool pvpIn dls = do
+  let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
+  let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
+  pure . headMay . filter (\(v, _) -> matchPVPrefix pvpIn v) $ ps
+
 
 
 
@@ -690,11 +785,10 @@ intoSubdir bdir tardir = case tardir of
 -- | Get the tool version that has this tag. If multiple have it,
 -- picks the greatest version.
 getTagged :: Tag
-          -> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo)
+          -> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
 getTagged tag =
-  to (Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
+  to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
-  % to Map.toDescList
+  % folding id
-  % _head
 
 getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
 getLatest av tool = headOf (ix tool % getTagged Latest) av
@@ -825,7 +919,7 @@ getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
 getChangeLog dls tool (Left v') =
   preview (ix tool % ix v' % viChangeLog % _Just) dls
 getChangeLog dls tool (Right tag) =
-  preview (ix tool % getTagged tag % to snd % viChangeLog % _Just) dls
+  preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
 
 
 -- | Execute a build action while potentially cleaning up:
@@ -834,6 +928,8 @@ getChangeLog dls tool (Right tag) =
 --   2. the install destination, depending on whether the build failed
 runBuildAction :: ( Pretty (V e)
                   , Show (V e)
+                  , PopVariant BuildFailed e
+                  , ToVariantMaybe BuildFailed e
                   , MonadReader env m
                   , HasDirs env
                   , HasSettings env
@@ -841,6 +937,8 @@ runBuildAction :: ( Pretty (V e)
                   , MonadMask m
                   , HasLog env
                   , MonadUnliftIO m
+                  , MonadFail m
+                  , MonadCatch m
                   )
                => FilePath        -- ^ build directory (cleaned up depending on Settings)
                -> Maybe FilePath  -- ^ dir to *always* clean up on exception
@@ -1030,7 +1128,7 @@ ensureGlobalTools :: ( MonadMask m
                      , MonadUnliftIO m
                      , MonadFail m
                      )
-                  => Excepts '[DigestError , DownloadFailed, NoDownload] m ()
+                  => Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
 ensureGlobalTools = do
 #if defined(IS_WINDOWS)
   (GHCupInfo _ _ gTools) <- lift getGHCupInfo
@@ -1038,12 +1136,12 @@ ensureGlobalTools = do
   shimDownload <- liftE $ lE @_ @'[NoDownload]
     $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
   let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
-  void $ (\(DigestError _ _) -> do
+  void $ (\(DigestError _ _ _) -> do
       lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
       lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
       lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
-      liftE @'[DigestError , DownloadFailed] $ dl
+      liftE @'[GPGError, DigestError , DownloadFailed] $ dl
-    ) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
+    ) `catchE` (liftE @'[GPGError, DigestError , DownloadFailed] dl)
   pure ()
 #else
   pure ()

lib/GHCup/Utils/Dirs.hs

@@ -38,6 +38,7 @@ import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Types.Optics
 import           GHCup.Utils.MegaParsec
+import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
 
 import           Control.Exception.Safe

lib/GHCup/Utils/File/Common.hs

@@ -9,6 +9,8 @@ import           GHCup.Utils.Prelude
 
 import           Control.Monad.Reader
 import           Data.Maybe
+import           Data.Text               ( Text )
+import           Data.Void
 import           GHC.IO.Exception
 import           Optics                  hiding ((<|), (|>))
 import           System.Directory
@@ -16,7 +18,9 @@ import           System.FilePath
 import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 
+import qualified Data.Text                     as T
 import qualified Data.ByteString.Lazy          as BL
+import qualified Text.Megaparsec               as MP
 
 
 
@@ -28,11 +32,11 @@ data ProcessError = NonZeroExit Int FilePath [String]
 
 instance Pretty ProcessError where
   pPrint (NonZeroExit e exe args) =
-    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " failed with exit code " <+> text (show e) <+> "."
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
   pPrint (PTerminated exe args) =
-    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " terminated."
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
   pPrint (PStopped exe args) =
-    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " stopped."
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
   pPrint (NoSuchPid exe args) =
     text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
 
@@ -101,6 +105,16 @@ findFiles path regex = do
   contents <- listDirectory path
   pure $ filter (match regex) contents
 
+findFilesDeep :: FilePath -> Regex -> IO [FilePath]
+findFilesDeep path regex = do
+  contents <- getDirectoryContentsRecursive path
+  pure $ filter (match regex) contents
+
+findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
+findFiles' path parser = do
+  contents <- listDirectory path
+  pure $ filter (\fp -> either (const False) (const True) $ MP.parse parser "" (T.pack fp)) contents
+
 
 checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
 checkFileAlreadyExists fp = liftIO $ doesFileExist fp

lib/GHCup/Utils/File/Common.hs-boot

@@ -0,0 +1,5 @@
+module GHCup.Utils.File.Common where
+
+import           Text.Regex.Posix
+
+findFiles :: FilePath -> Regex -> IO [FilePath]

lib/GHCup/Utils/File/Posix.hs

@@ -17,6 +17,7 @@ module GHCup.Utils.File.Posix where
 
 import           GHCup.Utils.File.Common
 import           GHCup.Utils.Prelude
+import           GHCup.Utils.Logger
 import           GHCup.Types
 import           GHCup.Types.Optics
 
@@ -34,8 +35,7 @@ import           Data.Sequence                  ( Seq, (|>) )
 import           Data.List
 import           Data.Word8
 import           GHC.IO.Exception
-import           System.Console.Pretty   hiding ( Pretty )
+import           System.Console.Terminal.Common
-import           System.Console.Regions
 import           System.IO.Error
 import           System.FilePath
 import           System.Directory
@@ -51,6 +51,7 @@ import qualified Data.Sequence                 as Sq
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified System.Posix.Process          as SPP
+import qualified System.Console.Terminal.Posix as TP
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as BL
 import qualified "unix-bytestring" System.Posix.IO.ByteString
@@ -87,9 +88,9 @@ execLogged exe args chdir lfile env = do
   let logfile = logsDir </> lfile <> ".log"
   liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
                    closeFd
-                   (action verbose)
+                   (action verbose noColor)
  where
-  action verbose fd = do
+  action verbose no_color fd = do
     actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
       -- start the thread that logs to stdout
       pState <- newEmptyMVar
@@ -100,7 +101,7 @@ execLogged exe args chdir lfile env = do
         $ EX.finally
             (if verbose
               then tee fd stdoutRead
-              else printToRegion fd stdoutRead 6 pState
+              else printToRegion fd stdoutRead 6 pState no_color
             )
             (putMVar done ())
 
@@ -137,46 +138,57 @@ execLogged exe args chdir lfile env = do
 
   -- Reads fdIn and logs the output in a continous scrolling area
   -- of 'size' terminal lines. Also writes to a log file.
-  printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
+  printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
-  printToRegion fileFd fdIn size pState = do
+  printToRegion fileFd fdIn size pState no_color = do
-    void $ displayConsoleRegions $ do
+    -- init region
-      rs <-
+    forM_ [1..size] $ \_ -> BS.putStr "\n"
-        liftIO
+
-        . fmap Sq.fromList
+    void $ flip runStateT mempty
-        . sequence
+      $ do
-        . replicate size
+        handle
-        . openConsoleRegion
+          (\(ex :: SomeException) -> do
-        $ Linear
+            ps <- liftIO $ takeMVar pState
-      flip runStateT mempty
+            when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen))
-        $ handle
+            throw ex
-            (\(ex :: SomeException) -> do
+          ) $ readTilEOF lineAction fdIn
-              ps <- liftIO $ takeMVar pState
-              when ps (forM_ rs (liftIO . closeConsoleRegion))
-              throw ex
-            )
-        $ readTilEOF (lineAction rs) fdIn
 
    where
+    clearScreen :: ByteString
+    clearScreen = "\x1b[0J"
+    clearLine :: ByteString
+    clearLine = "\x1b[2K"
+    moveLineUp :: Int -> ByteString
+    moveLineUp n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "A"
+    moveLineDown :: Int -> ByteString
+    moveLineDown n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "B"
+    pos1 :: ByteString
+    pos1 = "\r"
+    overwriteNthLine :: Int -> ByteString -> ByteString
+    overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
+
+    blue :: ByteString -> ByteString
+    blue bs 
+      | no_color = bs
+      | otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
+
     -- action to perform line by line
-    -- TODO: do this with vty for efficiency
     lineAction :: (MonadMask m, MonadIO m)
-               => Seq ConsoleRegion
+               => ByteString
-               -> ByteString
                -> StateT (Seq ByteString) m ()
-    lineAction rs = \bs' -> do
+    lineAction = \bs' -> do
       void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
       modify (swapRegs bs')
-      regs <- get
+      liftIO TP.size >>= \case
-      liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
+        Nothing -> pure ()
-        w <- consoleWidth
+        Just (Window _ w) -> do
-        return
+          regs <- get
-          . T.pack
+          liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
-          . color Blue
+              BS.putStr
-          . T.unpack
+              . overwriteNthLine (size - i)
-          . decUTF8Safe
+              . trim w
-          . trim w
+              . blue
-          . (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
+              . (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
-          $ bs
+              $ bs
 
     swapRegs :: a -> Seq a -> Seq a
     swapRegs bs = \regs -> if

lib/GHCup/Utils/Logger.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE QuasiQuotes      #-}
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE OverloadedStrings   #-}
 
 {-|
 Module      : GHCup.Utils.Logger
@@ -16,21 +18,97 @@ module GHCup.Utils.Logger where
 
 import           GHCup.Types
 import           GHCup.Types.Optics
-import           GHCup.Utils.File
+import {-# SOURCE #-} GHCup.Utils.File.Common
 import           GHCup.Utils.String.QQ
 
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
+import           Data.Text               ( Text )
+import           Optics
 import           Prelude                 hiding ( appendFile )
+import           System.Console.Pretty
 import           System.FilePath
 import           System.IO.Error
 import           Text.Regex.Posix
 
 import qualified Data.ByteString               as B
 import GHCup.Utils.Prelude
+import qualified Data.Text                     as T
 
+logInfo :: ( MonadReader env m
+           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+           , MonadIO m
+           )
+        => Text
+        -> m ()
+logInfo = logInternal Info
+
+logWarn :: ( MonadReader env m
+           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+           , MonadIO m
+           )
+        => Text
+        -> m ()
+logWarn = logInternal Warn
+
+logDebug :: ( MonadReader env m
+            , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+            , MonadIO m
+            )
+         => Text
+         -> m ()
+logDebug = logInternal Debug
+
+logError :: ( MonadReader env m
+            , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+            , MonadIO m
+            )
+         => Text
+         -> m ()
+logError = logInternal Error
+
+
+logInternal :: ( MonadReader env m
+               , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+               , MonadIO m
+               ) => LogLevel
+                 -> Text
+                 -> m ()
+logInternal logLevel msg = do
+  LoggerConfig {..} <- gets @"loggerConfig"
+  let color' c = if fancyColors then color c else id
+  let style' = case logLevel of
+        Debug   -> style Bold . color' Blue
+        Info    -> style Bold . color' Green
+        Warn    -> style Bold . color' Yellow
+        Error   -> style Bold . color' Red
+  let l = case logLevel of
+        Debug   -> style' "[ Debug ]"
+        Info    -> style' "[ Info  ]"
+        Warn    -> style' "[ Warn  ]"
+        Error   -> style' "[ Error ]"
+  let strs = T.split (== '\n') msg
+  let out = case strs of
+              [] -> T.empty
+              (x:xs) -> 
+                  foldr (\a b -> a <> "\n" <> b) mempty
+                . ((l <> " " <> x) :)
+                . fmap (\line' -> style' "[ ...   ] " <> line' )
+                $ xs
+
+  when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
+    $ liftIO $ consoleOutter out
+
+  -- raw output
+  let lr = case logLevel of
+        Debug   -> "Debug:"
+        Info    -> "Info:"
+        Warn    -> "Warn:"
+        Error   -> "Error:"
+  let outr = lr <> " " <> msg <> "\n"
+  liftIO $ fileOutter outr
 
 
 initGHCupFileLogging :: ( MonadReader env m

lib/GHCup/Utils/Logger.hs-boot

@@ -0,0 +1,21 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE QuasiQuotes      #-}
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE OverloadedStrings   #-}
+
+module GHCup.Utils.Logger where
+
+import           GHCup.Types
+
+import           Control.Monad.IO.Class
+import           Control.Monad.Reader
+import           Data.Text               ( Text )
+import           Optics
+
+logWarn :: ( MonadReader env m
+           , LabelOptic' "loggerConfig" A_Lens env LoggerConfig
+           , MonadIO m
+           )
+        => Text
+        -> m ()
+

lib/GHCup/Utils/Prelude.hs

@@ -22,7 +22,9 @@ module GHCup.Utils.Prelude where
 #if defined(IS_WINDOWS)
 import           GHCup.Types
 #endif
+import           GHCup.Errors
 import           GHCup.Types.Optics
+import {-# SOURCE #-} GHCup.Utils.Logger
 
 import           Control.Applicative
 import           Control.Exception.Safe
@@ -31,13 +33,14 @@ import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
-import           Data.List                      ( nub, intercalate, stripPrefix, isPrefixOf )
+import           Data.List                      ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd )
 import           Data.Maybe
 import           Data.Foldable
+import           Data.List.NonEmpty             ( NonEmpty( (:|) ))
 import           Data.String
 import           Data.Text                      ( Text )
 import           Data.Versions
-import           Data.Word8
+import           Data.Word8                  hiding ( isDigit )
 import           Haskus.Utils.Types.List
 import           Haskus.Utils.Variant.Excepts
 import           Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
@@ -58,6 +61,7 @@ import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as L
 import qualified Data.Strict.Maybe             as S
 import qualified Data.List.Split               as Split
+import qualified Data.List.NonEmpty            as NE
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified Data.Text.Encoding.Error      as E
@@ -295,12 +299,28 @@ removeLensFieldLabel str' =
   maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
 
 
-pvpToVersion :: PVP -> Version
+pvpToVersion :: MonadThrow m => PVP -> m Version
 pvpToVersion =
-  either (\_ -> error "Couldn't convert PVP to Version") id
+  either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP
-    . version
-    . prettyPVP
 
+versionToPVP :: MonadThrow m => Version -> m PVP
+versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
+ where
+  alternative :: MonadThrow m => Version -> m PVP
+  alternative v' = case NE.takeWhile isDigit (_vChunks v') of
+    [] -> throwM $ ParseError "Couldn't convert Version to PVP"
+    xs -> pure $ pvpFromList (unsafeDigit <$> xs)
+
+  isDigit :: VChunk -> Bool
+  isDigit (Digits _ :| []) = True
+  isDigit _                = False
+
+  unsafeDigit :: VChunk -> Int
+  unsafeDigit (Digits x :| []) = fromIntegral x
+  unsafeDigit _ = error "unsafeDigit: wrong input"
+
+pvpFromList :: [Int] -> PVP
+pvpFromList = PVP . NE.fromList . fmap fromIntegral
 
 -- | Safe 'decodeUtf8With'. Replaces an invalid input byte with
 -- the Unicode replacement character U+FFFD.
@@ -508,6 +528,10 @@ recover action =
 #endif
 
 
+copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m ()
+copyFileE from = handleIO (throwE . CopyError . show) . liftIO . copyFile from
+
+
 -- | Gathering monoidal values
 --
 -- >>> traverseFold (pure . (:["0"])) ["1","2"]
@@ -528,6 +552,8 @@ forFold = \t -> (`traverseFold` t)
 --
 -- >>> stripNewline "foo\n\n\n"
 -- "foo"
+-- >>> stripNewline "foo\n\n\nfoo"
+-- "foofoo"
 -- >>> stripNewline "foo\r"
 -- "foo"
 -- >>> stripNewline "foo"
@@ -539,10 +565,29 @@ stripNewline :: String -> String
 stripNewline = filter (`notElem` "\n\r")
 
 
+-- | Strip @\\r@ and @\\n@ from end of 'String'.
+--
+-- >>> stripNewlineEnd "foo\n\n\n"
+-- "foo"
+-- >>> stripNewlineEnd "foo\n\n\nfoo"
+-- "foo\n\n\nfoo"
+-- >>> stripNewlineEnd "foo\r"
+-- "foo"
+-- >>> stripNewlineEnd "foo"
+-- "foo"
+--
+-- prop> \t -> stripNewlineEnd (t <> "\n") === stripNewlineEnd t
+-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewlineEnd t == t
+stripNewlineEnd :: String -> String
+stripNewlineEnd = dropWhileEnd (`elem` "\n\r")
+
+
 -- | Strip @\\r@ and @\\n@ from 'Text's
 --
 -- >>> stripNewline' "foo\n\n\n"
 -- "foo"
+-- >>> stripNewline' "foo\n\n\nfoo"
+-- "foofoo"
 -- >>> stripNewline' "foo\r"
 -- "foo"
 -- >>> stripNewline' "foo"

lib/GHCup/Version.hs

@@ -28,7 +28,7 @@ import qualified Data.Text                     as T
 -- Note that when updating this, CI requires that the file exsists AND the same file exists at
 -- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
 ghcupURL :: URI
-ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|]
+ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: PVP

lib/System/Console/Terminal/Common.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveTraversable #-}
+
+#if __GLASGOW_HASKELL__ >= 702
+#define LANGUAGE_DeriveGeneric
+{-# LANGUAGE DeriveGeneric #-}
+#endif
+
+module System.Console.Terminal.Common
+  ( Window(..)
+  ) where
+
+import Data.Data (Typeable, Data)
+
+#if __GLASGOW_HASKELL__ < 710
+import Data.Foldable (Foldable)
+import Data.Traversable (Traversable)
+#endif
+
+#ifdef LANGUAGE_DeriveGeneric
+import GHC.Generics
+  ( Generic
+#if __GLASGOW_HASKELL__ >= 706
+  , Generic1
+#endif
+  )
+#endif
+
+-- | Terminal window width and height
+data Window a = Window
+  { height :: !a
+  , width  :: !a
+  } deriving
+    ( Show, Eq, Read, Data, Typeable
+    , Foldable, Functor, Traversable
+#ifdef LANGUAGE_DeriveGeneric
+    , Generic
+#if __GLASGOW_HASKELL__ >= 706
+    , Generic1
+#endif
+#endif
+    )

lib/System/Console/Terminal/Posix.hsc

@@ -0,0 +1,65 @@
+{-# LANGUAGE CApiFFI #-}
+
+module System.Console.Terminal.Posix
+  ( size, fdSize, hSize
+  ) where
+
+import System.Console.Terminal.Common
+import Control.Exception (catch)
+import Data.Typeable (cast)
+import Foreign
+import Foreign.C.Error
+import Foreign.C.Types
+import GHC.IO.FD (FD(FD, fdFD))
+import GHC.IO.Handle.Internals (withHandle_)
+import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice))
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
+import Prelude hiding (catch)
+#endif
+import System.Posix.Types (Fd(Fd))
+
+#include <sys/ioctl.h>
+#include <unistd.h>
+
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+
+
+-- Interesting part of @struct winsize@
+data CWin = CWin CUShort CUShort
+
+instance Storable CWin where
+  sizeOf _ = (#size struct winsize)
+  alignment _ = (#alignment struct winsize)
+  peek ptr = do
+    row <- (#peek struct winsize, ws_row) ptr
+    col <- (#peek struct winsize, ws_col) ptr
+    return $ CWin row col
+  poke ptr (CWin row col) = do
+    (#poke struct winsize, ws_row) ptr row
+    (#poke struct winsize, ws_col) ptr col
+
+
+fdSize :: Integral n => Fd -> IO (Maybe (Window n))
+fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do
+  _ <- throwErrnoIfMinus1 "ioctl" $
+    ioctl fd (#const TIOCGWINSZ) ws
+  CWin row col <- peek ws
+  return . Just $ Window (fromIntegral row) (fromIntegral col)
+ `catch`
+  handler
+ where
+  handler :: IOError -> IO (Maybe (Window h))
+  handler _ = return Nothing
+
+foreign import capi "sys/ioctl.h ioctl"
+  ioctl :: CInt -> CULong -> Ptr CWin -> IO CInt
+
+size :: Integral n => IO (Maybe (Window n))
+size = fdSize (Fd (#const STDOUT_FILENO))
+
+hSize :: Integral n => Handle -> IO (Maybe (Window n))
+hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } ->
+  case cast dev of
+    Nothing -> return Nothing
+    Just FD { fdFD = fd } -> fdSize (Fd fd)

scripts/bootstrap/bootstrap-haskell

@@ -1,5 +1,9 @@
 #!/bin/sh
 
+# This script downloads the 'ghcup' binary into '~/.ghcup/bin/' and then runs an interactive
+# installation that lets you choose various options. Below is a list of environment variables
+# that affect the installation procedure.
+
 # Main settings:
 #   * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
 #   * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
@@ -21,7 +25,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.16.2"
+ghver="0.1.17.1"
 base_url="https://downloads.haskell.org/~ghcup"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -52,41 +56,57 @@ esac
 
 
 die() {
-    (>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
+    if [ -n "${NO_COLOR}" ] ; then
+        (>&2 printf "%s\\n" "$1")
+    else
+        (>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
+    fi
     exit 2
 }
 
 warn() {
-	case "${plat}" in
+    if [ -n "${NO_COLOR}" ] ; then
-			MSYS*|MINGW*)
+        printf "%s\\n" "$1"
-				echo -e "\\033[0;35m$1\\033[0m"
+    else
-				;;
+        case "${plat}" in
-			*)
+                MSYS*|MINGW*)
-				printf "\\033[0;35m%s\\033[0m\\n" "$1"
+                    echo -e "\\033[0;35m$1\\033[0m"
-				;;
+                    ;;
-	esac
+                *)
+                    printf "\\033[0;35m%s\\033[0m\\n" "$1"
+                    ;;
+        esac
+    fi
 }
 
 yellow() {
-	case "${plat}" in
+    if [ -n "${NO_COLOR}" ] ; then
-			MSYS*|MINGW*)
+        printf "%s\\n" "$1"
-				echo -e "\\033[0;33m$1\\033[0m"
+    else
-				;;
+        case "${plat}" in
-			*)
+                MSYS*|MINGW*)
-				printf "\\033[0;33m%s\\033[0m\\n" "$1"
+                    echo -e "\\033[0;33m$1\\033[0m"
-				;;
+                    ;;
-	esac
+                *)
+                    printf "\\033[0;33m%s\\033[0m\\n" "$1"
+                    ;;
+        esac
+    fi
 }
 
 green() {
-	case "${plat}" in
+    if [ -n "${NO_COLOR}" ] ; then
-			MSYS*|MINGW*)
+        printf "%s\\n" "$1"
-				echo -e "\\033[0;32m$1\\033[0m"
+    else
-				;;
+        case "${plat}" in
-			*)
+                MSYS*|MINGW*)
-				printf "\\033[0;32m%s\\033[0m\\n" "$1"
+                    echo -e "\\033[0;32m$1\\033[0m"
-				;;
+                    ;;
-	esac
+                *)
+                    printf "\\033[0;32m%s\\033[0m\\n" "$1"
+                    ;;
+        esac
+    fi
 }
 
 edo() {
@@ -100,7 +120,7 @@ eghcup() {
 _eghcup() {
 	if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
 		args="-s ${BOOTSTRAP_HASKELL_YAML}"
-	fi 
+	fi
     if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
         "${GHCUP_BIN}/ghcup" ${args} "$@"
     else
@@ -176,7 +196,15 @@ download_ghcup() {
 					_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
 					;;
 				aarch64|arm64|armv8l)
-					_url=${base_url}/${ghver}/aarch64-linux-ghcup-${ghver}
+					# we could be in a 32bit docker container, in which
+					# case uname doesn't give us what we want
+					if [ "$(getconf LONG_BIT)" = "32" ] ; then
+						_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
+					elif [ "$(getconf LONG_BIT)" = "64" ] ; then
+						_url=${base_url}/${ghver}/aarch64-linux-ghcup-${ghver}
+					else
+						die "Unknown long bit size: $(getconf LONG_BIT)"
+					fi
 					;;
 				*) die "Unknown architecture: ${arch}"
 					;;
@@ -293,16 +321,7 @@ ask_bashrc() {
 
 			read -r bashrc_answer </dev/tty
 		else
-			# On windows .bashrc isn't an important user config, so we adjust it
+			return 0
-			# always. On other platforms, let's be a bit more conservative.
-			case "${plat}" in
-					MSYS*|MINGW*)
-						return 1
-						;;
-					*)
-						return 0
-						;;
-			esac
 		fi
 		case $bashrc_answer in
 			[Pp]* | "")
@@ -406,7 +425,7 @@ warn_path() {
 	echo
 	[ -n "$1" ] && warn "$1"
 	yellow "In order to run ghc and cabal, you need to adjust your PATH variable."
-	yellow "To do so, you may want run 'source $GHCUP_DIR/env' in your current terminal"
+	yellow "To do so, you may want to run 'source $GHCUP_DIR/env' in your current terminal"
 	yellow "session as well as your shell configuration (e.g. ~/.bashrc)."
 
 }
@@ -678,4 +697,3 @@ _done
 )
 
 # vim: tabstop=4 shiftwidth=4 expandtab
-

scripts/bootstrap/bootstrap-haskell.ps1

@@ -11,6 +11,8 @@
     * cabal - The Cabal build tool for managing Haskell software"
     * stack - (optional) A cross-platform program for developing Haskell projects"
     * hls   - (optional) A language server for developers to integrate with their editor/IDE"
+    
+	By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
 #>
 param (
     # Run an interactive installation

stack.yaml

@@ -4,24 +4,21 @@ packages:
   - .
 
 extra-deps:
-  - git: https://github.com/bgamari/terminal-size
-    commit: 34ea816bd63f75f800eedac12c6908c6f3736036
-
   - git: https://github.com/hasufell/libarchive
     commit: 8587aab78dd515928024ecd82c8f215e06db85cd
 
-  - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
   - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
   - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
   - base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
+  - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
   - brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
   - brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
   - chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153
   - chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
   - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
-  - haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466
+  - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
   - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
-  - haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159
+  - haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
   - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
   - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
   - hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
@@ -30,11 +27,11 @@ extra-deps:
   - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
   - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
   - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
-  - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
   - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
   - optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
   - optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
   - optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
+  - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
   - primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
   - regex-posix-clib-2.7
   - streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
@@ -63,3 +60,11 @@ ghc-options:
   "$locals": -O2
   streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
   ghcup: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
+
+build:
+  test: true
+  test-arguments:
+    no-run-tests: true
+  bench: true
+  benchmark-opts:
+    no-run-benchmarks: true

www/ghcup.css

@@ -174,7 +174,17 @@ span.code {
     line-height: 2rem;
 }
 
+#help {
+    margin-bottom: 0px !important;
+}
+
+#collective {
+    margin-top: 1em !important;
+    margin-bottom: 0px !important;
+}
+
 #about {
+    margin-top: 0.5em !important;
     font-size: 16px;
     line-height: 2em;
 }

www/index.html

@@ -24,30 +24,29 @@
       </p>
 
       <div id="platform-instructions-linux" class="instructions" style="display: none;">
-        <p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
+        <p>On Linux, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
-		<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
+		<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div> 
-        <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running Linux. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
+	<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b>&nbsp;&middot;&nbsp;</b> <a class="default-platform-button" href="#">I'm not running Linux</a></p>
       </div>
 
       <div id="platform-instructions-mac" class="instructions" style="display: none;">
-        <p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
+        <p>On macOS, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
 		<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-normal">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
-        <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running macOS. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
+	<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b>&nbsp;&middot;&nbsp;</b> <a class="default-platform-button" href="#">I'm not running macOS</a></p>
       </div>
 
       <div id="platform-instructions-freebsd" class="instructions" style="display: none;">
-        <p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
+        <p>On FreeBSD Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
 		<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
-        <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running FreeBSD. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
+	<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b>&nbsp;&middot;&nbsp;</b> <a class="default-platform-button" href="#">I'm not running FreeBSD</a></p>
       </div>
 
       <div id="platform-instructions-win32" class="instructions">
         <p>
-            To install Haskell,<br/>run the following in a powershell session (as a non-admin user).
+            On Windows, to install Haskell,<br/>run the following in a powershell session (as a non-admin user).
 			<div>
 			<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-powershell">Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
 			</div>
-				<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
 			</div>
 		<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
 		</p>
@@ -58,18 +57,19 @@
 		</div>
         </p>
         <hr/>
-		<p class="other-help">You appear to be running Windows 32-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
+	<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
       </div>
 
       <div id="platform-instructions-win64" class="instructions" style="display: none;">
         <p>
-            To install Haskell,<br/>run the following in a powershell session (as a non-admin user).
+            On Windows, to install Haskell,<br/>run the following in a powershell session (as a non-admin user).
 			<div>
 			<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
 			</div>
-				<p class="other-help">If you want to run an non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
+	<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
 			</div>
         </p>
+        <hr/>
 		<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
 		</p>
 		<div>
@@ -77,7 +77,7 @@
 		</div>
 		<p class="other-help">WSL1 does not work with ghcup, follow  <a href="https://docs.microsoft.com/en-us/windows/wsl/install-win10">the instructions here</a> to upgrade to WSL2 if needed.</p>
 		</div>
-		<p class="other-help">You appear to be running Windows 64-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
+	<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
       </div>
 
       <div id="platform-instructions-unknown" class="instructions" style="display: none;">
@@ -101,7 +101,7 @@
         <div>
           <p>If you are running Linux, macOS, FreeBSD or Windows Subsystem 2 for Linux, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
 		  <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
-          <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
+		<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a></p>
         </div>
 
         <hr/>
@@ -120,7 +120,7 @@
           <p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem 2 for Linux, run the following
           in your terminal (as a user other than root), then follow the onscreen instructions.</p>
 		  <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
-          <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
+	<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a></p>
         </div>
 
         <hr/>
@@ -130,25 +130,30 @@
             If you are running Windows,<br/>run the following in a powershell session (as a non-admin user).
 			<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
 			</div>
-				<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
+				<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a></p>
 			</div>
           </p>
         </div>
 
       </div>
 
-      <p>
+      <p id="help">
 	  Need help? Ask on <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup"><img src="irc.svg" height="18px" alt="" />IRC</a>, <a href="https://discord.gg/pKYf3zDQU7"><img src="Discord-Logo-Black.svg" height="18px" alt="" />Discord</a>, <a href="https://app.element.io/#/room/#haskell-tooling:matrix.org"><img src="Matrix_logo.svg" height="25px" alt="" style="top:5px;position:relative;" /></a> or <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">report a bug <img src="Octicons-bug.svg" height="18px" alt="" /></a>.
       </p>
+      <p id="collective">
+		<a id="collective" href="https://opencollective.com/ghcup#category-CONTRIBUTE" target="_blank">
+			<img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" width=200 />
+		</a>
+      </p>
 
       <p id="about">
         <img src="haskell-logo.svg" alt="" />
         ghcup is a haskell.org supported project.
         <br/>
         <a href="https://www.haskell.org/downloads/">other installation options</a>
-        &nbsp;&middot;&nbsp;
+		<b>&nbsp;&middot;&nbsp;</b>
         <a href="https://gitlab.haskell.org/haskell/ghcup-hs">about ghcup</a>
-        &nbsp;&middot;&nbsp;
+		<b>&nbsp;&middot;&nbsp;</b>
         <a href="https://github.com/rust-lang/rustup.rs/tree/master/www">web design from rustup</a>
       </p>
     <script type="text/javascript" src="ghcup.js"></script>