{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}

module Distribution.Client.GlobalFlags (
    GlobalFlags(..)
  , defaultGlobalFlags
  , RepoContext(..)
  , withRepoContext
  , withRepoContext'
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.Client.Types
         ( Repo(..), unRepoName, RemoteRepo(..), LocalRepo (..), localRepoCacheKey )
import Distribution.Simple.Setup
         ( Flag(..), fromFlag, flagToMaybe )
import Distribution.Utils.NubList
         ( NubList, fromNubList )
import Distribution.Client.HttpUtils
         ( HttpTransport, configureTransport )
import Distribution.Simple.Utils
         ( info, warn )

import Distribution.Client.IndexUtils.ActiveRepos
         ( ActiveRepos )

import Control.Concurrent
         ( MVar, newMVar, modifyMVar )
import System.FilePath
         ( (</>) )
import Network.URI
         ( URI, uriScheme, uriPath )
import qualified Data.Map as Map

import qualified Hackage.Security.Client                    as Sec
import qualified Hackage.Security.Util.Path                 as Sec
import qualified Hackage.Security.Util.Pretty               as Sec
import qualified Hackage.Security.Client.Repository.Cache   as Sec
import qualified Hackage.Security.Client.Repository.Local   as Sec.Local
import qualified Hackage.Security.Client.Repository.Remote  as Sec.Remote
import qualified Distribution.Client.Security.HTTP          as Sec.HTTP
import qualified Distribution.Client.Security.DNS           as Sec.DNS

import qualified System.FilePath.Posix as FilePath.Posix

-- ------------------------------------------------------------
-- * Global flags
-- ------------------------------------------------------------

-- | Flags that apply at the top level, not to any sub-command.

data GlobalFlags = GlobalFlags
    { GlobalFlags -> Flag Bool
globalVersion           :: Flag Bool
    , GlobalFlags -> Flag Bool
globalNumericVersion    :: Flag Bool
    , GlobalFlags -> Flag FilePath
globalConfigFile        :: Flag FilePath
    , GlobalFlags -> Flag FilePath
globalConstraintsFile   :: Flag FilePath
    , GlobalFlags -> NubList RemoteRepo
globalRemoteRepos       :: NubList RemoteRepo     -- ^ Available Hackage servers.
    , GlobalFlags -> Flag FilePath
globalCacheDir          :: Flag FilePath
    , GlobalFlags -> NubList LocalRepo
globalLocalNoIndexRepos :: NubList LocalRepo
    , GlobalFlags -> Flag ActiveRepos
globalActiveRepos       :: Flag ActiveRepos
    , GlobalFlags -> Flag FilePath
globalLogsDir           :: Flag FilePath
    , GlobalFlags -> Flag Bool
globalIgnoreExpiry      :: Flag Bool    -- ^ Ignore security expiry dates
    , GlobalFlags -> Flag FilePath
globalHttpTransport     :: Flag String
    , GlobalFlags -> Flag Bool
globalNix               :: Flag Bool  -- ^ Integrate with Nix
    , GlobalFlags -> Flag FilePath
globalStoreDir          :: Flag FilePath
    , GlobalFlags -> NubList FilePath
globalProgPathExtra     :: NubList FilePath -- ^ Extra program path used for packagedb lookups in a global context (i.e. for http transports)
    } deriving (Int -> GlobalFlags -> ShowS
[GlobalFlags] -> ShowS
GlobalFlags -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GlobalFlags] -> ShowS
$cshowList :: [GlobalFlags] -> ShowS
show :: GlobalFlags -> FilePath
$cshow :: GlobalFlags -> FilePath
showsPrec :: Int -> GlobalFlags -> ShowS
$cshowsPrec :: Int -> GlobalFlags -> ShowS
Show, forall x. Rep GlobalFlags x -> GlobalFlags
forall x. GlobalFlags -> Rep GlobalFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalFlags x -> GlobalFlags
$cfrom :: forall x. GlobalFlags -> Rep GlobalFlags x
Generic)

defaultGlobalFlags :: GlobalFlags
defaultGlobalFlags :: GlobalFlags
defaultGlobalFlags  = GlobalFlags
    { globalVersion :: Flag Bool
globalVersion           = forall a. a -> Flag a
Flag Bool
False
    , globalNumericVersion :: Flag Bool
globalNumericVersion    = forall a. a -> Flag a
Flag Bool
False
    , globalConfigFile :: Flag FilePath
globalConfigFile        = forall a. Monoid a => a
mempty
    , globalConstraintsFile :: Flag FilePath
globalConstraintsFile   = forall a. Monoid a => a
mempty
    , globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos       = forall a. Monoid a => a
mempty
    , globalCacheDir :: Flag FilePath
globalCacheDir          = forall a. Monoid a => a
mempty
    , globalLocalNoIndexRepos :: NubList LocalRepo
globalLocalNoIndexRepos = forall a. Monoid a => a
mempty
    , globalActiveRepos :: Flag ActiveRepos
globalActiveRepos       = forall a. Monoid a => a
mempty
    , globalLogsDir :: Flag FilePath
globalLogsDir           = forall a. Monoid a => a
mempty
    , globalIgnoreExpiry :: Flag Bool
globalIgnoreExpiry      = forall a. a -> Flag a
Flag Bool
False
    , globalHttpTransport :: Flag FilePath
globalHttpTransport     = forall a. Monoid a => a
mempty
    , globalNix :: Flag Bool
globalNix               = forall a. a -> Flag a
Flag Bool
False
    , globalStoreDir :: Flag FilePath
globalStoreDir          = forall a. Monoid a => a
mempty
    , globalProgPathExtra :: NubList FilePath
globalProgPathExtra     = forall a. Monoid a => a
mempty
    }

instance Monoid GlobalFlags where
    mempty :: GlobalFlags
mempty = forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
    mappend :: GlobalFlags -> GlobalFlags -> GlobalFlags
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup GlobalFlags where
    <> :: GlobalFlags -> GlobalFlags -> GlobalFlags
(<>) = forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

-- ------------------------------------------------------------
-- * Repo context
-- ------------------------------------------------------------

-- | Access to repositories
data RepoContext = RepoContext {
    -- | All user-specified repositories
    RepoContext -> [Repo]
repoContextRepos :: [Repo]

    -- | Get the HTTP transport
    --
    -- The transport will be initialized on the first call to this function.
    --
    -- NOTE: It is important that we don't eagerly initialize the transport.
    -- Initializing the transport is not free, and especially in contexts where
    -- we don't know a priori whether or not we need the transport (for instance
    -- when using cabal in "nix mode") incurring the overhead of transport
    -- initialization on _every_ invocation (eg @cabal build@) is undesirable.
  , RepoContext -> IO HttpTransport
repoContextGetTransport :: IO HttpTransport

    -- | Get the (initialized) secure repo
    --
    -- (the 'Repo' type itself is stateless and must remain so, because it
    -- must be serializable)
  , RepoContext
-> forall a.
   Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo :: forall a.
                                 Repo
                              -> (forall down. Sec.Repository down -> IO a)
                              -> IO a

    -- | Should we ignore expiry times (when checking security)?
  , RepoContext -> Bool
repoContextIgnoreExpiry :: Bool
  }

-- | Wrapper around 'Repository', hiding the type argument
data SecureRepo = forall down. SecureRepo (Sec.Repository down)

withRepoContext :: Verbosity -> GlobalFlags -> (RepoContext -> IO a) -> IO a
withRepoContext :: forall a. Verbosity -> GlobalFlags -> (RepoContext -> IO a) -> IO a
withRepoContext Verbosity
verbosity GlobalFlags
globalFlags =
    forall a.
Verbosity
-> [RemoteRepo]
-> [LocalRepo]
-> FilePath
-> Maybe FilePath
-> Maybe Bool
-> [FilePath]
-> (RepoContext -> IO a)
-> IO a
withRepoContext'
      Verbosity
verbosity
      (forall a. NubList a -> [a]
fromNubList (GlobalFlags -> NubList RemoteRepo
globalRemoteRepos       GlobalFlags
globalFlags))
      (forall a. NubList a -> [a]
fromNubList (GlobalFlags -> NubList LocalRepo
globalLocalNoIndexRepos GlobalFlags
globalFlags))
      (forall a. WithCallStack (Flag a -> a)
fromFlag    (GlobalFlags -> Flag FilePath
globalCacheDir          GlobalFlags
globalFlags))
      (forall a. Flag a -> Maybe a
flagToMaybe (GlobalFlags -> Flag FilePath
globalHttpTransport     GlobalFlags
globalFlags))
      (forall a. Flag a -> Maybe a
flagToMaybe (GlobalFlags -> Flag Bool
globalIgnoreExpiry      GlobalFlags
globalFlags))
      (forall a. NubList a -> [a]
fromNubList (GlobalFlags -> NubList FilePath
globalProgPathExtra     GlobalFlags
globalFlags))

withRepoContext' :: Verbosity -> [RemoteRepo] -> [LocalRepo]
                 -> FilePath  -> Maybe String -> Maybe Bool
                 -> [FilePath]
                 -> (RepoContext -> IO a)
                 -> IO a
withRepoContext' :: forall a.
Verbosity
-> [RemoteRepo]
-> [LocalRepo]
-> FilePath
-> Maybe FilePath
-> Maybe Bool
-> [FilePath]
-> (RepoContext -> IO a)
-> IO a
withRepoContext' Verbosity
verbosity [RemoteRepo]
remoteRepos [LocalRepo]
localNoIndexRepos
                 FilePath
sharedCacheDir Maybe FilePath
httpTransport Maybe Bool
ignoreExpiry [FilePath]
extraPaths = \RepoContext -> IO a
callback -> do
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [LocalRepo]
localNoIndexRepos forall a b. (a -> b) -> a -> b
$ \LocalRepo
local ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> Bool
FilePath.Posix.isAbsolute (LocalRepo -> FilePath
localRepoPath LocalRepo
local)) forall a b. (a -> b) -> a -> b
$
            Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"file+noindex " forall a. [a] -> [a] -> [a]
++ RepoName -> FilePath
unRepoName (LocalRepo -> RepoName
localRepoName LocalRepo
local) forall a. [a] -> [a] -> [a]
++ FilePath
" repository path is not absolute; this is fragile, and not recommended"

    MVar (Maybe HttpTransport)
transportRef <- forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing
    let httpLib :: HttpLib
httpLib = Verbosity -> IO HttpTransport -> HttpLib
Sec.HTTP.transportAdapter
                    Verbosity
verbosity
                    (MVar (Maybe HttpTransport) -> IO HttpTransport
getTransport MVar (Maybe HttpTransport)
transportRef)
    forall a.
Verbosity
-> HttpLib
-> [(RemoteRepo, FilePath)]
-> (Map Repo SecureRepo -> IO a)
-> IO a
initSecureRepos Verbosity
verbosity HttpLib
httpLib [(RemoteRepo, FilePath)]
secureRemoteRepos forall a b. (a -> b) -> a -> b
$ \Map Repo SecureRepo
secureRepos' ->
      RepoContext -> IO a
callback RepoContext {
          repoContextRepos :: [Repo]
repoContextRepos          = [Repo]
allRemoteRepos
                                   forall a. [a] -> [a] -> [a]
++ [Repo]
allLocalNoIndexRepos
        , repoContextGetTransport :: IO HttpTransport
repoContextGetTransport   = MVar (Maybe HttpTransport) -> IO HttpTransport
getTransport MVar (Maybe HttpTransport)
transportRef
        , repoContextWithSecureRepo :: forall a.
Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo = forall a.
Map Repo SecureRepo
-> Repo
-> (forall (down :: * -> *). Repository down -> IO a)
-> IO a
withSecureRepo Map Repo SecureRepo
secureRepos'
        , repoContextIgnoreExpiry :: Bool
repoContextIgnoreExpiry   = forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
ignoreExpiry
        }
  where
    secureRemoteRepos :: [(RemoteRepo, FilePath)]
secureRemoteRepos =
      [ (RemoteRepo
remote, FilePath
cacheDir) | RepoSecure RemoteRepo
remote FilePath
cacheDir <- [Repo]
allRemoteRepos ]

    allRemoteRepos :: [Repo]
    allRemoteRepos :: [Repo]
allRemoteRepos =
      [ (if Bool
isSecure then RemoteRepo -> FilePath -> Repo
RepoSecure else RemoteRepo -> FilePath -> Repo
RepoRemote) RemoteRepo
remote FilePath
cacheDir
      | RemoteRepo
remote <- [RemoteRepo]
remoteRepos
      , let cacheDir :: FilePath
cacheDir = FilePath
sharedCacheDir FilePath -> ShowS
</> RepoName -> FilePath
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
remote)
            isSecure :: Bool
isSecure = RemoteRepo -> Maybe Bool
remoteRepoSecure RemoteRepo
remote forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
      ]

    allLocalNoIndexRepos :: [Repo]
    allLocalNoIndexRepos :: [Repo]
allLocalNoIndexRepos =
      [ LocalRepo -> FilePath -> Repo
RepoLocalNoIndex LocalRepo
local FilePath
cacheDir
      | LocalRepo
local <- [LocalRepo]
localNoIndexRepos
      , let cacheDir :: FilePath
cacheDir | LocalRepo -> Bool
localRepoSharedCache LocalRepo
local = FilePath
sharedCacheDir FilePath -> ShowS
</> LocalRepo -> FilePath
localRepoCacheKey LocalRepo
local
                     | Bool
otherwise                  = LocalRepo -> FilePath
localRepoPath LocalRepo
local
      ]

    getTransport :: MVar (Maybe HttpTransport) -> IO HttpTransport
    getTransport :: MVar (Maybe HttpTransport) -> IO HttpTransport
getTransport MVar (Maybe HttpTransport)
transportRef =
      forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe HttpTransport)
transportRef forall a b. (a -> b) -> a -> b
$ \Maybe HttpTransport
mTransport -> do
        HttpTransport
transport <- case Maybe HttpTransport
mTransport of
          Just HttpTransport
tr -> forall (m :: * -> *) a. Monad m => a -> m a
return HttpTransport
tr
          Maybe HttpTransport
Nothing -> Verbosity -> [FilePath] -> Maybe FilePath -> IO HttpTransport
configureTransport Verbosity
verbosity [FilePath]
extraPaths Maybe FilePath
httpTransport
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just HttpTransport
transport, HttpTransport
transport)

    withSecureRepo :: Map Repo SecureRepo
                   -> Repo
                   -> (forall down. Sec.Repository down -> IO a)
                   -> IO a
    withSecureRepo :: forall a.
Map Repo SecureRepo
-> Repo
-> (forall (down :: * -> *). Repository down -> IO a)
-> IO a
withSecureRepo Map Repo SecureRepo
secureRepos Repo
repo forall (down :: * -> *). Repository down -> IO a
callback =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Repo
repo Map Repo SecureRepo
secureRepos of
        Just (SecureRepo Repository down
secureRepo) -> forall (down :: * -> *). Repository down -> IO a
callback Repository down
secureRepo
        Maybe SecureRepo
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError FilePath
"repoContextWithSecureRepo: unknown repo"

-- | Initialize the provided secure repositories
--
-- Assumed invariant: `remoteRepoSecure` should be set for all these repos.
initSecureRepos :: forall a. Verbosity
                -> Sec.HTTP.HttpLib
                -> [(RemoteRepo, FilePath)]
                -> (Map Repo SecureRepo -> IO a)
                -> IO a
initSecureRepos :: forall a.
Verbosity
-> HttpLib
-> [(RemoteRepo, FilePath)]
-> (Map Repo SecureRepo -> IO a)
-> IO a
initSecureRepos Verbosity
verbosity HttpLib
httpLib [(RemoteRepo, FilePath)]
repos Map Repo SecureRepo -> IO a
callback = Map Repo SecureRepo -> [(RemoteRepo, FilePath)] -> IO a
go forall k a. Map k a
Map.empty [(RemoteRepo, FilePath)]
repos
  where
    go :: Map Repo SecureRepo -> [(RemoteRepo, FilePath)] -> IO a
    go :: Map Repo SecureRepo -> [(RemoteRepo, FilePath)] -> IO a
go !Map Repo SecureRepo
acc [] = Map Repo SecureRepo -> IO a
callback Map Repo SecureRepo
acc
    go !Map Repo SecureRepo
acc ((RemoteRepo
r,FilePath
cacheDir):[(RemoteRepo, FilePath)]
rs) = do
      Path Absolute
cachePath <- FsPath -> IO (Path Absolute)
Sec.makeAbsolute forall a b. (a -> b) -> a -> b
$ FilePath -> FsPath
Sec.fromFilePath FilePath
cacheDir
      forall a.
Verbosity
-> HttpLib
-> RemoteRepo
-> Path Absolute
-> (SecureRepo -> IO a)
-> IO a
initSecureRepo Verbosity
verbosity HttpLib
httpLib RemoteRepo
r Path Absolute
cachePath forall a b. (a -> b) -> a -> b
$ \SecureRepo
r' ->
        Map Repo SecureRepo -> [(RemoteRepo, FilePath)] -> IO a
go (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RemoteRepo -> FilePath -> Repo
RepoSecure RemoteRepo
r FilePath
cacheDir) SecureRepo
r' Map Repo SecureRepo
acc) [(RemoteRepo, FilePath)]
rs

-- | Initialize the given secure repo
--
-- The security library has its own concept of a "local" repository, distinct
-- from @cabal-install@'s; these are secure repositories, but live in the local
-- file system. We use the convention that these repositories are identified by
-- URLs of the form @file:/path/to/local/repo@.
initSecureRepo :: Verbosity
               -> Sec.HTTP.HttpLib
               -> RemoteRepo  -- ^ Secure repo ('remoteRepoSecure' assumed)
               -> Sec.Path Sec.Absolute -- ^ Cache dir
               -> (SecureRepo -> IO a)  -- ^ Callback
               -> IO a
initSecureRepo :: forall a.
Verbosity
-> HttpLib
-> RemoteRepo
-> Path Absolute
-> (SecureRepo -> IO a)
-> IO a
initSecureRepo Verbosity
verbosity HttpLib
httpLib RemoteRepo{Bool
Int
[FilePath]
Maybe Bool
URI
RepoName
remoteRepoShouldTryHttps :: RemoteRepo -> Bool
remoteRepoKeyThreshold :: RemoteRepo -> Int
remoteRepoRootKeys :: RemoteRepo -> [FilePath]
remoteRepoURI :: RemoteRepo -> URI
remoteRepoShouldTryHttps :: Bool
remoteRepoKeyThreshold :: Int
remoteRepoRootKeys :: [FilePath]
remoteRepoSecure :: Maybe Bool
remoteRepoURI :: URI
remoteRepoName :: RepoName
remoteRepoSecure :: RemoteRepo -> Maybe Bool
remoteRepoName :: RemoteRepo -> RepoName
..} Path Absolute
cachePath = \SecureRepo -> IO a
callback -> do
    Bool
requiresBootstrap <- forall a.
[URI] -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
withRepo [] forall (down :: * -> *). Repository down -> IO Bool
Sec.requiresBootstrap

    [URI]
mirrors <- if Bool
requiresBootstrap
               then do
                   Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Trying to locate mirrors via DNS for " forall a. [a] -> [a] -> [a]
++
                                    FilePath
"initial bootstrap of secure " forall a. [a] -> [a] -> [a]
++
                                    FilePath
"repository '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show URI
remoteRepoURI forall a. [a] -> [a] -> [a]
++
                                    FilePath
"' ..."

                   Verbosity -> URI -> IO [URI]
Sec.DNS.queryBootstrapMirrors Verbosity
verbosity URI
remoteRepoURI
               else forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    forall a.
[URI] -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
withRepo [URI]
mirrors forall a b. (a -> b) -> a -> b
$ \Repository down
r -> do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
requiresBootstrap forall a b. (a -> b) -> a -> b
$ forall a.
((Throws VerificationError, Throws SomeRemoteError,
  Throws InvalidPackageException) =>
 IO a)
-> IO a
Sec.uncheckClientErrors forall a b. (a -> b) -> a -> b
$
        forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError) =>
Repository down -> [KeyId] -> KeyThreshold -> IO ()
Sec.bootstrap Repository down
r
          (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> KeyId
Sec.KeyId    [FilePath]
remoteRepoRootKeys)
          (Int54 -> KeyThreshold
Sec.KeyThreshold (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
remoteRepoKeyThreshold))
      SecureRepo -> IO a
callback forall a b. (a -> b) -> a -> b
$ forall (down :: * -> *). Repository down -> SecureRepo
SecureRepo Repository down
r
  where
    -- Initialize local or remote repo depending on the URI
    withRepo :: [URI] -> (forall down. Sec.Repository down -> IO a) -> IO a
    withRepo :: forall a.
[URI] -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
withRepo [URI]
_ forall (down :: * -> *). Repository down -> IO a
callback | URI -> FilePath
uriScheme URI
remoteRepoURI forall a. Eq a => a -> a -> Bool
== FilePath
"file:" = do
      Path Absolute
dir <- FsPath -> IO (Path Absolute)
Sec.makeAbsolute forall a b. (a -> b) -> a -> b
$ FilePath -> FsPath
Sec.fromFilePath (URI -> FilePath
uriPath URI
remoteRepoURI)
      forall a.
Path Absolute
-> Cache
-> RepoLayout
-> IndexLayout
-> (LogMessage -> IO ())
-> (Repository LocalFile -> IO a)
-> IO a
Sec.Local.withRepository Path Absolute
dir
                               Cache
cache
                               RepoLayout
Sec.hackageRepoLayout
                               IndexLayout
Sec.hackageIndexLayout
                               LogMessage -> IO ()
logTUF
                               forall (down :: * -> *). Repository down -> IO a
callback
    withRepo [URI]
mirrors forall (down :: * -> *). Repository down -> IO a
callback =
      forall a.
HttpLib
-> [URI]
-> RepoOpts
-> Cache
-> RepoLayout
-> IndexLayout
-> (LogMessage -> IO ())
-> (Repository RemoteTemp -> IO a)
-> IO a
Sec.Remote.withRepository HttpLib
httpLib
                                (URI
remoteRepoURIforall a. a -> [a] -> [a]
:[URI]
mirrors)
                                RepoOpts
Sec.Remote.defaultRepoOpts
                                Cache
cache
                                RepoLayout
Sec.hackageRepoLayout
                                IndexLayout
Sec.hackageIndexLayout
                                LogMessage -> IO ()
logTUF
                                forall (down :: * -> *). Repository down -> IO a
callback

    cache :: Sec.Cache
    cache :: Cache
cache = Sec.Cache {
        cacheRoot :: Path Absolute
cacheRoot   = Path Absolute
cachePath
      , cacheLayout :: CacheLayout
cacheLayout = CacheLayout
Sec.cabalCacheLayout {
            cacheLayoutIndexTar :: CachePath
Sec.cacheLayoutIndexTar   = FilePath -> CachePath
cacheFn FilePath
"01-index.tar"
          , cacheLayoutIndexIdx :: CachePath
Sec.cacheLayoutIndexIdx   = FilePath -> CachePath
cacheFn FilePath
"01-index.tar.idx"
          , cacheLayoutIndexTarGz :: CachePath
Sec.cacheLayoutIndexTarGz = FilePath -> CachePath
cacheFn FilePath
"01-index.tar.gz"
          }
      }

    cacheFn :: FilePath -> Sec.CachePath
    cacheFn :: FilePath -> CachePath
cacheFn = forall root. Path Unrooted -> Path root
Sec.rootPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Path Unrooted
Sec.fragment

    -- We display any TUF progress only in verbose mode, including any transient
    -- verification errors. If verification fails, then the final exception that
    -- is thrown will of course be shown.
    logTUF :: Sec.LogMessage -> IO ()
    logTUF :: LogMessage -> IO ()
logTUF = Verbosity -> FilePath -> IO ()
info Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> FilePath
Sec.pretty