Compare commits
3 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
2895dd9d13
|
|||
|
8d0432b961
|
|||
|
ab2c01d1c9
|
@@ -17,6 +17,8 @@ task:
|
|||||||
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
||||||
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake
|
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake
|
||||||
script:
|
script:
|
||||||
|
- tzsetup Etc/GMT
|
||||||
|
- adjkerntz -a
|
||||||
- bash .github/scripts/build.sh
|
- bash .github/scripts/build.sh
|
||||||
- bash .github/scripts/test.sh
|
- bash .github/scripts/test.sh
|
||||||
binaries_artifacts:
|
binaries_artifacts:
|
||||||
|
|||||||
16
.github/scripts/common.sh
vendored
16
.github/scripts/common.sh
vendored
@@ -88,28 +88,28 @@ download_cabal_cache() {
|
|||||||
case "${RUNNER_OS}" in
|
case "${RUNNER_OS}" in
|
||||||
"Linux")
|
"Linux")
|
||||||
case "${ARCH}" in
|
case "${ARCH}" in
|
||||||
"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/i386-linux-cabal-cache
|
"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/i386-linux-cabal-cache
|
||||||
;;
|
;;
|
||||||
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-linux-cabal-cache
|
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-linux-cabal-cache
|
||||||
;;
|
;;
|
||||||
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-linux-cabal-cache
|
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/aarch64-linux-cabal-cache
|
||||||
;;
|
;;
|
||||||
"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/armv7-linux-cabal-cache
|
"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/armv7-linux-cabal-cache
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
;;
|
;;
|
||||||
"FreeBSD")
|
"FreeBSD")
|
||||||
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-portbld-freebsd-cabal-cache
|
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-portbld-freebsd-cabal-cache
|
||||||
;;
|
;;
|
||||||
"Windows")
|
"Windows")
|
||||||
exe=".exe"
|
exe=".exe"
|
||||||
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-mingw64-cabal-cache
|
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-mingw64-cabal-cache
|
||||||
;;
|
;;
|
||||||
"macOS")
|
"macOS")
|
||||||
case "${ARCH}" in
|
case "${ARCH}" in
|
||||||
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-apple-darwin-cabal-cache
|
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/aarch64-apple-darwin-cabal-cache
|
||||||
;;
|
;;
|
||||||
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-apple-darwin-cabal-cache
|
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-apple-darwin-cabal-cache
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
;;
|
;;
|
||||||
|
|||||||
@@ -59,7 +59,7 @@ data ConfigCommand
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
configP :: Parser ConfigCommand
|
configP :: Parser ConfigCommand
|
||||||
configP = subparser
|
configP = subparser
|
||||||
( command "init" initP
|
( command "init" initP
|
||||||
@@ -133,8 +133,7 @@ updateSettings UserSettings{..} Settings{..} =
|
|||||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||||
platformOverride' = uPlatformOverride <|> platformOverride
|
platformOverride' = uPlatformOverride <|> platformOverride
|
||||||
mirrors' = fromMaybe mirrors uMirrors
|
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
|
||||||
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride' mirrors'
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -89,7 +89,6 @@ toSettings options = do
|
|||||||
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
|
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
|
||||||
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
||||||
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
|
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
|
||||||
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
|
|
||||||
in (Settings {..}, keyBindings)
|
in (Settings {..}, keyBindings)
|
||||||
#if defined(INTERNAL_DOWNLOADER)
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
defaultDownloader = Internal
|
defaultDownloader = Internal
|
||||||
|
|||||||
@@ -92,30 +92,3 @@ url-source:
|
|||||||
# tag: Linux
|
# tag: Linux
|
||||||
# version: '18.04'
|
# version: '18.04'
|
||||||
platform-override: null
|
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"
|
|
||||||
|
|
||||||
|
|||||||
@@ -334,21 +334,19 @@ download :: ( MonadReader env m
|
|||||||
-> Maybe FilePath -- ^ optional filename
|
-> Maybe FilePath -- ^ optional filename
|
||||||
-> Bool -- ^ whether to read an write etags
|
-> Bool -- ^ whether to read an write etags
|
||||||
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
|
-> 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 == "https" = liftE dl
|
||||||
| scheme == "http" = liftE dl
|
| scheme == "http" = liftE dl
|
||||||
| scheme == "file" = do
|
| 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'
|
lift $ logDebug $ "using local file: " <> T.pack destFile'
|
||||||
forM_ eDigest (liftE . flip checkDigest destFile')
|
forM_ eDigest (liftE . flip checkDigest destFile')
|
||||||
pure destFile'
|
pure destFile'
|
||||||
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
||||||
|
|
||||||
where
|
where
|
||||||
scheme = view (uriSchemeL' % schemeBSL') rawUri
|
scheme = view (uriSchemeL' % schemeBSL') uri
|
||||||
dl = do
|
dl = do
|
||||||
Settings{ mirrors } <- lift getSettings
|
|
||||||
let uri = applyMirrors mirrors rawUri
|
|
||||||
baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
|
baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
|
||||||
lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
|
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 :: FilePath -> FilePath
|
||||||
tmpFile = (<.> "tmp")
|
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
|
|
||||||
|
|
||||||
|
|||||||
@@ -274,23 +274,6 @@ instance NFData DownloadInfo
|
|||||||
--[ Others ]--
|
--[ 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.
|
-- | How to descend into a tar archive.
|
||||||
data TarDir = RealDir FilePath
|
data TarDir = RealDir FilePath
|
||||||
@@ -333,13 +316,12 @@ data UserSettings = UserSettings
|
|||||||
, uUrlSource :: Maybe URLSource
|
, uUrlSource :: Maybe URLSource
|
||||||
, uNoNetwork :: Maybe Bool
|
, uNoNetwork :: Maybe Bool
|
||||||
, uGPGSetting :: Maybe GPGSetting
|
, uGPGSetting :: Maybe GPGSetting
|
||||||
, uPlatformOverride :: Maybe PlatformRequest
|
, uPlatformOverride :: Maybe PlatformRequest
|
||||||
, uMirrors :: Maybe DownloadMirrors
|
|
||||||
}
|
}
|
||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic)
|
||||||
|
|
||||||
defaultUserSettings :: UserSettings
|
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 -> Maybe KeyBindings -> UserSettings
|
||||||
fromSettings Settings{..} Nothing =
|
fromSettings Settings{..} Nothing =
|
||||||
@@ -356,7 +338,6 @@ fromSettings Settings{..} Nothing =
|
|||||||
, uUrlSource = Just urlSource
|
, uUrlSource = Just urlSource
|
||||||
, uGPGSetting = Just gpgSetting
|
, uGPGSetting = Just gpgSetting
|
||||||
, uPlatformOverride = platformOverride
|
, uPlatformOverride = platformOverride
|
||||||
, uMirrors = Just mirrors
|
|
||||||
}
|
}
|
||||||
fromSettings Settings{..} (Just KeyBindings{..}) =
|
fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||||
let ukb = UserKeyBindings
|
let ukb = UserKeyBindings
|
||||||
@@ -383,7 +364,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
|||||||
, uUrlSource = Just urlSource
|
, uUrlSource = Just urlSource
|
||||||
, uGPGSetting = Just gpgSetting
|
, uGPGSetting = Just gpgSetting
|
||||||
, uPlatformOverride = platformOverride
|
, uPlatformOverride = platformOverride
|
||||||
, uMirrors = Just mirrors
|
|
||||||
}
|
}
|
||||||
|
|
||||||
data UserKeyBindings = UserKeyBindings
|
data UserKeyBindings = UserKeyBindings
|
||||||
@@ -465,7 +445,6 @@ data Settings = Settings
|
|||||||
, gpgSetting :: GPGSetting
|
, gpgSetting :: GPGSetting
|
||||||
, noColor :: Bool -- this also exists in LoggerConfig
|
, noColor :: Bool -- this also exists in LoggerConfig
|
||||||
, platformOverride :: Maybe PlatformRequest
|
, platformOverride :: Maybe PlatformRequest
|
||||||
, mirrors :: DownloadMirrors
|
|
||||||
}
|
}
|
||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic)
|
||||||
|
|
||||||
@@ -473,7 +452,7 @@ defaultMetaCache :: Integer
|
|||||||
defaultMetaCache = 300 -- 5 minutes
|
defaultMetaCache = 300 -- 5 minutes
|
||||||
|
|
||||||
defaultSettings :: Settings
|
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
|
instance NFData Settings
|
||||||
|
|
||||||
|
|||||||
@@ -29,7 +29,6 @@ import Control.Applicative ( (<|>) )
|
|||||||
import Data.Aeson hiding (Key)
|
import Data.Aeson hiding (Key)
|
||||||
import Data.Aeson.TH
|
import Data.Aeson.TH
|
||||||
import Data.Aeson.Types hiding (Key)
|
import Data.Aeson.Types hiding (Key)
|
||||||
import Data.ByteString ( ByteString )
|
|
||||||
import Data.List.NonEmpty ( NonEmpty(..) )
|
import Data.List.NonEmpty ( NonEmpty(..) )
|
||||||
import Data.Text.Encoding as E
|
import Data.Text.Encoding as E
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
@@ -226,12 +225,6 @@ instance FromJSON VersionCmp where
|
|||||||
Right r -> pure r
|
Right r -> pure r
|
||||||
Left e -> fail (MP.errorBundlePretty e)
|
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 :: VersionCmp -> T.Text
|
||||||
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
|
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
|
||||||
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
|
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
|
||||||
@@ -327,12 +320,6 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI
|
|||||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
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 = \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 = kebab } ''Settings
|
||||||
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
||||||
|
|
||||||
@@ -369,3 +356,4 @@ instance FromJSON URLSource where
|
|||||||
pure (AddSource r)
|
pure (AddSource r)
|
||||||
|
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user