{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# 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 : portable

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 qualified GHCup.Types.Stack                as Stack
import           GHCup.Types.Optics
import           GHCup.Types.JSON               ( )
import           GHCup.Utils.Dirs
import           GHCup.Utils.URI
import           GHCup.Platform
import           GHCup.Prelude
import           GHCup.Prelude.File
import           GHCup.Prelude.Logger.Internal
import           GHCup.Prelude.Process
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.Reader
import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
import           Data.Aeson
import           Data.ByteString                ( ByteString )
#if defined(INTERNAL_DOWNLOADER)
import           Data.CaseInsensitive           ( mk )
#endif
import           Data.Maybe
import           Data.Either
import           Data.List
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Data.Versions
import           Data.Word8              hiding ( isSpace )
import           Data.Variant.Excepts
#if defined(INTERNAL_DOWNLOADER)
import           Network.Http.Client     hiding ( URL )
#endif
import           Optics
import           Prelude                 hiding ( abs
                                                , readFile
                                                , writeFile
                                                )
import           Safe
import           System.Environment
import           System.Exit
import           System.FilePath
import           System.IO.Error
import           System.IO.Temp
import           URI.ByteString          hiding (parseURI)

import qualified Crypto.Hash.SHA256            as SHA256
import qualified Data.ByteString               as B
import qualified Data.ByteString.Base16        as B16
import qualified Data.ByteString.Lazy          as L
import qualified Data.Map.Strict               as M
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T
import qualified Data.Text.Encoding            as E
import qualified Data.Yaml.Aeson               as Y



-- $setup
-- >>> :set -XOverloadedStrings



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



-- | Downloads the download information! But only if we need to ;P
getDownloadsF :: ( FromJSONKey Tool
                 , FromJSONKey Version
                 , FromJSON VersionInfo
                 , MonadReader env m
                 , HasSettings env
                 , HasDirs env
                 , MonadIO m
                 , MonadCatch m
                 , HasLog env
                 , MonadThrow m
                 , MonadFail m
                 , MonadMask m
                 )
              => PlatformRequest
              -> Excepts
                   '[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
                   m
                   GHCupInfo
getDownloadsF :: forall env (m :: * -> *).
(FromJSONKey Tool, FromJSONKey Version, FromJSON VersionInfo,
 MonadReader env m, HasSettings env, HasDirs env, MonadIO m,
 MonadCatch m, HasLog env, MonadThrow m, MonadFail m,
 MonadMask m) =>
PlatformRequest
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     GHCupInfo
getDownloadsF pfreq :: PlatformRequest
pfreq@(PlatformRequest Architecture
arch Platform
plat Maybe Versioning
_) = do
  Settings { [NewURLSource]
urlSource :: [NewURLSource]
$sel:urlSource:Settings :: Settings -> [NewURLSource]
urlSource } <- m Settings
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     Settings
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
  [Either GHCupInfo SetupInfo]
infos <- Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  [Either GHCupInfo SetupInfo]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [Either GHCupInfo SetupInfo]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DownloadFailed, GPGError, DigestError, ContentLengthError,
     JSONError, FileDoesNotExistError]
   m
   [Either GHCupInfo SetupInfo]
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      m
      [Either GHCupInfo SetupInfo])
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     [Either GHCupInfo SetupInfo]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [Either GHCupInfo SetupInfo]
forall a b. (a -> b) -> a -> b
$ (NewURLSource
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      (Either GHCupInfo SetupInfo))
-> [NewURLSource]
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     [Either GHCupInfo SetupInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM NewURLSource
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall env (m :: * -> *).
(FromJSONKey Tool, FromJSONKey Version, FromJSON VersionInfo,
 MonadReader env m, HasSettings env, HasDirs env, MonadIO m,
 MonadCatch m, HasLog env, MonadThrow m, MonadFail m,
 MonadMask m) =>
NewURLSource
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
dl' [NewURLSource]
urlSource
  [String]
keys <- if (Either GHCupInfo SetupInfo -> Bool)
-> [Either GHCupInfo SetupInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Either GHCupInfo SetupInfo -> Bool
forall a b. Either a b -> Bool
isRight [Either GHCupInfo SetupInfo]
infos
          then Excepts '[StackPlatformDetectError] m [String]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [String]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[StackPlatformDetectError] m [String]
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      m
      [String])
-> (Excepts
      '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
        NoCompatibleArch, DistroNotFound, ProcessError]
      m
      [String]
    -> Excepts '[StackPlatformDetectError] m [String])
-> Excepts
     '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
       NoCompatibleArch, DistroNotFound, ProcessError]
     m
     [String]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @_ @'[StackPlatformDetectError] V '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
    NoCompatibleArch, DistroNotFound, ProcessError]
-> StackPlatformDetectError
forall (es :: [*]).
(ToVariantMaybe StackPlatformDetectError es,
 PopVariant StackPlatformDetectError es, Show (V es), Pretty (V es),
 HFErrorProject (V es)) =>
V es -> StackPlatformDetectError
StackPlatformDetectError (Excepts
   '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
     NoCompatibleArch, DistroNotFound, ProcessError]
   m
   [String]
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      m
      [String])
-> Excepts
     '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
       NoCompatibleArch, DistroNotFound, ProcessError]
     m
     [String]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [String]
forall a b. (a -> b) -> a -> b
$ PlatformRequest
-> Excepts
     '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
       NoCompatibleArch, DistroNotFound, ProcessError]
     m
     [String]
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
PlatformRequest
-> Excepts
     '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
       NoCompatibleArch, DistroNotFound, ProcessError]
     m
     [String]
getStackPlatformKey PlatformRequest
pfreq
          else [String]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [String]
forall a.
a
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  [GHCupInfo]
ghcupInfos <- ([Maybe GHCupInfo] -> [GHCupInfo])
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [Maybe GHCupInfo]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [GHCupInfo]
forall a b.
(a -> b)
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     a
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe GHCupInfo] -> [GHCupInfo]
forall a. [Maybe a] -> [a]
catMaybes (Excepts
   '[DigestError, ContentLengthError, GPGError, JSONError,
     DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
   m
   [Maybe GHCupInfo]
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      m
      [GHCupInfo])
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [Maybe GHCupInfo]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [GHCupInfo]
forall a b. (a -> b) -> a -> b
$ [Either GHCupInfo SetupInfo]
-> (Either GHCupInfo SetupInfo
    -> Excepts
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         m
         (Maybe GHCupInfo))
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [Maybe GHCupInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either GHCupInfo SetupInfo]
infos ((Either GHCupInfo SetupInfo
  -> Excepts
       '[DigestError, ContentLengthError, GPGError, JSONError,
         DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
       m
       (Maybe GHCupInfo))
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      m
      [Maybe GHCupInfo])
-> (Either GHCupInfo SetupInfo
    -> Excepts
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         m
         (Maybe GHCupInfo))
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     [Maybe GHCupInfo]
forall a b. (a -> b) -> a -> b
$ \case
    Left GHCupInfo
gi  -> Maybe GHCupInfo
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     (Maybe GHCupInfo)
forall a.
a
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> Maybe GHCupInfo
forall a. a -> Maybe a
Just GHCupInfo
gi)
    Right SetupInfo
si -> Maybe GHCupInfo
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     (Maybe GHCupInfo)
forall a.
a
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GHCupInfo
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      m
      (Maybe GHCupInfo))
-> Maybe GHCupInfo
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     (Maybe GHCupInfo)
forall a b. (a -> b) -> a -> b
$ SetupInfo -> [String] -> Maybe GHCupInfo
forall (m :: * -> *).
MonadThrow m =>
SetupInfo -> [String] -> m GHCupInfo
fromStackSetupInfo SetupInfo
si [String]
keys
  [GHCupInfo]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     GHCupInfo
forall (m :: * -> *). MonadFail m => [GHCupInfo] -> m GHCupInfo
mergeGhcupInfo [GHCupInfo]
ghcupInfos
 where

  dl' :: ( FromJSONKey Tool
         , FromJSONKey Version
         , FromJSON VersionInfo
         , MonadReader env m
         , HasSettings env
         , HasDirs env
         , MonadIO m
         , MonadCatch m
         , HasLog env
         , MonadThrow m
         , MonadFail m
         , MonadMask m
         )
      => NewURLSource
      -> Excepts
           '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
           m (Either GHCupInfo Stack.SetupInfo)
  dl' :: forall env (m :: * -> *).
(FromJSONKey Tool, FromJSONKey Version, FromJSON VersionInfo,
 MonadReader env m, HasSettings env, HasDirs env, MonadIO m,
 MonadCatch m, HasLog env, MonadThrow m, MonadFail m,
 MonadMask m) =>
NewURLSource
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
dl' NewURLSource
NewGHCupURL       = (GHCupInfo -> Either GHCupInfo SetupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b.
(a -> b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GHCupInfo -> Either GHCupInfo SetupInfo
forall a b. a -> Either a b
Left (Excepts
   '[DownloadFailed, GPGError, DigestError, ContentLengthError,
     JSONError, FileDoesNotExistError]
   m
   GHCupInfo
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      (Either GHCupInfo SetupInfo))
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b. (a -> b) -> a -> b
$ Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError]
  m
  String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
getBase URI
ghcupURL) Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  String
-> (String
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         GHCupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall a b.
Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  a
-> (a
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, 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
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> (String
    -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo)
-> String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall j (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m, FromJSON j) =>
String -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata @GHCupInfo
  dl' NewURLSource
NewStackSetupURL  = (SetupInfo -> Either GHCupInfo SetupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b.
(a -> b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SetupInfo -> Either GHCupInfo SetupInfo
forall a b. b -> Either a b
Right (Excepts
   '[DownloadFailed, GPGError, DigestError, ContentLengthError,
     JSONError, FileDoesNotExistError]
   m
   SetupInfo
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      (Either GHCupInfo SetupInfo))
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b. (a -> b) -> a -> b
$ Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError]
  m
  String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
getBase URI
stackSetupURL) Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  String
-> (String
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         SetupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
forall a b.
Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  a
-> (a
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Excepts '[JSONError, FileDoesNotExistError] m SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[JSONError, FileDoesNotExistError] m SetupInfo
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      SetupInfo)
-> (String
    -> Excepts '[JSONError, FileDoesNotExistError] m SetupInfo)
-> String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall j (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m, FromJSON j) =>
String -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata @Stack.SetupInfo
  dl' (NewChannelAlias ChannelAlias
StackChannel) = (SetupInfo -> Either GHCupInfo SetupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b.
(a -> b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SetupInfo -> Either GHCupInfo SetupInfo
forall a b. b -> Either a b
Right (Excepts
   '[DownloadFailed, GPGError, DigestError, ContentLengthError,
     JSONError, FileDoesNotExistError]
   m
   SetupInfo
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      (Either GHCupInfo SetupInfo))
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b. (a -> b) -> a -> b
$ Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError]
  m
  String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
getBase (URI
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError]
      m
      String)
-> URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall a b. (a -> b) -> a -> b
$ ChannelAlias -> URI
channelURL ChannelAlias
StackChannel) Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  String
-> (String
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         SetupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
forall a b.
Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  a
-> (a
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Excepts '[JSONError, FileDoesNotExistError] m SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[JSONError, FileDoesNotExistError] m SetupInfo
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      SetupInfo)
-> (String
    -> Excepts '[JSONError, FileDoesNotExistError] m SetupInfo)
-> String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     SetupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall j (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m, FromJSON j) =>
String -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata @Stack.SetupInfo
  dl' (NewChannelAlias ChannelAlias
c) = (GHCupInfo -> Either GHCupInfo SetupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b.
(a -> b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GHCupInfo -> Either GHCupInfo SetupInfo
forall a b. a -> Either a b
Left (Excepts
   '[DownloadFailed, GPGError, DigestError, ContentLengthError,
     JSONError, FileDoesNotExistError]
   m
   GHCupInfo
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      (Either GHCupInfo SetupInfo))
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b. (a -> b) -> a -> b
$ Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError]
  m
  String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
getBase (URI
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError]
      m
      String)
-> URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall a b. (a -> b) -> a -> b
$ ChannelAlias -> URI
channelURL ChannelAlias
c) Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  String
-> (String
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         GHCupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall a b.
Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError,
    JSONError, FileDoesNotExistError]
  m
  a
-> (a
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError,
           JSONError, FileDoesNotExistError]
         m
         b)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, 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
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> (String
    -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo)
-> String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall j (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m, FromJSON j) =>
String -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata @GHCupInfo
  dl' (NewGHCupInfo GHCupInfo
gi) = Either GHCupInfo SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a.
a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> Either GHCupInfo SetupInfo
forall a b. a -> Either a b
Left GHCupInfo
gi)
  dl' (NewSetupInfo SetupInfo
si) = Either GHCupInfo SetupInfo
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a.
a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SetupInfo -> Either GHCupInfo SetupInfo
forall a b. b -> Either a b
Right SetupInfo
si)
  dl' (NewURI URI
uri)      = do
                            String
base <- Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError]
  m
  String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DownloadFailed, GPGError, DigestError, ContentLengthError]
   m
   String
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      String)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     String
forall a b. (a -> b) -> a -> b
$ URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
getBase URI
uri
                            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 (\(JSONDecodeError String
s) -> do
                                Text -> Excepts '[JSONError, FileDoesNotExistError] m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> Excepts '[JSONError, FileDoesNotExistError] m ())
-> Text -> Excepts '[JSONError, FileDoesNotExistError] m ()
forall a b. (a -> b) -> a -> b
$ Text
"Couldn't decode " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as GHCupInfo, trying as SetupInfo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
s
                                SetupInfo -> Either GHCupInfo SetupInfo
forall a b. b -> Either a b
Right (SetupInfo -> Either GHCupInfo SetupInfo)
-> Excepts '[JSONError, FileDoesNotExistError] m SetupInfo
-> Excepts
     '[JSONError, FileDoesNotExistError] m (Either GHCupInfo SetupInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall j (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m, FromJSON j) =>
String -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata @Stack.SetupInfo String
base)
                              (Excepts
   '[JSONError, FileDoesNotExistError] m (Either GHCupInfo SetupInfo)
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError,
        JSONError, FileDoesNotExistError]
      m
      (Either GHCupInfo SetupInfo))
-> Excepts
     '[JSONError, FileDoesNotExistError] m (Either GHCupInfo SetupInfo)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError,
       JSONError, FileDoesNotExistError]
     m
     (Either GHCupInfo SetupInfo)
forall a b. (a -> b) -> a -> b
$ (GHCupInfo -> Either GHCupInfo SetupInfo)
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts
     '[JSONError, FileDoesNotExistError] m (Either GHCupInfo SetupInfo)
forall a b.
(a -> b)
-> Excepts '[JSONError, FileDoesNotExistError] m a
-> Excepts '[JSONError, FileDoesNotExistError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GHCupInfo -> Either GHCupInfo SetupInfo
forall a b. a -> Either a b
Left (forall j (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m, FromJSON j) =>
String -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata @GHCupInfo String
base Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> (GHCupInfo
    -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo)
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall a b.
Excepts '[JSONError, FileDoesNotExistError] m a
-> (a -> Excepts '[JSONError, FileDoesNotExistError] m b)
-> Excepts '[JSONError, FileDoesNotExistError] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GHCupInfo
gI -> URI
-> GHCupInfo -> Excepts '[JSONError, FileDoesNotExistError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadIO m, HasLog env, HasDirs env) =>
URI -> GHCupInfo -> m ()
warnOnMetadataUpdate URI
uri GHCupInfo
gI Excepts '[JSONError, FileDoesNotExistError] m ()
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall a b.
Excepts '[JSONError, FileDoesNotExistError] m a
-> Excepts '[JSONError, FileDoesNotExistError] m b
-> Excepts '[JSONError, FileDoesNotExistError] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GHCupInfo
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
forall a. a -> Excepts '[JSONError, FileDoesNotExistError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCupInfo
gI)

  fromStackSetupInfo :: MonadThrow m
                     => Stack.SetupInfo
                     -> [String]
                     -> m GHCupInfo
  fromStackSetupInfo :: forall (m :: * -> *).
MonadThrow m =>
SetupInfo -> [String] -> m GHCupInfo
fromStackSetupInfo (SetupInfo -> Map Text (Map Version GHCDownloadInfo)
Stack.siGHCs -> Map Text (Map Version GHCDownloadInfo)
ghcDli) [String]
keys = do
    let ghcVersionsPerKey :: [Maybe (Map Version GHCDownloadInfo)]
ghcVersionsPerKey = (Text
-> Map Text (Map Version GHCDownloadInfo)
-> Maybe (Map Version GHCDownloadInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Text (Map Version GHCDownloadInfo)
ghcDli) (Text -> Maybe (Map Version GHCDownloadInfo))
-> (String -> Text)
-> String
-> Maybe (Map Version GHCDownloadInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe (Map Version GHCDownloadInfo))
-> [String] -> [Maybe (Map Version GHCDownloadInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
keys
        ghcVersions :: Map Version GHCDownloadInfo
ghcVersions = Map Version GHCDownloadInfo
-> Maybe (Map Version GHCDownloadInfo)
-> Map Version GHCDownloadInfo
forall a. a -> Maybe a -> a
fromMaybe Map Version GHCDownloadInfo
forall a. Monoid a => a
mempty (Maybe (Map Version GHCDownloadInfo)
 -> Map Version GHCDownloadInfo)
-> ([Maybe (Map Version GHCDownloadInfo)]
    -> Maybe (Map Version GHCDownloadInfo))
-> [Maybe (Map Version GHCDownloadInfo)]
-> Map Version GHCDownloadInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map Version GHCDownloadInfo]
-> Maybe (Map Version GHCDownloadInfo)
forall a. [a] -> Maybe a
listToMaybe ([Map Version GHCDownloadInfo]
 -> Maybe (Map Version GHCDownloadInfo))
-> ([Maybe (Map Version GHCDownloadInfo)]
    -> [Map Version GHCDownloadInfo])
-> [Maybe (Map Version GHCDownloadInfo)]
-> Maybe (Map Version GHCDownloadInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Map Version GHCDownloadInfo)]
-> [Map Version GHCDownloadInfo]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Map Version GHCDownloadInfo)]
 -> Map Version GHCDownloadInfo)
-> [Maybe (Map Version GHCDownloadInfo)]
-> Map Version GHCDownloadInfo
forall a b. (a -> b) -> a -> b
$ [Maybe (Map Version GHCDownloadInfo)]
ghcVersionsPerKey
    (Map GHCTargetVersion DownloadInfo
ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
      (Version -> GHCTargetVersion)
-> Map Version DownloadInfo -> Map GHCTargetVersion DownloadInfo
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Version -> GHCTargetVersion
mkTVer (Map Version DownloadInfo -> Map GHCTargetVersion DownloadInfo)
-> m (Map Version DownloadInfo)
-> m (Map GHCTargetVersion DownloadInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Version -> GHCDownloadInfo -> m (Maybe DownloadInfo))
-> Map Version GHCDownloadInfo -> m (Map Version DownloadInfo)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
M.traverseMaybeWithKey (\Version
_ GHCDownloadInfo
a -> Maybe DownloadInfo -> m (Maybe DownloadInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DownloadInfo -> m (Maybe DownloadInfo))
-> Maybe DownloadInfo -> m (Maybe DownloadInfo)
forall a b. (a -> b) -> a -> b
$ GHCDownloadInfo -> Maybe DownloadInfo
forall (m :: * -> *).
MonadThrow m =>
GHCDownloadInfo -> m DownloadInfo
fromStackDownloadInfo GHCDownloadInfo
a) Map Version GHCDownloadInfo
ghcVersions
    let ghcupDownloads' :: Map Tool (Map GHCTargetVersion VersionInfo)
ghcupDownloads' = Tool
-> Map GHCTargetVersion VersionInfo
-> Map Tool (Map GHCTargetVersion VersionInfo)
forall k a. k -> a -> Map k a
M.singleton Tool
GHC ((DownloadInfo -> VersionInfo)
-> Map GHCTargetVersion DownloadInfo
-> Map GHCTargetVersion VersionInfo
forall a b k. (a -> b) -> Map k a -> Map k b
M.map DownloadInfo -> VersionInfo
fromDownloadInfo Map GHCTargetVersion DownloadInfo
ghcupInfo')
    GHCupInfo -> m GHCupInfo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ToolRequirements
-> Map Tool (Map GHCTargetVersion VersionInfo)
-> Maybe URI
-> GHCupInfo
GHCupInfo ToolRequirements
forall a. Monoid a => a
mempty Map Tool (Map GHCTargetVersion VersionInfo)
ghcupDownloads' Maybe URI
forall a. Maybe a
Nothing)
   where
    fromDownloadInfo :: DownloadInfo -> VersionInfo
    fromDownloadInfo :: DownloadInfo -> VersionInfo
fromDownloadInfo DownloadInfo
dli = let aspec :: MapIgnoreUnknownKeys
  Architecture
  (MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo))
aspec = Map
  Architecture
  (MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo))
-> MapIgnoreUnknownKeys
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
forall k v. Map k v -> MapIgnoreUnknownKeys k v
MapIgnoreUnknownKeys (Map
   Architecture
   (MapIgnoreUnknownKeys
      Platform (Map (Maybe VersionRange) DownloadInfo))
 -> MapIgnoreUnknownKeys
      Architecture
      (MapIgnoreUnknownKeys
         Platform (Map (Maybe VersionRange) DownloadInfo)))
-> Map
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
-> MapIgnoreUnknownKeys
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
forall a b. (a -> b) -> a -> b
$ Architecture
-> MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo)
-> Map
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
forall k a. k -> a -> Map k a
M.singleton Architecture
arch (Map Platform (Map (Maybe VersionRange) DownloadInfo)
-> MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo)
forall k v. Map k v -> MapIgnoreUnknownKeys k v
MapIgnoreUnknownKeys (Map Platform (Map (Maybe VersionRange) DownloadInfo)
 -> MapIgnoreUnknownKeys
      Platform (Map (Maybe VersionRange) DownloadInfo))
-> Map Platform (Map (Maybe VersionRange) DownloadInfo)
-> MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo)
forall a b. (a -> b) -> a -> b
$ Platform
-> Map (Maybe VersionRange) DownloadInfo
-> Map Platform (Map (Maybe VersionRange) DownloadInfo)
forall k a. k -> a -> Map k a
M.singleton Platform
plat (Maybe VersionRange
-> DownloadInfo -> Map (Maybe VersionRange) DownloadInfo
forall k a. k -> a -> Map k a
M.singleton Maybe VersionRange
forall a. Maybe a
Nothing DownloadInfo
dli))
                           in [Tag]
-> Maybe Day
-> Maybe URI
-> Maybe DownloadInfo
-> Maybe DownloadInfo
-> MapIgnoreUnknownKeys
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> VersionInfo
VersionInfo [] Maybe Day
forall a. Maybe a
Nothing Maybe URI
forall a. Maybe a
Nothing Maybe DownloadInfo
forall a. Maybe a
Nothing Maybe DownloadInfo
forall a. Maybe a
Nothing MapIgnoreUnknownKeys
  Architecture
  (MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo))
aspec Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

    fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
    fromStackDownloadInfo :: forall (m :: * -> *).
MonadThrow m =>
GHCDownloadInfo -> m DownloadInfo
fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo :: GHCDownloadInfo -> DownloadInfo
gdiDownloadInfo = Stack.DownloadInfo{Maybe Int
Maybe ByteString
Text
downloadInfoUrl :: Text
downloadInfoContentLength :: Maybe Int
downloadInfoSha1 :: Maybe ByteString
downloadInfoSha256 :: Maybe ByteString
downloadInfoUrl :: DownloadInfo -> Text
downloadInfoContentLength :: DownloadInfo -> Maybe Int
downloadInfoSha1 :: DownloadInfo -> Maybe ByteString
downloadInfoSha256 :: DownloadInfo -> Maybe ByteString
..} }) = do
      Text
sha256 <- m Text -> (ByteString -> m Text) -> Maybe ByteString -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DigestMissing -> m Text
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM (DigestMissing -> m Text) -> DigestMissing -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> DigestMissing
DigestMissing Text
downloadInfoUrl) (Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> (ByteString -> Text) -> ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
E.decodeUtf8) Maybe ByteString
downloadInfoSha256
      DownloadInfo -> m DownloadInfo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DownloadInfo -> m DownloadInfo) -> DownloadInfo -> m DownloadInfo
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe TarDir
-> Text
-> Maybe Integer
-> Maybe String
-> Maybe [Tag]
-> DownloadInfo
DownloadInfo Text
downloadInfoUrl (TarDir -> Maybe TarDir
forall a. a -> Maybe a
Just (TarDir -> Maybe TarDir) -> TarDir -> Maybe TarDir
forall a b. (a -> b) -> a -> b
$ String -> TarDir
RegexDir String
"ghc-.*") Text
sha256 Maybe Integer
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe [Tag]
forall a. Maybe a
Nothing


  mergeGhcupInfo :: MonadFail m
                 => [GHCupInfo]
                 -> m GHCupInfo
  mergeGhcupInfo :: forall (m :: * -> *). MonadFail m => [GHCupInfo] -> m GHCupInfo
mergeGhcupInfo [] = String -> m GHCupInfo
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mergeGhcupInfo: internal error: need at least one GHCupInfo"
  mergeGhcupInfo xs :: [GHCupInfo]
xs@(GHCupInfo{}: [GHCupInfo]
_) =
    let newDownloads :: Map Tool (Map GHCTargetVersion VersionInfo)
newDownloads   = (Map GHCTargetVersion VersionInfo
 -> Map GHCTargetVersion VersionInfo
 -> Map GHCTargetVersion VersionInfo)
-> [Map Tool (Map GHCTargetVersion VersionInfo)]
-> Map Tool (Map GHCTargetVersion VersionInfo)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith ((VersionInfo -> VersionInfo -> VersionInfo)
-> Map GHCTargetVersion VersionInfo
-> Map GHCTargetVersion VersionInfo
-> Map GHCTargetVersion VersionInfo
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (\VersionInfo
_ VersionInfo
b2 -> VersionInfo
b2)) (GHCupInfo -> Map Tool (Map GHCTargetVersion VersionInfo)
_ghcupDownloads   (GHCupInfo -> Map Tool (Map GHCTargetVersion VersionInfo))
-> [GHCupInfo] -> [Map Tool (Map GHCTargetVersion VersionInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GHCupInfo]
xs)
        newToolReqs :: ToolRequirements
newToolReqs    = (Map (Maybe Version) PlatformReqSpec
 -> Map (Maybe Version) PlatformReqSpec
 -> Map (Maybe Version) PlatformReqSpec)
-> [ToolRequirements] -> ToolRequirements
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith ((PlatformReqSpec -> PlatformReqSpec -> PlatformReqSpec)
-> Map (Maybe Version) PlatformReqSpec
-> Map (Maybe Version) PlatformReqSpec
-> Map (Maybe Version) PlatformReqSpec
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (\PlatformReqSpec
_ PlatformReqSpec
b2 -> PlatformReqSpec
b2)) (GHCupInfo -> ToolRequirements
_toolRequirements (GHCupInfo -> ToolRequirements)
-> [GHCupInfo] -> [ToolRequirements]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GHCupInfo]
xs)
    in GHCupInfo -> m GHCupInfo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> m GHCupInfo) -> GHCupInfo -> m GHCupInfo
forall a b. (a -> b) -> a -> b
$ ToolRequirements
-> Map Tool (Map GHCTargetVersion VersionInfo)
-> Maybe URI
-> GHCupInfo
GHCupInfo ToolRequirements
newToolReqs Map Tool (Map GHCTargetVersion VersionInfo)
newDownloads Maybe URI
forall a. Maybe a
Nothing



yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
yamlFromCache :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
URI -> m String
yamlFromCache URI
uri = do
  Dirs{String
GHCupPath
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> String
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> String
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath -> String
fromGHCupPath GHCupPath
cacheDir String -> String -> String
</> (Text -> String
T.unpack (Text -> String) -> (URI -> Text) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
urlBaseName (ByteString -> ByteString)
-> (URI -> ByteString) -> URI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> String) -> URI -> String
forall a b. (a -> b) -> a -> b
$ URI
uri))


etagsFile :: FilePath -> FilePath
etagsFile :: String -> String
etagsFile = (String -> String -> String
<.> String
"etags")


getBase :: forall m env . ( MonadReader env m
           , HasDirs env
           , HasSettings env
           , MonadFail m
           , MonadIO m
           , MonadCatch m
           , HasLog env
           , MonadMask m
           )
        => URI
        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError] m FilePath
getBase :: forall (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
getBase URI
uri = do
  Settings { Bool
noNetwork :: Bool
$sel:noNetwork:Settings :: Settings -> Bool
noNetwork, Downloader
downloader :: Downloader
$sel:downloader:Settings :: Settings -> Downloader
downloader, MetaMode
metaMode :: MetaMode
$sel:metaMode:Settings :: Settings -> MetaMode
metaMode } <- m Settings
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     Settings
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings

  -- try to download yaml... usually this writes it into cache dir,
  -- but in some cases not (e.g. when using file://), so we honour
  -- the return filepath, if any
  Maybe String
mYaml <- if Bool
noNetwork Bool -> Bool -> Bool
&& Optic' A_Lens '[] URI ByteString -> URI -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' URI Scheme
uriSchemeL' Lens' URI 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 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"file" -- for file://, let it fall through
           then Maybe String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall a.
a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
           else (IOException
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError]
      m
      (Maybe String))
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> case MetaMode
metaMode of
                                  MetaMode
Strict -> IOException
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwIO IOException
e
                                  MetaMode
Lax -> m ()
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Downloader -> m ()
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
 MonadIO m) =>
String -> Downloader -> m ()
warnCache (IOException -> String
forall e. Exception e => e -> String
displayException IOException
e) Downloader
downloader) Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError] m ()
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall a b.
Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError] m a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m b
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall a.
a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing)
               (Excepts
   '[DownloadFailed, GPGError, DigestError, ContentLengthError]
   m
   (Maybe String)
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError]
      m
      (Maybe String))
-> (URI
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError]
         m
         (Maybe String))
-> URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 @_ @_ @'[DownloadFailed] (\e :: DownloadFailed
e@(DownloadFailed V xs
_) -> case MetaMode
metaMode of
                   MetaMode
Strict -> DownloadFailed -> Excepts '[DownloadFailed] m (Maybe String)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE DownloadFailed
e
                   MetaMode
Lax -> m () -> Excepts '[DownloadFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[DownloadFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Downloader -> m ()
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
 MonadIO m) =>
String -> Downloader -> m ()
warnCache (DownloadFailed -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError DownloadFailed
e) Downloader
downloader) Excepts '[DownloadFailed] m ()
-> Excepts '[DownloadFailed] m (Maybe String)
-> Excepts '[DownloadFailed] m (Maybe String)
forall a b.
Excepts '[DownloadFailed] m a
-> Excepts '[DownloadFailed] m b -> Excepts '[DownloadFailed] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> Excepts '[DownloadFailed] m (Maybe String)
forall a. a -> Excepts '[DownloadFailed] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing)
               (Excepts
   '[DownloadFailed, DigestError, ContentLengthError, GPGError]
   m
   (Maybe String)
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError]
      m
      (Maybe String))
-> (URI
    -> Excepts
         '[DownloadFailed, DigestError, ContentLengthError, GPGError]
         m
         (Maybe String))
-> URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String)
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m
     String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m
     (Maybe String)
forall a b.
(a -> b)
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just
               (Excepts
   '[DownloadFailed, DigestError, ContentLengthError, GPGError]
   m
   String
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError]
      m
      (Maybe String))
-> (URI
    -> Excepts
         '[DownloadFailed, DigestError, ContentLengthError, GPGError]
         m
         String)
-> URI
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m
     (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m
     String
forall (m1 :: * -> *) env1.
(MonadReader env1 m1, HasDirs env1, HasSettings env1,
 MonadCatch m1, MonadIO m1, MonadFail m1, HasLog env1,
 MonadMask m1) =>
URI
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
smartDl
               (URI
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError]
      m
      (Maybe String))
-> URI
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     (Maybe String)
forall a b. (a -> b) -> a -> b
$ URI
uri

  -- if we didn't get a filepath from the download, use the cached yaml
  Excepts
  '[DownloadFailed, GPGError, DigestError, ContentLengthError]
  m
  String
-> (String
    -> Excepts
         '[DownloadFailed, GPGError, DigestError, ContentLengthError]
         m
         String)
-> Maybe String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (m String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m String
 -> Excepts
      '[DownloadFailed, GPGError, DigestError, ContentLengthError]
      m
      String)
-> m String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall a b. (a -> b) -> a -> b
$ URI -> m String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
URI -> m String
yamlFromCache URI
uri) String
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError]
     m
     String
forall a.
a
-> Excepts
     '[DownloadFailed, GPGError, DigestError, ContentLengthError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
mYaml
 where
  warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
  warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
 MonadIO m) =>
String -> Downloader -> m ()
warnCache String
s Downloader
downloader' = do
    let tryDownloder :: Text
tryDownloder = case Downloader
downloader' of
                         Downloader
Curl -> Text
"Wget"
                         Downloader
Wget -> Text
"Curl"
#if defined(INTERNAL_DOWNLOADER)
                         Internal -> "Curl"
#endif
    Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not get download info, trying cached version (this may not be recent!)" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"If this problem persists, consider switching downloader via: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"ghcup config set downloader " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tryDownloder
    Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Error was: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
s

  -- 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.
  --
  -- Always save the local file with the mod time of the remote file.
  smartDl :: forall m1 env1
           . ( MonadReader env1 m1
             , HasDirs env1
             , HasSettings env1
             , MonadCatch m1
             , MonadIO m1
             , MonadFail m1
             , HasLog env1
             , MonadMask m1
             )
          => URI
          -> Excepts
               '[ DownloadFailed
                , DigestError
                , ContentLengthError
                , GPGError
                ]
               m1
               FilePath
  smartDl :: forall (m1 :: * -> *) env1.
(MonadReader env1 m1, HasDirs env1, HasSettings env1,
 MonadCatch m1, MonadIO m1, MonadFail m1, HasLog env1,
 MonadMask m1) =>
URI
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
smartDl URI
uri' = do
    String
json_file <- m1 String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 String
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError]
      m1
      String)
-> m1 String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall a b. (a -> b) -> a -> b
$ URI -> m1 String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
URI -> m String
yamlFromCache URI
uri'
    let 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 (Lens' URI Scheme
uriSchemeL' Lens' URI 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'
    Bool
e <- IO Bool
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     Bool
forall a.
IO a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError]
      m1
      Bool)
-> IO Bool
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
json_file
    UTCTime
currentTime <- IO UTCTime
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     UTCTime
forall a.
IO a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    Dirs { GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
cacheDir :: GHCupPath
cacheDir } <- m1 Dirs
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     Dirs
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m1 Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
    Settings { Integer
metaCache :: Integer
$sel:metaCache:Settings :: Settings -> Integer
metaCache } <- m1 Settings
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     Settings
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m1 Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings

       -- for local files, let's short-circuit and ignore access time
    if | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"file" -> Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m1
  String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m1
   String
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError]
      m1
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m1
     String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m1
     String
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
download URI
uri' Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing (GHCupPath -> String
fromGHCupPath GHCupPath
cacheDir) Maybe String
forall a. Maybe a
Nothing Bool
True
       | Bool
e -> do
          POSIXTime
accessTime <- (UTCTime -> POSIXTime)
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     UTCTime
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     POSIXTime
forall a b.
(a -> b)
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (Excepts
   '[DownloadFailed, DigestError, ContentLengthError, GPGError]
   m1
   UTCTime
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError]
      m1
      POSIXTime)
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     UTCTime
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     POSIXTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     UTCTime
forall a.
IO a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError]
      m1
      UTCTime)
-> IO UTCTime
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     UTCTime
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getAccessTime String
json_file
          let sinceLastAccess :: POSIXTime
sinceLastAccess = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
currentTime POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
accessTime
          let cacheInterval :: POSIXTime
cacheInterval = Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger Integer
metaCache
          m1 ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 ()
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> m1 ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ Text -> m1 ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m1 ()) -> Text -> m1 ()
forall a b. (a -> b) -> a -> b
$ Text
"last access was " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (POSIXTime -> String
forall a. Show a => a -> String
show POSIXTime
sinceLastAccess) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ago, cache interval is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (POSIXTime -> String
forall a. Show a => a -> String
show POSIXTime
cacheInterval)
          -- access time won't work on most linuxes, but we can try regardless
          if | Integer
metaCache Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 -> UTCTime
-> String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
dlWithMod UTCTime
currentTime String
json_file
             | (POSIXTime
sinceLastAccess POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
cacheInterval) ->
                -- no access in last 5 minutes, re-check upstream mod time
                UTCTime
-> String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
dlWithMod UTCTime
currentTime String
json_file
             | Bool
otherwise -> String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall a.
a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
json_file
       | Bool
otherwise -> UTCTime
-> String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
dlWithMod UTCTime
currentTime String
json_file
   where
    dlWithMod :: UTCTime
-> String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
dlWithMod UTCTime
modTime String
json_file = do
      let (String
dir, String
fn) = String -> (String, String)
splitFileName String
json_file
      String
f <- Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m1
  String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m1
   String
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError]
      m1
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m1
     String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m1
     String
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
download URI
uri' (URI -> Maybe URI
forall a. a -> Maybe a
Just (URI -> Maybe URI) -> URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens '[] URI ByteString
-> (ByteString -> ByteString) -> URI -> URI
forall k (is :: [*]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens '[] URI ByteString
forall a. Lens' (URIRef a) ByteString
pathL' (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".sig") URI
uri') Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing String
dir (String -> Maybe String
forall a. a -> Maybe a
Just String
fn) Bool
True

      -- make these failures non-fatal, also see:
      -- https://github.com/actions/runner-images/issues/7061
      (IOException
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> Text
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> Text
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ Text
"setModificationTime failed with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IOException -> String
forall e. Exception e => e -> String
displayException IOException
e)) (Excepts
   '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ IO ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a.
IO a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> IO ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ String -> UTCTime -> IO ()
setModificationTime String
f UTCTime
modTime
      (IOException
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> Text
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> Text
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ Text
"setAccessTime failed with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IOException -> String
forall e. Exception e => e -> String
displayException IOException
e)) (Excepts
   '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ IO ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a.
IO a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ())
-> IO ()
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ String -> UTCTime -> IO ()
setAccessTime String
f UTCTime
modTime

      String
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError]
     m1
     String
forall a.
a
-> Excepts
     '[DownloadFailed, DigestError, ContentLengthError, GPGError] m1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
f

warnOnMetadataUpdate ::
           ( MonadReader env m
           , MonadIO m
           , HasLog env
           , HasDirs env
           )
        => URI
        -> GHCupInfo
        -> m ()
warnOnMetadataUpdate :: forall env (m :: * -> *).
(MonadReader env m, MonadIO m, HasLog env, HasDirs env) =>
URI -> GHCupInfo -> m ()
warnOnMetadataUpdate URI
uri (GHCupInfo { $sel:_metadataUpdate:GHCupInfo :: GHCupInfo -> Maybe URI
_metadataUpdate = Just URI
newUri })
  | URI -> ByteString
scheme' URI
uri ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"file"
  , URI -> String
forall {a}. URIRef a -> String
urlBase' URI
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= URI -> String
forall {a}. URIRef a -> String
urlBase' URI
newUri = do
      String
confFile <- m String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
m String
getConfigFilePath'
      Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"New metadata version detected"
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n    old URI: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
uri
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n    new URI: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
newUri
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nYou might need to update your " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
confFile
  | URI -> ByteString
scheme' URI
uri ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"file"
  , URI
uri URI -> URI -> Bool
forall a. Eq a => a -> a -> Bool
/= URI
newUri = do
      String
confFile <- m String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
m String
getConfigFilePath'
      Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"New metadata version detected"
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n    old URI: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
uri
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n    new URI: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
newUri
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nYou might need to update your " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
confFile
 where
  scheme' :: URI -> 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 (Lens' URI Scheme
uriSchemeL' Lens' URI 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')
  urlBase' :: URIRef a -> String
urlBase' = Text -> String
T.unpack (Text -> String) -> (URIRef a -> Text) -> URIRef a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe (ByteString -> Text)
-> (URIRef a -> ByteString) -> URIRef a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
urlBaseName (ByteString -> ByteString)
-> (URIRef a -> ByteString) -> URIRef a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens '[] (URIRef a) ByteString -> URIRef a -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (URIRef a) ByteString
forall a. Lens' (URIRef a) ByteString
pathL'
warnOnMetadataUpdate URI
_ GHCupInfo
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


decodeMetadata :: forall j m env .
               ( MonadReader env m
               , HasDirs env
               , HasSettings env
               , MonadFail m
               , MonadIO m
               , MonadCatch m
               , HasLog env
               , MonadMask m
               , FromJSON j
               )
               => FilePath
               -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata :: forall j (m :: * -> *) env.
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m, FromJSON j) =>
String -> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata String
actualYaml = do
  m () -> Excepts '[JSONError, FileDoesNotExistError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[JSONError, FileDoesNotExistError] m a
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
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Decoding yaml at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
actualYaml

  Excepts '[JSONError] m j
-> Excepts '[JSONError, FileDoesNotExistError] m j
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE
    (Excepts '[JSONError] m j
 -> Excepts '[JSONError, FileDoesNotExistError] m j)
-> (String -> Excepts '[JSONError] m j)
-> String
-> Excepts '[JSONError, FileDoesNotExistError] m j
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> Excepts '[JSONError] m j -> Excepts '[JSONError] m j
forall (m :: * -> *) (es :: [*]) a.
Monad m =>
m () -> Excepts es m a -> Excepts es m a
onE_ (String -> m ()
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
 MonadIO m) =>
String -> m ()
onError String
actualYaml)
    (Excepts '[JSONError] m j -> Excepts '[JSONError] m j)
-> (String -> Excepts '[JSONError] m j)
-> String
-> Excepts '[JSONError] m j
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e' e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
(e' -> e) -> m (Either e' a) -> Excepts es m a
lEM' @_ @_ @'[JSONError] (\(ParseException -> String
forall e. Exception e => e -> String
displayException -> String
e) -> String -> JSONError
JSONDecodeError (String -> JSONError) -> String -> JSONError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
e, String
"Consider removing " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
actualYaml String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" manually."])
    (m (Either ParseException j) -> Excepts '[JSONError] m j)
-> (String -> m (Either ParseException j))
-> String
-> Excepts '[JSONError] m j
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ParseException j) -> m (Either ParseException j)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Either ParseException j) -> m (Either ParseException j))
-> (String -> IO (Either ParseException j))
-> String
-> m (Either ParseException j)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Either ParseException j)
forall a. FromJSON a => String -> IO (Either ParseException a)
Y.decodeFileEither
    (String -> Excepts '[JSONError, FileDoesNotExistError] m j)
-> String -> Excepts '[JSONError, FileDoesNotExistError] m j
forall a b. (a -> b) -> a -> b
$ String
actualYaml
 where
  -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
  -- may re-download and succeed.
  onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
  onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
 MonadIO m) =>
String -> m ()
onError String
fp = do
    let efp :: String
efp = String -> String
etagsFile String
fp
    (IOException -> m ()) -> m () -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Couldn't remove file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
efp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", error was: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IOException -> String
forall e. Exception e => e -> String
displayException IOException
e))
      (IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
rmFile String
efp)
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> 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
$ String -> UTCTime -> IO ()
setAccessTime String
fp (POSIXTime -> UTCTime
posixSecondsToUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int Int
0))


getDownloadInfo :: ( MonadReader env m
                   , HasPlatformReq env
                   , HasGHCupInfo env
                   )
                => Tool
                -> Version
                -- ^ tool version
                -> Excepts
                     '[NoDownload]
                     m
                     DownloadInfo
getDownloadInfo :: forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
t Version
v = Tool -> GHCTargetVersion -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> GHCTargetVersion -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo' Tool
t (Version -> GHCTargetVersion
mkTVer Version
v)

getDownloadInfo' :: ( MonadReader env m
                    , HasPlatformReq env
                    , HasGHCupInfo env
                    )
                 => Tool
                 -> GHCTargetVersion
                 -- ^ tool version
                 -> Excepts
                      '[NoDownload]
                      m
                      DownloadInfo
getDownloadInfo' :: forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> GHCTargetVersion -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo' Tool
t GHCTargetVersion
v = do
  pfreq :: PlatformRequest
pfreq@(PlatformRequest Architecture
a Platform
p Maybe Versioning
mv) <- m PlatformRequest -> Excepts '[NoDownload] m PlatformRequest
forall (m :: * -> *) a. Monad m => m a -> Excepts '[NoDownload] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> Map Tool (Map GHCTargetVersion VersionInfo)
_ghcupDownloads = Map Tool (Map GHCTargetVersion VersionInfo)
dls } <- m GHCupInfo -> Excepts '[NoDownload] m GHCupInfo
forall (m :: * -> *) a. Monad m => m a -> Excepts '[NoDownload] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo

  let 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_AffineFold
  '[]
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map (Maybe VersionRange) DownloadInfo)
-> Map Tool (Map GHCTargetVersion VersionInfo)
-> Maybe (Map (Maybe VersionRange) DownloadInfo)
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index (Map Tool (Map GHCTargetVersion VersionInfo))
-> Optic'
     (IxKind (Map Tool (Map GHCTargetVersion VersionInfo)))
     '[]
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (IxValue (Map Tool (Map GHCTargetVersion VersionInfo)))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Tool (Map GHCTargetVersion VersionInfo))
Tool
t Optic
  An_AffineTraversal
  '[]
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map GHCTargetVersion VersionInfo)
  (Map GHCTargetVersion VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map GHCTargetVersion VersionInfo)
     (Map GHCTargetVersion VersionInfo)
     VersionInfo
     VersionInfo
-> Optic
     An_AffineTraversal
     '[]
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (Map Tool (Map GHCTargetVersion VersionInfo))
     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 GHCTargetVersion VersionInfo)
-> Optic'
     (IxKind (Map GHCTargetVersion VersionInfo))
     '[]
     (Map GHCTargetVersion VersionInfo)
     (IxValue (Map GHCTargetVersion VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map GHCTargetVersion VersionInfo)
GHCTargetVersion
v Optic
  An_AffineTraversal
  '[]
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map Tool (Map GHCTargetVersion VersionInfo))
  VersionInfo
  VersionInfo
-> Optic
     A_Lens
     '[]
     VersionInfo
     VersionInfo
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
-> Optic
     An_AffineTraversal
     '[]
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           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
% Optic
  A_Lens
  '[]
  VersionInfo
  VersionInfo
  (MapIgnoreUnknownKeys
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
  (MapIgnoreUnknownKeys
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
viArch Optic
  An_AffineTraversal
  '[]
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (MapIgnoreUnknownKeys
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
  (MapIgnoreUnknownKeys
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
-> Optic
     A_Getter
     '[]
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
-> Optic
     An_AffineFold
     '[]
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           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
% (MapIgnoreUnknownKeys
   Architecture
   (MapIgnoreUnknownKeys
      Platform (Map (Maybe VersionRange) DownloadInfo))
 -> Map
      Architecture
      (MapIgnoreUnknownKeys
         Platform (Map (Maybe VersionRange) DownloadInfo)))
-> Optic
     A_Getter
     '[]
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (MapIgnoreUnknownKeys
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
forall s a. (s -> a) -> Getter s a
to MapIgnoreUnknownKeys
  Architecture
  (MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo))
-> Map
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
forall k v. MapIgnoreUnknownKeys k v -> Map k v
unMapIgnoreUnknownKeys Optic
  An_AffineFold
  '[]
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
  (Map
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
-> Optic
     An_AffineTraversal
     '[]
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
     An_AffineFold
     '[]
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
     (MapIgnoreUnknownKeys
        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
  (Map
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
-> Optic'
     (IxKind
        (Map
           Architecture
           (MapIgnoreUnknownKeys
              Platform (Map (Maybe VersionRange) DownloadInfo))))
     '[]
     (Map
        Architecture
        (MapIgnoreUnknownKeys
           Platform (Map (Maybe VersionRange) DownloadInfo)))
     (IxValue
        (Map
           Architecture
           (MapIgnoreUnknownKeys
              Platform (Map (Maybe VersionRange) DownloadInfo))))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index
  (Map
     Architecture
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo)))
Architecture
a Optic
  An_AffineFold
  '[]
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo))
  (MapIgnoreUnknownKeys
     Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
     A_Getter
     '[]
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
     An_AffineFold
     '[]
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (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
% (MapIgnoreUnknownKeys
   Platform (Map (Maybe VersionRange) DownloadInfo)
 -> Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
     A_Getter
     '[]
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
     (MapIgnoreUnknownKeys
        Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
forall s a. (s -> a) -> Getter s a
to MapIgnoreUnknownKeys
  Platform (Map (Maybe VersionRange) DownloadInfo)
-> Map Platform (Map (Maybe VersionRange) DownloadInfo)
forall k v. MapIgnoreUnknownKeys k v -> Map k v
unMapIgnoreUnknownKeys Optic
  An_AffineFold
  '[]
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (Map Tool (Map GHCTargetVersion VersionInfo))
  (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_AffineFold
     '[]
     (Map Tool (Map GHCTargetVersion VersionInfo))
     (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)) Map Tool (Map GHCTargetVersion VersionInfo)
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 a b. (a -> b) -> Maybe a -> Maybe b
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
      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)

  Excepts '[NoDownload] m DownloadInfo
-> (DownloadInfo -> Excepts '[NoDownload] m DownloadInfo)
-> Maybe DownloadInfo
-> Excepts '[NoDownload] m DownloadInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (NoDownload -> Excepts '[NoDownload] m DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (NoDownload -> Excepts '[NoDownload] m DownloadInfo)
-> NoDownload -> Excepts '[NoDownload] m DownloadInfo
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Tool -> Maybe PlatformRequest -> NoDownload
NoDownload GHCTargetVersion
v Tool
t (PlatformRequest -> Maybe PlatformRequest
forall a. a -> Maybe a
Just PlatformRequest
pfreq))
    DownloadInfo -> Excepts '[NoDownload] m DownloadInfo
forall a. a -> Excepts '[NoDownload] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro_ver Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro
    )



-- | 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 :: ( MonadReader env m
            , HasSettings env
            , HasDirs env
            , MonadMask m
            , MonadThrow m
            , HasLog env
            , MonadIO m
            )
         => URI
         -> Maybe URI         -- ^ URI for gpg sig
         -> Maybe T.Text      -- ^ expected hash
         -> Maybe Integer     -- ^ expected content length
         -> FilePath          -- ^ destination dir (ignored for file:// scheme)
         -> Maybe FilePath    -- ^ optional filename
         -> Bool              -- ^ whether to read an write etags
         -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
download :: forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
download URI
rawUri Maybe URI
gpgUri Maybe Text
eDigest Maybe Integer
eCSize String
dest Maybe String
mfn Bool
etags
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"https" = Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
dl
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"http"  = Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
dl
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"file"  = do
      let destFile' :: String
destFile' = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ 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
rawUri
      m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"using local file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
destFile'
      Maybe Text
-> (Text
    -> Excepts
         '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
eDigest (Excepts '[DigestError] m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] 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, ContentLengthError, DownloadFailed, GPGError] m ())
-> (Text -> Excepts '[DigestError] m ())
-> Text
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String -> Excepts '[DigestError] m ())
-> String -> Text -> Excepts '[DigestError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> String -> Excepts '[DigestError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadThrow m, HasLog env) =>
Text -> String -> Excepts '[DigestError] m ()
checkDigest String
destFile')
      String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall a.
a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
destFile'
  | Bool
otherwise = DownloadFailed
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DownloadFailed
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError]
      m
      String)
-> DownloadFailed
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall a b. (a -> b) -> a -> b
$ V '[UnsupportedScheme] -> DownloadFailed
forall (xs :: [*]).
(HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs,
 PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (UnsupportedScheme -> V '[UnsupportedScheme]
forall a. a -> V '[a]
variantFromValue 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 (Lens' URI Scheme
uriSchemeL' Lens' URI 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
rawUri
  dl :: Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
dl = do
    Settings{ DownloadMirrors
mirrors :: DownloadMirrors
$sel:mirrors:Settings :: Settings -> DownloadMirrors
mirrors } <- m Settings
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     Settings
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
    let uri :: URI
uri = DownloadMirrors -> URI -> URI
applyMirrors DownloadMirrors
mirrors URI
rawUri
    String
baseDestFile <- Excepts '[DownloadFailed] m String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DownloadFailed] m String
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError]
      m
      String)
-> (Excepts '[NoUrlBase] m String
    -> Excepts '[DownloadFailed] m String)
-> Excepts '[NoUrlBase] m String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @_ @'[DownloadFailed] V '[NoUrlBase] -> DownloadFailed
forall (xs :: [*]).
(HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs,
 PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts '[NoUrlBase] m String
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError]
      m
      String)
-> Excepts '[NoUrlBase] m String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String -> Excepts '[NoUrlBase] m String
forall (m :: * -> *).
Monad m =>
URI -> Maybe String -> Excepts '[NoUrlBase] m String
getDestFile URI
uri Maybe String
mfn
    m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"downloading: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
uri Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
baseDestFile

    -- destination dir must exist
    IO ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a.
IO a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> IO ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
createDirRecursive' String
dest


    -- download
    (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
onException
         (m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
String -> m ()
recycleFile (String -> String
tmpFile String
baseDestFile))
     (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError, ContentLengthError] @'[DigestError, ContentLengthError, DownloadFailed, GPGError]
          (\V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError, ContentLengthError]
e' -> do
            m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> m ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
String -> m ()
recycleFile (String -> String
tmpFile String
baseDestFile)
            case V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError, ContentLengthError]
e' of
              V e :: GPGError
e@GPGError {} -> GPGError
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE GPGError
e
              V e :: DigestError
e@DigestError {} -> DigestError
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE DigestError
e
              V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError, ContentLengthError]
_ -> DownloadFailed
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError, ContentLengthError]
-> DownloadFailed
forall (xs :: [*]).
(HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs,
 PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError, ContentLengthError]
e')
          ) (Excepts
   '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
     DigestError, ContentLengthError]
   m
   ()
 -> Excepts
      '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ do
              Settings{ Downloader
$sel:downloader:Settings :: Settings -> Downloader
downloader :: Downloader
downloader, Bool
$sel:noNetwork:Settings :: Settings -> Bool
noNetwork :: Bool
noNetwork, GPGSetting
gpgSetting :: GPGSetting
$sel:gpgSetting:Settings :: Settings -> GPGSetting
gpgSetting } <- m Settings
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     Settings
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
              Bool
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
noNetwork (Excepts
   '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
     DigestError, ContentLengthError]
   m
   ()
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ DownloadFailed
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (V '[NoNetwork] -> DownloadFailed
forall (xs :: [*]).
(HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs,
 PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (NoNetwork -> V '[NoNetwork]
forall c (cs :: [*]). (c :< cs) => c -> V cs
V NoNetwork
NoNetwork :: V '[NoNetwork]))
              String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
downloadAction <- case Downloader
downloader of
                    Downloader
Curl -> do
                      [String]
o' <- IO [String]
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     [String]
forall a.
IO a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getCurlOpts
                      if Bool
etags
                        then (String
 -> URI
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a.
a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadMask m,
 MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlEtagsDL [String]
o'
                        else (String
 -> URI
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a.
a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *).
(MonadCatch m, MonadMask m, MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlDL [String]
o'
                    Downloader
Wget -> do
                      [String]
o' <- IO [String]
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     [String]
forall a.
IO a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getWgetOpts
                      if Bool
etags
                        then (String
 -> URI
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a.
a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadMask m,
 MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetEtagsDL [String]
o'
                        else (String
 -> URI
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a.
a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *).
(MonadCatch m, MonadMask m, MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetDL [String]
o'
#if defined(INTERNAL_DOWNLOADER)
                    Internal -> do
                      if etags
                        then pure (\fp -> liftE . internalEtagsDL fp)
                        else pure (\fp -> liftE . internalDL fp)
#endif
              Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
downloadAction String
baseDestFile URI
uri
              case (Maybe URI
gpgUri, GPGSetting
gpgSetting) of
                (Maybe URI
_, GPGSetting
GPGNone) -> ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall a.
a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                (Just URI
gpgUri', GPGSetting
_) -> do
                  String
gpgDestFile <- Excepts '[DownloadFailed] m String
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DownloadFailed] m String
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      String)
-> (Excepts '[NoUrlBase] m String
    -> Excepts '[DownloadFailed] m String)
-> Excepts '[NoUrlBase] m String
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @_ @'[DownloadFailed] V '[NoUrlBase] -> DownloadFailed
forall (xs :: [*]).
(HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs,
 PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts '[NoUrlBase] m String
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      String)
-> Excepts '[NoUrlBase] m String
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String -> Excepts '[NoUrlBase] m String
forall (m :: * -> *).
Monad m =>
URI -> Maybe String -> Excepts '[NoUrlBase] m String
getDestFile URI
gpgUri' Maybe String
forall a. Maybe a
Nothing
                  Excepts '[GPGError] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[GPGError] m ()
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      ())
-> Excepts '[GPGError] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ (Excepts '[GPGError] m ()
 -> Excepts '[GPGError] m () -> Excepts '[GPGError] m ())
-> Excepts '[GPGError] m ()
-> Excepts '[GPGError] m ()
-> Excepts '[GPGError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[GPGError] m ()
-> Excepts '[GPGError] m () -> Excepts '[GPGError] m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
onException
                       (m () -> Excepts '[GPGError] m ()
forall (m :: * -> *) a. Monad m => m a -> Excepts '[GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[GPGError] m ())
-> m () -> Excepts '[GPGError] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
String -> m ()
recycleFile (String -> String
tmpFile String
gpgDestFile))
                   (Excepts '[GPGError] m () -> Excepts '[GPGError] m ())
-> Excepts '[GPGError] m () -> Excepts '[GPGError] m ()
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
                        (\V '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
e -> if GPGSetting
gpgSetting GPGSetting -> GPGSetting -> Bool
forall a. Eq a => a -> a -> Bool
== GPGSetting
GPGStrict then GPGError -> Excepts '[GPGError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (V '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
-> GPGError
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> GPGError
GPGError V '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
e) else m () -> Excepts '[GPGError] m ()
forall (m :: * -> *) a. Monad m => m a -> Excepts '[GPGError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[GPGError] m ())
-> m () -> Excepts '[GPGError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (GPGError -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError (V '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
-> GPGError
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> GPGError
GPGError V '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
e))
                        ) (Excepts
   '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
 -> Excepts '[GPGError] m ())
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
-> Excepts '[GPGError] m ()
forall a b. (a -> b) -> a -> b
$ do
                      [String]
o' <- IO [String]
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
     m
     [String]
forall a.
IO a
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getGpgOpts
                      m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ())
-> m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"downloading: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
gpgUri' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
gpgDestFile
                      Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
downloadAction String
gpgDestFile URI
gpgUri'
                      m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ())
-> m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"verifying signature of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
baseDestFile
                      let args :: [String]
args = [String]
o' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--batch", String
"--verify", String
"--quiet", String
"--no-tty", String
gpgDestFile, String
baseDestFile]
                      CapturedProcess
cp <- m CapturedProcess
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
     m
     CapturedProcess
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
 -> Excepts
      '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
      m
      CapturedProcess)
-> m CapturedProcess
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
     m
     CapturedProcess
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Maybe String -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
"gpg" [String]
args Maybe String
forall a. Maybe a
Nothing
                      case CapturedProcess
cp of
                        CapturedProcess { $sel:_exitCode:CapturedProcess :: CapturedProcess -> ExitCode
_exitCode = ExitFailure Int
i, ByteString
_stdErr :: ByteString
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
_stdErr } -> do
                          m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ())
-> m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decUTF8Safe' ByteString
_stdErr
                          GPGError
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> GPGError
GPGError @'[ProcessError] (ProcessError -> V '[ProcessError]
forall c (cs :: [*]). (c :< cs) => c -> V cs
V (Int -> String -> [String] -> ProcessError
NonZeroExit Int
i String
"gpg" [String]
args)))
                        CapturedProcess { ByteString
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
_stdErr :: ByteString
_stdErr } -> m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ())
-> m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decUTF8Safe' ByteString
_stdErr
                (Maybe URI, GPGSetting)
_ -> ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall a.
a
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

              Maybe Integer
-> (Integer
    -> Excepts
         '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
           DigestError, ContentLengthError]
         m
         ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Integer
eCSize  (Excepts '[ContentLengthError] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ContentLengthError] m ()
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      ())
-> (Integer -> Excepts '[ContentLengthError] m ())
-> Integer
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> String -> Excepts '[ContentLengthError] m ())
-> String -> Integer -> Excepts '[ContentLengthError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> String -> Excepts '[ContentLengthError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadThrow m, HasLog env) =>
Integer -> String -> Excepts '[ContentLengthError] m ()
checkCSize  String
baseDestFile)
              Maybe Text
-> (Text
    -> Excepts
         '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
           DigestError, ContentLengthError]
         m
         ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
eDigest (Excepts '[DigestError] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError] m ()
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError, ContentLengthError]
      m
      ())
-> (Text -> Excepts '[DigestError] m ())
-> Text
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError, ContentLengthError]
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String -> Excepts '[DigestError] m ())
-> String -> Text -> Excepts '[DigestError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> String -> Excepts '[DigestError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadThrow m, HasLog env) =>
Text -> String -> Excepts '[DigestError] m ()
checkDigest String
baseDestFile)
    String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall a.
a
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
baseDestFile

  curlDL :: ( MonadCatch m
            , MonadMask m
            , MonadIO m
            )
         => [String]
         -> FilePath
         -> URI
         -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
  curlDL :: forall (m :: * -> *).
(MonadCatch m, MonadMask m, MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlDL [String]
o' String
destFile (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' -> Text
uri') = do
    let destFileTemp :: String
destFileTemp = String -> String
tmpFile String
destFile
    (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ())
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally (forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ()))
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ String
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
rmFile String
destFileTemp) (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ do
      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
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
exec String
"curl"
        ([String]
o' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-fL", String
"-o", String
destFileTemp, Text -> String
T.unpack Text
uri']
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> (Integer -> [String]) -> Maybe Integer -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
s -> [String
"--max-filesize", Integer -> String
forall a. Show a => a -> String
show Integer
s]) Maybe Integer
eCSize
        ) Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
      IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a.
IO a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renameFile String
destFileTemp String
destFile

  curlEtagsDL :: ( MonadReader env m
                 , HasLog env
                 , MonadCatch m
                 , MonadMask m
                 , MonadIO m
                 )
              => [String]
              -> FilePath
              -> URI
              -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
  curlEtagsDL :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadMask m,
 MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlEtagsDL [String]
o' String
destFile (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' -> Text
uri') = do
    let destFileTemp :: String
destFileTemp = String -> String
tmpFile String
destFile
    String
dh <- IO String
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m String
forall a.
IO a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme] m String)
-> IO String
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
emptySystemTempFile String
"curl-header"
    (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ())
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally (forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ()))
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ String
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
rmFile String
dh) (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$
      (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ())
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally (forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ()))
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ String
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
rmFile String
destFileTemp) (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe Text
metag <- m (Maybe Text)
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m (Maybe Text)
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Text)
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme] m (Maybe Text))
-> m (Maybe Text)
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe Text)
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
String -> m (Maybe Text)
readETag String
destFile
        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
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
exec String
"curl"
            ([String]
o' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (if Bool
etags then [String
"--dump-header", String
dh] else [])
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> (Text -> [String]) -> Maybe Text -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
t -> [String
"-H", String
"If-None-Match: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t]) Maybe Text
metag
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-fL", String
"-o", String
destFileTemp, Text -> String
T.unpack Text
uri']) Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
        Text
headers <- IO Text
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m Text
forall a.
IO a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme] m Text)
-> IO Text
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
dh

        -- this nonsense is necessary, because some older versions of curl would overwrite
        -- the destination file when 304 is returned
        case (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Text]
T.words (Maybe Text -> Maybe [Text])
-> (Text -> Maybe Text) -> Text -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getLastHeader (Text -> Maybe [Text]) -> Text -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ Text
headers of
          Just (Text
http':Text
sc:[Text]
_)
            | Text
sc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"304"
            , String -> Text
T.pack String
"HTTP" Text -> Text -> Bool
`T.isPrefixOf` Text
http' -> m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug Text
"Status code was 304, not overwriting"
            | String -> Text
T.pack String
"HTTP" Text -> Text -> Bool
`T.isPrefixOf` Text
http' -> do
                m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Status code was " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", overwriting"
                IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a.
IO a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renameFile String
destFileTemp String
destFile
          Maybe [Text]
_ -> Excepts '[DownloadFailed] 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 '[DownloadFailed] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[DownloadFailed] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE @_ @'[DownloadFailed] (V '[MalformedHeaders] -> DownloadFailed
forall (xs :: [*]).
(HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs,
 PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (forall (n :: Natural) (l :: [*]). KnownNat n => Index n l -> V l
toVariantAt @0 (Text -> MalformedHeaders
MalformedHeaders Text
headers)
            :: V '[MalformedHeaders]))

        m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe Text) -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
String -> m (Maybe Text) -> m ()
writeEtags String
destFile (Text -> m (Maybe Text)
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
Text -> m (Maybe Text)
parseEtags Text
headers)

  wgetDL :: ( MonadCatch m
            , MonadMask m
            , MonadIO m
            )
         => [String]
         -> FilePath
         -> URI
         -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
  wgetDL :: forall (m :: * -> *).
(MonadCatch m, MonadMask m, MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetDL [String]
o' String
destFile (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' -> Text
uri') = do
    let destFileTemp :: String
destFileTemp = String -> String
tmpFile String
destFile
    (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ())
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally (forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ()))
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ String
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
rmFile String
destFileTemp) (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ do
      let opts :: [String]
opts = [String]
o' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-O", String
destFileTemp , Text -> String
T.unpack Text
uri']
      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
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
exec String
"wget" [String]
opts Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
      IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a.
IO a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renameFile String
destFileTemp String
destFile


  wgetEtagsDL :: ( MonadReader env m
                 , HasLog env
                 , MonadCatch m
                 , MonadMask m
                 , MonadIO m
                 )
              => [String]
              -> FilePath
              -> URI
              -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
  wgetEtagsDL :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadMask m,
 MonadIO m) =>
[String]
-> String
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetEtagsDL [String]
o' String
destFile (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' -> Text
uri') = do
    let destFileTemp :: String
destFileTemp = String -> String
tmpFile String
destFile
    (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ())
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally (forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      (Either SomeException ()))
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ String
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
rmFile String
destFileTemp) (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text
metag <- m (Maybe Text)
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m (Maybe Text)
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Text)
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme] m (Maybe Text))
-> m (Maybe Text)
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme] m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe Text)
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
String -> m (Maybe Text)
readETag String
destFile
      let opts :: [String]
opts = [String]
o' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> (Text -> [String]) -> Maybe Text -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
t -> [String
"--header", String
"If-None-Match: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t]) Maybe Text
metag
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-q", String
"-S", String
"-O", String
destFileTemp , Text -> String
T.unpack Text
uri']
      CapturedProcess {ExitCode
$sel:_exitCode:CapturedProcess :: CapturedProcess -> ExitCode
_exitCode :: ExitCode
_exitCode, ByteString
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
_stdErr :: ByteString
_stdErr} <- m CapturedProcess
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     CapturedProcess
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
 -> Excepts
      '[ProcessError, DownloadFailed, UnsupportedScheme]
      m
      CapturedProcess)
-> m CapturedProcess
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     CapturedProcess
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Maybe String -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
"wget" [String]
opts Maybe String
forall a. Maybe a
Nothing
      case ExitCode
_exitCode of
        ExitCode
ExitSuccess -> do
          IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a.
IO a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renameFile String
destFileTemp String
destFile
          m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe Text) -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
String -> m (Maybe Text) -> m ()
writeEtags String
destFile (Text -> m (Maybe Text)
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
Text -> m (Maybe Text)
parseEtags (ByteString -> Text
decUTF8Safe' ByteString
_stdErr))
        ExitFailure Int
i'
          | Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8
          , Just Text
_ <- (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> Text
T.pack String
"304 Not Modified" Text -> Text -> Bool
`T.isInfixOf`) ([Text] -> Maybe Text)
-> (ByteString -> [Text]) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString -> Maybe Text) -> ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ByteString
_stdErr
                   -> do
                        m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug Text
"Not modified, skipping download"
                        m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe Text) -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
String -> m (Maybe Text) -> m ()
writeEtags String
destFile (Text -> m (Maybe Text)
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
Text -> m (Maybe Text)
parseEtags (ByteString -> Text
decUTF8Safe' ByteString
_stdErr))
          | Bool
otherwise -> ProcessError
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Int -> String -> [String] -> ProcessError
NonZeroExit Int
i' String
"wget" [String]
opts)

#if defined(INTERNAL_DOWNLOADER)
  internalDL :: ( MonadCatch m
                , MonadMask m
                , MonadIO m
                )
             => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
  internalDL destFile uri' = do
    let destFileTemp = tmpFile destFile
    flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
      (https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
      void $ liftE $ catchE @HTTPNotModified
                 @'[DownloadFailed]
            (\e@(HTTPNotModified _) ->
              throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
        $ downloadToFile https host fullPath port destFileTemp mempty eCSize
      liftIO $ renameFile destFileTemp destFile


  internalEtagsDL :: ( MonadReader env m
                     , HasLog env
                     , MonadCatch m
                     , MonadMask m
                     , MonadIO m
                     )
                  => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
  internalEtagsDL destFile uri' = do
    let destFileTemp = tmpFile destFile
    flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
      (https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
      metag <- lift $ readETag destFile
      let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
                                                         , E.encodeUtf8 etag)]) metag
      liftE
        $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
        $ do
          r <- downloadToFile https host fullPath port destFileTemp addHeaders eCSize
          liftIO $ renameFile destFileTemp destFile
          lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
#endif


  -- Manage to find a file we can write the body into.
  getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
  getDestFile :: forall (m :: * -> *).
Monad m =>
URI -> Maybe String -> Excepts '[NoUrlBase] m String
getDestFile URI
uri' Maybe String
mfn' =
    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'
    in case Maybe String
mfn' of
        Just String
fn -> String -> Excepts '[NoUrlBase] m String
forall a. a -> Excepts '[NoUrlBase] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dest String -> String -> String
</> String
fn)
        Maybe String
Nothing
          | let urlBase :: String
urlBase = Text -> String
T.unpack (ByteString -> Text
decUTF8Safe (ByteString -> ByteString
urlBaseName ByteString
path))
          , Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
urlBase) -> String -> Excepts '[NoUrlBase] m String
forall a. a -> Excepts '[NoUrlBase] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dest String -> String -> String
</> String
urlBase)
          -- TODO: remove this once we use hpath again
          | Bool
otherwise -> NoUrlBase -> Excepts '[NoUrlBase] m String
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (NoUrlBase -> Excepts '[NoUrlBase] m String)
-> NoUrlBase -> Excepts '[NoUrlBase] m String
forall a b. (a -> b) -> a -> b
$ Text -> NoUrlBase
NoUrlBase (ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URI -> Text) -> URI -> Text
forall a b. (a -> b) -> a -> b
$ URI
uri')

  parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
  parseEtags :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
Text -> m (Maybe Text)
parseEtags Text
stderr = do
    let mEtag :: Maybe Text
mEtag = (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Text
line -> String -> Text
T.pack String
"etag:" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toLower Text
line) ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getLastHeader (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
stderr
    case Text -> [Text]
T.words (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mEtag of
      (Just []) -> do
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug Text
"Couldn't parse etags, no input: "
        Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      (Just [Text
_, Text
etag']) -> do
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Parsed etag: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
etag'
        Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
etag')
      (Just [Text]
xs) -> do
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"Couldn't parse etags, unexpected input: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
xs)
        Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      Maybe [Text]
Nothing -> do
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug Text
"No etags header found"
        Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

  writeEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
  writeEtags :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
String -> m (Maybe Text) -> m ()
writeEtags String
destFile m (Maybe Text)
getTags = do
    m (Maybe Text)
getTags m (Maybe Text) -> (Maybe Text -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Text
t -> do
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Writing etagsFile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
etagsFile String
destFile)
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile (String -> String
etagsFile String
destFile) Text
t
      Maybe Text
Nothing ->
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug Text
"No etags files written"

  readETag :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
  readETag :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
String -> m (Maybe Text)
readETag String
fp = do
    Bool
e <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
    if Bool
e
    then do
      Either SomeException Text
rE <- forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (m Text -> m (Either SomeException Text))
-> m Text -> m (Either SomeException Text)
forall a b. (a -> b) -> a -> b
$ IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> IO Text -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
stripNewline' (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile (String -> String
etagsFile String
fp)
      case Either SomeException Text
rE of
        (Right Text
et) -> do
          Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Read etag: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
et
          Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
et)
        (Left SomeException
_) -> do
          Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug Text
"Etag file doesn't exist (yet)"
          Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
    else do
      Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Skipping and deleting etags file because destination file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" doesn't exist"
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> 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
$ String -> IO ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
rmFile (String -> String
etagsFile String
fp)
      Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing


-- | Download into tmpdir or use cached version, if it exists. If filename
-- is omitted, infers the filename from the url.
downloadCached :: ( MonadReader env m
                  , HasDirs env
                  , HasSettings env
                  , MonadMask m
                  , MonadResource m
                  , MonadThrow m
                  , HasLog env
                  , MonadIO m
                  , MonadUnliftIO m
                  )
               => DownloadInfo
               -> Maybe FilePath  -- ^ optional filename
               -> Excepts '[URIParseError, DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
downloadCached :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadResource m, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m) =>
DownloadInfo
-> Maybe String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
downloadCached DownloadInfo
dli Maybe String
mfn = do
  Settings{ Bool
cache :: Bool
$sel:cache:Settings :: Settings -> Bool
cache } <- m Settings
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     Settings
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
  case Bool
cache of
    Bool
True -> DownloadInfo
-> Maybe String
-> Maybe String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe String
-> Maybe String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
downloadCached' DownloadInfo
dli Maybe String
mfn Maybe String
forall a. Maybe a
Nothing
    Bool
False -> do
      URI
dlu <- Either URIParseError URI
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     URI
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either URIParseError URI
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      URI)
-> Either URIParseError URI
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     URI
forall a b. (a -> b) -> a -> b
$ Text -> Either URIParseError URI
parseURI' (DownloadInfo -> Text
_dlUri DownloadInfo
dli)
      GHCupPath
tmp <- m GHCupPath
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
 MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
 MonadMask m, MonadIO m) =>
m GHCupPath
withGHCupTmpDir
      Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m
   String
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
download URI
dlu Maybe URI
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just (DownloadInfo -> Text
_dlHash DownloadInfo
dli)) (DownloadInfo -> Maybe Integer
_dlCSize DownloadInfo
dli) (GHCupPath -> String
fromGHCupPath GHCupPath
tmp) Maybe String
outputFileName Bool
False
 where
  outputFileName :: Maybe String
outputFileName = Maybe String
mfn Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DownloadInfo -> Maybe String
_dlOutput DownloadInfo
dli


downloadCached' :: ( MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadMask m
                   , MonadThrow m
                   , HasLog env
                   , MonadIO m
                   , MonadUnliftIO m
                   )
                => DownloadInfo
                -> Maybe FilePath  -- ^ optional filename
                -> Maybe FilePath  -- ^ optional destination dir (default: cacheDir)
                -> Excepts '[URIParseError, DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
downloadCached' :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe String
-> Maybe String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
downloadCached' DownloadInfo
dli Maybe String
mfn Maybe String
mDestDir = do
  Dirs { GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
cacheDir :: GHCupPath
cacheDir } <- m Dirs
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     Dirs
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  URI
dlu <- Either URIParseError URI
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     URI
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either URIParseError URI
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      URI)
-> Either URIParseError URI
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     URI
forall a b. (a -> b) -> a -> b
$ Text -> Either URIParseError URI
parseURI' (DownloadInfo -> Text
_dlUri DownloadInfo
dli)
  let destDir :: String
destDir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (GHCupPath -> String
fromGHCupPath GHCupPath
cacheDir) Maybe String
mDestDir
  let fn :: String
fn = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe ((Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe) (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
urlBaseName (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ 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
dlu) Maybe String
outputFileName
  let cachfile :: String
cachfile = String
destDir String -> String -> String
</> String
fn
  Bool
fileExists <- IO Bool
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     Bool
forall a.
IO a
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      Bool)
-> IO Bool
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
cachfile
  if
    | Bool
fileExists -> do
      Maybe Integer
-> (Integer
    -> Excepts
         '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
           GPGError]
         m
         ())
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Optic' A_Lens '[] DownloadInfo (Maybe Integer)
-> DownloadInfo -> Maybe Integer
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe Integer)
dlCSize DownloadInfo
dli) ((Integer
  -> Excepts
       '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
         GPGError]
       m
       ())
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      ())
-> (Integer
    -> Excepts
         '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
           GPGError]
         m
         ())
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \Integer
s -> Excepts '[ContentLengthError] m ()
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ContentLengthError] m ()
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      ())
-> Excepts '[ContentLengthError] m ()
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Integer -> String -> Excepts '[ContentLengthError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadThrow m, HasLog env) =>
Integer -> String -> Excepts '[ContentLengthError] m ()
checkCSize Integer
s String
cachfile
      Excepts '[DigestError] m ()
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError] m ()
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      ())
-> Excepts '[DigestError] m ()
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> String -> Excepts '[DigestError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadThrow m, HasLog env) =>
Text -> String -> Excepts '[DigestError] m ()
checkDigest (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) String
cachfile
      String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
forall a.
a
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
cachfile
    | Bool
otherwise -> Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m
   String
 -> Excepts
      '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
        GPGError]
      m
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
-> Excepts
     '[URIParseError, DigestError, ContentLengthError, DownloadFailed,
       GPGError]
     m
     String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
download URI
dlu Maybe URI
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just (DownloadInfo -> Text
_dlHash DownloadInfo
dli)) (DownloadInfo -> Maybe Integer
_dlCSize DownloadInfo
dli) String
destDir Maybe String
outputFileName Bool
False
 where
  outputFileName :: Maybe String
outputFileName = Maybe String
mfn Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DownloadInfo -> Maybe String
_dlOutput DownloadInfo
dli




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



checkDigest :: ( MonadReader env m
               , HasDirs env
               , HasSettings env
               , MonadIO m
               , MonadThrow m
               , HasLog env
               )
            => T.Text     -- ^ the hash
            -> FilePath
            -> Excepts '[DigestError] m ()
checkDigest :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadThrow m, HasLog env) =>
Text -> String -> Excepts '[DigestError] m ()
checkDigest Text
eDigest String
file = do
  Settings{ Bool
noVerify :: Bool
$sel:noVerify:Settings :: Settings -> Bool
noVerify } <- m Settings -> Excepts '[DigestError] m Settings
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[DigestError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
  let verify :: Bool
verify = Bool -> Bool
not Bool
noVerify
  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
    let p' :: String
p' = String -> String
takeFileName String
file
    m () -> Excepts '[DigestError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[DigestError] m a
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
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"verifying digest of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
p'
    ByteString
c <- IO ByteString -> Excepts '[DigestError] m ByteString
forall a. IO a -> Excepts '[DigestError] m a
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
$ String -> IO ByteString
L.readFile String
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
    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 (String -> Text -> Text -> DigestError
DigestError String
file Text
cDigest Text
eDigest)

checkCSize :: ( MonadReader env m
              , HasDirs env
              , HasSettings env
              , MonadIO m
              , MonadThrow m
              , HasLog env
              )
           => Integer
           -> FilePath
           -> Excepts '[ContentLengthError] m ()
checkCSize :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadThrow m, HasLog env) =>
Integer -> String -> Excepts '[ContentLengthError] m ()
checkCSize Integer
eCSize String
file = do
  Settings{ Bool
$sel:noVerify:Settings :: Settings -> Bool
noVerify :: Bool
noVerify } <- m Settings -> Excepts '[ContentLengthError] m Settings
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ContentLengthError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
  let verify :: Bool
verify = Bool -> Bool
not Bool
noVerify
  Bool
-> Excepts '[ContentLengthError] m ()
-> Excepts '[ContentLengthError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verify (Excepts '[ContentLengthError] m ()
 -> Excepts '[ContentLengthError] m ())
-> Excepts '[ContentLengthError] m ()
-> Excepts '[ContentLengthError] m ()
forall a b. (a -> b) -> a -> b
$ do
    let p' :: String
p' = String -> String
takeFileName String
file
    m () -> Excepts '[ContentLengthError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ContentLengthError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ContentLengthError] m ())
-> m () -> Excepts '[ContentLengthError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"verifying content length of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
p'
    Integer
cSize <- IO Integer -> Excepts '[ContentLengthError] m Integer
forall a. IO a -> Excepts '[ContentLengthError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> Excepts '[ContentLengthError] m Integer)
-> IO Integer -> Excepts '[ContentLengthError] m Integer
forall a b. (a -> b) -> a -> b
$ String -> IO Integer
getFileSize String
file
    Bool
-> Excepts '[ContentLengthError] m ()
-> Excepts '[ContentLengthError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Integer
eCSize Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
cSize) Bool -> Bool -> Bool
&& Bool
verify) (Excepts '[ContentLengthError] m ()
 -> Excepts '[ContentLengthError] m ())
-> Excepts '[ContentLengthError] m ()
-> Excepts '[ContentLengthError] m ()
forall a b. (a -> b) -> a -> b
$ ContentLengthError -> Excepts '[ContentLengthError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Maybe String -> Maybe Integer -> Integer -> ContentLengthError
ContentLengthError (String -> Maybe String
forall a. a -> Maybe a
Just String
file) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
cSize) Integer
eCSize)


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


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

-- | Get additional gpg args from env. This is an undocumented option.
getGpgOpts :: IO [String]
getGpgOpts :: IO [String]
getGpgOpts =
  String -> IO (Maybe String)
lookupEnv String
"GHCUP_GPG_OPTS" IO (Maybe String) -> (Maybe String -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
r  -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
" " String
r
    Maybe String
Nothing -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Get the url base name.
--
-- >>> urlBaseName "/foo/bar/baz"
-- "baz"
urlBaseName :: ByteString  -- ^ the url path (without scheme and host)
            -> ByteString
urlBaseName :: ByteString -> ByteString
urlBaseName = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.breakEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_slash)


-- | Curl saves all intermediate connect headers as well, not just the last one, so we make an effort to take the
-- last HTTP block only. Passing '--suppress-connect-headers' would be better, but it isn't supported by all versions,
-- also see:
--   https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/213
--
-- >>> getLastHeader "\n\nHTTP/1.0 200 Connection established\n\nHTTP/1.1 304 Not Modified\n"
-- "HTTP/1.1 304 Not Modified\n"
-- >>> getLastHeader "HTTP/1.1 304 Not Modified\n"
-- "HTTP/1.1 304 Not Modified\n"
getLastHeader :: T.Text -> T.Text
getLastHeader :: Text -> Text
getLastHeader = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [[Text]] -> [Text]
forall a. a -> [a] -> a
lastDef [] ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Bool) -> [[Text]] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Text]
x -> Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
x)) ([[Text]] -> [[Text]]) -> (Text -> [[Text]]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text] -> [[Text]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Text
""] ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.stripEnd ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines


tmpFile :: FilePath -> FilePath
tmpFile :: String -> String
tmpFile = (String -> String -> String
<.> String
"tmp")


applyMirrors :: DownloadMirrors -> URI -> URI
applyMirrors :: DownloadMirrors -> URI -> URI
applyMirrors (DM Map Text DownloadMirror
ms) uri :: URI
uri@(URI { uriAuthority :: URI -> Maybe Authority
uriAuthority = Just (Authority { authorityHost :: Authority -> Host
authorityHost = Host ByteString
host }) }) =
  case Text -> Map Text DownloadMirror -> Maybe DownloadMirror
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ByteString -> Text
decUTF8Safe ByteString
host) Map Text DownloadMirror
ms of
    Maybe DownloadMirror
Nothing -> URI
uri
    Just (DownloadMirror Authority
auth (Just Text
prefix)) ->
      URI
uri { uriAuthority = Just auth
          , uriPath = E.encodeUtf8 $ T.pack ("/" <> T.unpack prefix <> (T.unpack . decUTF8Safe . uriPath $ uri))
          }
    Just (DownloadMirror Authority
auth Maybe Text
Nothing) ->
      URI
uri { uriAuthority = Just auth }
applyMirrors DownloadMirrors
_ URI
uri = URI
uri