Allow to specify custom bindist, fixes #14

app/ghcup/Main.hs

@@ -38,6 +38,7 @@ import           Control.Monad.Fail             ( MonadFail )
 import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
+import           Data.Aeson                     ( eitherDecode )
 import           Data.Bifunctor
 import           Data.Char
 import           Data.Either
@@ -68,6 +69,7 @@ import           URI.ByteString
 
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.UTF8          as UTF8
+import qualified Data.ByteString.Lazy.UTF8     as BLU
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
@@ -119,6 +121,7 @@ data InstallCommand = InstallGHC InstallOptions
 data InstallOptions = InstallOptions
   { instVer      :: Maybe ToolVersion
   , instPlatform :: Maybe PlatformRequest
+  , instBindist  :: Maybe DownloadInfo
   }
 
 data SetCommand = SetGHC SetOptions
@@ -405,7 +408,7 @@ installParser =
 
 installOpts :: Parser InstallOptions
 installOpts =
-  (flip InstallOptions)
+  (\p u v -> InstallOptions v p u)
     <$> (optional
           (option
             (eitherReader platformParser)
@@ -417,6 +420,17 @@ installOpts =
             )
           )
         )
+    <*> (optional
+          (option
+            (eitherReader bindistParser)
+            (  short 'u'
+            <> long "url"
+            <> metavar "BINDIST_URL"
+            <> help
+                 "Provide DownloadInfo as json string, e.g.: '{ \"dlHash\": \"<sha256 hash>\", \"dlSubdir\": \"ghc-<ver>\", \"dlUri\": \"<uri>\" }'"
+            )
+          )
+        )
     <*> optional toolVersionArgument
 
 
@@ -800,6 +814,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
         pure v
 
 
+bindistParser :: String -> Either String DownloadInfo
+bindistParser = eitherDecode . BLU.fromString
 
 
 toSettings :: Options -> Settings
@@ -1047,7 +1063,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           let installGHC InstallOptions{..} =
                   (runInstTool $ do
                       v <- liftE $ fromVersion dls instVer GHC
-                      liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
+                      case instBindist of
+                        Nothing -> liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
+                        Just uri -> liftE $ installGHCBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
                     )
                     >>= \case
                           VRight _ -> do
@@ -1081,7 +1099,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           let installCabal InstallOptions{..} =
                 (runInstTool $ do
                     v <- liftE $ fromVersion dls instVer Cabal
-                    liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
+                    case instBindist of
+                      Nothing -> liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
+                      Just uri -> liftE $ installCabalBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
                   )
                   >>= \case
                         VRight _ -> do

ghcup.cabal

@@ -341,6 +341,7 @@ executable ghcup
   import:
     config
     , base
+    , aeson
     , bytestring
     , containers
     , haskus-utils-variant

lib/GHCup.hs

@@ -77,7 +77,7 @@ import qualified Data.Text.Encoding            as E
 
 
 
-installGHCBin :: ( MonadFail m
+installGHCBindist :: ( MonadFail m
                  , MonadMask m
                  , MonadCatch m
                  , MonadReader Settings m
@@ -85,7 +85,7 @@ installGHCBin :: ( MonadFail m
                  , MonadResource m
                  , MonadIO m
                  )
-              => GHCupDownloads
+              => DownloadInfo
               -> Version
               -> PlatformRequest
               -> Excepts
@@ -102,14 +102,13 @@ installGHCBin :: ( MonadFail m
                     ]
                    m
                    ()
-installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
+installGHCBindist dlinfo ver (PlatformRequest {..}) = do
   let tver = (mkTVer ver)
   lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
   whenM (liftIO $ ghcInstalled tver)
     $ (throwE $ AlreadyInstalled GHC ver)
 
   -- download (or use cached version)
-  dlinfo                       <- lE $ getDownloadInfo GHC ver pfreq bDls
   dl                           <- liftE $ downloadCached dlinfo Nothing
 
   -- unpack
@@ -150,7 +149,37 @@ installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
     | otherwise = []
 
 
-installCabalBin :: ( MonadMask m
+installGHCBin :: ( MonadFail m
+                 , MonadMask m
+                 , MonadCatch m
+                 , MonadReader Settings m
+                 , MonadLogger m
+                 , MonadResource m
+                 , MonadIO m
+                 )
+              => GHCupDownloads
+              -> Version
+              -> PlatformRequest
+              -> Excepts
+                   '[ AlreadyInstalled
+                    , BuildFailed
+                    , DigestError
+                    , DownloadFailed
+                    , NoDownload
+                    , NotInstalled
+                    , UnknownArchive
+#if !defined(TAR)
+                    , ArchiveResult
+#endif
+                    ]
+                   m
+                   ()
+installGHCBin bDls ver pfreq = do
+  dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
+  installGHCBindist dlinfo ver pfreq
+
+
+installCabalBindist :: ( MonadMask m
                        , MonadCatch m
                        , MonadReader Settings m
                        , MonadLogger m
@@ -158,7 +187,7 @@ installCabalBin :: ( MonadMask m
                        , MonadIO m
                        , MonadFail m
                        )
-                => GHCupDownloads
+                    => DownloadInfo
                     -> Version
                     -> PlatformRequest
                     -> Excepts
@@ -175,7 +204,7 @@ installCabalBin :: ( MonadMask m
                           ]
                          m
                          ()
-installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
+installCabalBindist dlinfo ver (PlatformRequest {..}) = do
   lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
 
   bindir <- liftIO ghcupBinDir
@@ -190,7 +219,6 @@ installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
     $ (throwE $ AlreadyInstalled Cabal ver)
 
   -- download (or use cached version)
-  dlinfo                       <- lE $ getDownloadInfo Cabal ver pfreq bDls
   dl                           <- liftE $ downloadCached dlinfo Nothing
 
   -- unpack
@@ -227,6 +255,37 @@ installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
       Overwrite
 
 
+installCabalBin :: ( MonadMask m
+                   , MonadCatch m
+                   , MonadReader Settings m
+                   , MonadLogger m
+                   , MonadResource m
+                   , MonadIO m
+                   , MonadFail m
+                   )
+                => GHCupDownloads
+                -> Version
+                -> PlatformRequest
+                -> Excepts
+                     '[ AlreadyInstalled
+                      , CopyError
+                      , DigestError
+                      , DownloadFailed
+                      , NoDownload
+                      , NotInstalled
+                      , UnknownArchive
+#if !defined(TAR)
+                      , ArchiveResult
+#endif
+                      ]
+                     m
+                     ()
+installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
+  dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
+  installCabalBindist dlinfo ver pfreq
+
+
+
 
     ---------------------
     --[ Set GHC/cabal ]--