From 4b3ffd857053ffd7f2059557267939560534688a Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 20 Jan 2024 18:23:08 +0800
Subject: [PATCH 1/7] Use file-uri for better URI handling, fixes #978

---
 ghcup.cabal                      |  2 ++
 lib-opt/GHCup/OptParse/Common.hs |  9 +++---
 lib/GHCup/Download.hs            |  5 ++--
 lib/GHCup/Download/IOStreams.hs  |  5 ++--
 lib/GHCup/Types/JSON.hs          |  5 ++--
 lib/GHCup/Utils.hs               |  4 ++-
 lib/GHCup/Utils/URI.hs           | 49 ++++++++++++++++++++++++++++++++
 7 files changed, 68 insertions(+), 11 deletions(-)
 create mode 100644 lib/GHCup/Utils/URI.hs

diff --git a/ghcup.cabal b/ghcup.cabal
index 97641b8..3230d56 100644
--- a/ghcup.cabal
+++ b/ghcup.cabal
@@ -142,6 +142,7 @@ library
     GHCup.Utils.Dirs
     GHCup.Utils.Tar
     GHCup.Utils.Tar.Types
+    GHCup.Utils.URI
     GHCup.Version
 
   hs-source-dirs:     lib
@@ -184,6 +185,7 @@ library
     , disk-free-space       ^>=0.1.0.1
     , exceptions            ^>=0.10
     , filepath              ^>=1.4.2.1
+    , file-uri              ^>=0.1.0.0
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.3
     , lzma-static           ^>=5.2.5.3
diff --git a/lib-opt/GHCup/OptParse/Common.hs b/lib-opt/GHCup/OptParse/Common.hs
index 597b9d7..4c8fad3 100644
--- a/lib-opt/GHCup/OptParse/Common.hs
+++ b/lib-opt/GHCup/OptParse/Common.hs
@@ -17,6 +17,7 @@ import           GHCup.Platform
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
+import           GHCup.Utils.URI
 import           GHCup.Prelude
 import           GHCup.Prelude.Process
 import           GHCup.Prelude.Logger
@@ -59,7 +60,7 @@ import           Safe
 import           System.Process                  ( readProcess )
 import           System.FilePath
 import           Text.HTML.TagSoup       hiding ( Tag )
-import           URI.ByteString
+import           URI.ByteString          hiding (parseURI)
 
 import qualified Data.ByteString.UTF8          as UTF8
 import qualified Data.Map.Strict               as M
@@ -215,7 +216,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
 
 
 uriParser :: String -> Either String URI
-uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
+uriParser = first show . parseURI . UTF8.fromString
 
 
 absolutePathParser :: FilePath -> Either String FilePath
@@ -834,11 +835,11 @@ parseUrlSource :: String -> Either String URLSource
 parseUrlSource "GHCupURL" = pure GHCupURL
 parseUrlSource "StackSetupURL" = pure StackSetupURL
 parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
-            <|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
+            <|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI .UTF8.fromString $ s')
 
 parseNewUrlSource :: String -> Either String NewURLSource
 parseNewUrlSource "GHCupURL" = pure NewGHCupURL
 parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
 parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
-            <|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
+            <|> (fmap NewURI . first show . parseURI .UTF8.fromString $ s')
 
diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs
index a6e840b..3cf3116 100644
--- a/lib/GHCup/Download.hs
+++ b/lib/GHCup/Download.hs
@@ -34,6 +34,7 @@ import qualified GHCup.Types.Stack                as Stack
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
+import           GHCup.Utils.URI
 import           GHCup.Platform
 import           GHCup.Prelude
 import           GHCup.Prelude.File
@@ -77,7 +78,7 @@ import           System.Exit
 import           System.FilePath
 import           System.IO.Error
 import           System.IO.Temp
-import           URI.ByteString
+import           URI.ByteString          hiding (parseURI)
 
 import qualified Crypto.Hash.SHA256            as SHA256
 import qualified Data.ByteString               as B
@@ -178,7 +179,7 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
 
     fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
     fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do
-      url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
+      url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI . E.encodeUtf8 $ downloadInfoUrl
       sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
       pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
 
diff --git a/lib/GHCup/Download/IOStreams.hs b/lib/GHCup/Download/IOStreams.hs
index 3a396f6..adc9f14 100644
--- a/lib/GHCup/Download/IOStreams.hs
+++ b/lib/GHCup/Download/IOStreams.hs
@@ -11,6 +11,7 @@ import           GHCup.Download.Utils
 import           GHCup.Errors
 import           GHCup.Types.JSON               ( )
 import           GHCup.Prelude
+import           GHCup.Utils.URI
 
 import           Control.Applicative
 import           Control.Exception.Safe
@@ -28,7 +29,7 @@ import           Prelude                 hiding ( abs
                                                 , writeFile
                                                 )
 import           System.ProgressBar
-import           URI.ByteString
+import           URI.ByteString          hiding (parseURI)
 
 import qualified Data.ByteString               as BS
 import qualified Data.Map.Strict               as M
@@ -114,7 +115,7 @@ downloadInternal = go (5 :: Int)
             | otherwise -> throwE $ HTTPStatusError scode (getHeaderMap r)
         )
 
-    followRedirectURL bs = case parseURI strictURIParserOptions bs of
+    followRedirectURL bs = case parseURI bs of
       Right uri' -> do
         (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
         go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders eCSize
diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs
index 99c281a..ce95303 100644
--- a/lib/GHCup/Types/JSON.hs
+++ b/lib/GHCup/Types/JSON.hs
@@ -26,6 +26,7 @@ import           GHCup.Types.Stack (SetupInfo)
 import           GHCup.Types.JSON.Utils
 import           GHCup.Types.JSON.Versions ()
 import           GHCup.Prelude.MegaParsec
+import           GHCup.Utils.URI
 
 import           Control.Applicative            ( (<|>) )
 import           Data.Aeson              hiding (Key)
@@ -38,7 +39,7 @@ import           Data.Text.Encoding            as E
 import           Data.Foldable
 import           Data.Versions
 import           Data.Void
-import           URI.ByteString
+import           URI.ByteString hiding (parseURI)
 import           Text.Casing
 
 import qualified Data.List.NonEmpty            as NE
@@ -95,7 +96,7 @@ instance ToJSON URI where
 
 instance FromJSON URI where
   parseJSON = withText "URL" $ \t ->
-    case parseURI strictURIParserOptions (encodeUtf8 t) of
+    case parseURI (encodeUtf8 t) of
       Right x -> pure x
       Left  e -> fail . show $ e
 
diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs
index 310b5fa..551e679 100644
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@@ -23,6 +23,7 @@ module GHCup.Utils
   ( module GHCup.Utils.Dirs
   , module GHCup.Utils.Tar
   , module GHCup.Utils
+  , module GHCup.Utils.URI
 #if defined(IS_WINDOWS)
   , module GHCup.Prelude.Windows
 #else
@@ -44,6 +45,7 @@ import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.Tar
+import           GHCup.Utils.URI
 import           GHCup.Version
 import           GHCup.Prelude
 import           GHCup.Prelude.File
@@ -78,7 +80,7 @@ import           System.FilePath
 import           System.IO.Error
 import           Text.Regex.Posix
 import           Text.PrettyPrint.HughesPJClass (prettyShow)
-import           URI.ByteString
+import           URI.ByteString hiding (parseURI)
 
 import qualified Data.Map.Strict               as Map
 import qualified Data.Text                     as T
diff --git a/lib/GHCup/Utils/URI.hs b/lib/GHCup/Utils/URI.hs
new file mode 100644
index 0000000..b80be33
--- /dev/null
+++ b/lib/GHCup/Utils/URI.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE OverloadedStrings     #-}
+
+{-|
+Module      : GHCup.Utils.URI
+Description : GHCup domain specific URI utilities
+Copyright   : (c) Julian Ospald, 2024
+License     : LGPL-3.0
+Maintainer  : hasufell@hasufell.de
+Stability   : experimental
+Portability : portable
+
+This module contains GHCup helpers specific to
+URI handling.
+-}
+module GHCup.Utils.URI where
+
+import           Data.ByteString
+import           URI.ByteString hiding (parseURI)
+import           System.URI.File
+
+import qualified URI.ByteString                as URI
+
+
+    -----------
+    --[ URI ]--
+    -----------
+
+
+parseURI :: ByteString -> Either URIParseError (URIRef Absolute)
+parseURI bs = case parseFile bs of
+                Left _ -> case URI.parseURI strictURIParserOptions bs of
+                            Right (URI { uriScheme = (Scheme "file") }) ->
+#if defined(IS_WINDOWS)
+                              Left (OtherError "Invalid file URI. File URIs must be absolute (start with a drive letter or UNC path) and not contain backslashes.")
+#else
+                              Left (OtherError "Invalid file URI. File URIs must be absolute.")
+#endif
+                            o -> o
+                Right (FileURI (Just _) _) -> Left $ OtherError "File URIs with auth part are not supported!"
+                Right (FileURI _ fp) -> Right $ URI (Scheme "file") Nothing fp (Query []) Nothing
+ where
+  parseFile
+#if defined(IS_WINDOWS)
+    = parseFileURI ExtendedWindows
+#else
+    = parseFileURI ExtendedPosix
+#endif
+

From c9a44d211e4ec6cca0fedb0b523b6404b0843250 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 20 Jan 2024 18:24:17 +0800
Subject: [PATCH 2/7] Update .gitignore

---
 .gitignore | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.gitignore b/.gitignore
index a1e3592..595bb69 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,6 +4,7 @@ codex.tags
 dist-newstyle/
 cabal.project.local
 .stack-work/
+.hiefiles/
 bin/
 /*.prof
 /*.ps

From e325728f38f2926de25c1676e43ed54c61998fbe Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 21 Jan 2024 13:47:03 +0800
Subject: [PATCH 3/7] Fix windows golden test

---
 test/ghcup-test/golden/windows/GHCupInfo.json | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/ghcup-test/golden/windows/GHCupInfo.json b/test/ghcup-test/golden/windows/GHCupInfo.json
index 19840b9..4ed33f0 100644
--- a/test/ghcup-test/golden/windows/GHCupInfo.json
+++ b/test/ghcup-test/golden/windows/GHCupInfo.json
@@ -845,7 +845,7 @@
                                         "dlHash": "et",
                                         "dlOutput": "𥗚%󲔐ဖ-\u000e",
                                         "dlSubdir": {
-                                            "RegexDir": "BP!a⠀􏀨"
+                                            "RegexDir": "BP!a𖫈􏀨"
                                         },
                                         "dlUri": "https:"
                                     },
@@ -17546,7 +17546,7 @@
                                         "dlHash": "knn",
                                         "dlOutput": "",
                                         "dlSubdir": {
-                                            "RegexDir": "𢹂􄝹 "
+                                            "RegexDir": "𐞳􄝹 "
                                         },
                                         "dlUri": "http:qlay"
                                     }

From c225f2cfeed59f4872e0ab28b5be05dfa9ee8cff Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 21 Jan 2024 13:49:55 +0800
Subject: [PATCH 4/7] Fix language-c on windows

---
 .github/workflows/release.yaml | 4 ++--
 cabal.project                  | 4 ++++
 cabal.project.release          | 4 +++-
 3 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml
index fa3259e..7297e1c 100644
--- a/.github/workflows/release.yaml
+++ b/.github/workflows/release.yaml
@@ -178,7 +178,7 @@ jobs:
             ARCH: 64
           - os: windows-latest
             ARTIFACT: "x86_64-mingw64-ghcup"
-            GHC_VER: 9.2.8
+            GHC_VER: 9.4.8
             ARCH: 64
     steps:
       - name: Checkout code
@@ -414,7 +414,7 @@ jobs:
             DISTRO: na
           - os: windows-latest
             ARTIFACT: "x86_64-mingw64-ghcup"
-            GHC_VER: 9.2.8
+            GHC_VER: 9.4.8
             ARCH: 64
             DISTRO: na
 
diff --git a/cabal.project b/cabal.project
index 6568a2f..d78cd41 100644
--- a/cabal.project
+++ b/cabal.project
@@ -12,6 +12,10 @@ else
 constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0
 
+if os(mingw32)
+	if impl(ghc >= 9.4)
+	  constraints: language-c >= 0.9.3
+
 source-repository-package
   type: git
   location: https://github.com/haskell/tar.git
diff --git a/cabal.project.release b/cabal.project.release
index 97328b7..b01bf49 100644
--- a/cabal.project.release
+++ b/cabal.project.release
@@ -18,7 +18,9 @@ elif os(mingw32)
   constraints: zlib +bundled-c-zlib,
                lzma +static,
                text -simdutf,
-			   vty-windows >=0.1.0.3
+               vty-windows >=0.1.0.3
+  if impl(ghc >= 9.4)
+    constraints: language-c >= 0.9.3
 elif os(freebsd)
   constraints: zlib +bundled-c-zlib,
                zip +disable-zstd

From ec4e69e89dddf5f6a37d87eb149ab396650fff2d Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 21 Jan 2024 13:52:49 +0800
Subject: [PATCH 5/7] Fix indentation

---
 cabal.project | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/cabal.project b/cabal.project
index d78cd41..446c376 100644
--- a/cabal.project
+++ b/cabal.project
@@ -13,8 +13,8 @@ constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0
 
 if os(mingw32)
-	if impl(ghc >= 9.4)
-	  constraints: language-c >= 0.9.3
+  if impl(ghc >= 9.4)
+    constraints: language-c >= 0.9.3
 
 source-repository-package
   type: git

From ca92b29ffee169648fc412fe383b4bbf4a39b584 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 21 Jan 2024 14:00:53 +0800
Subject: [PATCH 6/7] Fix optparse tests on windows

---
 test/optparse-test/CompileTest.hs | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/test/optparse-test/CompileTest.hs b/test/optparse-test/CompileTest.hs
index 378415f..4fed639 100644
--- a/test/optparse-test/CompileTest.hs
+++ b/test/optparse-test/CompileTest.hs
@@ -80,7 +80,11 @@ compileGhcCheckList = mapSecond CompileGHC
   , (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10})
   , (baseCmd <> "-c build.mk", baseOptions{GHC.buildConfig = Just "build.mk"})
   , (baseCmd <> "--config build.mk", baseOptions{GHC.buildConfig = Just "build.mk"})
+#ifdef IS_WINDOWS
+  , (baseCmd <> "--patch file:c:/example.patch", baseOptions{GHC.patches = Just $ Right [[uri|file:c:/example.patch|]]})
+#else
   , (baseCmd <> "--patch file:///example.patch", baseOptions{GHC.patches = Just $ Right [[uri|file:///example.patch|]]})
+#endif
   , (baseCmd <> "-p patch_dir", baseOptions{GHC.patches = Just (Left "patch_dir")})
   , (baseCmd <> "--patchdir patch_dir", baseOptions{GHC.patches = Just (Left "patch_dir")})
   , (baseCmd <> "-x armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
@@ -164,10 +168,22 @@ compileHlsCheckList = mapSecond CompileHLS
   , (baseCmd <> "-i /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
   , (baseCmd <> "--isolate /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
 #endif
+#ifdef IS_WINDOWS
+  , (baseCmd <> "--cabal-project file:c:/tmp/cabal.project", baseOptions{HLS.cabalProject = Just $ Right [uri|file:c:/tmp/cabal.project|]})
+#else
   , (baseCmd <> "--cabal-project file:///tmp/cabal.project", baseOptions{HLS.cabalProject = Just $ Right [uri|file:///tmp/cabal.project|]})
+#endif
   , (baseCmd <> "--cabal-project cabal.ghc8107.project", baseOptions{HLS.cabalProject = Just $ Left "cabal.ghc8107.project"})
+#ifdef IS_WINDOWS
+  , (baseCmd <> "--cabal-project-local file:c:/tmp/cabal.project.local", baseOptions{HLS.cabalProjectLocal = Just [uri|file:c:/tmp/cabal.project.local|]})
+#else
   , (baseCmd <> "--cabal-project-local file:///tmp/cabal.project.local", baseOptions{HLS.cabalProjectLocal = Just [uri|file:///tmp/cabal.project.local|]})
+#endif
+#ifdef IS_WINDOWS
+  , (baseCmd <> "--patch file:c:/example.patch", baseOptions{HLS.patches = Just $ Right [[uri|file:c:/example.patch|]]})
+#else
   , (baseCmd <> "--patch file:///example.patch", baseOptions{HLS.patches = Just $ Right [[uri|file:///example.patch|]]})
+#endif
   , (baseCmd <> "-p patch_dir", baseOptions{HLS.patches = Just (Left "patch_dir")})
   , (baseCmd <> "--patchdir patch_dir", baseOptions{HLS.patches = Just (Left "patch_dir")})
   , (baseCmd <> "-- --enable-tests", baseOptions{HLS.cabalArgs = ["--enable-tests"]})

From 4b338ccfd8ab49692e3c1d47f15a4123d1cf40b0 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 21 Jan 2024 15:29:12 +0800
Subject: [PATCH 7/7] Fix windows ghcup test script

---
 .github/scripts/common.sh | 2 +-
 .github/scripts/test.sh   | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/.github/scripts/common.sh b/.github/scripts/common.sh
index 262c09b..3006776 100644
--- a/.github/scripts/common.sh
+++ b/.github/scripts/common.sh
@@ -44,7 +44,7 @@ raw_eghcup() {
 
 eghcup() {
 	if [ "${OS}" = "Windows" ] ; then
-		"$GHCUP_BIN/ghcup${ext}" -c -s "file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
+		"$GHCUP_BIN/ghcup${ext}" -c -s "file:${GITHUB_WORKSPACE//\\//}/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
 	else
 		"$GHCUP_BIN/ghcup${ext}" -c -s "file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
 	fi
diff --git a/.github/scripts/test.sh b/.github/scripts/test.sh
index 331c1c3..ce5ae26 100644
--- a/.github/scripts/test.sh
+++ b/.github/scripts/test.sh
@@ -11,6 +11,7 @@ else
 	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
 fi
 
+env
 git_describe
 
 rm -rf "${GHCUP_DIR}"