{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.FetchUtils (
fetchPackage,
isFetched,
checkFetched,
checkRepoTarballFetched,
fetchRepoTarball,
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, 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 )
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
isFetched :: UnresolvedPkgLoc -> IO Bool
isFetched :: UnresolvedPkgLoc -> IO Bool
isFetched UnresolvedPkgLoc
loc = case UnresolvedPkgLoc
loc of
LocalUnpackedPackage FilePath
_dir -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
LocalTarballPackage FilePath
_file -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
RemoteTarballPackage URI
_uri Maybe FilePath
local -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Bool
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 -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Bool
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 ->
Maybe ResolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a. a -> Maybe a
Just (ResolvedPkgLoc -> Maybe ResolvedPkgLoc)
-> ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a b. (a -> b) -> a -> b
$ FilePath -> ResolvedPkgLoc
forall local. FilePath -> PackageLocation local
LocalUnpackedPackage FilePath
dir)
LocalTarballPackage FilePath
file ->
Maybe ResolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a. a -> Maybe a
Just (ResolvedPkgLoc -> Maybe ResolvedPkgLoc)
-> ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a b. (a -> b) -> a -> b
$ FilePath -> ResolvedPkgLoc
forall local. FilePath -> PackageLocation local
LocalTarballPackage FilePath
file)
RemoteTarballPackage URI
uri (Just FilePath
file) ->
Maybe ResolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a. a -> Maybe a
Just (ResolvedPkgLoc -> Maybe ResolvedPkgLoc)
-> ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a b. (a -> b) -> a -> b
$ URI -> FilePath -> ResolvedPkgLoc
forall local. URI -> local -> PackageLocation local
RemoteTarballPackage URI
uri FilePath
file)
RepoTarballPackage Repo
repo PackageId
pkgid (Just FilePath
file) ->
Maybe ResolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a. a -> Maybe a
Just (ResolvedPkgLoc -> Maybe ResolvedPkgLoc)
-> ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a b. (a -> b) -> a -> b
$ Repo -> PackageId -> FilePath -> ResolvedPkgLoc
forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid FilePath
file)
RemoteSourceRepoPackage SourceRepoMaybe
repo (Just FilePath
file) ->
Maybe ResolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a. a -> Maybe a
Just (ResolvedPkgLoc -> Maybe ResolvedPkgLoc)
-> ResolvedPkgLoc -> Maybe ResolvedPkgLoc
forall a b. (a -> b) -> a -> b
$ SourceRepoMaybe -> FilePath -> ResolvedPkgLoc
forall local. SourceRepoMaybe -> local -> PackageLocation local
RemoteSourceRepoPackage SourceRepoMaybe
repo FilePath
file)
RemoteTarballPackage URI
_uri Maybe FilePath
Nothing -> Maybe ResolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ResolvedPkgLoc
forall a. Maybe a
Nothing
RemoteSourceRepoPackage SourceRepoMaybe
_repo Maybe FilePath
Nothing -> Maybe ResolvedPkgLoc -> IO (Maybe ResolvedPkgLoc)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ResolvedPkgLoc
forall a. Maybe a
Nothing
RepoTarballPackage Repo
repo PackageId
pkgid Maybe FilePath
Nothing ->
(Maybe FilePath -> Maybe ResolvedPkgLoc)
-> IO (Maybe FilePath) -> IO (Maybe ResolvedPkgLoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> ResolvedPkgLoc)
-> Maybe FilePath -> Maybe ResolvedPkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Repo -> PackageId -> FilePath -> ResolvedPkgLoc
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 Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file)
else Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
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 ->
ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ResolvedPkgLoc
forall local. FilePath -> PackageLocation local
LocalUnpackedPackage FilePath
dir)
LocalTarballPackage FilePath
file ->
ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ResolvedPkgLoc
forall local. FilePath -> PackageLocation local
LocalTarballPackage FilePath
file)
RemoteTarballPackage URI
uri (Just FilePath
file) ->
ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> FilePath -> ResolvedPkgLoc
forall local. URI -> local -> PackageLocation local
RemoteTarballPackage URI
uri FilePath
file)
RepoTarballPackage Repo
repo PackageId
pkgid (Just FilePath
file) ->
ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Repo -> PackageId -> FilePath -> ResolvedPkgLoc
forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid FilePath
file)
RemoteSourceRepoPackage SourceRepoMaybe
repo (Just FilePath
dir) ->
ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceRepoMaybe -> FilePath -> ResolvedPkgLoc
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
ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> FilePath -> ResolvedPkgLoc
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
ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Repo -> PackageId -> FilePath -> ResolvedPkgLoc
forall local. Repo -> PackageId -> local -> PackageLocation local
RepoTarballPackage Repo
repo PackageId
pkgid FilePath
local)
RemoteSourceRepoPackage SourceRepoMaybe
_repo Maybe FilePath
Nothing ->
Verbosity -> FilePath -> IO ResolvedPkgLoc
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 " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ URI -> FilePath
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
FilePath -> IO FilePath
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 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" has already been downloaded."
FilePath -> IO FilePath
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 (PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid)
FilePath
res <- IO FilePath
downloadRepoPackage
Verbosity -> ProgressPhase -> FilePath -> IO ()
progressMessage Verbosity
verbosity ProgressPhase
ProgressDownloaded (PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid)
FilePath -> IO FilePath
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{} -> FilePath -> IO FilePath
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
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
RepoSecure{} -> RepoContext
-> Repo
-> (forall (down :: * -> *). Repository down -> IO FilePath)
-> IO FilePath
RepoContext
-> forall a.
Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoCtxt Repo
repo ((forall (down :: * -> *). Repository down -> IO FilePath)
-> IO FilePath)
-> (forall (down :: * -> *). Repository down -> IO FilePath)
-> IO FilePath
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
((Throws VerificationError, Throws SomeRemoteError,
Throws InvalidPackageException) =>
IO ())
-> IO ()
forall a.
((Throws VerificationError, Throws SomeRemoteError,
Throws InvalidPackageException) =>
IO a)
-> IO a
Sec.uncheckClientErrors (((Throws VerificationError, Throws SomeRemoteError,
Throws InvalidPackageException) =>
IO ())
-> IO ())
-> ((Throws VerificationError, Throws SomeRemoteError,
Throws InvalidPackageException) =>
IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Writing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path)
Repository down -> PackageId -> FilePath -> IO ()
forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError,
Throws InvalidPackageException) =>
Repository down -> PackageId -> FilePath -> IO ()
Sec.downloadPackage' Repository down
rep PackageId
pkgid FilePath
path
FilePath -> IO FilePath
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 :: 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 <- [IO (UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
-> IO
[(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ do MVar (Either SomeException ResolvedPkgLoc)
v <- IO (MVar (Either SomeException ResolvedPkgLoc))
forall a. IO (MVar a)
newEmptyMVar
(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))
-> IO
(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))
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 =
[(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
-> ((UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))
-> IO ())
-> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
asyncDownloadVars (((UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))
-> IO ())
-> IO ())
-> ((UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))
-> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(UnresolvedPkgLoc
pkgloc, MVar (Either SomeException ResolvedPkgLoc)
var) -> do
Either SomeException ResolvedPkgLoc
result <- IO ResolvedPkgLoc -> IO (Either SomeException ResolvedPkgLoc)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Safe.try (IO ResolvedPkgLoc -> IO (Either SomeException ResolvedPkgLoc))
-> IO ResolvedPkgLoc -> IO (Either SomeException ResolvedPkgLoc)
forall a b. (a -> b) -> a -> b
$
Verbosity -> RepoContext -> UnresolvedPkgLoc -> IO ResolvedPkgLoc
fetchPackage (Verbosity -> Verbosity
verboseUnmarkOutput Verbosity
verbosity) RepoContext
repoCtxt UnresolvedPkgLoc
pkgloc
MVar (Either SomeException ResolvedPkgLoc)
-> Either SomeException ResolvedPkgLoc -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException ResolvedPkgLoc)
var Either SomeException ResolvedPkgLoc
result
(()
_, a
res) <- IO () -> IO a -> IO ((), a)
forall a b. IO a -> IO b -> IO (a, b)
concurrently
IO ()
fetchPackages
(AsyncFetchMap -> IO a
body (AsyncFetchMap -> IO a) -> AsyncFetchMap -> IO a
forall a b. (a -> b) -> a -> b
$ [(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
-> AsyncFetchMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(UnresolvedPkgLoc, MVar (Either SomeException ResolvedPkgLoc))]
asyncDownloadVars)
a -> IO a
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 UnresolvedPkgLoc
-> AsyncFetchMap
-> Maybe (MVar (Either SomeException ResolvedPkgLoc))
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 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Waiting for download of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UnresolvedPkgLoc -> FilePath
forall a. Show a => a -> FilePath
show UnresolvedPkgLoc
srcloc
(SomeException -> IO ResolvedPkgLoc)
-> (ResolvedPkgLoc -> IO ResolvedPkgLoc)
-> Either SomeException ResolvedPkgLoc
-> IO ResolvedPkgLoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO ResolvedPkgLoc
forall e a. Exception e => e -> IO a
throwIO ResolvedPkgLoc -> IO ResolvedPkgLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException ResolvedPkgLoc -> IO ResolvedPkgLoc)
-> IO (Either SomeException ResolvedPkgLoc) -> IO ResolvedPkgLoc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVar (Either SomeException ResolvedPkgLoc)
-> IO (Either SomeException ResolvedPkgLoc)
forall a. MVar a -> IO a
readMVar MVar (Either SomeException ResolvedPkgLoc)
hnd
Maybe (MVar (Either SomeException ResolvedPkgLoc))
Nothing -> FilePath -> IO ResolvedPkgLoc
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
</> PackageId -> 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
</> PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid)
FilePath -> FilePath -> FilePath
</> Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageId -> Version
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)
,PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid)
,Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageId -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageId
pkgid)
,PackageId -> FilePath
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"
,PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"]
}