{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
module Distribution.Client.FetchUtils (
fetchPackage,
isFetched,
checkFetched,
checkRepoTarballFetched,
fetchRepoTarball,
verifyFetchedTarball,
asyncFetchPackages,
waitAsyncFetchPackage,
AsyncFetchMap,
downloadIndex,
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.Types
import Distribution.Client.HttpUtils
( downloadURI, isOldHackageURI, DownloadResult(..)
, HttpTransport(..), transportCheckHttps, remoteRepoCheckHttps )
import Distribution.Package
( PackageId, packageName, packageVersion )
import Distribution.Simple.Utils
( notice, info, debug, warn, die' )
import Distribution.Verbosity
( verboseUnmarkOutput )
import Distribution.Client.GlobalFlags
( RepoContext(..) )
import Distribution.Client.Utils
( ProgressPhase(..), progressMessage )
import qualified Data.Map as Map
import qualified Control.Exception.Safe as Safe
import Control.Concurrent.Async
import Control.Concurrent.MVar
import System.Directory
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory
, getFileSize )
import System.IO
( openTempFile, hClose )
import System.FilePath
( (</>), (<.>) )
import qualified System.FilePath.Posix as FilePath.Posix
( combine, joinPath )
import Network.URI
( URI(uriPath) )
import qualified Hackage.Security.Client as Sec
import qualified Hackage.Security.Util.Path as Sec
import qualified Hackage.Security.Util.Checked as Sec
isFetched :: UnresolvedPkgLoc -> IO Bool
isFetched :: UnresolvedPkgLoc -> IO Bool
isFetched UnresolvedPkgLoc
loc = case UnresolvedPkgLoc
loc of
LocalUnpackedPackage FilePath
_dir -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
LocalTarballPackage FilePath
_file -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
RemoteTarballPackage URI
_uri Maybe FilePath
local -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a -> Bool
isJust Maybe FilePath
local)
RepoTarballPackage Repo
repo PackageId
pkgid Maybe FilePath
_ -> FilePath -> IO Bool
doesFileExist (Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid)
RemoteSourceRepoPackage SourceRepoMaybe
_ Maybe FilePath
local -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a -> Bool
isJust Maybe FilePath
local)
checkFetched :: UnresolvedPkgLoc
-> IO (Maybe ResolvedPkgLoc)
checkFetched :: UnresolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
checkFetched UnresolvedPkgLoc
loc = case UnresolvedPkgLoc
loc of
LocalUnpackedPackage FilePath
dir ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall local. FilePath -> PackageLocation local
LocalUnpackedPackage FilePath
dir)
LocalTarballPackage FilePath
file ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall local. FilePath -> PackageLocation local
LocalTarballPackage FilePath
file)
RemoteTarballPackage URI
uri (Just FilePath
file) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall local. URI -> local -> PackageLocation local
RemoteTarballPackage URI
uri FilePath
file)
RepoTarballPackage Repo
repo PackageId
pkgid (Just FilePath
file) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid FilePath
file)
RemoteSourceRepoPackage SourceRepoMaybe
repo (Just FilePath
file) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall local. SourceRepoMaybe -> local -> PackageLocation local
RemoteSourceRepoPackage SourceRepoMaybe
repo FilePath
file)
RemoteTarballPackage URI
_uri Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
RemoteSourceRepoPackage SourceRepoMaybe
_repo Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
RepoTarballPackage Repo
repo PackageId
pkgid Maybe FilePath
Nothing ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid))
(Repo -> PackageId -> IO (Maybe FilePath)
checkRepoTarballFetched Repo
repo PackageId
pkgid)
checkRepoTarballFetched :: Repo -> PackageId -> IO (Maybe FilePath)
checkRepoTarballFetched :: Repo -> PackageId -> IO (Maybe FilePath)
checkRepoTarballFetched Repo
repo PackageId
pkgid = do
let file :: FilePath
file = Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
file
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
file)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
verifyFetchedTarball :: Verbosity -> RepoContext -> Repo -> PackageId -> IO Bool
verifyFetchedTarball :: Verbosity -> RepoContext -> Repo -> PackageId -> IO Bool
verifyFetchedTarball Verbosity
verbosity RepoContext
repoCtxt Repo
repo PackageId
pkgid =
let file :: FilePath
file = Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid
handleError :: IO Bool -> IO Bool
handleError :: IO Bool -> IO Bool
handleError IO Bool
act = do
Either SomeException Bool
res <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Safe.try IO Bool
act
case Either SomeException Bool
res of
Left SomeException
e -> Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath
"Error verifying fetched tarball " forall a. [a] -> [a] -> [a]
++ FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
", will redownload: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (SomeException
e :: SomeException)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Right Bool
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
in IO Bool -> IO Bool
handleError forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
file
if Bool -> Bool
not Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else case Repo
repo of
RepoSecure{} ->
RepoContext
-> forall a.
Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoCtxt Repo
repo forall a b. (a -> b) -> a -> b
$ \Repository down
repoSecure ->
forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
Sec.withIndex Repository down
repoSecure forall a b. (a -> b) -> a -> b
$ \IndexCallbacks
callbacks ->
let warnAndFail :: FilePath -> IO Bool
warnAndFail FilePath
s = Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath
"Fetched tarball " forall a. [a] -> [a] -> [a]
++ FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
" does not match server, will redownload: " forall a. [a] -> [a] -> [a]
++ FilePath
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
in (do Trusted FileInfo
fileInfo <- IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
PackageId -> IO (Trusted FileInfo)
Sec.indexLookupFileInfo IndexCallbacks
callbacks PackageId
pkgid
FileLength
sz <- Int54 -> FileLength
Sec.FileLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Integer
getFileSize FilePath
file
if FileLength
sz forall a. Eq a => a -> a -> Bool
/= FileInfo -> FileLength
Sec.fileInfoLength (forall a. Trusted a -> a
Sec.trusted Trusted FileInfo
fileInfo)
then FilePath -> IO Bool
warnAndFail FilePath
"file length mismatch"
else do
Bool
res <- FileInfo -> FileInfo -> Bool
Sec.compareTrustedFileInfo (forall a. Trusted a -> a
Sec.trusted Trusted FileInfo
fileInfo) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall root. FsRoot root => Path root -> IO FileInfo
Sec.computeFileInfo (forall a. FilePath -> Path a
Sec.Path FilePath
file :: Sec.Path Sec.Absolute)
if Bool
res
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else FilePath -> IO Bool
warnAndFail FilePath
"file hash mismatch")
forall a e.
Exception e =>
(Throws e => IO a) -> (e -> IO a) -> IO a
`Sec.catchChecked` (\(InvalidPackageException
e :: Sec.InvalidPackageException) -> FilePath -> IO Bool
warnAndFail (forall a. Show a => a -> FilePath
show InvalidPackageException
e))
forall a e.
Exception e =>
(Throws e => IO a) -> (e -> IO a) -> IO a
`Sec.catchChecked` (\(VerificationError
e :: Sec.VerificationError) -> FilePath -> IO Bool
warnAndFail (forall a. Show a => a -> FilePath
show VerificationError
e))
Repo
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
fetchPackage :: Verbosity
-> RepoContext
-> UnresolvedPkgLoc
-> IO ResolvedPkgLoc
fetchPackage :: Verbosity -> RepoContext -> UnresolvedPkgLoc -> IO ResolvedPkgLoc
fetchPackage Verbosity
verbosity RepoContext
repoCtxt UnresolvedPkgLoc
loc = case UnresolvedPkgLoc
loc of
LocalUnpackedPackage FilePath
dir ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall local. FilePath -> PackageLocation local
LocalUnpackedPackage FilePath
dir)
LocalTarballPackage FilePath
file ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall local. FilePath -> PackageLocation local
LocalTarballPackage FilePath
file)
RemoteTarballPackage URI
uri (Just FilePath
file) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall local. URI -> local -> PackageLocation local
RemoteTarballPackage URI
uri FilePath
file)
RepoTarballPackage Repo
repo PackageId
pkgid (Just FilePath
file) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid FilePath
file)
RemoteSourceRepoPackage SourceRepoMaybe
repo (Just FilePath
dir) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall local. SourceRepoMaybe -> local -> PackageLocation local
RemoteSourceRepoPackage SourceRepoMaybe
repo FilePath
dir)
RemoteTarballPackage URI
uri Maybe FilePath
Nothing -> do
FilePath
path <- URI -> IO FilePath
downloadTarballPackage URI
uri
forall (m :: * -> *) a. Monad m => a -> m a
return (forall local. URI -> local -> PackageLocation local
RemoteTarballPackage URI
uri FilePath
path)
RepoTarballPackage Repo
repo PackageId
pkgid Maybe FilePath
Nothing -> do
FilePath
local <- Verbosity -> RepoContext -> Repo -> PackageId -> IO FilePath
fetchRepoTarball Verbosity
verbosity RepoContext
repoCtxt Repo
repo PackageId
pkgid
forall (m :: * -> *) a. Monad m => a -> m a
return (forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid FilePath
local)
RemoteSourceRepoPackage SourceRepoMaybe
_repo Maybe FilePath
Nothing ->
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
"fetchPackage: source repos not supported"
where
downloadTarballPackage :: URI -> IO FilePath
downloadTarballPackage :: URI -> IO FilePath
downloadTarballPackage URI
uri = do
HttpTransport
transport <- RepoContext -> IO HttpTransport
repoContextGetTransport RepoContext
repoCtxt
Verbosity -> HttpTransport -> URI -> IO ()
transportCheckHttps Verbosity
verbosity HttpTransport
transport URI
uri
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath
"Downloading " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show URI
uri)
FilePath
tmpdir <- IO FilePath
getTemporaryDirectory
(FilePath
path, Handle
hnd) <- FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
tmpdir FilePath
"cabal-.tar.gz"
Handle -> IO ()
hClose Handle
hnd
DownloadResult
_ <- HttpTransport -> Verbosity -> URI -> FilePath -> IO DownloadResult
downloadURI HttpTransport
transport Verbosity
verbosity URI
uri FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
fetchRepoTarball :: Verbosity -> RepoContext -> Repo -> PackageId -> IO FilePath
fetchRepoTarball :: Verbosity -> RepoContext -> Repo -> PackageId -> IO FilePath
fetchRepoTarball Verbosity
verbosity' RepoContext
repoCtxt Repo
repo PackageId
pkgid = do
Bool
fetched <- FilePath -> IO Bool
doesFileExist (Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid)
if Bool
fetched
then do Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid forall a. [a] -> [a] -> [a]
++ FilePath
" has already been downloaded."
forall (m :: * -> *) a. Monad m => a -> m a
return (Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid)
else do Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
ProgressDownloading (forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid)
FilePath
res <- IO FilePath
downloadRepoPackage
Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
ProgressDownloaded (forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid)
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
res
where
verbosity :: Verbosity
verbosity = Verbosity -> Verbosity
verboseUnmarkOutput Verbosity
verbosity'
downloadRepoPackage :: IO FilePath
downloadRepoPackage :: IO FilePath
downloadRepoPackage = case Repo
repo of
RepoLocalNoIndex{} -> forall (m :: * -> *) a. Monad m => a -> m a
return (Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid)
RepoRemote{FilePath
RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> FilePath
repoLocalDir :: FilePath
repoRemote :: RemoteRepo
..} -> do
HttpTransport
transport <- RepoContext -> IO HttpTransport
repoContextGetTransport RepoContext
repoCtxt
Verbosity -> HttpTransport -> RemoteRepo -> IO ()
remoteRepoCheckHttps Verbosity
verbosity HttpTransport
transport RemoteRepo
repoRemote
let uri :: URI
uri = RemoteRepo -> PackageId -> URI
packageURI RemoteRepo
repoRemote PackageId
pkgid
dir :: FilePath
dir = Repo -> PackageId -> FilePath
packageDir Repo
repo PackageId
pkgid
path :: FilePath
path = Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
DownloadResult
_ <- HttpTransport -> Verbosity -> URI -> FilePath -> IO DownloadResult
downloadURI HttpTransport
transport Verbosity
verbosity URI
uri FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
RepoSecure{} -> RepoContext
-> forall a.
Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoCtxt Repo
repo forall a b. (a -> b) -> a -> b
$ \Repository down
rep -> do
let dir :: FilePath
dir = Repo -> PackageId -> FilePath
packageDir Repo
repo PackageId
pkgid
path :: FilePath
path = Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
forall a.
((Throws VerificationError, Throws SomeRemoteError,
Throws InvalidPackageException) =>
IO a)
-> IO a
Sec.uncheckClientErrors forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Writing " forall a. [a] -> [a] -> [a]
++ FilePath
path)
forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError,
Throws InvalidPackageException) =>
Repository down -> PackageId -> FilePath -> IO ()
Sec.downloadPackage' Repository down
rep PackageId
pkgid FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
downloadIndex :: HttpTransport -> Verbosity -> RemoteRepo -> FilePath -> IO DownloadResult
downloadIndex :: HttpTransport
-> Verbosity -> RemoteRepo -> FilePath -> IO DownloadResult
downloadIndex HttpTransport
transport Verbosity
verbosity RemoteRepo
remoteRepo FilePath
cacheDir = do
Verbosity -> HttpTransport -> RemoteRepo -> IO ()
remoteRepoCheckHttps Verbosity
verbosity HttpTransport
transport RemoteRepo
remoteRepo
let uri :: URI
uri = (RemoteRepo -> URI
remoteRepoURI RemoteRepo
remoteRepo) {
uriPath :: FilePath
uriPath = URI -> FilePath
uriPath (RemoteRepo -> URI
remoteRepoURI RemoteRepo
remoteRepo)
FilePath -> FilePath -> FilePath
`FilePath.Posix.combine` FilePath
"00-index.tar.gz"
}
path :: FilePath
path = FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
"00-index" FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cacheDir
HttpTransport -> Verbosity -> URI -> FilePath -> IO DownloadResult
downloadURI HttpTransport
transport Verbosity
verbosity URI
uri FilePath
path
type AsyncFetchMap = Map UnresolvedPkgLoc
(MVar (Either SomeException ResolvedPkgLoc))
asyncFetchPackages :: Verbosity
-> RepoContext
-> [UnresolvedPkgLoc]
-> (AsyncFetchMap -> IO a)
-> IO a
asyncFetchPackages :: forall a.
Verbosity
-> RepoContext
-> [UnresolvedPkgLoc]
-> (AsyncFetchMap -> IO a)
-> IO a
asyncFetchPackages Verbosity
verbosity RepoContext
repoCtxt [UnresolvedPkgLoc]
pkglocs AsyncFetchMap -> IO a
body = do
[(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
asyncDownloadVars <- forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ do MVar (Either SomeException ResolvedPkgLoc)
v <- forall a. IO (MVar a)
newEmptyMVar
forall (m :: * -> *) a. Monad m => a -> m a
return (UnresolvedPkgLoc
pkgloc, MVar (Either SomeException ResolvedPkgLoc)
v)
| UnresolvedPkgLoc
pkgloc <- [UnresolvedPkgLoc]
pkglocs
]
let fetchPackages :: IO ()
fetchPackages :: IO ()
fetchPackages =
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
asyncDownloadVars forall a b. (a -> b) -> a -> b
$ \(UnresolvedPkgLoc
pkgloc, MVar (Either SomeException ResolvedPkgLoc)
var) -> do
Either SomeException ResolvedPkgLoc
result <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Safe.try forall a b. (a -> b) -> a -> b
$
Verbosity -> RepoContext -> UnresolvedPkgLoc -> IO ResolvedPkgLoc
fetchPackage (Verbosity -> Verbosity
verboseUnmarkOutput Verbosity
verbosity) RepoContext
repoCtxt UnresolvedPkgLoc
pkgloc
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException ResolvedPkgLoc)
var Either SomeException ResolvedPkgLoc
result
(()
_, a
res) <- forall a b. IO a -> IO b -> IO (a, b)
concurrently
IO ()
fetchPackages
(AsyncFetchMap -> IO a
body forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
asyncDownloadVars)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
waitAsyncFetchPackage :: Verbosity
-> AsyncFetchMap
-> UnresolvedPkgLoc
-> IO ResolvedPkgLoc
waitAsyncFetchPackage :: Verbosity -> AsyncFetchMap -> UnresolvedPkgLoc -> IO ResolvedPkgLoc
waitAsyncFetchPackage Verbosity
verbosity AsyncFetchMap
downloadMap UnresolvedPkgLoc
srcloc =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnresolvedPkgLoc
srcloc AsyncFetchMap
downloadMap of
Just MVar (Either SomeException ResolvedPkgLoc)
hnd -> do
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Waiting for download of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show UnresolvedPkgLoc
srcloc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. MVar a -> IO a
readMVar MVar (Either SomeException ResolvedPkgLoc)
hnd
Maybe (MVar (Either SomeException ResolvedPkgLoc))
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"waitAsyncFetchPackage: package not being downloaded"
packageFile :: Repo -> PackageId -> FilePath
packageFile :: Repo -> PackageId -> FilePath
packageFile Repo
repo PackageId
pkgid = Repo -> PackageId -> FilePath
packageDir Repo
repo PackageId
pkgid
FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid
FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
packageDir :: Repo -> PackageId -> FilePath
packageDir :: Repo -> PackageId -> FilePath
packageDir (RepoLocalNoIndex (LocalRepo RepoName
_ FilePath
dir Bool
_) FilePath
_) PackageId
_pkgid = FilePath
dir
packageDir Repo
repo PackageId
pkgid = Repo -> FilePath
repoLocalDir Repo
repo
FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid)
FilePath -> FilePath -> FilePath
</> forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid)
packageURI :: RemoteRepo -> PackageId -> URI
packageURI :: RemoteRepo -> PackageId -> URI
packageURI RemoteRepo
repo PackageId
pkgid | URI -> Bool
isOldHackageURI (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo) =
(RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo) {
uriPath :: FilePath
uriPath = [FilePath] -> FilePath
FilePath.Posix.joinPath
[URI -> FilePath
uriPath (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo)
,forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid)
,forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid)
,forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"]
}
packageURI RemoteRepo
repo PackageId
pkgid =
(RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo) {
uriPath :: FilePath
uriPath = [FilePath] -> FilePath
FilePath.Posix.joinPath
[URI -> FilePath
uriPath (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo)
,FilePath
"package"
,forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"]
}