{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}


{-|
Module      : GHCup.Download
Description : Downloading
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : POSIX

Module for handling all download related functions.

Generally we support downloading via:

  - curl (default)
  - wget
  - internal downloader (only when compiled)
-}
module GHCup.Download where

#if defined(INTERNAL_DOWNLOADER)
import           GHCup.Download.IOStreams
import           GHCup.Download.Utils
#endif
import           GHCup.Errors
import           GHCup.Types
import           GHCup.Types.JSON               ( )
import           GHCup.Types.Optics
import           GHCup.Utils
import           GHCup.Utils.File
import           GHCup.Utils.Prelude
import           GHCup.Version

import           Control.Applicative
import           Control.Exception.Safe
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
import           Data.Aeson
import           Data.Bifunctor
import           Data.ByteString                ( ByteString )
#if defined(INTERNAL_DOWNLOADER)
import           Data.CaseInsensitive           ( CI )
#endif
import           Data.List                      ( find )
import           Data.Maybe
import           Data.String.Interpolate
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
#if defined(INTERNAL_DOWNLOADER)
import           Data.Time.Format
#endif
import           Data.Versions
import           Data.Word8
import           GHC.IO.Exception
import           HPath
import           HPath.IO                     as HIO hiding ( hideError )
import           Haskus.Utils.Variant.Excepts
import           Optics
import           Prelude                 hiding ( abs
                                                , readFile
                                                , writeFile
                                                )
import           System.IO.Error
import           System.Posix.Env.ByteString    ( getEnv )
import           URI.ByteString

import qualified Crypto.Hash.SHA256            as SHA256
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Base16        as B16
import qualified Data.ByteString.Lazy          as L
import qualified Data.Map.Strict               as M
#if defined(INTERNAL_DOWNLOADER)
import qualified Data.CaseInsensitive          as CI
import qualified Data.Text                     as T
#endif
import qualified Data.Text.Encoding            as E
import qualified Data.Yaml                     as Y
import qualified System.Posix.Files.ByteString as PF
import qualified System.Posix.RawFilePath.Directory
                                               as RD






    ------------------
    --[ High-level ]--
    ------------------



-- | Downloads the download information! But only if we need to ;P
getDownloadsF :: ( FromJSONKey Tool
                 , FromJSONKey Version
                 , FromJSON VersionInfo
                 , MonadIO m
                 , MonadCatch m
                 , MonadLogger m
                 , MonadThrow m
                 , MonadFail m
                 , MonadReader AppState m
                 )
              => URLSource
              -> Excepts
                   '[JSONError , DownloadFailed , FileDoesNotExistError]
                   m
                   GHCupInfo
getDownloadsF :: URLSource
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
getDownloadsF URLSource
urlSource = do
  case URLSource
urlSource of
    URLSource
GHCupURL -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall (m :: * -> *).
(MonadFail m, MonadIO m, MonadCatch m, MonadLogger m,
 MonadReader AppState m) =>
Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
getBase
    (OwnSource URI
url) -> do
      ByteString
bs <- (V '[FileDoesNotExistError, HTTPStatusError, URIParseError,
     UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
 -> DownloadFailed)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m ByteString
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll V '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
-> DownloadFailed
forall x (xs :: [*]).
(Show x, Show (V xs), Pretty x, Pretty (V xs)) =>
V (x : xs) -> DownloadFailed
DownloadFailed (Excepts
   '[FileDoesNotExistError, HTTPStatusError, URIParseError,
     UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
   m
   ByteString
 -> Excepts
      '[JSONError, DownloadFailed, FileDoesNotExistError] m ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m ByteString
forall a b. (a -> b) -> a -> b
$ URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m) =>
URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
downloadBS URI
url
      (String -> JSONError)
-> Either String GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall e' e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
(e' -> e) -> Either e' a -> Excepts es m a
lE' String -> JSONError
JSONDecodeError (Either String GHCupInfo
 -> Excepts
      '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo)
-> Either String GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall a b. (a -> b) -> a -> b
$ (ParseException -> String)
-> Either ParseException GHCupInfo -> Either String GHCupInfo
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
forall a. Show a => a -> String
show (Either ParseException GHCupInfo -> Either String GHCupInfo)
-> Either ParseException GHCupInfo -> Either String GHCupInfo
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException GHCupInfo
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' (ByteString -> ByteString
L.toStrict ByteString
bs)
    (OwnSpec GHCupInfo
av) -> GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCupInfo
av
    (AddSource (Left GHCupInfo
ext)) -> do
      GHCupInfo
base <- Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall (m :: * -> *).
(MonadFail m, MonadIO m, MonadCatch m, MonadLogger m,
 MonadReader AppState m) =>
Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
getBase
      GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> GHCupInfo -> GHCupInfo
mergeGhcupInfo GHCupInfo
base GHCupInfo
ext)
    (AddSource (Right URI
uri)) -> do
      GHCupInfo
base <- Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall (m :: * -> *).
(MonadFail m, MonadIO m, MonadCatch m, MonadLogger m,
 MonadReader AppState m) =>
Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
getBase
      ByteString
bsExt <- (V '[FileDoesNotExistError, HTTPStatusError, URIParseError,
     UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
 -> DownloadFailed)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m ByteString
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll V '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
-> DownloadFailed
forall x (xs :: [*]).
(Show x, Show (V xs), Pretty x, Pretty (V xs)) =>
V (x : xs) -> DownloadFailed
DownloadFailed (Excepts
   '[FileDoesNotExistError, HTTPStatusError, URIParseError,
     UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
   m
   ByteString
 -> Excepts
      '[JSONError, DownloadFailed, FileDoesNotExistError] m ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m ByteString
forall a b. (a -> b) -> a -> b
$ URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m) =>
URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
downloadBS URI
uri
      GHCupInfo
ext <- (String -> JSONError)
-> Either String GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall e' e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
(e' -> e) -> Either e' a -> Excepts es m a
lE' String -> JSONError
JSONDecodeError (Either String GHCupInfo
 -> Excepts
      '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo)
-> Either String GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall a b. (a -> b) -> a -> b
$ (ParseException -> String)
-> Either ParseException GHCupInfo -> Either String GHCupInfo
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
forall a. Show a => a -> String
show (Either ParseException GHCupInfo -> Either String GHCupInfo)
-> Either ParseException GHCupInfo -> Either String GHCupInfo
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException GHCupInfo
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' (ByteString -> ByteString
L.toStrict ByteString
bsExt)
      GHCupInfo
-> Excepts
     '[JSONError, DownloadFailed, FileDoesNotExistError] m GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> GHCupInfo -> GHCupInfo
mergeGhcupInfo GHCupInfo
base GHCupInfo
ext)

    where

  mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
                 -> GHCupInfo -- ^ extension overwriting the base
                 -> GHCupInfo
  mergeGhcupInfo :: GHCupInfo -> GHCupInfo -> GHCupInfo
mergeGhcupInfo (GHCupInfo ToolRequirements
tr GHCupDownloads
base) (GHCupInfo ToolRequirements
_ GHCupDownloads
ext) =
    let new :: GHCupDownloads
new = (Tool -> Map Version VersionInfo -> Map Version VersionInfo)
-> GHCupDownloads -> GHCupDownloads
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\Tool
k Map Version VersionInfo
a -> case Tool -> GHCupDownloads -> Maybe (Map Version VersionInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Tool
k GHCupDownloads
ext of
                                        Just Map Version VersionInfo
a' -> Map Version VersionInfo
-> Map Version VersionInfo -> Map Version VersionInfo
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Version VersionInfo
a' Map Version VersionInfo
a
                                        Maybe (Map Version VersionInfo)
Nothing -> Map Version VersionInfo
a
                           ) GHCupDownloads
base
    in ToolRequirements -> GHCupDownloads -> GHCupInfo
GHCupInfo ToolRequirements
tr GHCupDownloads
new


readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
              => Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache :: Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache = do
  AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
..}} <- m AppState
-> Excepts '[JSONError, FileDoesNotExistError] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  m () -> Excepts '[JSONError, FileDoesNotExistError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[JSONError, FileDoesNotExistError] m ())
-> m () -> Excepts '[JSONError, FileDoesNotExistError] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn)
    [i|Could not get download info, trying cached version (this may not be recent!)|]
  let path :: ByteString
path = Optic' A_Lens '[] URI ByteString -> URI -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] URI ByteString
forall a. Lens' (URIRef a) ByteString
pathL' URI
ghcupURL
  Path Abs
yaml_file <- (Path Abs
cacheDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</>) (Path Rel -> Path Abs)
-> Excepts '[JSONError, FileDoesNotExistError] m (Path Rel)
-> Excepts '[JSONError, FileDoesNotExistError] m (Path Abs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Excepts '[JSONError, FileDoesNotExistError] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
urlBaseName ByteString
path
  ByteString
bs        <-
    IOErrorType
-> (IOException
    -> Excepts '[JSONError, FileDoesNotExistError] m ByteString)
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
NoSuchThing
              (\IOException
_ -> FileDoesNotExistError
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (FileDoesNotExistError
 -> Excepts '[JSONError, FileDoesNotExistError] m ByteString)
-> FileDoesNotExistError
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> FileDoesNotExistError
FileDoesNotExistError (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
yaml_file))
    (Excepts '[JSONError, FileDoesNotExistError] m ByteString
 -> Excepts '[JSONError, FileDoesNotExistError] m ByteString)
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO ByteString
 -> Excepts '[JSONError, FileDoesNotExistError] m ByteString)
-> IO ByteString
-> Excepts '[JSONError, FileDoesNotExistError] m ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile Path Abs
yaml_file
  (String -> JSONError)
-> Either String GHCupInfo
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall e' e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
(e' -> e) -> Either e' a -> Excepts es m a
lE' String -> JSONError
JSONDecodeError (Either String GHCupInfo
 -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo)
-> Either String GHCupInfo
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall a b. (a -> b) -> a -> b
$ (ParseException -> String)
-> Either ParseException GHCupInfo -> Either String GHCupInfo
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
forall a. Show a => a -> String
show (Either ParseException GHCupInfo -> Either String GHCupInfo)
-> Either ParseException GHCupInfo -> Either String GHCupInfo
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException GHCupInfo
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' (ByteString -> ByteString
L.toStrict ByteString
bs)


getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
        => Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
getBase :: Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
getBase =
  (IOException
 -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo)
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall (m :: * -> *).
(MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m) =>
Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache)
  (Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
 -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo)
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall a b. (a -> b) -> a -> b
$ (DownloadFailed
 -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo)
-> Excepts '[JSONError, DownloadFailed] m GHCupInfo
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
 LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
catchE @_ @'[JSONError, FileDoesNotExistError]
      (\(DownloadFailed V (x : xs)
_) -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall (m :: * -> *).
(MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m) =>
Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache)
  ((V '[FileDoesNotExistError, HTTPStatusError, URIParseError,
     UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
 -> DownloadFailed)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
-> Excepts '[JSONError, DownloadFailed] m ByteString
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @_ @'[JSONError, DownloadFailed] V '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
-> DownloadFailed
forall x (xs :: [*]).
(Show x, Show (V xs), Pretty x, Pretty (V xs)) =>
V (x : xs) -> DownloadFailed
DownloadFailed (URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (m1 :: * -> *).
(MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1,
 MonadReader AppState m1) =>
URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
smartDl URI
ghcupURL)
    Excepts '[JSONError, DownloadFailed] m ByteString
-> (ByteString -> Excepts '[JSONError, DownloadFailed] m GHCupInfo)
-> Excepts '[JSONError, DownloadFailed] m GHCupInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Excepts '[JSONError] m GHCupInfo
-> Excepts '[JSONError, DownloadFailed] m GHCupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[JSONError] m GHCupInfo
 -> Excepts '[JSONError, DownloadFailed] m GHCupInfo)
-> (ByteString -> Excepts '[JSONError] m GHCupInfo)
-> ByteString
-> Excepts '[JSONError, DownloadFailed] m GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> JSONError)
-> Either String GHCupInfo -> Excepts '[JSONError] m GHCupInfo
forall e' e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
(e' -> e) -> Either e' a -> Excepts es m a
lE' @_ @_ @'[JSONError] String -> JSONError
JSONDecodeError (Either String GHCupInfo -> Excepts '[JSONError] m GHCupInfo)
-> (ByteString -> Either String GHCupInfo)
-> ByteString
-> Excepts '[JSONError] m GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseException -> String)
-> Either ParseException GHCupInfo -> Either String GHCupInfo
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
forall a. Show a => a -> String
show (Either ParseException GHCupInfo -> Either String GHCupInfo)
-> (ByteString -> Either ParseException GHCupInfo)
-> ByteString
-> Either String GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException GHCupInfo
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' (ByteString -> Either ParseException GHCupInfo)
-> (ByteString -> ByteString)
-> ByteString
-> Either ParseException GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict))
    where
  -- 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.
  --
  -- If not, then send a HEAD request and check for modification time.
  -- Only download the file if the modification time is newer
  -- than the local file.
  --
  -- Always save the local file with the mod time of the remote file.
  smartDl :: forall m1
           . ( MonadCatch m1
             , MonadIO m1
             , MonadFail m1
             , MonadLogger m1
             , MonadReader AppState m1
             )
          => URI
          -> Excepts
               '[ FileDoesNotExistError
                , HTTPStatusError
                , URIParseError
                , UnsupportedScheme
                , NoLocationHeader
                , TooManyRedirs
                , ProcessError
                ]
               m1
               L.ByteString
  smartDl :: URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
smartDl URI
uri' = do
    AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m1 AppState
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m1 AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
    let path :: ByteString
path = Optic' A_Lens '[] URI ByteString -> URI -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] URI ByteString
forall a. Lens' (URIRef a) ByteString
pathL' URI
uri'
    Path Abs
json_file <- (Path Abs
cacheDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</>) (Path Rel -> Path Abs)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     (Path Rel)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     (Path Abs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
urlBaseName ByteString
path
    Bool
e         <- IO Bool
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      Bool)
-> IO Bool
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     Bool
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesFileExist Path Abs
json_file
    if Bool
e
      then do
        POSIXTime
accessTime <-
          FileStatus -> POSIXTime
PF.accessTimeHiRes
            (FileStatus -> POSIXTime)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     FileStatus
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FileStatus
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO FileStatus
PF.getFileStatus (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
json_file))
        POSIXTime
currentTime <- IO POSIXTime
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime

        -- access time won't work on most linuxes, but we can try regardless
        if (POSIXTime
currentTime POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
accessTime) POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
300
          then do -- no access in last 5 minutes, re-check upstream mod time
            Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  (Maybe UTCTime)
forall a.
Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  (Maybe a)
getModTime Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  (Maybe UTCTime)
-> (Maybe UTCTime
    -> Excepts
         '[FileDoesNotExistError, HTTPStatusError, URIParseError,
           UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
         m1
         ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just UTCTime
modTime -> do
                UTCTime
fileMod <- IO UTCTime
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      UTCTime)
-> IO UTCTime
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     UTCTime
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO UTCTime
forall b. Path b -> IO UTCTime
getModificationTime Path Abs
json_file
                if UTCTime
modTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
fileMod
                  then UTCTime
-> Path Abs
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
dlWithMod UTCTime
modTime Path Abs
json_file
                  else IO ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ByteString)
-> IO ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile Path Abs
json_file
              Maybe UTCTime
Nothing -> do
                m1 ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ())
-> m1 ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m1 ()
(Text -> m1 ()) -> (Text -> Text) -> Text -> m1 ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Unable to get/parse Last-Modified header|]
                Path Abs
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
dlWithoutMod Path Abs
json_file
          else -- access in less than 5 minutes, re-use file
               IO ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ByteString)
-> IO ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile Path Abs
json_file
      else do
        IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
cacheDir
        Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  (Maybe UTCTime)
forall a.
Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  (Maybe a)
getModTime Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  (Maybe UTCTime)
-> (Maybe UTCTime
    -> Excepts
         '[FileDoesNotExistError, HTTPStatusError, URIParseError,
           UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
         m1
         ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just UTCTime
modTime -> UTCTime
-> Path Abs
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
dlWithMod UTCTime
modTime Path Abs
json_file
          Maybe UTCTime
Nothing -> do
            -- although we don't know last-modified, we still save
            -- it to a file, so we might use it in offline mode
            m1 ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ())
-> m1 ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m1 ()
(Text -> m1 ()) -> (Text -> Text) -> Text -> m1 ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Unable to get/parse Last-Modified header|]
            Path Abs
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
dlWithoutMod Path Abs
json_file

   where
    dlWithMod :: UTCTime
-> Path Abs
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
dlWithMod UTCTime
modTime Path Abs
json_file = do
      ByteString
bs <- Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[FileDoesNotExistError, HTTPStatusError, URIParseError,
     UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
   m1
   ByteString
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall a b. (a -> b) -> a -> b
$ URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m) =>
URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
downloadBS URI
uri'
      IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> Path Abs -> ByteString -> IO ()
writeFileWithModTime UTCTime
modTime Path Abs
json_file ByteString
bs
      ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
    dlWithoutMod :: Path Abs
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
dlWithoutMod Path Abs
json_file = do
      ByteString
bs <- Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[FileDoesNotExistError, HTTPStatusError, URIParseError,
     UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
   m1
   ByteString
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall a b. (a -> b) -> a -> b
$ URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m) =>
URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
downloadBS URI
uri'
      IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
json_file
      IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Maybe FileMode -> ByteString -> IO ()
forall b. Path b -> Maybe FileMode -> ByteString -> IO ()
writeFileL Path Abs
json_file (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
newFilePerms) ByteString
bs
      IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m1
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> EpochTime -> IO ()
forall b. Path b -> EpochTime -> IO ()
setModificationTime Path Abs
json_file (Int -> EpochTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int Int
0)
      ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs


    getModTime :: Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m1
  (Maybe a)
getModTime = do
#if !defined(INTERNAL_DOWNLOADER)
      Maybe a
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m1
     (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
#else
      headers <-
        handleIO (\_ -> pure mempty)
        $ liftE
        $ ( catchAllE
              (\_ ->
                pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString)
              )
          $ getHead uri'
          )
      pure $ parseModifiedHeader headers

  parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
  parseModifiedHeader headers =
    (M.lookup (CI.mk "Last-Modified") headers) >>= \h -> parseTimeM
      True
      defaultTimeLocale
      "%a, %d %b %Y %H:%M:%S %Z"
      (T.unpack . decUTF8Safe $ h)

#endif

  writeFileWithModTime :: UTCTime -> Path Abs -> L.ByteString -> IO ()
  writeFileWithModTime :: UTCTime -> Path Abs -> ByteString -> IO ()
writeFileWithModTime UTCTime
utctime Path Abs
path ByteString
content = do
    let mod_time :: POSIXTime
mod_time = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utctime
    Path Abs -> Maybe FileMode -> ByteString -> IO ()
forall b. Path b -> Maybe FileMode -> ByteString -> IO ()
writeFileL Path Abs
path (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
newFilePerms) ByteString
content
    Path Abs -> POSIXTime -> IO ()
forall b. Path b -> POSIXTime -> IO ()
setModificationTimeHiRes Path Abs
path POSIXTime
mod_time


getDownloadInfo :: Tool
                -> Version
                -- ^ tool version
                -> PlatformRequest
                -> GHCupDownloads
                -> Either NoDownload DownloadInfo
getDownloadInfo :: Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
t Version
v (PlatformRequest Architecture
a Platform
p Maybe Versioning
mv) GHCupDownloads
dls = Either NoDownload DownloadInfo
-> (DownloadInfo -> Either NoDownload DownloadInfo)
-> Maybe DownloadInfo
-> Either NoDownload DownloadInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (NoDownload -> Either NoDownload DownloadInfo
forall a b. a -> Either a b
Left NoDownload
NoDownload)
  DownloadInfo -> Either NoDownload DownloadInfo
forall a b. b -> Either a b
Right
  (case Platform
p of
    -- non-musl won't work on alpine
    Linux LinuxDistro
Alpine -> Maybe DownloadInfo
with_distro Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro_ver
    Platform
_            -> Maybe DownloadInfo
with_distro Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro_ver Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro
  )

 where
  with_distro :: Maybe DownloadInfo
with_distro        = (Platform -> Platform)
-> (Maybe Versioning -> Maybe Versioning) -> Maybe DownloadInfo
distro_preview Platform -> Platform
forall a. a -> a
id Maybe Versioning -> Maybe Versioning
forall a. a -> a
id
  without_distro_ver :: Maybe DownloadInfo
without_distro_ver = (Platform -> Platform)
-> (Maybe Versioning -> Maybe Versioning) -> Maybe DownloadInfo
distro_preview Platform -> Platform
forall a. a -> a
id (Maybe Versioning -> Maybe Versioning -> Maybe Versioning
forall a b. a -> b -> a
const Maybe Versioning
forall a. Maybe a
Nothing)
  without_distro :: Maybe DownloadInfo
without_distro     = (Platform -> Platform)
-> (Maybe Versioning -> Maybe Versioning) -> Maybe DownloadInfo
distro_preview (Optic A_Prism '[] Platform Platform LinuxDistro LinuxDistro
-> LinuxDistro -> Platform -> Platform
forall k (is :: [*]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Prism '[] Platform Platform LinuxDistro LinuxDistro
_Linux LinuxDistro
UnknownLinux) (Maybe Versioning -> Maybe Versioning -> Maybe Versioning
forall a b. a -> b -> a
const Maybe Versioning
forall a. Maybe a
Nothing)

  distro_preview :: (Platform -> Platform)
-> (Maybe Versioning -> Maybe Versioning) -> Maybe DownloadInfo
distro_preview Platform -> Platform
f Maybe Versioning -> Maybe Versioning
g =
    let platformVersionSpec :: Maybe (Map (Maybe VersionRange) DownloadInfo)
platformVersionSpec =
          Optic'
  An_AffineTraversal
  '[]
  GHCupDownloads
  (Map (Maybe VersionRange) DownloadInfo)
-> GHCupDownloads -> Maybe (Map (Maybe VersionRange) DownloadInfo)
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
     (IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
t Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     VersionInfo
     VersionInfo
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     VersionInfo
     VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Version VersionInfo)
-> Optic'
     (IxKind (Map Version VersionInfo))
     '[]
     (Map Version VersionInfo)
     (IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Version VersionInfo)
Version
v Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  VersionInfo
  VersionInfo
-> Optic
     A_Lens
     '[]
     VersionInfo
     VersionInfo
     ArchitectureSpec
     ArchitectureSpec
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     ArchitectureSpec
     ArchitectureSpec
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  VersionInfo
  VersionInfo
  ArchitectureSpec
  ArchitectureSpec
viArch Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  ArchitectureSpec
  ArchitectureSpec
-> Optic
     An_AffineTraversal
     '[]
     ArchitectureSpec
     ArchitectureSpec
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index ArchitectureSpec
-> Optic'
     (IxKind ArchitectureSpec)
     '[]
     ArchitectureSpec
     (IxValue ArchitectureSpec)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index ArchitectureSpec
Architecture
a Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Platform (Map (Maybe VersionRange) DownloadInfo))
  (Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
     An_AffineTraversal
     '[]
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map (Maybe VersionRange) DownloadInfo)
     (Map (Maybe VersionRange) DownloadInfo)
-> Optic'
     An_AffineTraversal
     '[]
     GHCupDownloads
     (Map (Maybe VersionRange) DownloadInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic'
     (IxKind (Map Platform (Map (Maybe VersionRange) DownloadInfo)))
     '[]
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (IxValue (Map Platform (Map (Maybe VersionRange) DownloadInfo)))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (Platform -> Platform
f Platform
p)) GHCupDownloads
dls
        mv' :: Maybe Versioning
mv' = Maybe Versioning -> Maybe Versioning
g Maybe Versioning
mv
    in  ((Maybe VersionRange, DownloadInfo) -> DownloadInfo)
-> Maybe (Maybe VersionRange, DownloadInfo) -> Maybe DownloadInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe VersionRange, DownloadInfo) -> DownloadInfo
forall a b. (a, b) -> b
snd
          (Maybe (Maybe VersionRange, DownloadInfo) -> Maybe DownloadInfo)
-> (Map (Maybe VersionRange) DownloadInfo
    -> Maybe (Maybe VersionRange, DownloadInfo))
-> Map (Maybe VersionRange) DownloadInfo
-> Maybe DownloadInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   ((Maybe VersionRange, DownloadInfo) -> Bool)
-> [(Maybe VersionRange, DownloadInfo)]
-> Maybe (Maybe VersionRange, DownloadInfo)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
                (\(Maybe VersionRange
mverRange, DownloadInfo
_) -> Bool -> (VersionRange -> Bool) -> Maybe VersionRange -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                  (Maybe Versioning -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Versioning
mv')
                  (\VersionRange
range -> Bool -> (Versioning -> Bool) -> Maybe Versioning -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Versioning -> VersionRange -> Bool
`versionRange` VersionRange
range) Maybe Versioning
mv')
                  Maybe VersionRange
mverRange
                )
          ([(Maybe VersionRange, DownloadInfo)]
 -> Maybe (Maybe VersionRange, DownloadInfo))
-> (Map (Maybe VersionRange) DownloadInfo
    -> [(Maybe VersionRange, DownloadInfo)])
-> Map (Maybe VersionRange) DownloadInfo
-> Maybe (Maybe VersionRange, DownloadInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Map (Maybe VersionRange) DownloadInfo
-> [(Maybe VersionRange, DownloadInfo)]
forall k a. Map k a -> [(k, a)]
M.toList
          (Map (Maybe VersionRange) DownloadInfo -> Maybe DownloadInfo)
-> Maybe (Map (Maybe VersionRange) DownloadInfo)
-> Maybe DownloadInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Map (Maybe VersionRange) DownloadInfo)
platformVersionSpec


-- | Tries to download from the given http or https url
-- and saves the result in continuous memory into a file.
-- If the filename is not provided, then we:
--   1. try to guess the filename from the url path
--   2. otherwise create a random file
--
-- The file must not exist.
download :: ( MonadMask m
            , MonadReader AppState m
            , MonadThrow m
            , MonadLogger m
            , MonadIO m
            )
         => DownloadInfo
         -> Path Abs          -- ^ destination dir
         -> Maybe (Path Rel)  -- ^ optional filename
         -> Excepts '[DigestError , DownloadFailed] m (Path Abs)
download :: DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
download DownloadInfo
dli Path Abs
dest Maybe (Path Rel)
mfn
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"https" = Excepts '[DigestError, DownloadFailed] m (Path Abs)
dl
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"http"  = Excepts '[DigestError, DownloadFailed] m (Path Abs)
dl
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"file"  = Excepts '[DigestError, DownloadFailed] m (Path Abs)
cp
  | Bool
otherwise = DownloadFailed
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DownloadFailed
 -> Excepts '[DigestError, DownloadFailed] m (Path Abs))
-> DownloadFailed
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ V '[UnsupportedScheme] -> DownloadFailed
forall x (xs :: [*]).
(Show x, Show (V xs), Pretty x, Pretty (V xs)) =>
V (x : xs) -> DownloadFailed
DownloadFailed (UnsupportedScheme -> V '[UnsupportedScheme]
forall a. a -> V '[a]
variantFromValue UnsupportedScheme
UnsupportedScheme)

 where
  scheme :: ByteString
scheme = Optic' A_Lens '[] DownloadInfo ByteString
-> DownloadInfo -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' DownloadInfo URI
dlUri Lens' DownloadInfo URI
-> Optic A_Lens '[] URI URI Scheme Scheme
-> Optic A_Lens '[] DownloadInfo DownloadInfo Scheme Scheme
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] URI URI Scheme Scheme
uriSchemeL' Optic A_Lens '[] DownloadInfo DownloadInfo Scheme Scheme
-> Optic A_Lens '[] Scheme Scheme ByteString ByteString
-> Optic' A_Lens '[] DownloadInfo ByteString
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Scheme Scheme ByteString ByteString
schemeBSL') DownloadInfo
dli
  cp :: Excepts '[DigestError, DownloadFailed] m (Path Abs)
cp     = do
    -- destination dir must exist
    IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[DigestError, DownloadFailed] m ())
-> IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
dest
    Path Abs
destFile <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *). MonadThrow m => m (Path Abs)
getDestFile
    Path Abs
fromFile <- ByteString -> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
path
    IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[DigestError, DownloadFailed] m ())
-> IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile Path Abs
fromFile Path Abs
destFile CopyMode
Strict
    Path Abs -> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
destFile
  dl :: Excepts '[DigestError, DownloadFailed] m (Path Abs)
dl = do
    let uri' :: Text
uri' = ByteString -> Text
decUTF8Safe (URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (Lens' DownloadInfo URI -> DownloadInfo -> URI
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' DownloadInfo URI
dlUri DownloadInfo
dli))
    m () -> Excepts '[DigestError, DownloadFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[DigestError, DownloadFailed] m ())
-> m () -> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|downloading: #{uri'}|]

    -- destination dir must exist
    IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[DigestError, DownloadFailed] m ())
-> IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
dest
    Path Abs
destFile <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *). MonadThrow m => m (Path Abs)
getDestFile

    -- download
    (Excepts '[DigestError, DownloadFailed] m ()
 -> Excepts '[DigestError, DownloadFailed] m ()
 -> Excepts '[DigestError, DownloadFailed] m ())
-> Excepts '[DigestError, DownloadFailed] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[DigestError, DownloadFailed] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException
         (IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[DigestError, DownloadFailed] m ())
-> IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
destFile)
     (Excepts '[DigestError, DownloadFailed] m ()
 -> Excepts '[DigestError, DownloadFailed] m ())
-> Excepts '[DigestError, DownloadFailed] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ (V '[ProcessError, DownloadFailed, UnsupportedScheme]
 -> Excepts '[DigestError, DownloadFailed] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
          (\V '[ProcessError, DownloadFailed, UnsupportedScheme]
e ->
            IO () -> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
destFile)
              Excepts '[DigestError, DownloadFailed] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (DownloadFailed -> Excepts '[DigestError, DownloadFailed] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DownloadFailed -> Excepts '[DigestError, DownloadFailed] m ())
-> (V '[ProcessError, DownloadFailed, UnsupportedScheme]
    -> DownloadFailed)
-> V '[ProcessError, DownloadFailed, UnsupportedScheme]
-> Excepts '[DigestError, DownloadFailed] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V '[ProcessError, DownloadFailed, UnsupportedScheme]
-> DownloadFailed
forall x (xs :: [*]).
(Show x, Show (V xs), Pretty x, Pretty (V xs)) =>
V (x : xs) -> DownloadFailed
DownloadFailed (V '[ProcessError, DownloadFailed, UnsupportedScheme]
 -> Excepts '[DigestError, DownloadFailed] m ())
-> V '[ProcessError, DownloadFailed, UnsupportedScheme]
-> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ V '[ProcessError, DownloadFailed, UnsupportedScheme]
e)
          ) (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts '[DigestError, DownloadFailed] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
              m Downloader
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m Downloader
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Downloader
forall (m :: * -> *). MonadReader AppState m => m Downloader
getDownloader Excepts
  '[ProcessError, DownloadFailed, UnsupportedScheme] m Downloader
-> (Downloader
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Downloader
Curl -> do
                  [ByteString]
o' <- IO [ByteString]
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getCurlOpts
                  Excepts '[ProcessError] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ()) -> m (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ()) -> m (Either ProcessError ()))
-> IO (Either ProcessError ()) -> m (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> IO (Either ProcessError ())
exec ByteString
"curl" Bool
True
                    ([ByteString]
o' [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
"-fL", ByteString
"-o", Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
destFile, URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URI -> ByteString) -> URI -> ByteString
forall a b. (a -> b) -> a -> b
$ Lens' DownloadInfo URI -> DownloadInfo -> URI
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' DownloadInfo URI
dlUri DownloadInfo
dli]) Maybe (Path Abs)
forall a. Maybe a
Nothing Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing
                Downloader
Wget -> do
                  [ByteString]
o' <- IO [ByteString]
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getWgetOpts
                  Excepts '[ProcessError] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ()) -> m (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ()) -> m (Either ProcessError ()))
-> IO (Either ProcessError ()) -> m (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> IO (Either ProcessError ())
exec ByteString
"wget" Bool
True
                    ([ByteString]
o' [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
"-O", Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
destFile , URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URI -> ByteString) -> URI -> ByteString
forall a b. (a -> b) -> a -> b
$ Lens' DownloadInfo URI -> DownloadInfo -> URI
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' DownloadInfo URI
dlUri DownloadInfo
dli]) Maybe (Path Abs)
forall a. Maybe a
Nothing Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing
#if defined(INTERNAL_DOWNLOADER)
                Internal -> do
                  (https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
                  liftE $ downloadToFile https host fullPath port destFile
#endif

    Excepts '[DigestError] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError] m ()
 -> Excepts '[DigestError, DownloadFailed] m ())
-> Excepts '[DigestError] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ DownloadInfo -> Path Abs -> Excepts '[DigestError] m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m, MonadLogger m, MonadReader AppState m) =>
DownloadInfo -> Path Abs -> Excepts '[DigestError] m ()
checkDigest DownloadInfo
dli Path Abs
destFile
    Path Abs -> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
destFile

  -- Manage to find a file we can write the body into.
  getDestFile :: MonadThrow m => m (Path Abs)
  getDestFile :: m (Path Abs)
getDestFile = m (Path Abs)
-> (Path Rel -> m (Path Abs)) -> Maybe (Path Rel) -> m (Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
urlBaseName ByteString
path m (Path Rel) -> (Path Rel -> Path Abs) -> m (Path Abs)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs
dest Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</>)) (Path Abs -> m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs -> m (Path Abs))
-> (Path Rel -> Path Abs) -> Path Rel -> m (Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs
dest Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</>)) Maybe (Path Rel)
mfn

  path :: ByteString
path        = Optic' A_Lens '[] DownloadInfo ByteString
-> DownloadInfo -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' DownloadInfo URI
dlUri Lens' DownloadInfo URI
-> Optic' A_Lens '[] URI ByteString
-> Optic' A_Lens '[] DownloadInfo ByteString
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens '[] URI ByteString
forall a. Lens' (URIRef a) ByteString
pathL') DownloadInfo
dli


-- | Download into tmpdir or use cached version, if it exists. If filename
-- is omitted, infers the filename from the url.
downloadCached :: ( MonadMask m
                  , MonadResource m
                  , MonadThrow m
                  , MonadLogger m
                  , MonadIO m
                  , MonadReader AppState m
                  )
               => DownloadInfo
               -> Maybe (Path Rel)  -- ^ optional filename
               -> Excepts '[DigestError , DownloadFailed] m (Path Abs)
downloadCached :: DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dli Maybe (Path Rel)
mfn = do
  Bool
cache <- m Bool -> Excepts '[DigestError, DownloadFailed] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
forall (m :: * -> *). MonadReader AppState m => m Bool
getCache
  case Bool
cache of
    Bool
True -> do
      AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState -> Excepts '[DigestError, DownloadFailed] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
      Path Rel
fn       <- Excepts '[DigestError, DownloadFailed] m (Path Rel)
-> (Path Rel
    -> Excepts '[DigestError, DownloadFailed] m (Path Rel))
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Rel)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Excepts '[DigestError, DownloadFailed] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
urlBaseName (ByteString -> Excepts '[DigestError, DownloadFailed] m (Path Rel))
-> ByteString
-> Excepts '[DigestError, DownloadFailed] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens '[] DownloadInfo ByteString
-> DownloadInfo -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' DownloadInfo URI
dlUri Lens' DownloadInfo URI
-> Optic' A_Lens '[] URI ByteString
-> Optic' A_Lens '[] DownloadInfo ByteString
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens '[] URI ByteString
forall a. Lens' (URIRef a) ByteString
pathL') DownloadInfo
dli) Path Rel -> Excepts '[DigestError, DownloadFailed] m (Path Rel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Rel)
mfn
      let cachfile :: Path Abs
cachfile = Path Abs
cacheDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
fn
      Bool
fileExists <- IO Bool -> Excepts '[DigestError, DownloadFailed] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[DigestError, DownloadFailed] m Bool)
-> IO Bool -> Excepts '[DigestError, DownloadFailed] m Bool
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesFileExist Path Abs
cachfile
      if
        | Bool
fileExists -> do
          Excepts '[DigestError] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError] m ()
 -> Excepts '[DigestError, DownloadFailed] m ())
-> Excepts '[DigestError] m ()
-> Excepts '[DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ DownloadInfo -> Path Abs -> Excepts '[DigestError] m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m, MonadLogger m, MonadReader AppState m) =>
DownloadInfo -> Path Abs -> Excepts '[DigestError] m ()
checkDigest DownloadInfo
dli Path Abs
cachfile
          Path Abs -> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
cachfile
        | Bool
otherwise -> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
 -> Excepts '[DigestError, DownloadFailed] m (Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadReader AppState m, MonadThrow m, MonadLogger m,
 MonadIO m) =>
DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
download DownloadInfo
dli Path Abs
cacheDir Maybe (Path Rel)
mfn
    Bool
False -> do
      Path Abs
tmp <- m (Path Abs) -> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *).
(MonadResource m, MonadThrow m, MonadIO m) =>
m (Path Abs)
withGHCupTmpDir
      Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
 -> Excepts '[DigestError, DownloadFailed] m (Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadReader AppState m, MonadThrow m, MonadLogger m,
 MonadIO m) =>
DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
download DownloadInfo
dli Path Abs
tmp Maybe (Path Rel)
mfn




    ------------------
    --[ Low-level ]--
    ------------------




-- | This is used for downloading the JSON.
downloadBS :: (MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m)
           => URI
           -> Excepts
                '[ FileDoesNotExistError
                 , HTTPStatusError
                 , URIParseError
                 , UnsupportedScheme
                 , NoLocationHeader
                 , TooManyRedirs
                 , ProcessError
                 ]
                m
                L.ByteString
downloadBS :: URI
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
downloadBS URI
uri'
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"https"
  = Bool
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
dl Bool
True
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"http"
  = Bool
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
dl Bool
False
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"file"
  = IOErrorType
-> FileDoesNotExistError
-> m ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (m :: * -> *) e (es' :: [*]) a.
(MonadCatch m, MonadIO m, Monad m, e :< es') =>
IOErrorType -> e -> m a -> Excepts es' m a
liftIOException IOErrorType
doesNotExistErrorType (ByteString -> FileDoesNotExistError
FileDoesNotExistError ByteString
path)
    (IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
RD.readFile ByteString
path)
  | Bool
otherwise
  = UnsupportedScheme
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE UnsupportedScheme
UnsupportedScheme

 where
  scheme :: ByteString
scheme = Optic' A_Lens '[] URI ByteString -> URI -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens '[] URI URI Scheme Scheme
uriSchemeL' Optic A_Lens '[] URI URI Scheme Scheme
-> Optic A_Lens '[] Scheme Scheme ByteString ByteString
-> Optic' A_Lens '[] URI ByteString
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Scheme Scheme ByteString ByteString
schemeBSL') URI
uri'
  path :: ByteString
path   = Optic' A_Lens '[] URI ByteString -> URI -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] URI ByteString
forall a. Lens' (URIRef a) ByteString
pathL' URI
uri'
#if defined(INTERNAL_DOWNLOADER)
  dl https = do
#else
  dl :: Bool
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
dl Bool
_ = do
#endif
    m ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|downloading: #{serializeURIRef' uri'}|]
    m Downloader
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     Downloader
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Downloader
forall (m :: * -> *). MonadReader AppState m => m Downloader
getDownloader Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m
  Downloader
-> (Downloader
    -> Excepts
         '[FileDoesNotExistError, HTTPStatusError, URIParseError,
           UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
         m
         ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Downloader
Curl -> do
        [ByteString]
o' <- IO [ByteString]
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getCurlOpts
        let exe :: Path Rel
exe = [rel|curl|]
            args :: [ByteString]
args = [ByteString]
o' [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
"-sSfL", URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' URI
uri']
        IO CapturedProcess
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     CapturedProcess
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Rel -> [ByteString] -> Maybe (Path Abs) -> IO CapturedProcess
forall b.
Path b -> [ByteString] -> Maybe (Path Abs) -> IO CapturedProcess
executeOut Path Rel
exe [ByteString]
args Maybe (Path Abs)
forall a. Maybe a
Nothing) Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m
  CapturedProcess
-> (CapturedProcess
    -> Excepts
         '[FileDoesNotExistError, HTTPStatusError, URIParseError,
           UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
         m
         ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          CapturedProcess ExitCode
ExitSuccess ByteString
stdout ByteString
_ -> do
            ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m
      ByteString)
-> ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
stdout
          CapturedProcess (ExitFailure Int
i') ByteString
_ ByteString
_ -> ProcessError
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (ProcessError
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m
      ByteString)
-> ProcessError
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString] -> ProcessError
NonZeroExit Int
i' (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
exe) [ByteString]
args
      Downloader
Wget -> do
        [ByteString]
o' <- IO [ByteString]
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getWgetOpts
        let exe :: Path Rel
exe = [rel|wget|]
            args :: [ByteString]
args = [ByteString]
o' [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
"-qO-", URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' URI
uri']
        IO CapturedProcess
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     CapturedProcess
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Rel -> [ByteString] -> Maybe (Path Abs) -> IO CapturedProcess
forall b.
Path b -> [ByteString] -> Maybe (Path Abs) -> IO CapturedProcess
executeOut Path Rel
exe [ByteString]
args Maybe (Path Abs)
forall a. Maybe a
Nothing) Excepts
  '[FileDoesNotExistError, HTTPStatusError, URIParseError,
    UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
  m
  CapturedProcess
-> (CapturedProcess
    -> Excepts
         '[FileDoesNotExistError, HTTPStatusError, URIParseError,
           UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
         m
         ByteString)
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          CapturedProcess ExitCode
ExitSuccess ByteString
stdout ByteString
_ -> do
            ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m
      ByteString)
-> ByteString
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
stdout
          CapturedProcess (ExitFailure Int
i') ByteString
_ ByteString
_ -> ProcessError
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (ProcessError
 -> Excepts
      '[FileDoesNotExistError, HTTPStatusError, URIParseError,
        UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
      m
      ByteString)
-> ProcessError
-> Excepts
     '[FileDoesNotExistError, HTTPStatusError, URIParseError,
       UnsupportedScheme, NoLocationHeader, TooManyRedirs, ProcessError]
     m
     ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString] -> ProcessError
NonZeroExit Int
i' (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
exe) [ByteString]
args
#if defined(INTERNAL_DOWNLOADER)
      Internal -> do
        (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
        liftE $ downloadBS' https host' fullPath' port'
#endif


checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader AppState m)
            => DownloadInfo
            -> Path Abs
            -> Excepts '[DigestError] m ()
checkDigest :: DownloadInfo -> Path Abs -> Excepts '[DigestError] m ()
checkDigest DownloadInfo
dli Path Abs
file = do
  Bool
verify <- m AppState -> Excepts '[DigestError] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask Excepts '[DigestError] m AppState
-> (AppState -> Bool) -> Excepts '[DigestError] m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Bool -> Bool
not (Bool -> Bool) -> (AppState -> Bool) -> AppState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Bool
noVerify (Settings -> Bool) -> (AppState -> Settings) -> AppState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> Settings
settings)
  Bool -> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verify (Excepts '[DigestError] m () -> Excepts '[DigestError] m ())
-> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString
p' <- Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> ByteString)
-> Excepts '[DigestError] m (Path Rel)
-> Excepts '[DigestError] m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs -> Excepts '[DigestError] m (Path Rel)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Rel)
basename Path Abs
file
    m () -> Excepts '[DigestError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[DigestError] m ())
-> m () -> Excepts '[DigestError] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|verifying digest of: #{p'}|]
    ByteString
c <- IO ByteString -> Excepts '[DigestError] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Excepts '[DigestError] m ByteString)
-> IO ByteString -> Excepts '[DigestError] m ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile Path Abs
file
    Text
cDigest <- Either UnicodeException Text -> Excepts '[DigestError] m Text
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either UnicodeException Text -> Excepts '[DigestError] m Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Excepts '[DigestError] m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
E.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA256.hashlazy (ByteString -> Excepts '[DigestError] m Text)
-> ByteString -> Excepts '[DigestError] m Text
forall a b. (a -> b) -> a -> b
$ ByteString
c
    let eDigest :: Text
eDigest = Optic' A_Lens '[] DownloadInfo Text -> DownloadInfo -> Text
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo Text
dlHash DownloadInfo
dli
    Bool -> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Text
cDigest Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
eDigest) Bool -> Bool -> Bool
&& Bool
verify) (Excepts '[DigestError] m () -> Excepts '[DigestError] m ())
-> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
forall a b. (a -> b) -> a -> b
$ DigestError -> Excepts '[DigestError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Text -> Text -> DigestError
DigestError Text
cDigest Text
eDigest)


-- | Get additional curl args from env. This is an undocumented option.
getCurlOpts :: IO [ByteString]
getCurlOpts :: IO [ByteString]
getCurlOpts =
  ByteString -> IO (Maybe ByteString)
getEnv ByteString
"GHCUP_CURL_OPTS" IO (Maybe ByteString)
-> (Maybe ByteString -> IO [ByteString]) -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ByteString
r  -> [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> [ByteString]
BS.split Word8
_space ByteString
r
    Maybe ByteString
Nothing -> [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []


-- | Get additional wget args from env. This is an undocumented option.
getWgetOpts :: IO [ByteString]
getWgetOpts :: IO [ByteString]
getWgetOpts =
  ByteString -> IO (Maybe ByteString)
getEnv ByteString
"GHCUP_WGET_OPTS" IO (Maybe ByteString)
-> (Maybe ByteString -> IO [ByteString]) -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ByteString
r  -> [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> [ByteString]
BS.split Word8
_space ByteString
r
    Maybe ByteString
Nothing -> [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []