Document distribution policies

.github/scripts/common.sh

@@ -151,7 +151,7 @@ install_ghcup() {
 		chmod +x ghcup
 		mv ghcup "$HOME/.local/bin/ghcup"
 	else
-		curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
+		curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
 	fi
 }
 

app/ghcup/GHCup/OptParse/Config.hs

@@ -59,7 +59,7 @@ data ConfigCommand
     --[ Parsers ]--
     ---------------
 
-          
+
 configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
@@ -133,8 +133,7 @@ updateSettings UserSettings{..} Settings{..} =
        noNetwork'  = fromMaybe noNetwork uNoNetwork
        gpgSetting' = fromMaybe gpgSetting uGPGSetting
        platformOverride' = uPlatformOverride <|> platformOverride
-       mirrors' = fromMaybe mirrors uMirrors
-   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride' mirrors'
+   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
 
 
 

app/ghcup/Main.hs

@@ -89,7 +89,6 @@ toSettings options = do
          noNetwork   = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
          platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
-         mirrors  = fromMaybe (Types.mirrors defaultSettings) uMirrors
      in (Settings {..}, keyBindings)
 #if defined(INTERNAL_DOWNLOADER)
    defaultDownloader = Internal

data/config.yaml

@@ -92,30 +92,3 @@ url-source:
 #     tag: Linux
 #   version: '18.04'
 platform-override: null
-
-# Support for mirrors. Currently there are 3 hosts you can mirror:
-#   - github.com (for stack and some older HLS versions)
-#   - raw.githubusercontent.com (for the yaml metadata)
-#   - downloads.haskell.org (for everything else)
-#
-# E.g. when we have 'https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
-# and the following mirror config
-#
-#  "raw.githubusercontent.com":
-#    authority:
-#      host: "mirror.sjtu.edu.cn"
-#    pathPrefix: "ghcup/yaml"
-#
-# Then the resulting url will be 'https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
-mirrors:
-  "github.com":
-    authority:
-      host: "mirror.sjtu.edu.cn"
-  "raw.githubusercontent.com":
-    authority:
-      host: "mirror.sjtu.edu.cn"
-    pathPrefix: "ghcup/yaml"
-  "downloads.haskell.org":
-    authority:
-      host: "mirror.sjtu.edu.cn"
-

docs/about.md

@@ -60,6 +60,29 @@ All you wanted to know about GHCup.
 3. handling cabal projects
 4. being a stack alternative
 
+## Distribution policies
+
+Like most Linux distros and other distribution channels, GHCup also
+follows certain policies. These are as follows:
+
+1. The end-user experience is our primary concern
+    - ghcup in CI systems as a use case is a first class citizen
+2. We strive to collaborate with all maintainers of all the tools we support and maintain a good relationship
+3. We may fix build system or other distribution bugs in upstream bindists
+    - these are always communicated upstream
+4. We may even patch source code of supported tools in very rare cases if that is required to ensure that the end-user experience does not break
+    - we'll first try to upstream any such required patch and demand a new release to avoid downstream patching
+    - patches will be communicated to the maintainers either way and we'll strive to get their review
+    - they will also be communicated to the end-user
+    - they will be uploaded along with the bindist
+    - we will avoid maintaining long-running downstream patches (currently zero)
+5. We may add bindists for platforms that upstream does not support
+    - this is currently the case for GHC for e.g. Alpine and possibly FreeBSD in the future
+    - this is currently also the case for stack on darwin M1
+    - we don't guarantee for unofficial bindists that the test suite passes at the moment (this may change in the future)
+6. We GPG sign all the GHCup metadata as well as the unofficial bindists
+    - any trust issues relating to missing checksums or GPG signatures is a bug and given high priority
+
 ## How
 
 Installs a specified GHC version into `~/.ghcup/ghc/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`.
@@ -75,15 +98,15 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
 ## Known users
 
 * CI:
-	- [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
-	- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
-	- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
+    - [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
+    - [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
+    - [haskell-ci](https://github.com/haskell-CI/haskell-ci)
 * mirrors:
-	- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
+    - [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
 * tools:
-	- [vscode-haskell](https://github.com/haskell/vscode-haskell)
-	- [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
-	- [vabal](https://github.com/Franciman/vabal)
+    - [vscode-haskell](https://github.com/haskell/vscode-haskell)
+    - [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
+    - [vabal](https://github.com/Franciman/vabal)
 
 ## Known problems
 

lib/GHCup/Download.hs

@@ -334,21 +334,19 @@ download :: ( MonadReader env m
          -> Maybe FilePath    -- ^ optional filename
          -> Bool              -- ^ whether to read an write etags
          -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
-download rawUri gpgUri eDigest eCSize dest mfn etags
+download uri gpgUri eDigest eCSize dest mfn etags
   | scheme == "https" = liftE dl
   | scheme == "http"  = liftE dl
   | scheme == "file"  = do
-      let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
+      let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
       forM_ eDigest (liftE . flip checkDigest destFile')
       pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
 
  where
-  scheme = view (uriSchemeL' % schemeBSL') rawUri
+  scheme = view (uriSchemeL' % schemeBSL') uri
   dl = do
-    Settings{ mirrors } <- lift getSettings
-    let uri = applyMirrors mirrors rawUri
     baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
     lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
 
@@ -751,17 +749,3 @@ getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [
 
 tmpFile :: FilePath -> FilePath
 tmpFile = (<.> "tmp")
-
-
-applyMirrors :: DownloadMirrors -> URI -> URI
-applyMirrors (DM ms) uri@(URI { uriAuthority = Just (Authority { authorityHost = Host host }) }) =
-  case M.lookup (decUTF8Safe host) ms of
-    Nothing -> uri
-    Just (DownloadMirror auth (Just prefix)) ->
-      uri { uriAuthority = Just auth
-          , uriPath = E.encodeUtf8 $ T.pack ("/" <> T.unpack prefix <> (T.unpack . decUTF8Safe . uriPath $ uri))
-          }
-    Just (DownloadMirror auth Nothing) ->
-      uri { uriAuthority = Just auth }
-applyMirrors _ uri = uri
-

lib/GHCup/Types.hs

@@ -274,23 +274,6 @@ instance NFData DownloadInfo
     --[ Others ]--
     --------------
 
-data DownloadMirror = DownloadMirror {
-     authority :: Authority
-   , pathPrefix :: Maybe Text
-} deriving (Eq, Ord, GHC.Generic, Show)
-
-instance NFData DownloadMirror
-
-newtype DownloadMirrors = DM (Map Text DownloadMirror)
-  deriving (Eq, Ord, GHC.Generic, Show)
-
-instance NFData DownloadMirrors
-
-instance NFData UserInfo
-instance NFData Host
-instance NFData Port
-instance NFData Authority
-
 
 -- | How to descend into a tar archive.
 data TarDir = RealDir FilePath
@@ -333,13 +316,12 @@ data UserSettings = UserSettings
   , uUrlSource   :: Maybe URLSource
   , uNoNetwork   :: Maybe Bool
   , uGPGSetting  :: Maybe GPGSetting
-  , uPlatformOverride :: Maybe PlatformRequest
-  , uMirrors     :: Maybe DownloadMirrors
+  , uPlatformOverride    :: Maybe PlatformRequest
   }
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
@@ -356,7 +338,6 @@ fromSettings Settings{..} Nothing =
     , uUrlSource = Just urlSource
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
-    , uMirrors = Just mirrors
   }
 fromSettings Settings{..} (Just KeyBindings{..}) =
   let ukb = UserKeyBindings
@@ -383,7 +364,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
     , uUrlSource = Just urlSource
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
-    , uMirrors = Just mirrors
   }
 
 data UserKeyBindings = UserKeyBindings
@@ -465,7 +445,6 @@ data Settings = Settings
   , gpgSetting       :: GPGSetting
   , noColor          :: Bool -- this also exists in LoggerConfig
   , platformOverride :: Maybe PlatformRequest
-  , mirrors          :: DownloadMirrors
   }
   deriving (Show, GHC.Generic)
 
@@ -473,7 +452,7 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
 
 instance NFData Settings
 

lib/GHCup/Types/JSON.hs

@@ -29,7 +29,6 @@ import           Control.Applicative            ( (<|>) )
 import           Data.Aeson              hiding (Key)
 import           Data.Aeson.TH
 import           Data.Aeson.Types        hiding (Key)
-import           Data.ByteString                ( ByteString )
 import           Data.List.NonEmpty             ( NonEmpty(..) )
 import           Data.Text.Encoding            as E
 import           Data.Versions
@@ -226,12 +225,6 @@ instance FromJSON VersionCmp where
       Right r -> pure r
       Left  e -> fail (MP.errorBundlePretty e)
 
-instance ToJSON ByteString where
-  toJSON = toJSON . E.decodeUtf8With E.lenientDecode
-
-instance FromJSON ByteString where
-  parseJSON = withText "ByteString" $ \t -> pure $ E.encodeUtf8 t
-
 versionCmpToText :: VersionCmp -> T.Text
 versionCmpToText (VR_gt   ver') = "> " <> prettyV ver'
 versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
@@ -327,12 +320,6 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI
 deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
-deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
 deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
 deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
 
@@ -369,3 +356,4 @@ instance FromJSON URLSource where
       pure (AddSource r)
 
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
+