Add --offline switch wrt #186

2021-07-18 23:29:09 +02:00 · 2021-07-18 23:29:09 +02:00 · 6143cdf2e0
commit 6143cdf2e0
parent 2c7176d998
11 changed files with 193 additions and 120 deletions
--- a/app/ghcup-gen/Validate.hs
+++ b/app/ghcup-gen/Validate.hs
@ -12,7 +12,7 @@ import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
 import           GHCup.Platform
-import           GHCup.Types
+import           GHCup.Types                  hiding ( LeanAppState (..) )
 import           GHCup.Types.Optics
 import           GHCup.Utils
 import           GHCup.Utils.Logger
@ -226,7 +226,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
                                     , rawOutter    = \_ -> pure ()
                                     }
  downloadAll dli = do
-    dirs <- liftIO getDirs
+    dirs <- liftIO getAllDirs

    pfreq <- (
      runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
@ -237,7 +237,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
                  ($(logError) $ T.pack $ prettyShow e)
                liftIO $ exitWith (ExitFailure 2)

-    let appstate = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
+    let appstate = AppState (Settings True False Never Curl False GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq

    r <-
      runLogger
@ -256,17 +256,17 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
        case etool of
          Right (Just GHCup) -> do
            tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (settings appstate) dli tmpUnpack Nothing
+            _ <- liftE $ download dli tmpUnpack Nothing
            pure Nothing
          Right _ -> do
-            p <- liftE $ downloadCached (settings appstate) dirs dli Nothing
+            p <- liftE $ downloadCached dli Nothing
            fmap (Just . head . splitDirectories . head)
              . liftE
              . getArchiveFiles
              $ p
          Left ShimGen -> do
            tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (settings appstate) dli tmpUnpack Nothing
+            _ <- liftE $ download dli tmpUnpack Nothing
            pure Nothing
    case r of
      VRight (Just basePath) -> do
--- a/app/ghcup/BrickMain.hs
+++ b/app/ghcup/BrickMain.hs
@ -13,7 +13,7 @@ module BrickMain where
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
-import           GHCup.Types
+import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
 import           GHCup.Utils.Prelude ( decUTF8Safe )
 import           GHCup.Utils.File
@ -53,8 +53,6 @@ import           System.IO.Unsafe
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           URI.ByteString

-import qualified GHCup.Types                   as GT
-
 import qualified Data.Text                     as T
 import qualified Graphics.Vty                  as Vty
 import qualified Data.Vector                   as V
@ -550,13 +548,14 @@ changelog' _ (_, ListResult {..}) = do
 settings' :: IORef AppState
 {-# NOINLINE settings' #-}
 settings' = unsafePerformIO $ do
-  dirs <- getDirs
+  dirs <- getAllDirs
  newIORef $ AppState (Settings { cache      = True
                                , noVerify   = False
                                , keepDirs   = Never
                                , downloader = Curl
                                , verbose    = False
                                , urlSource  = GHCupURL
+                                , noNetwork  = False
                                , ..
                                })
                      dirs
@ -578,9 +577,8 @@ logger' = unsafePerformIO

 brickMain :: AppState
          -> LoggerConfig
-          -> GHCupInfo
          -> IO ()
-brickMain s l gi = do
+brickMain s l = do
  writeIORef settings' s
  -- logger interpreter
  writeIORef logger'   l
@ -588,7 +586,7 @@ brickMain s l gi = do

  no_color <- isJust <$> lookupEnv "NO_COLOR"

-  eAppData <- getAppData (Just gi)
+  eAppData <- getAppData (Just $ ghcupInfo s)
  case eAppData of
    Right ad ->
      defaultMain
@ -596,7 +594,7 @@ brickMain s l gi = do
          (BrickState ad
                    defaultAppSettings
                    (constructList ad defaultAppSettings Nothing)
-                    (keyBindings s)
+                    (keyBindings (s :: AppState))

          )
        $> ()
@ -620,7 +618,7 @@ getGHCupInfo = do
    . flip runReaderT settings
    . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
    $ liftE
-    $ getDownloadsF (GT.settings settings) (GT.dirs settings)
+    $ getDownloadsF

  case r of
    VRight a -> pure $ Right a
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@ -91,6 +91,7 @@ data Options = Options
  , optNoVerify  :: Maybe Bool
  , optKeepDirs  :: Maybe KeepDirs
  , optsDownloader :: Maybe Downloader
+  , optNoNetwork :: Maybe Bool
  -- commands
  , optCommand   :: Command
  }
@ -277,6 +278,7 @@ opts =
 #endif
          <> hidden
          ))
+    <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
    <*> com
 where
  parseUri s' =
@ -943,13 +945,19 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
 tagCompleter :: Tool -> [String] -> Completer
 tagCompleter tool add = listIOCompleter $ do
  dirs' <- liftIO getAllDirs
+  let appState = LeanAppState
+        (Settings True False Never Curl False GHCupURL True)
+        dirs'
+        defaultKeyBindings
+
  let loggerConfig = LoggerConfig
        { lcPrintDebug = False
        , colorOutter  = mempty
        , rawOutter    = mempty
        }
  let runLogger = myLoggerT loggerConfig
-  mGhcUpInfo <- runLogger . runE $ readFromCache dirs'
+
+  mGhcUpInfo <- runLogger . flip runReaderT appState . runE $ getDownloadsF
  case mGhcUpInfo of
    VRight ghcupInfo -> do
      let allTags = filter (\t -> t /= Old)
@ -969,12 +977,17 @@ versionCompleter criteria tool = listIOCompleter $ do
        , rawOutter    = mempty
        }
  let runLogger = myLoggerT loggerConfig
-  mGhcUpInfo <- runLogger . runE $ readFromCache dirs'
-  mpFreq <- runLogger . runE $ platformRequest
-  forFold mpFreq $ \pfreq ->
+      settings = Settings True False Never Curl False GHCupURL True
+  let leanAppState = LeanAppState
+                   settings
+                   dirs'
+                   defaultKeyBindings
+  mpFreq <- runLogger . flip runReaderT leanAppState . runE $ platformRequest
+  mGhcUpInfo <- runLogger . flip runReaderT leanAppState . runE $ getDownloadsF
+  forFold mpFreq $ \pfreq -> do
    forFold mGhcUpInfo $ \ghcupInfo -> do
      let appState = AppState
-            (Settings True False Never Curl False GHCupURL)
+            settings
            dirs'
            defaultKeyBindings
            ghcupInfo
@ -1123,6 +1136,7 @@ toSettings options = do
         downloader  = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
         keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
         urlSource   = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
+         noNetwork   = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork
     in (Settings {..}, keyBindings)
 #if defined(INTERNAL_DOWNLOADER)
   defaultDownloader = Internal
@ -1168,7 +1182,9 @@ describe_result = $( LitE . StringL <$>
                     runIO (do
                             CapturedProcess{..} <-  do
                              dirs <- liftIO getAllDirs
-                              let settings = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings
+                              let settings = AppState (Settings True False Never Curl False GHCupURL False)
+                                               dirs
+                                               defaultKeyBindings
                              flip runReaderT settings $ executeOut "git" ["describe"] Nothing
                             case _exitCode of
                               ExitSuccess   -> pure . T.unpack . decUTF8Safe' $ _stdOut
@ -1259,9 +1275,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]

                ghcupInfo <-
                  ( runLogger
+                    . flip runReaderT leanAppstate
                    . runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
                    $ liftE
-                    $ getDownloadsF settings dirs
+                    $ getDownloadsF
                    )
                    >>= \case
                          VRight r -> pure r
@ -1285,7 +1302,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                pure s'


+#if defined(IS_WINDOWS)
+              -- FIXME: windows needs 'ensureGlobalTools', which requires
+              -- full appstate
+              runLeanAppState = runAppState
+#else
              runLeanAppState = flip runReaderT leanAppstate
+#endif
              runAppState action' = do
                s' <- liftIO appState
                flip runReaderT s' action'
@ -1299,7 +1322,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]

          let runInstTool' appstate' mInstPlatform =
                runLogger
-                  . flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x }) mInstPlatform)
+                  . flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
                  . runResourceT
                  . runE
                    @'[ AlreadyInstalled
@ -1733,7 +1756,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
          res <- case optCommand of
 #if defined(BRICK)
            Interactive -> do
-              liftIO $ brickMain appstate loggerConfig ghcupInfo >> pure ExitSuccess
+              s' <- appState
+              liftIO $ brickMain s' loggerConfig >> pure ExitSuccess
 #endif
            Install (Right iopts) -> do
              runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
--- a/ghcup.cabal
+++ b/ghcup.cabal
@ -116,7 +116,7 @@ library
    , megaparsec            >=8.0.0      && <9.1
    , monad-logger          ^>=0.3.31
    , mtl                   ^>=2.2
-    , optics                >=0.2        && <0.5
+    , optics                ^>=0.4
    , optics-vl             ^>=0.2
    , os-release            ^>=1.0.0
    , parsec                ^>=3.1
@ -279,7 +279,7 @@ executable ghcup-gen
    , haskus-utils-variant  >=3.0      && <3.2
    , monad-logger          ^>=0.3.31
    , mtl                   ^>=2.2
-    , optics                >=0.2      && <0.5
+    , optics                ^>=0.4
    , optparse-applicative  >=0.15.1.0 && <0.17
    , pretty                ^>=1.1.3.1
    , pretty-terminal       ^>=0.1.0.0
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@ -133,15 +133,12 @@ installGHCBindist :: ( MonadFail m
                       m
                       ()
 installGHCBindist dlinfo ver = do
-  dirs <- lift getDirs
-  settings <- lift getSettings
-
  let tver = mkTVer ver
  lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
  whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)

  -- download (or use cached version)
-  dl                           <- liftE $ downloadCached settings dirs dlinfo Nothing
+  dl <- liftE $ downloadCached dlinfo Nothing

  -- prepare paths
  ghcdir <- lift $ ghcupGHCDir tver
@ -328,8 +325,7 @@ installCabalBindist dlinfo ver = do
  lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]

  PlatformRequest {..} <- lift getPlatformReq
-  dirs@Dirs {..} <- lift getDirs
-  settings <- lift getSettings
+  Dirs {..} <- lift getDirs

  whenM
      (lift (cabalInstalled ver) >>= \a -> liftIO $
@ -341,10 +337,10 @@ installCabalBindist dlinfo ver = do
      (throwE $ AlreadyInstalled Cabal ver)

  -- download (or use cached version)
-  dl                           <- liftE $ downloadCached settings dirs dlinfo Nothing
+  dl <- liftE $ downloadCached dlinfo Nothing

  -- unpack
-  tmpUnpack                    <- lift withGHCupTmpDir
+  tmpUnpack <- lift withGHCupTmpDir
  liftE $ unpackToDir tmpUnpack dl
  void $ lift $ darwinNotarization _rPlatform tmpUnpack

@ -451,17 +447,16 @@ installHLSBindist dlinfo ver = do
  lift $ $(logDebug) [i|Requested to install hls version #{ver}|]

  PlatformRequest {..} <- lift getPlatformReq
-  dirs@Dirs {..} <- lift getDirs
-  settings <- lift getSettings
+  Dirs {..} <- lift getDirs

  whenM (lift (hlsInstalled ver))
    (throwE $ AlreadyInstalled HLS ver)

  -- download (or use cached version)
-  dl                           <- liftE $ downloadCached settings dirs dlinfo Nothing
+  dl <- liftE $ downloadCached dlinfo Nothing

  -- unpack
-  tmpUnpack                    <- lift withGHCupTmpDir
+  tmpUnpack <- lift withGHCupTmpDir
  liftE $ unpackToDir tmpUnpack dl
  void $ lift $ darwinNotarization _rPlatform tmpUnpack

@ -623,17 +618,16 @@ installStackBindist dlinfo ver = do
  lift $ $(logDebug) [i|Requested to install stack version #{ver}|]

  PlatformRequest {..} <- lift getPlatformReq
-  dirs@Dirs {..} <- lift getDirs
-  settings <- lift getSettings
+  Dirs {..} <- lift getDirs

  whenM (lift (stackInstalled ver))
    (throwE $ AlreadyInstalled Stack ver)

  -- download (or use cached version)
-  dl                           <- liftE $ downloadCached settings dirs dlinfo Nothing
+  dl <- liftE $ downloadCached dlinfo Nothing

  -- unpack
-  tmpUnpack                    <- lift withGHCupTmpDir
+  tmpUnpack <- lift withGHCupTmpDir
  liftE $ unpackToDir tmpUnpack dl
  void $ lift $ darwinNotarization _rPlatform tmpUnpack

@ -1634,8 +1628,6 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs
  = do
    PlatformRequest { .. } <- lift getPlatformReq
    GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-    settings <- lift getSettings
-    dirs <- lift getDirs

    (workdir, tmpUnpack, tver) <- case targetGhc of
      -- unpack from version tarball
@ -1646,7 +1638,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs
        dlInfo <-
          preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
            ?? NoDownload
-        dl        <- liftE $ downloadCached settings dirs dlInfo Nothing
+        dl <- liftE $ downloadCached dlInfo Nothing

        -- unpack
        tmpUnpack <- lift mkGhcupTmpDir
@ -1931,7 +1923,6 @@ upgradeGHCup :: ( MonadMask m
 upgradeGHCup mtarget force' = do
  Dirs {..} <- lift getDirs
  pfreq <- lift getPlatformReq
-  settings <- lift getSettings
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo

  lift $ $(logInfo) [i|Upgrading GHCup...|]
@ -1940,7 +1931,7 @@ upgradeGHCup mtarget force' = do
  dli   <- lE $ getDownloadInfo GHCup latestVer pfreq dls
  tmp   <- lift withGHCupTmpDir
  let fn = "ghcup" <> exeExt
-  p <- liftE $ download settings dli tmp (Just fn)
+  p <- liftE $ download dli tmp (Just fn)
  let destDir = takeDirectory destFile
      destFile = fromMaybe (binDir </> fn <> exeExt) mtarget
  lift $ $(logDebug) [i|mkdir -p #{destDir}|]
--- a/lib/GHCup/Download.hs
+++ b/lib/GHCup/Download.hs
@ -107,32 +107,31 @@ import qualified Data.Yaml                     as Y
 getDownloadsF :: ( FromJSONKey Tool
                 , FromJSONKey Version
                 , FromJSON VersionInfo
+                 , MonadReader env m
+                 , HasSettings env
+                 , HasDirs env
                 , MonadIO m
                 , MonadCatch m
                 , MonadLogger m
                 , MonadThrow m
                 , MonadFail m
                 )
-              => Settings
-              -> Dirs
-              -> Excepts
+              => Excepts
                   '[JSONError , DownloadFailed , FileDoesNotExistError]
                   m
                   GHCupInfo
-getDownloadsF settings@Settings{ urlSource } dirs = do
+getDownloadsF = do
+  Settings { urlSource } <- lift getSettings
  case urlSource of
-    GHCupURL -> liftE $ getBase dirs settings
-    (OwnSource url) -> do
-      bs <- reThrowAll DownloadFailed $ downloadBS (downloader settings) url
-      lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
+    GHCupURL -> liftE $ getBase ghcupURL
+    (OwnSource url) -> liftE $ getBase url
    (OwnSpec av) -> pure av
    (AddSource (Left ext)) -> do
-      base <- liftE $ getBase dirs settings
+      base <- liftE $ getBase ghcupURL
      pure (mergeGhcupInfo base ext)
    (AddSource (Right uri)) -> do
-      base <- liftE $ getBase dirs settings
-      bsExt <- reThrowAll DownloadFailed $ downloadBS (downloader settings) uri
-      ext <- lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bsExt)
+      base <- liftE $ getBase ghcupURL
+      ext  <- liftE $ getBase uri
      pure (mergeGhcupInfo base ext)

    where
@ -149,33 +148,49 @@ getDownloadsF settings@Settings{ urlSource } dirs = do
    in GHCupInfo tr newDownloads newGlobalTools


-readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m)
-              => Dirs
-              -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-readFromCache Dirs {..} = do
-  lift $ $(logWarn)
-    [i|Could not get download info, trying cached version (this may not be recent!)|]
-  let path = view pathL' ghcupURL
-  let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
-  bs        <-
-    handleIO' NoSuchThing
-              (\_ -> throwE $ FileDoesNotExistError yaml_file)
-    $ liftIO
-    $ L.readFile yaml_file
-  lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
+readFromCache :: ( MonadReader env m
+                 , HasDirs env
+                 , MonadIO m
+                 , MonadCatch m)
+              => URI
+              -> Excepts '[JSONError, FileDoesNotExistError] m L.ByteString
+readFromCache uri = do
+  Dirs{..} <- lift getDirs
+  let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri)
+  handleIO' NoSuchThing (\_ -> throwE $ FileDoesNotExistError yaml_file)
+    . liftIO
+    . L.readFile
+    $ yaml_file


-getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m)
-        => Dirs
-        -> Settings
+getBase :: ( MonadReader env m
+           , HasDirs env
+           , HasSettings env
+           , MonadFail m
+           , MonadIO m
+           , MonadCatch m
+           , MonadLogger m
+           )
+        => URI
        -> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
-getBase dirs@Dirs{..} Settings{ downloader }  =
-  handleIO (\_ -> readFromCache dirs)
-  $ catchE @_ @'[JSONError, FileDoesNotExistError]
-      (\(DownloadFailed _) -> readFromCache dirs)
-  (reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed (smartDl ghcupURL)
-    >>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . first show . Y.decodeEither' . L.toStrict))
-    where
+getBase uri = do
+  Settings { noNetwork } <- lift getSettings
+  bs <- if noNetwork
+        then readFromCache uri
+        else handleIO (\_ -> warnCache >> readFromCache uri)
+               . catchE @_ @'[JSONError, FileDoesNotExistError] (\(DownloadFailed _) -> warnCache >> readFromCache uri)
+               . reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed
+               $ smartDl uri
+  liftE
+    . lE' @_ @_ @'[JSONError] JSONDecodeError
+    . first show
+    . Y.decodeEither'
+    . L.toStrict
+    $ bs
+ where
+  warnCache = lift $ $(logWarn)
+      [i|Could not get download info, trying cached version (this may not be recent!)|]
+
  -- 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
  -- last 5 minutes, just reuse it.
@ -185,8 +200,11 @@ getBase dirs@Dirs{..} Settings{ downloader }  =
  -- than the local file.
  --
  -- Always save the local file with the mod time of the remote file.
-  smartDl :: forall m1
-           . ( MonadCatch m1
+  smartDl :: forall m1 env1
+           . ( MonadReader env1 m1
+             , HasDirs env1
+             , HasSettings env1
+             , MonadCatch m1
             , MonadIO m1
             , MonadFail m1
             , MonadLogger m1
@ -200,13 +218,15 @@ getBase dirs@Dirs{..} Settings{ downloader }  =
                , NoLocationHeader
                , TooManyRedirs
                , ProcessError
+                , NoNetwork
                ]
               m1
               L.ByteString
  smartDl uri' = do
+    Dirs{..} <- lift getDirs
    let path = view pathL' uri'
    let json_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
-    e         <- liftIO $ doesFileExist json_file
+    e <- liftIO $ doesFileExist json_file
    if e
      then do
        accessTime <- liftIO $ getAccessTime json_file
@ -237,11 +257,11 @@ getBase dirs@Dirs{..} Settings{ downloader }  =

   where
    dlWithMod modTime json_file = do
-      bs <- liftE $ downloadBS downloader uri'
+      bs <- liftE $ downloadBS uri'
      liftIO $ writeFileWithModTime modTime json_file bs
      pure bs
    dlWithoutMod json_file = do
-      bs <- liftE $ downloadBS downloader uri'
+      bs <- liftE $ downloadBS uri'
      liftIO $ hideError doesNotExistErrorType $ rmFile json_file
      liftIO $ L.writeFile json_file bs
      liftIO $ setModificationTime json_file (posixSecondsToUTCTime (fromIntegral @Int 0))
@ -321,17 +341,19 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
 --   2. otherwise create a random file
 --
 -- The file must not exist.
-download :: ( MonadMask m
+download :: ( MonadReader env m
+            , HasSettings env
+            , HasDirs env
+            , MonadMask m
            , MonadThrow m
            , MonadLogger m
            , MonadIO m
            )
-         => Settings
-         -> DownloadInfo
+         => DownloadInfo
         -> FilePath          -- ^ destination dir
         -> Maybe FilePath    -- ^ optional filename
         -> Excepts '[DigestError , DownloadFailed] m FilePath
-download settings@Settings{ downloader } dli dest mfn
+download dli dest mfn
  | scheme == "https" = dl
  | scheme == "http"  = dl
  | scheme == "file"  = cp
@ -362,6 +384,8 @@ download settings@Settings{ downloader } dli dest mfn
            liftIO (hideError doesNotExistErrorType $ rmFile destFile)
              >> (throwE . DownloadFailed $ e)
          ) $ do
+              Settings{ downloader, noNetwork } <- lift getSettings
+              when noNetwork $ throwE (DownloadFailed (V NoNetwork :: V '[NoNetwork]))
              case downloader of
                Curl -> do
                  o' <- liftIO getCurlOpts
@ -377,58 +401,64 @@ download settings@Settings{ downloader } dli dest mfn
                  liftE $ downloadToFile https host fullPath port destFile
 #endif

-    liftE $ checkDigest settings dli destFile
+    liftE $ checkDigest dli destFile
    pure destFile

  -- Manage to find a file we can write the body into.
  getDestFile :: FilePath
-  getDestFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path))) (dest </>) mfn
+  getDestFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
+                  (dest </>)
+                  mfn

-  path        = view (dlUri % pathL') dli
+  path = view (dlUri % pathL') dli


 -- | Download into tmpdir or use cached version, if it exists. If filename
 -- is omitted, infers the filename from the url.
-downloadCached :: ( MonadMask m
+downloadCached :: ( MonadReader env m
+                  , HasDirs env
+                  , HasSettings env
+                  , MonadMask m
                  , MonadResource m
                  , MonadThrow m
                  , MonadLogger m
                  , MonadIO m
                  , MonadUnliftIO m
                  )
-               => Settings
-               -> Dirs
-               -> DownloadInfo
+               => DownloadInfo
               -> Maybe FilePath  -- ^ optional filename
               -> Excepts '[DigestError , DownloadFailed] m FilePath
-downloadCached settings@Settings{ cache } dirs dli mfn = do
+downloadCached dli mfn = do
+  Settings{ cache } <- lift getSettings
  case cache of
-    True -> downloadCached' settings dirs dli mfn
+    True -> downloadCached' dli mfn
    False -> do
      tmp <- lift withGHCupTmpDir
-      liftE $ download settings dli tmp mfn
+      liftE $ download dli tmp mfn


-downloadCached' :: ( MonadMask m
+downloadCached' :: ( MonadReader env m
+                   , HasDirs env
+                   , HasSettings env
+                   , MonadMask m
                   , MonadThrow m
                   , MonadLogger m
                   , MonadIO m
                   , MonadUnliftIO m
                   )
-                => Settings
-                -> Dirs
-                -> DownloadInfo
+                => DownloadInfo
                -> Maybe FilePath  -- ^ optional filename
                -> Excepts '[DigestError , DownloadFailed] m FilePath
-downloadCached' settings Dirs{..} dli mfn = do
+downloadCached' dli mfn = do
+  Dirs { cacheDir } <- lift getDirs
  let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
  let cachfile = cacheDir </> fn
  fileExists <- liftIO $ doesFileExist cachfile
  if
    | fileExists -> do
-      liftE $ checkDigest settings dli cachfile
+      liftE $ checkDigest dli cachfile
      pure cachfile
-    | otherwise -> liftE $ download settings dli cacheDir mfn
+    | otherwise -> liftE $ download dli cacheDir mfn



@ -441,9 +471,13 @@ downloadCached' settings Dirs{..} dli mfn = do


 -- | This is used for downloading the JSON.
-downloadBS :: (MonadCatch m, MonadIO m, MonadLogger m)
-           => Downloader
-           -> URI
+downloadBS :: ( MonadReader env m
+              , HasSettings env
+              , MonadCatch m
+              , MonadIO m
+              , MonadLogger m
+              )
+           => URI
           -> Excepts
                '[ FileDoesNotExistError
                 , HTTPStatusError
@ -452,10 +486,11 @@ downloadBS :: (MonadCatch m, MonadIO m, MonadLogger m)
                 , NoLocationHeader
                 , TooManyRedirs
                 , ProcessError
+                 , NoNetwork
                 ]
                m
                L.ByteString
-downloadBS downloader uri'
+downloadBS uri'
  | scheme == "https"
  = dl True
  | scheme == "http"
@ -475,6 +510,8 @@ downloadBS downloader uri'
  dl _ = do
 #endif
    lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
+    Settings{ downloader, noNetwork } <- lift getSettings
+    when noNetwork $ throwE NoNetwork
    case downloader of
      Curl -> do
        o' <- liftIO getCurlOpts
@ -499,12 +536,18 @@ downloadBS downloader uri'
 #endif


-checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m)
-            => Settings
-            -> DownloadInfo
+checkDigest :: ( MonadReader env m
+               , HasDirs env
+               , HasSettings env
+               , MonadIO m
+               , MonadThrow m
+               , MonadLogger m
+               )
+            => DownloadInfo
            -> FilePath
            -> Excepts '[DigestError] m ()
-checkDigest Settings{ noVerify } dli file = do
+checkDigest dli file = do
+  Settings{ noVerify } <- lift getSettings
  let verify = not noVerify
  when verify $ do
    let p' = takeFileName file
--- a/lib/GHCup/Errors.hs
+++ b/lib/GHCup/Errors.hs
@ -233,6 +233,13 @@ instance Pretty NoToolVersionSet where
  pPrint (NoToolVersionSet tool) =
    text [i|No version is set for tool "#{tool}".|]

+data NoNetwork = NoNetwork
+  deriving Show
+
+instance Pretty NoNetwork where
+  pPrint NoNetwork =
+    text [i|A download was required or requested, but '--offline' was specified.|]
+

    -------------------------
    --[ High-level errors ]--
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@ -297,11 +297,12 @@ data UserSettings = UserSettings
  , uDownloader  :: Maybe Downloader
  , uKeyBindings :: Maybe UserKeyBindings
  , uUrlSource   :: Maybe URLSource
+  , uNoNetwork   :: Maybe Bool
  }
  deriving (Show, GHC.Generic)

 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

 data UserKeyBindings = UserKeyBindings
  { kUp        :: Maybe Key
@ -353,13 +354,16 @@ data AppState = AppState
  , pfreq :: PlatformRequest
  } deriving (Show, GHC.Generic)

+instance NFData AppState
+
 data LeanAppState = LeanAppState
  { settings :: Settings
  , dirs :: Dirs
  , keyBindings :: KeyBindings
  } deriving (Show, GHC.Generic)

-instance NFData AppState
+instance NFData LeanAppState
+

 data Settings = Settings
  { cache      :: Bool
@ -368,6 +372,7 @@ data Settings = Settings
  , downloader :: Downloader
  , verbose    :: Bool
  , urlSource  :: URLSource
+  , noNetwork  :: Bool
  }
  deriving (Show, GHC.Generic)

--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@ -1071,7 +1071,7 @@ ensureGlobalTools = do
  dirs <- lift getDirs
  shimDownload <- liftE $ lE @_ @'[NoDownload]
    $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
-  let dl = downloadCached' settings dirs shimDownload (Just "gs.exe")
+  let dl = downloadCached' shimDownload (Just "gs.exe")
  void $ (\(DigestError _ _) -> do
      lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|]
      lift $ $(logDebug) [i|rm -f #{shimDownload}|]
--- a/lib/GHCup/Utils/File/Windows.hs
+++ b/lib/GHCup/Utils/File/Windows.hs
@ -19,6 +19,7 @@ import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File.Common
 import           GHCup.Types
+import           GHCup.Types.Optics

 import           Control.Concurrent
 import           Control.DeepSeq
--- a/stack.yaml
+++ b/stack.yaml
@ -31,6 +31,10 @@ extra-deps:
  - libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
  - 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
  - primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
  - regex-posix-clib-2.7
  - streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421