{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
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
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 URI
url) -> 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
url
(OwnSpec GHCupInfo
av) -> GHCupInfo
-> Excepts
'[DigestError, GPGError, JSONError, DownloadFailed,
FileDoesNotExistError]
m
GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCupInfo
av
(AddSource (Left GHCupInfo
ext)) -> 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
-> Excepts
'[DigestError, GPGError, JSONError, DownloadFailed,
FileDoesNotExistError]
m
GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> GHCupInfo -> GHCupInfo
mergeGhcupInfo GHCupInfo
base GHCupInfo
ext)
(AddSource (Right URI
uri)) -> do
GHCupInfo
base <- Excepts
'[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
$ 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
uri
GHCupInfo
-> Excepts
'[DigestError, GPGError, JSONError, DownloadFailed,
FileDoesNotExistError]
m
GHCupInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupInfo -> GHCupInfo -> GHCupInfo
mergeGhcupInfo GHCupInfo
base GHCupInfo
ext)
where
mergeGhcupInfo :: GHCupInfo
-> GHCupInfo
-> GHCupInfo
mergeGhcupInfo :: GHCupInfo -> GHCupInfo -> GHCupInfo
mergeGhcupInfo (GHCupInfo ToolRequirements
tr GHCupDownloads
base Map GlobalTool DownloadInfo
base2) (GHCupInfo ToolRequirements
_ GHCupDownloads
ext Map GlobalTool DownloadInfo
ext2) =
let newDownloads :: GHCupDownloads
newDownloads = (Tool -> Map Version VersionInfo -> Map Version VersionInfo)
-> GHCupDownloads -> GHCupDownloads
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\Tool
k Map Version VersionInfo
a -> case Tool -> GHCupDownloads -> Maybe (Map Version VersionInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Tool
k GHCupDownloads
ext of
Just Map Version VersionInfo
a' -> Map Version VersionInfo
-> Map Version VersionInfo -> Map Version VersionInfo
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Version VersionInfo
a' Map Version VersionInfo
a
Maybe (Map Version VersionInfo)
Nothing -> Map Version VersionInfo
a
) GHCupDownloads
base
newGlobalTools :: Map GlobalTool DownloadInfo
newGlobalTools = Map GlobalTool DownloadInfo
-> Map GlobalTool DownloadInfo -> Map GlobalTool DownloadInfo
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map GlobalTool DownloadInfo
base2 Map GlobalTool DownloadInfo
ext2
in ToolRequirements
-> GHCupDownloads -> Map GlobalTool DownloadInfo -> GHCupInfo
GHCupInfo ToolRequirements
tr GHCupDownloads
newDownloads Map GlobalTool DownloadInfo
newGlobalTools
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
yamlFromCache :: URI -> m FilePath
yamlFromCache URI
uri = do
Dirs{FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
cacheDir FilePath -> FilePath -> FilePath
</> (Text -> FilePath
T.unpack (Text -> FilePath) -> (URI -> Text) -> URI -> FilePath
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 -> FilePath) -> URI -> FilePath
forall a b. (a -> b) -> a -> b
$ URI
uri))
etagsFile :: FilePath -> FilePath
etagsFile :: FilePath -> FilePath
etagsFile = (FilePath -> FilePath -> FilePath
<.> FilePath
"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
Maybe FilePath
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"
then Maybe FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
else (IOException
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath))
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
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 (FilePath -> Downloader -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
MonadIO m) =>
FilePath -> Downloader -> m ()
warnCache (IOException -> FilePath
forall e. Exception e => e -> FilePath
displayException IOException
e) Downloader
downloader) Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError] m ()
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing)
(Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath))
-> (URI
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath))
-> URI
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DownloadFailed -> Excepts '[] m (Maybe FilePath))
-> Excepts
'[DownloadFailed, DigestError, GPGError] m (Maybe FilePath)
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
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 (FilePath -> Downloader -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
MonadIO m) =>
FilePath -> Downloader -> m ()
warnCache (DownloadFailed -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow DownloadFailed
e) Downloader
downloader) Excepts '[] m ()
-> Excepts '[] m (Maybe FilePath) -> Excepts '[] m (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe FilePath -> Excepts '[] m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing)
(Excepts
'[DownloadFailed, DigestError, GPGError] m (Maybe FilePath)
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath))
-> (URI
-> Excepts
'[DownloadFailed, DigestError, GPGError] m (Maybe FilePath))
-> URI
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe FilePath)
-> Excepts '[DownloadFailed, DigestError, GPGError] m FilePath
-> Excepts
'[DownloadFailed, DigestError, GPGError] m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just
(Excepts '[DownloadFailed, DigestError, GPGError] m FilePath
-> Excepts
'[DownloadFailed, DigestError, GPGError] m (Maybe FilePath))
-> (URI
-> Excepts '[DownloadFailed, DigestError, GPGError] m FilePath)
-> URI
-> Excepts
'[DownloadFailed, DigestError, GPGError] m (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Excepts '[DownloadFailed, DigestError, GPGError] m FilePath
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
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath))
-> URI
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
(Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ URI
uri
FilePath
actualYaml <- Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
FilePath
-> (FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
FilePath)
-> Maybe FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (m FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
FilePath)
-> m FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ URI -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
URI -> m FilePath
yamlFromCache URI
uri) FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
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
<> FilePath -> Text
T.pack FilePath
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)
-> (FilePath -> Excepts '[JSONError] m GHCupInfo)
-> FilePath
-> 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_ (FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadMask m, MonadCatch m,
MonadIO m) =>
FilePath -> m ()
onError FilePath
actualYaml)
(Excepts '[JSONError] m GHCupInfo
-> Excepts '[JSONError] m GHCupInfo)
-> (FilePath -> Excepts '[JSONError] m GHCupInfo)
-> FilePath
-> 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 -> FilePath
forall e. Exception e => e -> FilePath
displayException -> FilePath
e) -> FilePath -> JSONError
JSONDecodeError (FilePath -> JSONError) -> FilePath -> JSONError
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath
e, FilePath
"Consider removing " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
actualYaml FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" manually."])
(m (Either ParseException GHCupInfo)
-> Excepts '[JSONError] m GHCupInfo)
-> (FilePath -> m (Either ParseException GHCupInfo))
-> FilePath
-> 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))
-> (FilePath -> IO (Either ParseException GHCupInfo))
-> FilePath
-> m (Either ParseException GHCupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Either ParseException GHCupInfo)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Y.decodeFileEither
(FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
GHCupInfo)
-> FilePath
-> Excepts
'[GPGError, DigestError, JSONError, FileDoesNotExistError]
m
GHCupInfo
forall a b. (a -> b) -> a -> b
$ FilePath
actualYaml
where
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError :: FilePath -> m ()
onError FilePath
fp = do
let efp :: FilePath
efp = FilePath -> FilePath
etagsFile FilePath
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
<> FilePath -> Text
T.pack FilePath
efp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", error was: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (IOException -> FilePath
forall e. Exception e => e -> FilePath
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
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
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
$ FilePath -> UTCTime -> IO ()
setAccessTime FilePath
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 :: FilePath -> Downloader -> m ()
warnCache FilePath
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
<> FilePath -> Text
T.pack FilePath
s
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 FilePath
smartDl URI
uri' = do
FilePath
json_file <- m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath)
-> m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall a b. (a -> b) -> a -> b
$ URI -> m1 FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
URI -> m FilePath
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
$ FilePath -> IO Bool
doesFileExist FilePath
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 { FilePath
cacheDir :: FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
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
if | ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"file" -> Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
download URI
uri' Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing FilePath
cacheDir Maybe FilePath
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
$ FilePath -> IO UTCTime
getAccessTime FilePath
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
<> FilePath -> Text
T.pack (POSIXTime -> FilePath
forall a. Show a => a -> FilePath
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
<> FilePath -> Text
T.pack (POSIXTime -> FilePath
forall a. Show a => a -> FilePath
show POSIXTime
cacheInterval)
if | Integer
metaCache Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 -> UTCTime
-> FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
dlWithMod UTCTime
currentTime FilePath
json_file
| (POSIXTime
sinceLastAccess POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
cacheInterval) ->
UTCTime
-> FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
dlWithMod UTCTime
currentTime FilePath
json_file
| Bool
otherwise -> FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
json_file
| Bool
otherwise -> UTCTime
-> FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
dlWithMod UTCTime
currentTime FilePath
json_file
where
dlWithMod :: UTCTime
-> FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
dlWithMod UTCTime
modTime FilePath
json_file = do
let (FilePath
dir, FilePath
fn) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
json_file
FilePath
f <- Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m1 FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
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 FilePath
dir (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
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
$ FilePath -> UTCTime -> IO ()
setModificationTime FilePath
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
$ FilePath -> UTCTime -> IO ()
setAccessTime FilePath
f UTCTime
modTime
FilePath
-> Excepts '[DownloadFailed, DigestError, GPGError] m1 FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
f
getDownloadInfo :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
)
=> 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 -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
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
'[]
GHCupDownloads
(Map (Maybe VersionRange) DownloadInfo)
-> GHCupDownloads -> Maybe (Map (Maybe VersionRange) DownloadInfo)
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
t Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
An_AffineTraversal
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
VersionInfo
VersionInfo
-> Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Version VersionInfo)
-> Optic'
(IxKind (Map Version VersionInfo))
'[]
(Map Version VersionInfo)
(IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Version VersionInfo)
Version
v Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
-> Optic
A_Lens
'[]
VersionInfo
VersionInfo
ArchitectureSpec
ArchitectureSpec
-> Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
ArchitectureSpec
ArchitectureSpec
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Lens
'[]
VersionInfo
VersionInfo
ArchitectureSpec
ArchitectureSpec
viArch Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
ArchitectureSpec
ArchitectureSpec
-> Optic
An_AffineTraversal
'[]
ArchitectureSpec
ArchitectureSpec
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index ArchitectureSpec
-> Optic'
(IxKind ArchitectureSpec)
'[]
ArchitectureSpec
(IxValue ArchitectureSpec)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index ArchitectureSpec
Architecture
a Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic
An_AffineTraversal
'[]
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
(Map (Maybe VersionRange) DownloadInfo)
(Map (Maybe VersionRange) DownloadInfo)
-> Optic'
An_AffineTraversal
'[]
GHCupDownloads
(Map (Maybe VersionRange) DownloadInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Platform (Map (Maybe VersionRange) DownloadInfo))
-> Optic'
(IxKind (Map Platform (Map (Maybe VersionRange) DownloadInfo)))
'[]
(Map Platform (Map (Maybe VersionRange) DownloadInfo))
(IxValue (Map Platform (Map (Maybe VersionRange) DownloadInfo)))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (Platform -> Platform
f Platform
p)) GHCupDownloads
dls
mv' :: Maybe Versioning
mv' = Maybe Versioning -> Maybe Versioning
g Maybe Versioning
mv
in ((Maybe VersionRange, DownloadInfo) -> DownloadInfo)
-> Maybe (Maybe VersionRange, DownloadInfo) -> Maybe DownloadInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe VersionRange, DownloadInfo) -> DownloadInfo
forall a b. (a, b) -> b
snd
(Maybe (Maybe VersionRange, DownloadInfo) -> Maybe DownloadInfo)
-> (Map (Maybe VersionRange) DownloadInfo
-> Maybe (Maybe VersionRange, DownloadInfo))
-> Map (Maybe VersionRange) DownloadInfo
-> Maybe DownloadInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe VersionRange, DownloadInfo) -> Bool)
-> [(Maybe VersionRange, DownloadInfo)]
-> Maybe (Maybe VersionRange, DownloadInfo)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
(\(Maybe VersionRange
mverRange, DownloadInfo
_) -> Bool -> (VersionRange -> Bool) -> Maybe VersionRange -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Maybe Versioning -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Versioning
mv')
(\VersionRange
range -> Bool -> (Versioning -> Bool) -> Maybe Versioning -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Versioning -> VersionRange -> Bool
`versionRange` VersionRange
range) Maybe Versioning
mv')
Maybe VersionRange
mverRange
)
([(Maybe VersionRange, DownloadInfo)]
-> Maybe (Maybe VersionRange, DownloadInfo))
-> (Map (Maybe VersionRange) DownloadInfo
-> [(Maybe VersionRange, DownloadInfo)])
-> Map (Maybe VersionRange) DownloadInfo
-> Maybe (Maybe VersionRange, DownloadInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Maybe VersionRange) DownloadInfo
-> [(Maybe VersionRange, DownloadInfo)]
forall k a. Map k a -> [(k, a)]
M.toList
(Map (Maybe VersionRange) DownloadInfo -> Maybe DownloadInfo)
-> Maybe (Map (Maybe VersionRange) DownloadInfo)
-> Maybe DownloadInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Map (Maybe VersionRange) DownloadInfo)
platformVersionSpec
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
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
)
download :: ( MonadReader env m
, HasSettings env
, HasDirs env
, MonadMask m
, MonadThrow m
, HasLog env
, MonadIO m
)
=> URI
-> Maybe URI
-> Maybe T.Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
download :: URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
download URI
uri Maybe URI
gpgUri Maybe Text
eDigest FilePath
dest Maybe FilePath
mfn Bool
etags
| ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"https" = Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
dl
| ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"http" = Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
dl
| ByteString
scheme ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"file" = do
let destFile' :: FilePath
destFile' = Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe (ByteString -> FilePath) -> ByteString -> FilePath
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
<> FilePath -> Text
T.pack FilePath
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 -> FilePath -> Excepts '[DigestError] m ())
-> FilePath -> Text -> Excepts '[DigestError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> FilePath -> Excepts '[DigestError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadThrow m, HasLog env) =>
Text -> FilePath -> Excepts '[DigestError] m ()
checkDigest FilePath
destFile')
FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
destFile'
| Bool
otherwise = DownloadFailed
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DownloadFailed
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath)
-> DownloadFailed
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
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 FilePath
dl = do
FilePath
baseDestFile <- Excepts '[DownloadFailed] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DownloadFailed] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath)
-> (Excepts '[NoUrlBase] m FilePath
-> Excepts '[DownloadFailed] m FilePath)
-> Excepts '[NoUrlBase] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V '[NoUrlBase] -> DownloadFailed)
-> Excepts '[NoUrlBase] m FilePath
-> Excepts '[DownloadFailed] m FilePath
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 FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath)
-> Excepts '[NoUrlBase] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall a b. (a -> b) -> a -> b
$ URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
forall (m :: * -> *).
Monad m =>
URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
getDestFile URI
uri Maybe FilePath
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
<> FilePath -> Text
T.pack FilePath
baseDestFile
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
$ FilePath -> IO ()
createDirRecursive' FilePath
dest
(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
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> FilePath
tmpFile FilePath
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
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> FilePath
tmpFile FilePath
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]))
FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
downloadAction <- case Downloader
downloader of
Downloader
Curl -> do
[FilePath]
o' <- IO [FilePath]
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
[FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getCurlOpts
if Bool
etags
then (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts
'[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadMask m,
MonadIO m) =>
[FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlEtagsDL [FilePath]
o'
else (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts
'[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *).
(MonadCatch m, MonadMask m, MonadIO m) =>
[FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlDL [FilePath]
o'
Downloader
Wget -> do
[FilePath]
o' <- IO [FilePath]
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
[FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getWgetOpts
if Bool
etags
then (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts
'[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadMask m,
MonadIO m) =>
[FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetEtagsDL [FilePath]
o'
else (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts
'[ProcessError, DownloadFailed, UnsupportedScheme] m ()))
-> (FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
(FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ())
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *).
(MonadCatch m, MonadMask m, MonadIO m) =>
[FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetDL [FilePath]
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
$ FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
downloadAction FilePath
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
FilePath
gpgDestFile <- Excepts '[DownloadFailed] m FilePath
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DownloadFailed] m FilePath
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
FilePath)
-> (Excepts '[NoUrlBase] m FilePath
-> Excepts '[DownloadFailed] m FilePath)
-> Excepts '[NoUrlBase] m FilePath
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V '[NoUrlBase] -> DownloadFailed)
-> Excepts '[NoUrlBase] m FilePath
-> Excepts '[DownloadFailed] m FilePath
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 FilePath
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
FilePath)
-> Excepts '[NoUrlBase] m FilePath
-> Excepts
'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme,
DigestError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
forall (m :: * -> *).
Monad m =>
URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
getDestFile URI
gpgUri' Maybe FilePath
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
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> FilePath
tmpFile FilePath
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
$ FilePath -> Text
T.pack (GPGError -> FilePath
forall a. Pretty a => a -> FilePath
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
[FilePath]
o' <- IO [FilePath]
-> Excepts
'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed]
m
[FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
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
<> FilePath -> Text
T.pack FilePath
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
$ FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
downloadAction FilePath
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
<> FilePath -> Text
T.pack FilePath
baseDestFile
let args :: [FilePath]
args = [FilePath]
o' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--batch", FilePath
"--verify", FilePath
"--quiet", FilePath
"--no-tty", FilePath
gpgDestFile, FilePath
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
$ FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
executeOut FilePath
"gpg" [FilePath]
args Maybe FilePath
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 -> FilePath -> [FilePath] -> ProcessError
NonZeroExit Int
i FilePath
"gpg" [FilePath]
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 -> FilePath -> Excepts '[DigestError] m ())
-> FilePath -> Text -> Excepts '[DigestError] m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> FilePath -> Excepts '[DigestError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadThrow m, HasLog env) =>
Text -> FilePath -> Excepts '[DigestError] m ()
checkDigest FilePath
baseDestFile)
FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
baseDestFile
curlDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlDL :: [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlDL [FilePath]
o' FilePath
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 :: FilePath
destFileTemp = FilePath -> FilePath
tmpFile FilePath
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
$ FilePath
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
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
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
exec FilePath
"curl"
([FilePath]
o' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-fL", FilePath
"-o", FilePath
destFileTemp, Text -> FilePath
T.unpack Text
uri']) Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
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
$ FilePath -> FilePath -> IO ()
renameFile FilePath
destFileTemp FilePath
destFile
curlEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
=> [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlEtagsDL :: [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlEtagsDL [FilePath]
o' FilePath
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 :: FilePath
destFileTemp = FilePath -> FilePath
tmpFile FilePath
destFile
FilePath
dh <- IO FilePath
-> Excepts
'[ProcessError, DownloadFailed, UnsupportedScheme] m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath
-> Excepts
'[ProcessError, DownloadFailed, UnsupportedScheme] m FilePath)
-> IO FilePath
-> Excepts
'[ProcessError, DownloadFailed, UnsupportedScheme] m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
emptySystemTempFile FilePath
"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
$ FilePath
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
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
$ FilePath
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
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
$ FilePath -> m (Maybe Text)
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath -> m (Maybe Text)
readETag FilePath
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
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
exec FilePath
"curl"
([FilePath]
o' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
etags then [FilePath
"--dump-header", FilePath
dh] else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath] -> (Text -> [FilePath]) -> Maybe Text -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
t -> [FilePath
"-H", FilePath
"If-None-Match: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
t]) Maybe Text
metag
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-fL", FilePath
"-o", FilePath
destFileTemp, Text -> FilePath
T.unpack Text
uri']) Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
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
$ FilePath -> IO Text
T.readFile FilePath
dh
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"
, FilePath -> Text
T.pack FilePath
"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"
| FilePath -> Text
T.pack FilePath
"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
$ FilePath -> FilePath -> IO ()
renameFile FilePath
destFileTemp FilePath
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
$ FilePath -> m (Maybe Text) -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath -> m (Maybe Text) -> m ()
writeEtags FilePath
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 :: [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetDL [FilePath]
o' FilePath
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 :: FilePath
destFileTemp = FilePath -> FilePath
tmpFile FilePath
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
$ FilePath
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
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 :: [FilePath]
opts = [FilePath]
o' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-O", FilePath
destFileTemp , Text -> FilePath
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
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
exec FilePath
"wget" [FilePath]
opts Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
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
$ FilePath -> FilePath -> IO ()
renameFile FilePath
destFileTemp FilePath
destFile
wgetEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
=> [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetEtagsDL :: [FilePath]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetEtagsDL [FilePath]
o' FilePath
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 :: FilePath
destFileTemp = FilePath -> FilePath
tmpFile FilePath
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
$ FilePath
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
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
$ FilePath -> m (Maybe Text)
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath -> m (Maybe Text)
readETag FilePath
destFile
let opts :: [FilePath]
opts = [FilePath]
o' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath] -> (Text -> [FilePath]) -> Maybe Text -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
t -> [FilePath
"--header", FilePath
"If-None-Match: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
t]) Maybe Text
metag
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-q", FilePath
"-S", FilePath
"-O", FilePath
destFileTemp , Text -> FilePath
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
$ FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
executeOut FilePath
"wget" [FilePath]
opts Maybe FilePath
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
$ FilePath -> FilePath -> IO ()
renameFile FilePath
destFileTemp FilePath
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
$ FilePath -> m (Maybe Text) -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath -> m (Maybe Text) -> m ()
writeEtags FilePath
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 (FilePath -> Text
T.pack FilePath
"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
$ FilePath -> m (Maybe Text) -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath -> m (Maybe Text) -> m ()
writeEtags FilePath
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 -> FilePath -> [FilePath] -> ProcessError
NonZeroExit Int
i' FilePath
"wget" [FilePath]
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
getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
getDestFile :: URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
getDestFile URI
uri' Maybe FilePath
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 FilePath
mfn' of
Just FilePath
fn -> FilePath -> Excepts '[NoUrlBase] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
dest FilePath -> FilePath -> FilePath
</> FilePath
fn)
Maybe FilePath
Nothing
| let urlBase :: FilePath
urlBase = Text -> FilePath
T.unpack (ByteString -> Text
decUTF8Safe (ByteString -> ByteString
urlBaseName ByteString
path))
, Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
urlBase) -> FilePath -> Excepts '[NoUrlBase] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
dest FilePath -> FilePath -> FilePath
</> FilePath
urlBase)
| Bool
otherwise -> NoUrlBase -> Excepts '[NoUrlBase] m FilePath
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (NoUrlBase -> Excepts '[NoUrlBase] m FilePath)
-> NoUrlBase -> Excepts '[NoUrlBase] m FilePath
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 -> FilePath -> Text
T.pack FilePath
"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 :: FilePath -> m (Maybe Text) -> m ()
writeEtags FilePath
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
<> FilePath -> Text
T.pack (FilePath -> FilePath
etagsFile FilePath
destFile)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile (FilePath -> FilePath
etagsFile FilePath
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 :: FilePath -> m (Maybe Text)
readETag FilePath
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
$ FilePath -> IO Bool
doesFileExist FilePath
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
$ FilePath -> IO Text
T.readFile (FilePath -> FilePath
etagsFile FilePath
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
<> FilePath -> Text
T.pack FilePath
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
$ FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile (FilePath -> FilePath
etagsFile FilePath
fp)
Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
downloadCached :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadMask m
, MonadResource m
, MonadThrow m
, HasLog env
, MonadIO m
, MonadUnliftIO m
)
=> DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached :: DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached DownloadInfo
dli Maybe FilePath
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 FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached' DownloadInfo
dli Maybe FilePath
mfn Maybe FilePath
forall a. Maybe a
Nothing
Bool
False -> do
FilePath
tmp <- m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
withGHCupTmpDir
Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
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)) FilePath
tmp Maybe FilePath
mfn Bool
False
downloadCached' :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadMask m
, MonadThrow m
, HasLog env
, MonadIO m
, MonadUnliftIO m
)
=> DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached' :: DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached' DownloadInfo
dli Maybe FilePath
mfn Maybe FilePath
mDestDir = do
Dirs { FilePath
cacheDir :: FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
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 :: FilePath
destDir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
cacheDir Maybe FilePath
mDestDir
let fn :: FilePath
fn = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe ((Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe) (ByteString -> FilePath) -> ByteString -> FilePath
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 FilePath
mfn
let cachfile :: FilePath
cachfile = FilePath
destDir FilePath -> FilePath -> FilePath
</> FilePath
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
$ FilePath -> IO Bool
doesFileExist FilePath
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 -> FilePath -> Excepts '[DigestError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadThrow m, HasLog env) =>
Text -> FilePath -> 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) FilePath
cachfile
FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
cachfile
| Bool
otherwise -> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
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)) FilePath
destDir Maybe FilePath
mfn Bool
False
checkDigest :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadIO m
, MonadThrow m
, HasLog env
)
=> T.Text
-> FilePath
-> Excepts '[DigestError] m ()
checkDigest :: Text -> FilePath -> Excepts '[DigestError] m ()
checkDigest Text
eDigest FilePath
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' :: FilePath
p' = FilePath -> FilePath
takeFileName FilePath
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
<> FilePath -> Text
T.pack FilePath
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
$ FilePath -> IO ByteString
L.readFile FilePath
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 (FilePath -> Text -> Text -> DigestError
DigestError FilePath
file Text
cDigest Text
eDigest)
getCurlOpts :: IO [String]
getCurlOpts :: IO [FilePath]
getCurlOpts =
FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GHCUP_CURL_OPTS" IO (Maybe FilePath)
-> (Maybe FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
r -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
" " FilePath
r
Maybe FilePath
Nothing -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getWgetOpts :: IO [String]
getWgetOpts :: IO [FilePath]
getWgetOpts =
FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GHCUP_WGET_OPTS" IO (Maybe FilePath)
-> (Maybe FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
r -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
" " FilePath
r
Maybe FilePath
Nothing -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getGpgOpts :: IO [String]
getGpgOpts :: IO [FilePath]
getGpgOpts =
FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GHCUP_GPG_OPTS" IO (Maybe FilePath)
-> (Maybe FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
r -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
" " FilePath
r
Maybe FilePath
Nothing -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
urlBaseName :: ByteString
-> 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
getLastHeader :: T.Text -> T.Text
= [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 :: FilePath -> FilePath
tmpFile = (FilePath -> FilePath -> FilePath
<.> FilePath
"tmp")