{-# 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           GHCup.Types.Optics
import           GHCup.Types.JSON               ( )
import           GHCup.Utils.Dirs
import           GHCup.Utils.File
import           GHCup.Utils.Logger
import           GHCup.Utils.Prelude
import           GHCup.Version

import           Control.Applicative
import           Control.Exception.Safe
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.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.List
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Data.Versions
import           Data.Word8              hiding ( isSpace )
import           Haskus.Utils.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.Directory
import           System.Environment
import           System.Exit
import           System.FilePath
import           System.IO.Error
import           System.IO.Temp
import           Text.PrettyPrint.HughesPJClass ( prettyShow )
import           URI.ByteString

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






    ------------------
    --[ 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
                 )
              => Excepts
                   '[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
                   m
                   GHCupInfo
getDownloadsF :: Excepts
  '[DigestError, GPGError, JSONError, DownloadFailed,
    FileDoesNotExistError]
  m
  GHCupInfo
getDownloadsF = do
  Settings { URLSource
$sel:urlSource:Settings :: Settings -> URLSource
urlSource :: URLSource
urlSource } <- m Settings
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     Settings
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 URLSource
urlSource of
    URLSource
GHCupURL -> Excepts
  '[GPGError, DigestError, JSONError, FileDoesNotExistError]
  m
  GHCupInfo
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     GHCupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[GPGError, DigestError, JSONError, FileDoesNotExistError]
   m
   GHCupInfo
 -> Excepts
      '[DigestError, GPGError, JSONError, DownloadFailed,
        FileDoesNotExistError]
      m
      GHCupInfo)
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     GHCupInfo
forall a b. (a -> b) -> a -> b
$ URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
getBase URI
ghcupURL
    (OwnSource [Either GHCupInfo URI]
exts) -> do
      [GHCupInfo]
ext  <- Excepts
  '[GPGError, DigestError, JSONError, FileDoesNotExistError]
  m
  [GHCupInfo]
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     [GHCupInfo]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[GPGError, DigestError, JSONError, FileDoesNotExistError]
   m
   [GHCupInfo]
 -> Excepts
      '[DigestError, GPGError, JSONError, DownloadFailed,
        FileDoesNotExistError]
      m
      [GHCupInfo])
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     [GHCupInfo]
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     [GHCupInfo]
forall a b. (a -> b) -> a -> b
$ (Either GHCupInfo URI
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> [Either GHCupInfo URI]
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     [GHCupInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((GHCupInfo
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> (URI
    -> Excepts
         '[GPGError, DigestError, JSONError, FileDoesNotExistError]
         m
         GHCupInfo)
-> Either GHCupInfo URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GHCupInfo
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
getBase) [Either GHCupInfo URI]
exts
      [GHCupInfo]
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     GHCupInfo
forall (m :: * -> *). MonadFail m => [GHCupInfo] -> m GHCupInfo
mergeGhcupInfo [GHCupInfo]
ext
    (OwnSpec GHCupInfo
av) -> GHCupInfo
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCupInfo
av
    (AddSource [Either GHCupInfo URI]
exts) -> do
      GHCupInfo
base <- Excepts
  '[GPGError, DigestError, JSONError, FileDoesNotExistError]
  m
  GHCupInfo
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     GHCupInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[GPGError, DigestError, JSONError, FileDoesNotExistError]
   m
   GHCupInfo
 -> Excepts
      '[DigestError, GPGError, JSONError, DownloadFailed,
        FileDoesNotExistError]
      m
      GHCupInfo)
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     GHCupInfo
forall a b. (a -> b) -> a -> b
$ URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
getBase URI
ghcupURL
      [GHCupInfo]
ext  <- Excepts
  '[GPGError, DigestError, JSONError, FileDoesNotExistError]
  m
  [GHCupInfo]
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     [GHCupInfo]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[GPGError, DigestError, JSONError, FileDoesNotExistError]
   m
   [GHCupInfo]
 -> Excepts
      '[DigestError, GPGError, JSONError, DownloadFailed,
        FileDoesNotExistError]
      m
      [GHCupInfo])
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     [GHCupInfo]
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     [GHCupInfo]
forall a b. (a -> b) -> a -> b
$ (Either GHCupInfo URI
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> [Either GHCupInfo URI]
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     [GHCupInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((GHCupInfo
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> (URI
    -> Excepts
         '[GPGError, DigestError, JSONError, FileDoesNotExistError]
         m
         GHCupInfo)
-> Either GHCupInfo URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GHCupInfo
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadFail m,
 MonadIO m, MonadCatch m, HasLog env, MonadMask m) =>
URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
getBase) [Either GHCupInfo URI]
exts
      [GHCupInfo]
-> Excepts
     '[DigestError, GPGError, JSONError, DownloadFailed,
       FileDoesNotExistError]
     m
     GHCupInfo
forall (m :: * -> *). MonadFail m => [GHCupInfo] -> m GHCupInfo
mergeGhcupInfo (GHCupInfo
baseGHCupInfo -> [GHCupInfo] -> [GHCupInfo]
forall a. a -> [a] -> [a]
:[GHCupInfo]
ext)

 where
  mergeGhcupInfo :: MonadFail m
                 => [GHCupInfo]
                 -> m GHCupInfo
  mergeGhcupInfo :: [GHCupInfo] -> m GHCupInfo
mergeGhcupInfo [] = String -> m GHCupInfo
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 Version VersionInfo)
newDownloads   = (Map Version VersionInfo
 -> Map Version VersionInfo -> Map Version VersionInfo)
-> [Map Tool (Map Version VersionInfo)]
-> Map Tool (Map Version 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 Version VersionInfo
-> Map Version VersionInfo
-> Map Version 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 Version VersionInfo)
_ghcupDownloads   (GHCupInfo -> Map Tool (Map Version VersionInfo))
-> [GHCupInfo] -> [Map Tool (Map Version VersionInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GHCupInfo]
xs)
        newGlobalTools :: Map GlobalTool DownloadInfo
newGlobalTools = (DownloadInfo -> DownloadInfo -> DownloadInfo)
-> [Map GlobalTool DownloadInfo] -> Map GlobalTool DownloadInfo
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith (\DownloadInfo
_ DownloadInfo
a2 -> DownloadInfo
a2              ) (GHCupInfo -> Map GlobalTool DownloadInfo
_globalTools      (GHCupInfo -> Map GlobalTool DownloadInfo)
-> [GHCupInfo] -> [Map GlobalTool DownloadInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GHCupInfo]
xs)
        newToolReqs :: Map Tool (Map (Maybe Version) PlatformReqSpec)
newToolReqs    = (Map (Maybe Version) PlatformReqSpec
 -> Map (Maybe Version) PlatformReqSpec
 -> Map (Maybe Version) PlatformReqSpec)
-> [Map Tool (Map (Maybe Version) PlatformReqSpec)]
-> Map Tool (Map (Maybe Version) PlatformReqSpec)
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 -> Map Tool (Map (Maybe Version) PlatformReqSpec)
_toolRequirements (GHCupInfo -> Map Tool (Map (Maybe Version) PlatformReqSpec))
-> [GHCupInfo] -> [Map Tool (Map (Maybe Version) PlatformReqSpec)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GHCupInfo]
xs)
    in GHCupInfo -> m GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> m GHCupInfo) -> GHCupInfo -> m GHCupInfo
forall a b. (a -> b) -> a -> b
$ Map Tool (Map (Maybe Version) PlatformReqSpec)
-> Map Tool (Map Version VersionInfo)
-> Map GlobalTool DownloadInfo
-> GHCupInfo
GHCupInfo Map Tool (Map (Maybe Version) PlatformReqSpec)
newToolReqs Map Tool (Map Version VersionInfo)
newDownloads Map GlobalTool DownloadInfo
newGlobalTools


yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
yamlFromCache :: URI -> m String
yamlFromCache URI
uri = do
  Dirs{String
$sel:recycleDir:Dirs :: Dirs -> String
$sel:confDir:Dirs :: Dirs -> String
$sel:logsDir:Dirs :: Dirs -> String
$sel:cacheDir:Dirs :: Dirs -> String
$sel:binDir:Dirs :: Dirs -> String
$sel:baseDir:Dirs :: Dirs -> String
recycleDir :: String
confDir :: String
logsDir :: String
cacheDir :: String
binDir :: String
baseDir :: String
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
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 :: ( MonadReader env m
           , HasDirs env
           , HasSettings env
           , MonadFail m
           , MonadIO m
           , MonadCatch m
           , HasLog env
           , MonadMask m
           )
        => URI
        -> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
getBase :: URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
getBase URI
uri = do
  Settings { Bool
$sel:noNetwork:Settings :: Settings -> Bool
noNetwork :: Bool
noNetwork, Downloader
$sel:downloader:Settings :: Settings -> Downloader
downloader :: Downloader
downloader } <- m Settings
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     Settings
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
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
           else (IOException
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      (Maybe String))
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> m ()
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Downloader -> m ()
forall env (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
  '[GPGError, DigestError, JSONError, FileDoesNotExistError] m ()
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing)
               (Excepts
   '[GPGError, DigestError, JSONError, FileDoesNotExistError]
   m
   (Maybe String)
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      (Maybe String))
-> (URI
    -> Excepts
         '[GPGError, DigestError, JSONError, FileDoesNotExistError]
         m
         (Maybe String))
-> URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DownloadFailed -> Excepts '[] m (Maybe String))
-> Excepts
     '[DownloadFailed, DigestError, GPGError] m (Maybe String)
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
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 @_ @_ @'[] (\e :: DownloadFailed
e@(DownloadFailed V xs
_) -> m () -> Excepts '[] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Downloader -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
 MonadIO m) =>
String -> Downloader -> m ()
warnCache (DownloadFailed -> String
forall a. Pretty a => a -> String
prettyShow DownloadFailed
e) Downloader
downloader) Excepts '[] m ()
-> Excepts '[] m (Maybe String) -> Excepts '[] m (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> Excepts '[] m (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing)
               (Excepts '[DownloadFailed, DigestError, GPGError] m (Maybe String)
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      (Maybe String))
-> (URI
    -> Excepts
         '[DownloadFailed, DigestError, GPGError] m (Maybe String))
-> URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String)
-> Excepts '[DownloadFailed, DigestError, GPGError] m String
-> Excepts
     '[DownloadFailed, DigestError, GPGError] m (Maybe String)
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, GPGError] m String
 -> Excepts
      '[DownloadFailed, DigestError, GPGError] m (Maybe String))
-> (URI
    -> Excepts '[DownloadFailed, DigestError, GPGError] m String)
-> URI
-> Excepts
     '[DownloadFailed, DigestError, GPGError] m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Excepts '[DownloadFailed, DigestError, 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, GPGError] m1 String
smartDl
               (URI
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      (Maybe String))
-> URI
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     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
  String
actualYaml <- Excepts
  '[GPGError, DigestError, JSONError, FileDoesNotExistError] m String
-> (String
    -> Excepts
         '[GPGError, DigestError, JSONError, FileDoesNotExistError]
         m
         String)
-> Maybe String
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError] m String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (m String
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError] m String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m String
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      String)
-> m String
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError] 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
     '[GPGError, DigestError, JSONError, FileDoesNotExistError] m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
mYaml
  m ()
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError] m ())
-> m ()
-> Excepts
     '[GPGError, DigestError, 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 GHCupInfo
-> Excepts
     '[GPGError, DigestError, 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] m GHCupInfo
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> (String -> Excepts '[JSONError] m GHCupInfo)
-> String
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ()
-> Excepts '[JSONError] m GHCupInfo
-> Excepts '[JSONError] m GHCupInfo
forall (m :: * -> *) (es :: [*]) a.
Monad m =>
m () -> Excepts es m a -> Excepts es m a
onE_ (String -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
 MonadIO m) =>
String -> m ()
onError String
actualYaml)
    (Excepts '[JSONError] m GHCupInfo
 -> Excepts '[JSONError] m GHCupInfo)
-> (String -> Excepts '[JSONError] m GHCupInfo)
-> String
-> Excepts '[JSONError] m GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseException -> JSONError)
-> m (Either ParseException GHCupInfo)
-> Excepts '[JSONError] m GHCupInfo
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 GHCupInfo)
 -> Excepts '[JSONError] m GHCupInfo)
-> (String -> m (Either ParseException GHCupInfo))
-> String
-> Excepts '[JSONError] m GHCupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ParseException GHCupInfo)
-> m (Either ParseException GHCupInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 
    (IO (Either ParseException GHCupInfo)
 -> m (Either ParseException GHCupInfo))
-> (String -> IO (Either ParseException GHCupInfo))
-> String
-> m (Either ParseException GHCupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Either ParseException GHCupInfo)
forall a. FromJSON a => String -> IO (Either ParseException a)
Y.decodeFileEither
    (String
 -> Excepts
      '[GPGError, DigestError, JSONError, FileDoesNotExistError]
      m
      GHCupInfo)
-> String
-> Excepts
     '[GPGError, DigestError, JSONError, FileDoesNotExistError]
     m
     GHCupInfo
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 :: String -> m ()
onError String
fp = do
    let efp :: String
efp = String -> String
etagsFile String
fp
    (IOException -> m ()) -> m () -> m ()
forall (m :: * -> *) a.
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 (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 (Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int Int
0))

  warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
  warnCache :: 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
                , GPGError
                ]
               m1
               FilePath
  smartDl :: URI -> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
smartDl URI
uri' = do
    String
json_file <- m1 String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 String
 -> Excepts '[DownloadFailed, DigestError, GPGError] m1 String)
-> m1 String
-> Excepts '[DownloadFailed, DigestError, 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, GPGError] m1 Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
 -> Excepts '[DownloadFailed, DigestError, GPGError] m1 Bool)
-> IO Bool
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
json_file
    UTCTime
currentTime <- IO UTCTime
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    Dirs { String
cacheDir :: String
$sel:cacheDir:Dirs :: Dirs -> String
cacheDir } <- m1 Dirs -> Excepts '[DownloadFailed, DigestError, GPGError] m1 Dirs
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
$sel:metaCache:Settings :: Settings -> Integer
metaCache :: Integer
metaCache } <- m1 Settings
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 Settings
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, DownloadFailed, GPGError] m1 String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m1 String
 -> Excepts '[DownloadFailed, DigestError, GPGError] m1 String)
-> Excepts '[DigestError, DownloadFailed, GPGError] m1 String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, 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
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
download URI
uri' Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing String
cacheDir Maybe String
forall a. Maybe a
Nothing Bool
True
       | Bool
e -> do
          POSIXTime
accessTime <- (UTCTime -> POSIXTime)
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 UTCTime
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (Excepts '[DownloadFailed, DigestError, GPGError] m1 UTCTime
 -> Excepts '[DownloadFailed, DigestError, GPGError] m1 POSIXTime)
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 UTCTime
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 POSIXTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime
 -> Excepts '[DownloadFailed, DigestError, GPGError] m1 UTCTime)
-> IO UTCTime
-> Excepts '[DownloadFailed, DigestError, 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, GPGError] m1 ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 () -> Excepts '[DownloadFailed, DigestError, GPGError] m1 ())
-> m1 () -> Excepts '[DownloadFailed, DigestError, 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, 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, GPGError] m1 String
dlWithMod UTCTime
currentTime String
json_file
             | Bool
otherwise -> String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
json_file
       | Bool
otherwise -> UTCTime
-> String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
dlWithMod UTCTime
currentTime String
json_file
   where
    dlWithMod :: UTCTime
-> String
-> Excepts '[DownloadFailed, DigestError, 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, DownloadFailed, GPGError] m1 String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m1 String
 -> Excepts '[DownloadFailed, DigestError, GPGError] m1 String)
-> Excepts '[DigestError, DownloadFailed, GPGError] m1 String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, 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
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, 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 String
dir (String -> Maybe String
forall a. a -> Maybe a
Just String
fn) Bool
True
      IO () -> Excepts '[DownloadFailed, DigestError, GPGError] m1 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[DownloadFailed, DigestError, GPGError] m1 ())
-> IO () -> Excepts '[DownloadFailed, DigestError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ String -> UTCTime -> IO ()
setModificationTime String
f UTCTime
modTime
      IO () -> Excepts '[DownloadFailed, DigestError, GPGError] m1 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[DownloadFailed, DigestError, GPGError] m1 ())
-> IO () -> Excepts '[DownloadFailed, DigestError, GPGError] m1 ()
forall a b. (a -> b) -> a -> b
$ String -> UTCTime -> IO ()
setAccessTime String
f UTCTime
modTime
      String
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
f


getDownloadInfo :: ( MonadReader env m
                   , HasPlatformReq env
                   , HasGHCupInfo env
                   )
                => Tool
                -> Version
                -- ^ tool version
                -> Excepts
                     '[NoDownload]
                     m
                     DownloadInfo
getDownloadInfo :: Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
t Version
v = do
  (PlatformRequest Architecture
a Platform
p Maybe Versioning
mv) <- m PlatformRequest -> Excepts '[NoDownload] m PlatformRequest
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 Version VersionInfo)
_ghcupDownloads = Map Tool (Map Version VersionInfo)
dls } <- m GHCupInfo -> Excepts '[NoDownload] m GHCupInfo
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_AffineTraversal
  '[]
  (Map Tool (Map Version VersionInfo))
  (Map (Maybe VersionRange) DownloadInfo)
-> Map Tool (Map Version 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 Version VersionInfo))
-> Optic'
     (IxKind (Map Tool (Map Version VersionInfo)))
     '[]
     (Map Tool (Map Version VersionInfo))
     (IxValue (Map Tool (Map Version VersionInfo)))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Tool (Map Version VersionInfo))
Tool
t Optic
  An_AffineTraversal
  '[]
  (Map Tool (Map Version VersionInfo))
  (Map Tool (Map Version VersionInfo))
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     VersionInfo
     VersionInfo
-> Optic
     An_AffineTraversal
     '[]
     (Map Tool (Map Version VersionInfo))
     (Map Tool (Map Version 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 Version VersionInfo)
-> Optic'
     (IxKind (Map Version VersionInfo))
     '[]
     (Map Version VersionInfo)
     (IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Version VersionInfo)
Version
v Optic
  An_AffineTraversal
  '[]
  (Map Tool (Map Version VersionInfo))
  (Map Tool (Map Version VersionInfo))
  VersionInfo
  VersionInfo
-> Optic
     A_Lens
     '[]
     VersionInfo
     VersionInfo
     ArchitectureSpec
     ArchitectureSpec
-> Optic
     An_AffineTraversal
     '[]
     (Map Tool (Map Version VersionInfo))
     (Map Tool (Map Version VersionInfo))
     ArchitectureSpec
     ArchitectureSpec
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  VersionInfo
  VersionInfo
  ArchitectureSpec
  ArchitectureSpec
viArch Optic
  An_AffineTraversal
  '[]
  (Map Tool (Map Version VersionInfo))
  (Map Tool (Map Version VersionInfo))
  ArchitectureSpec
  ArchitectureSpec
-> Optic
     An_AffineTraversal
     '[]
     ArchitectureSpec
     ArchitectureSpec
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
     (Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
     An_AffineTraversal
     '[]
     (Map Tool (Map Version VersionInfo))
     (Map Tool (Map Version 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
% Index ArchitectureSpec
-> Optic'
     (IxKind ArchitectureSpec)
     '[]
     ArchitectureSpec
     (IxValue ArchitectureSpec)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index ArchitectureSpec
Architecture
a Optic
  An_AffineTraversal
  '[]
  (Map Tool (Map Version VersionInfo))
  (Map Tool (Map Version 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_AffineTraversal
     '[]
     (Map Tool (Map Version 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 Version 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 (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
NoDownload)
    DownloadInfo -> Excepts '[NoDownload] m DownloadInfo
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro_ver
      Platform
_            -> Maybe DownloadInfo
with_distro Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro_ver Maybe DownloadInfo -> Maybe DownloadInfo -> Maybe DownloadInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DownloadInfo
without_distro
    )


-- | 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
         -> FilePath          -- ^ destination dir (ignored for file:// scheme)
         -> Maybe FilePath    -- ^ optional filename
         -> Bool              -- ^ whether to read an write etags
         -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
download :: URI
-> Maybe URI
-> Maybe Text
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
download URI
uri Maybe URI
gpgUri Maybe Text
eDigest String
dest Maybe String
mfn Bool
etags
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"https" = Excepts '[DigestError, DownloadFailed, GPGError] m String
dl
  | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"http"  = Excepts '[DigestError, 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
uri
      m () -> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> m () -> Excepts '[DigestError, 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, DownloadFailed, GPGError] m ())
-> Excepts '[DigestError, 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, 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, DownloadFailed, GPGError] m ())
-> (Text -> Excepts '[DigestError] m ())
-> Text
-> Excepts '[DigestError, 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, DownloadFailed, GPGError] m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
destFile'
  | Bool
otherwise = DownloadFailed
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DownloadFailed
 -> Excepts '[DigestError, DownloadFailed, GPGError] m String)
-> DownloadFailed
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
forall a b. (a -> b) -> a -> b
$ V '[UnsupportedScheme] -> DownloadFailed
forall (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
uri
  dl :: Excepts '[DigestError, DownloadFailed, GPGError] m String
dl = do
    String
baseDestFile <- Excepts '[DownloadFailed] m String
-> Excepts '[DigestError, 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, DownloadFailed, GPGError] m String)
-> (Excepts '[NoUrlBase] m String
    -> Excepts '[DownloadFailed] m String)
-> Excepts '[NoUrlBase] m String
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V '[NoUrlBase] -> DownloadFailed)
-> Excepts '[NoUrlBase] m String
-> Excepts '[DownloadFailed] m String
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 :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts '[NoUrlBase] m String
 -> Excepts '[DigestError, DownloadFailed, GPGError] m String)
-> Excepts '[NoUrlBase] m String
-> Excepts '[DigestError, 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, DownloadFailed, GPGError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> m () -> Excepts '[DigestError, 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, DownloadFailed, GPGError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> IO () -> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
createDirRecursive' String
dest


    -- download
    (Excepts '[DigestError, DownloadFailed, GPGError] m ()
 -> Excepts '[DigestError, DownloadFailed, GPGError] m ()
 -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[DigestError, DownloadFailed, GPGError] m ()
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException
         (m () -> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> m () -> Excepts '[DigestError, 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, DownloadFailed, GPGError] m ()
 -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ (V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
     DigestError]
 -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     ()
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
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] @'[DigestError, DownloadFailed, GPGError]
          (\V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError]
e' -> do
            m () -> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> m () -> Excepts '[DigestError, 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]
e' of
              V e :: GPGError
e@GPGError {} -> GPGError -> Excepts '[DigestError, 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, 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]
_ -> DownloadFailed
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError]
-> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed V '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
    DigestError]
e')
          ) (Excepts
   '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
     DigestError]
   m
   ()
 -> Excepts '[DigestError, DownloadFailed, GPGError] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     ()
-> Excepts '[DigestError, DownloadFailed, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ do
              Settings{ Downloader
downloader :: Downloader
$sel:downloader:Settings :: Settings -> Downloader
downloader, Bool
noNetwork :: Bool
$sel:noNetwork:Settings :: Settings -> Bool
noNetwork, GPGSetting
$sel:gpgSetting:Settings :: Settings -> GPGSetting
gpgSetting :: GPGSetting
gpgSetting } <- m Settings
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     Settings
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]
     m
     ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
noNetwork (Excepts
   '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
     DigestError]
   m
   ()
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError]
      m
      ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ DownloadFailed
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (V '[NoNetwork] -> DownloadFailed
forall (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]
     m
     [String]
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]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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]
     m
     [String]
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]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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]
     m
     (String
      -> URI
      -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
  -> URI
  -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
 -> Excepts
      '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
        DigestError]
      m
      (String
       -> URI
       -> Excepts
            '[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (String
    -> URI
    -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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]
     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]
      m
      ())
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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]
     m
     ()
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]
     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]
      m
      String)
-> (Excepts '[NoUrlBase] m String
    -> Excepts '[DownloadFailed] m String)
-> Excepts '[NoUrlBase] m String
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     m
     String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V '[NoUrlBase] -> DownloadFailed)
-> Excepts '[NoUrlBase] m String
-> Excepts '[DownloadFailed] m String
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 :: [*]).
(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]
      m
      String)
-> Excepts '[NoUrlBase] m String
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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]
     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]
      m
      ())
-> Excepts '[GPGError] m ()
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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. MonadMask m => m a -> m b -> m a
onException
                       (m () -> Excepts '[GPGError] m ()
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
$ (V '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
 -> Excepts '[GPGError] m ())
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
-> Excepts '[GPGError] m ()
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 (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 a. Pretty a => a -> String
prettyShow (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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getGpgOpts
                      m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
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 (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 (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
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
_stdErr :: ByteString
_stdErr } -> do
                          m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
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 (V '[ProcessError] -> GPGError
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
_stdErr :: ByteString
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
_stdErr } -> m ()
-> Excepts
     '[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] m ()
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]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

              Maybe Text
-> (Text
    -> Excepts
         '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
           DigestError]
         m
         ())
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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]
     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]
      m
      ())
-> (Text -> Excepts '[DigestError] m ())
-> Text
-> Excepts
     '[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
       DigestError]
     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, DownloadFailed, GPGError] m String
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 :: [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. MonadMask m => m a -> m b -> m a
finally (forall a.
(MonadCatch
   (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m),
 Exception SomeException) =>
Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException a)
forall (m :: * -> *) e a.
(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
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ 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']) Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
      IO ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
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 :: [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 (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. MonadMask m => m a -> m b -> m a
finally (forall a.
(MonadCatch
   (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m),
 Exception SomeException) =>
Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException a)
forall (m :: * -> *) e a.
(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. MonadMask m => m a -> m b -> m a
finally (forall a.
(MonadCatch
   (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m),
 Exception SomeException) =>
Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException a)
forall (m :: * -> *) e a.
(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 (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
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ 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 (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 (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 (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 (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 (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 (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
$ DownloadFailed -> Excepts '[DownloadFailed] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE @_ @'[DownloadFailed] (V '[MalformedHeaders] -> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Index 0 '[MalformedHeaders] -> V '[MalformedHeaders]
forall (n :: Nat) (l :: [*]). KnownNat n => Index n l -> V l
toVariantAt @0 (Text -> MalformedHeaders
MalformedHeaders Text
headers)
            :: V '[MalformedHeaders]))

        m ()
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
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 :: [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. MonadMask m => m a -> m b -> m a
finally (forall a.
(MonadCatch
   (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m),
 Exception SomeException) =>
Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException a)
forall (m :: * -> *) e a.
(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
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ 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 (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 :: [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. MonadMask m => m a -> m b -> m a
finally (forall a.
(MonadCatch
   (Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m),
 Exception SomeException) =>
Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m a
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     (Either SomeException a)
forall (m :: * -> *) e a.
(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 (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
_exitCode :: ExitCode
$sel:_exitCode:CapturedProcess :: CapturedProcess -> ExitCode
_exitCode, ByteString
_stdErr :: ByteString
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
_stdErr} <- m CapturedProcess
-> Excepts
     '[ProcessError, DownloadFailed, UnsupportedScheme]
     m
     CapturedProcess
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 (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 (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 (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 (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
      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
          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 :: 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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null String
urlBase) -> String -> Excepts '[NoUrlBase] m String
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 :: 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 (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 (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 (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 (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 (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 :: 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 (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 (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 :: String -> m (Maybe Text)
readETag String
fp = do
    Bool
e <- IO Bool -> m Bool
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 a.
(MonadCatch m, Exception SomeException) =>
m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(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 (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 (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 (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 (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 (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 (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 '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached :: DownloadInfo
-> Maybe String
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
downloadCached DownloadInfo
dli Maybe String
mfn = do
  Settings{ Bool
$sel:cache:Settings :: Settings -> Bool
cache :: Bool
cache } <- m Settings
-> Excepts '[DigestError, DownloadFailed, GPGError] m Settings
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 '[DigestError, 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 '[DigestError, DownloadFailed, GPGError] m String
downloadCached' DownloadInfo
dli Maybe String
mfn Maybe String
forall a. Maybe a
Nothing
    Bool
False -> do
      String
tmp <- m String
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m String
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 String
withGHCupTmpDir
      Excepts '[DigestError, DownloadFailed, GPGError] m String
-> Excepts '[DigestError, 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, DownloadFailed, GPGError] m String
 -> Excepts '[DigestError, DownloadFailed, GPGError] m String)
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, 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
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
download (DownloadInfo -> URI
_dlUri DownloadInfo
dli) Maybe URI
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just (DownloadInfo -> Text
_dlHash DownloadInfo
dli)) String
tmp Maybe String
mfn Bool
False


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 '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached' :: DownloadInfo
-> Maybe String
-> Maybe String
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
downloadCached' DownloadInfo
dli Maybe String
mfn Maybe String
mDestDir = do
  Dirs { String
cacheDir :: String
$sel:cacheDir:Dirs :: Dirs -> String
cacheDir } <- m Dirs -> Excepts '[DigestError, DownloadFailed, GPGError] m Dirs
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
  let destDir :: String
destDir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
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 '[] DownloadInfo ByteString
-> DownloadInfo -> ByteString
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' DownloadInfo URI
dlUri Lens' DownloadInfo URI
-> Optic' A_Lens '[] URI ByteString
-> Optic' A_Lens '[] DownloadInfo ByteString
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens '[] URI ByteString
forall a. Lens' (URIRef a) ByteString
pathL') DownloadInfo
dli) Maybe String
mfn
  let cachfile :: String
cachfile = String
destDir String -> String -> String
</> String
fn
  Bool
fileExists <- IO Bool -> Excepts '[DigestError, DownloadFailed, GPGError] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
 -> Excepts '[DigestError, DownloadFailed, GPGError] m Bool)
-> IO Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
cachfile
  if
    | Bool
fileExists -> do
      Excepts '[DigestError] m ()
-> Excepts '[DigestError, 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, DownloadFailed, GPGError] m ())
-> Excepts '[DigestError] m ()
-> Excepts '[DigestError, 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 '[DigestError, DownloadFailed, GPGError] m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
cachfile
    | Bool
otherwise -> Excepts '[DigestError, DownloadFailed, GPGError] m String
-> Excepts '[DigestError, 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, DownloadFailed, GPGError] m String
 -> Excepts '[DigestError, DownloadFailed, GPGError] m String)
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, 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
-> String
-> Maybe String
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m String
download (DownloadInfo -> URI
_dlUri DownloadInfo
dli) Maybe URI
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just (DownloadInfo -> Text
_dlHash DownloadInfo
dli)) String
destDir Maybe String
mfn Bool
False




    ------------------
    --[ 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 :: Text -> String -> Excepts '[DigestError] m ()
checkDigest Text
eDigest String
file = do
  Settings{ Bool
$sel:noVerify:Settings :: Settings -> Bool
noVerify :: Bool
noVerify } <- m Settings -> Excepts '[DigestError] m Settings
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 (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 (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)


-- | 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
r  -> [String] -> IO [String]
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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
r  -> [String] -> IO [String]
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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
r  -> [String] -> IO [String]
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 (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) (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
False


-- | 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 (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 (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")