    {-# LANGUAGE CPP #-}
    -- | An implementation of Repository that talks to repositories over HTTP.
    --
    -- This implementation is itself parameterized over a 'HttpClient', so that it
    -- it not tied to a specific library; for instance, 'HttpClient' can be
    -- implemented with the @HTTP@ library, the @http-client@ libary, or others.
    --
    -- It would also be possible to give _other_ Repository implementations that
    -- talk to repositories over HTTP, if you want to make other design decisions
    -- than we did here, in particular:
    --
    -- * We attempt to do incremental downloads of the index when possible.
    -- * We reuse the "Repository.Local"  to deal with the local cache.
    -- * We download @timestamp.json@ and @snapshot.json@ together. This is
    --   implemented here because:
    --   - One level down (HttpClient) we have no access to the local cache
    --   - One level up (Repository API) would require _all_ Repositories to
    --     implement this optimization.
    module Hackage.Security.Client.Repository.Remote (
        -- * Top-level API
        withRepository
      , RepoOpts(..)
      , defaultRepoOpts
      , RemoteTemp
         -- * File sizes
      , FileSize(..)
      , fileSizeWithinBounds
      ) where

    import Prelude
    import Control.Concurrent
    import Control.Exception
    import Control.Monad (when, unless)
    import Control.Monad.IO.Class (MonadIO)
    import Data.Kind (Type)
    import Data.List (nub, intercalate)
    import Network.URI hiding (uriPath, path)
    import System.IO ()
    import qualified Data.ByteString      as BS
    import qualified Data.ByteString.Lazy as BS.L

    import Hackage.Security.Client.Formats
    import Hackage.Security.Client.Repository
    import Hackage.Security.Client.Repository.Cache (Cache)
    import Hackage.Security.Client.Repository.HttpLib
    import Hackage.Security.Client.Verify
    import Hackage.Security.Trusted
    import Hackage.Security.TUF
    import Hackage.Security.Util.Checked
    import Hackage.Security.Util.IO
    import Hackage.Security.Util.Path
    import Hackage.Security.Util.Pretty
    import Hackage.Security.Util.Some
    import Hackage.Security.Util.Exit
    import qualified Hackage.Security.Client.Repository.Cache as Cache

    {-------------------------------------------------------------------------------
      Server capabilities
    -------------------------------------------------------------------------------}

    -- | Server capabilities
    --
    -- As the library interacts with the server and receives replies, we may
    -- discover more information about the server's capabilities; for instance,
    -- we may discover that it supports incremental downloads.
    newtype ServerCapabilities = SC (MVar ServerCapabilities_)

    -- | Internal type recording the various server capabilities we support
    data ServerCapabilities_ = ServerCapabilities {
          -- | Does the server support range requests?
          ServerCapabilities_ -> Bool
    serverAcceptRangesBytes :: Bool
        }

    newServerCapabilities :: IO ServerCapabilities
    newServerCapabilities :: IO ServerCapabilities
    newServerCapabilities = MVar ServerCapabilities_ -> ServerCapabilities
    SC (MVar ServerCapabilities_ -> ServerCapabilities)
    -> IO (MVar ServerCapabilities_) -> IO ServerCapabilities
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ServerCapabilities_ -> IO (MVar ServerCapabilities_)
    forall a. a -> IO (MVar a)
    newMVar ServerCapabilities {
          serverAcceptRangesBytes :: Bool
    serverAcceptRangesBytes      = Bool
    False
        }

    updateServerCapabilities :: ServerCapabilities -> [HttpResponseHeader] -> IO ()
    updateServerCapabilities :: ServerCapabilities -> [HttpResponseHeader] -> IO ()
    updateServerCapabilities (SC MVar ServerCapabilities_
    mv) [HttpResponseHeader]
    responseHeaders = MVar ServerCapabilities_
    -> (ServerCapabilities_ -> IO ServerCapabilities_) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar ServerCapabilities_
    mv ((ServerCapabilities_ -> IO ServerCapabilities_) -> IO ())
    -> (ServerCapabilities_ -> IO ServerCapabilities_) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ServerCapabilities_
    caps ->
        ServerCapabilities_ -> IO ServerCapabilities_
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ServerCapabilities_ -> IO ServerCapabilities_)
    -> ServerCapabilities_ -> IO ServerCapabilities_
    forall a b. (a -> b) -> a -> b
    $ ServerCapabilities_
    caps {
            serverAcceptRangesBytes = serverAcceptRangesBytes caps
              || HttpResponseAcceptRangesBytes `elem` responseHeaders
          }

    checkServerCapability :: MonadIO m
                          => ServerCapabilities -> (ServerCapabilities_ -> a) -> m a
    checkServerCapability :: forall (m :: * -> *) a.
    MonadIO m =>
    ServerCapabilities -> (ServerCapabilities_ -> a) -> m a
    checkServerCapability (SC MVar ServerCapabilities_
    mv) ServerCapabilities_ -> a
    f = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ MVar ServerCapabilities_ -> (ServerCapabilities_ -> IO a) -> IO a
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ServerCapabilities_
    mv ((ServerCapabilities_ -> IO a) -> IO a)
    -> (ServerCapabilities_ -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a)
    -> (ServerCapabilities_ -> a) -> ServerCapabilities_ -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ServerCapabilities_ -> a
    f

    {-------------------------------------------------------------------------------
      File size
    -------------------------------------------------------------------------------}

    data FileSize =
        -- | For most files we download we know the exact size beforehand
        -- (because this information comes from the snapshot or delegated info)
        FileSizeExact Int54

        -- | For some files we might not know the size beforehand, but we might
        -- be able to provide an upper bound (timestamp, root info)
      | FileSizeBound Int54
      deriving Int -> FileSize -> ShowS
    [FileSize] -> ShowS
    FileSize -> String
    (Int -> FileSize -> ShowS)
    -> (FileSize -> String) -> ([FileSize] -> ShowS) -> Show FileSize
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FileSize -> ShowS
    showsPrec :: Int -> FileSize -> ShowS
    $cshow :: FileSize -> String
    show :: FileSize -> String
    $cshowList :: [FileSize] -> ShowS
    showList :: [FileSize] -> ShowS
    Show

    fileSizeWithinBounds :: Int54 -> FileSize -> Bool
    fileSizeWithinBounds :: Int54 -> FileSize -> Bool
    fileSizeWithinBounds Int54
    sz (FileSizeExact Int54
    sz') = Int54
    sz Int54 -> Int54 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int54
    sz'
    fileSizeWithinBounds Int54
    sz (FileSizeBound Int54
    sz') = Int54
    sz Int54 -> Int54 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int54
    sz'

    {-------------------------------------------------------------------------------
      Top-level API
    -------------------------------------------------------------------------------}

    -- | Repository options with a reasonable default
    --
    -- Clients should use 'defaultRepositoryOpts' and override required settings.
    data RepoOpts = RepoOpts {
          -- | Allow additional mirrors?
          --
          -- If this is set to True (default), in addition to the (out-of-band)
          -- specified mirrors we will also use mirrors reported by those
          -- out-of-band mirrors (that is, @mirrors.json@).
          RepoOpts -> Bool
    repoAllowAdditionalMirrors :: Bool
        }

    -- | Default repository options
    defaultRepoOpts :: RepoOpts
    defaultRepoOpts :: RepoOpts
    defaultRepoOpts = RepoOpts {
          repoAllowAdditionalMirrors :: Bool
    repoAllowAdditionalMirrors = Bool
    True
        }

    -- | Initialize the repository (and cleanup resources afterwards)
    --
    -- We allow to specify multiple mirrors to initialize the repository. These
    -- are mirrors that can be found "out of band" (out of the scope of the TUF
    -- protocol), for example in a @cabal.config@ file. The TUF protocol itself
    -- will specify that any of these mirrors can serve a @mirrors.json@ file
    -- that itself contains mirrors; we consider these as _additional_ mirrors
    -- to the ones that are passed here.
    --
    -- NOTE: The list of mirrors should be non-empty (and should typically include
    -- the primary server).
    --
    -- TODO: In the future we could allow finer control over precisely which
    -- mirrors we use (which combination of the mirrors that are passed as arguments
    -- here and the mirrors that we get from @mirrors.json@) as well as indicating
    -- mirror preferences.
    withRepository
      :: HttpLib                          -- ^ Implementation of the HTTP protocol
      -> [URI]                            -- ^ "Out of band" list of mirrors
      -> RepoOpts                         -- ^ Repository options
      -> Cache                            -- ^ Location of local cache
      -> RepoLayout                       -- ^ Repository layout
      -> IndexLayout                      -- ^ Index layout
      -> (LogMessage -> IO ())            -- ^ Logger
      -> (Repository RemoteTemp -> IO a)  -- ^ Callback
      -> IO a
    withRepository :: forall a.
    HttpLib
    -> [URI]
    -> RepoOpts
    -> Cache
    -> RepoLayout
    -> IndexLayout
    -> (LogMessage -> IO ())
    -> (Repository RemoteTemp -> IO a)
    -> IO a
    withRepository HttpLib
    httpLib
                   [URI]
    outOfBandMirrors
                   RepoOpts
    repoOpts
                   Cache
    cache
                   RepoLayout
    repLayout
                   IndexLayout
    repIndexLayout
                   LogMessage -> IO ()
    logger
                   Repository RemoteTemp -> IO a
    callback
                   = do
        selectedMirror <- Maybe URI -> IO (MVar (Maybe URI))
    forall a. a -> IO (MVar a)
    newMVar Maybe URI
    forall a. Maybe a
    Nothing
        caps <- newServerCapabilities
        let remoteConfig URI
    mirror = RemoteConfig {
                                      cfgLayout :: RepoLayout
    cfgLayout   = RepoLayout
    repLayout
                                    , cfgHttpLib :: HttpLib
    cfgHttpLib  = HttpLib
    httpLib
                                    , cfgBase :: URI
    cfgBase     = URI
    mirror
                                    , cfgCache :: Cache
    cfgCache    = Cache
    cache
                                    , cfgCaps :: ServerCapabilities
    cfgCaps     = ServerCapabilities
    caps
                                    , cfgLogger :: forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLogger   = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (LogMessage -> IO ()) -> LogMessage -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogMessage -> IO ()
    logger
                                    , cfgOpts :: RepoOpts
    cfgOpts     = RepoOpts
    repoOpts
                                    }
        callback Repository {
            repGetRemote     = getRemote remoteConfig selectedMirror
          , repGetCached     = Cache.getCached     cache
          , repGetCachedRoot = Cache.getCachedRoot cache
          , repClearCache    = Cache.clearCache    cache
          , repWithIndex     = Cache.withIndex     cache
          , repGetIndexIdx   = Cache.getIndexIdx   cache
          , repLockCache     = Cache.lockCacheWithLogger logger cache
          , repWithMirror    = withMirror httpLib
                                          selectedMirror
                                          logger
                                          outOfBandMirrors
                                          repoOpts
          , repLog           = logger
          , repLayout        = repLayout
          , repIndexLayout   = repIndexLayout
          , repDescription   = "Remote repository at " ++ show outOfBandMirrors
          }

    {-------------------------------------------------------------------------------
      Implementations of the various methods of Repository
    -------------------------------------------------------------------------------}

    -- | We select a mirror in 'withMirror' (the implementation of 'repWithMirror').
    -- Outside the scope of 'withMirror' no mirror is selected, and a call to
    -- 'getRemote' will throw an exception. If this exception is ever thrown its
    -- a bug: calls to 'getRemote' ('repGetRemote') should _always_ be in the
    -- scope of 'repWithMirror'.
    type SelectedMirror = MVar (Maybe URI)

    -- | Get the selected mirror
    --
    -- Throws an exception if no mirror was selected (this would be a bug in the
    -- client code).
    --
    -- NOTE: Cannot use 'withMVar' here, because the callback would be inside the
    -- scope of the withMVar, and there might be further calls to 'withRemote' made
    -- by the callback argument to 'withRemote', leading to deadlock.
    getSelectedMirror :: SelectedMirror -> IO URI
    getSelectedMirror :: MVar (Maybe URI) -> IO URI
    getSelectedMirror MVar (Maybe URI)
    selectedMirror = do
         mBaseURI <- MVar (Maybe URI) -> IO (Maybe URI)
    forall a. MVar a -> IO a
    readMVar MVar (Maybe URI)
    selectedMirror
         case mBaseURI of
           Maybe URI
    Nothing      -> String -> IO URI
    forall a. String -> IO a
    internalError String
    "Internal error: no mirror selected"
           Just URI
    baseURI -> URI -> IO URI
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return URI
    baseURI

    -- | Get a file from the server
    getRemote :: Throws SomeRemoteError
              => (URI -> RemoteConfig)
              -> SelectedMirror
              -> AttemptNr
              -> RemoteFile fs typ
              -> Verify (Some (HasFormat fs), RemoteTemp typ)
    getRemote :: forall fs typ.
    Throws SomeRemoteError =>
    (URI -> RemoteConfig)
    -> MVar (Maybe URI)
    -> AttemptNr
    -> RemoteFile fs typ
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    getRemote URI -> RemoteConfig
    remoteConfig MVar (Maybe URI)
    selectedMirror AttemptNr
    attemptNr RemoteFile fs typ
    remoteFile = do
        baseURI <- IO URI -> Verify URI
    forall a. IO a -> Verify a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO URI -> Verify URI) -> IO URI -> Verify URI
    forall a b. (a -> b) -> a -> b
    $ MVar (Maybe URI) -> IO URI
    getSelectedMirror MVar (Maybe URI)
    selectedMirror
        let cfg = URI -> RemoteConfig
    remoteConfig URI
    baseURI
        downloadMethod <- liftIO $ pickDownloadMethod cfg attemptNr remoteFile
        getFile cfg attemptNr remoteFile downloadMethod

    -- | HTTP options
    --
    -- We want to make sure caches don't transform files in any way (as this will
    -- mess things up with respect to hashes etc). Additionally, after a validation
    -- error we want to make sure caches get files upstream in case the validation
    -- error was because the cache updated files out of order.
    httpRequestHeaders :: RemoteConfig -> AttemptNr -> [HttpRequestHeader]
    httpRequestHeaders :: RemoteConfig -> AttemptNr -> [HttpRequestHeader]
    httpRequestHeaders RemoteConfig{} AttemptNr
    attemptNr =
        if AttemptNr
    attemptNr AttemptNr -> AttemptNr -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttemptNr
    0 then [HttpRequestHeader]
    defaultHeaders
                          else HttpRequestHeader
    HttpRequestMaxAge0 HttpRequestHeader -> [HttpRequestHeader] -> [HttpRequestHeader]
    forall a. a -> [a] -> [a]
    : [HttpRequestHeader]
    defaultHeaders
      where
        -- Headers we provide for _every_ attempt, first or not
        defaultHeaders :: [HttpRequestHeader]
        defaultHeaders :: [HttpRequestHeader]
    defaultHeaders = [HttpRequestHeader
    HttpRequestNoTransform]

    -- | Mirror selection
    withMirror :: forall a.
                  HttpLib                -- ^ HTTP client
               -> SelectedMirror         -- ^ MVar indicating currently mirror
               -> (LogMessage -> IO ())  -- ^ Logger
               -> [URI]                  -- ^ Out-of-band mirrors
               -> RepoOpts               -- ^ Repository options
               -> Maybe [Mirror]         -- ^ TUF mirrors
               -> IO a                   -- ^ Callback
               -> IO a
    withMirror :: forall a.
    HttpLib
    -> MVar (Maybe URI)
    -> (LogMessage -> IO ())
    -> [URI]
    -> RepoOpts
    -> Maybe [Mirror]
    -> IO a
    -> IO a
    withMirror HttpLib{}
               MVar (Maybe URI)
    selectedMirror
               LogMessage -> IO ()
    logger
               [URI]
    oobMirrors
               RepoOpts
    repoOpts
               Maybe [Mirror]
    tufMirrors
               IO a
    callback
               =
        [URI] -> IO a
    go [URI]
    orderedMirrors
      where
        go :: [URI] -> IO a
        -- Empty list of mirrors is a bug
        go :: [URI] -> IO a
    go [] = String -> IO a
    forall a. String -> IO a
    internalError String
    "No mirrors configured"
        -- If we only have a single mirror left, let exceptions be thrown up
        go [URI
    m] = do
          LogMessage -> IO ()
    logger (LogMessage -> IO ()) -> LogMessage -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> LogMessage
    LogSelectedMirror (URI -> String
    forall a. Show a => a -> String
    show URI
    m)
          URI -> IO a -> IO a
    select URI
    m (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ IO a
    callback
        -- Otherwise, catch exceptions and if any were thrown, try with different
        -- mirror
        go (URI
    m:[URI]
    ms) = do
          LogMessage -> IO ()
    logger (LogMessage -> IO ()) -> LogMessage -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> LogMessage
    LogSelectedMirror (URI -> String
    forall a. Show a => a -> String
    show URI
    m)
          (Throws SomeException => IO a) -> (SomeException -> IO a) -> IO a
    forall a e.
    Exception e =>
    (Throws e => IO a) -> (e -> IO a) -> IO a
    catchChecked (URI -> IO a -> IO a
    select URI
    m IO a
    callback) ((SomeException -> IO a) -> IO a)
    -> (SomeException -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \SomeException
    ex -> do
            LogMessage -> IO ()
    logger (LogMessage -> IO ()) -> LogMessage -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> SomeException -> LogMessage
    LogMirrorFailed (URI -> String
    forall a. Show a => a -> String
    show URI
    m) SomeException
    ex
            [URI] -> IO a
    go [URI]
    ms

        -- TODO: We will want to make the construction of this list configurable.
        orderedMirrors :: [URI]
        orderedMirrors :: [URI]
    orderedMirrors = [URI] -> [URI]
    forall a. Eq a => [a] -> [a]
    nub ([URI] -> [URI]) -> [URI] -> [URI]
    forall a b. (a -> b) -> a -> b
    $ [[URI]] -> [URI]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [
            [URI]
    oobMirrors
          , if RepoOpts -> Bool
    repoAllowAdditionalMirrors RepoOpts
    repoOpts
              then [URI] -> ([Mirror] -> [URI]) -> Maybe [Mirror] -> [URI]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] ((Mirror -> URI) -> [Mirror] -> [URI]
    forall a b. (a -> b) -> [a] -> [b]
    map Mirror -> URI
    mirrorUrlBase) Maybe [Mirror]
    tufMirrors
              else []
          ]

        select :: URI -> IO a -> IO a
        select :: URI -> IO a -> IO a
    select URI
    uri =
          IO () -> IO () -> IO a -> IO a
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ (MVar (Maybe URI) -> (Maybe URI -> IO (Maybe URI)) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar (Maybe URI)
    selectedMirror ((Maybe URI -> IO (Maybe URI)) -> IO ())
    -> (Maybe URI -> IO (Maybe URI)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Maybe URI
    _ -> Maybe URI -> IO (Maybe URI)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe URI -> IO (Maybe URI)) -> Maybe URI -> IO (Maybe URI)
    forall a b. (a -> b) -> a -> b
    $ URI -> Maybe URI
    forall a. a -> Maybe a
    Just URI
    uri)
                   (MVar (Maybe URI) -> (Maybe URI -> IO (Maybe URI)) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar (Maybe URI)
    selectedMirror ((Maybe URI -> IO (Maybe URI)) -> IO ())
    -> (Maybe URI -> IO (Maybe URI)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Maybe URI
    _ -> Maybe URI -> IO (Maybe URI)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe URI
    forall a. Maybe a
    Nothing)

    {-------------------------------------------------------------------------------
      Download methods
    -------------------------------------------------------------------------------}

    -- | Download method (downloading or updating)
    data DownloadMethod :: Type -> Type -> Type where
        -- Download this file (we never attempt to update this type of file)
        NeverUpdated :: {
            ()
    neverUpdatedFormat :: HasFormat fs f
          } -> DownloadMethod fs typ

        -- Download this file (we cannot update this file right now)
        CannotUpdate :: {
            ()
    cannotUpdateFormat :: HasFormat fs f
          , forall fs. DownloadMethod fs Binary -> UpdateFailure
    cannotUpdateReason :: UpdateFailure
          } -> DownloadMethod fs Binary

        -- Attempt an (incremental) update of this file
        Update :: {
            ()
    updateFormat :: HasFormat fs f
          , forall fs. DownloadMethod fs Binary -> Trusted FileInfo
    updateInfo   :: Trusted FileInfo
          , forall fs. DownloadMethod fs Binary -> Path Absolute
    updateLocal  :: Path Absolute
          , forall fs. DownloadMethod fs Binary -> Int54
    updateTail   :: Int54
          } -> DownloadMethod fs Binary
    --TODO: ^^ older haddock doesn't support GADT doc comments :-(

    pickDownloadMethod :: forall fs typ. RemoteConfig
                       -> AttemptNr
                       -> RemoteFile fs typ
                       -> IO (DownloadMethod fs typ)
    pickDownloadMethod :: forall fs typ.
    RemoteConfig
    -> AttemptNr -> RemoteFile fs typ -> IO (DownloadMethod fs typ)
    pickDownloadMethod RemoteConfig{URI
    RepoLayout
    HttpLib
    Cache
    RepoOpts
    ServerCapabilities
    forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLayout :: RemoteConfig -> RepoLayout
    cfgHttpLib :: RemoteConfig -> HttpLib
    cfgBase :: RemoteConfig -> URI
    cfgCache :: RemoteConfig -> Cache
    cfgCaps :: RemoteConfig -> ServerCapabilities
    cfgLogger :: RemoteConfig
    -> forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgOpts :: RemoteConfig -> RepoOpts
    cfgLayout :: RepoLayout
    cfgHttpLib :: HttpLib
    cfgBase :: URI
    cfgCache :: Cache
    cfgCaps :: ServerCapabilities
    cfgLogger :: forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgOpts :: RepoOpts
    ..} AttemptNr
    attemptNr RemoteFile fs typ
    remoteFile =
        case RemoteFile fs typ
    remoteFile of
          RemoteFile fs typ
    RemoteTimestamp        -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DownloadMethod fs typ -> IO (DownloadMethod fs typ))
    -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a b. (a -> b) -> a -> b
    $ HasFormat fs FormatUn -> DownloadMethod fs typ
    forall fs f typ. HasFormat fs f -> DownloadMethod fs typ
    NeverUpdated (Format FormatUn -> HasFormat (FormatUn :- ()) FormatUn
    forall b fs. Format b -> HasFormat (b :- fs) b
    HFZ Format FormatUn
    FUn)
          (RemoteRoot Maybe (Trusted FileInfo)
    _)         -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DownloadMethod fs typ -> IO (DownloadMethod fs typ))
    -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a b. (a -> b) -> a -> b
    $ HasFormat fs FormatUn -> DownloadMethod fs typ
    forall fs f typ. HasFormat fs f -> DownloadMethod fs typ
    NeverUpdated (Format FormatUn -> HasFormat (FormatUn :- ()) FormatUn
    forall b fs. Format b -> HasFormat (b :- fs) b
    HFZ Format FormatUn
    FUn)
          (RemoteSnapshot Trusted FileInfo
    _)     -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DownloadMethod fs typ -> IO (DownloadMethod fs typ))
    -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a b. (a -> b) -> a -> b
    $ HasFormat fs FormatUn -> DownloadMethod fs typ
    forall fs f typ. HasFormat fs f -> DownloadMethod fs typ
    NeverUpdated (Format FormatUn -> HasFormat (FormatUn :- ()) FormatUn
    forall b fs. Format b -> HasFormat (b :- fs) b
    HFZ Format FormatUn
    FUn)
          (RemoteMirrors Trusted FileInfo
    _)      -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DownloadMethod fs typ -> IO (DownloadMethod fs typ))
    -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a b. (a -> b) -> a -> b
    $ HasFormat fs FormatUn -> DownloadMethod fs typ
    forall fs f typ. HasFormat fs f -> DownloadMethod fs typ
    NeverUpdated (Format FormatUn -> HasFormat (FormatUn :- ()) FormatUn
    forall b fs. Format b -> HasFormat (b :- fs) b
    HFZ Format FormatUn
    FUn)
          (RemotePkgTarGz PackageIdentifier
    _ Trusted FileInfo
    _)   -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DownloadMethod fs typ -> IO (DownloadMethod fs typ))
    -> DownloadMethod fs typ -> IO (DownloadMethod fs typ)
    forall a b. (a -> b) -> a -> b
    $ HasFormat fs FormatGz -> DownloadMethod fs typ
    forall fs f typ. HasFormat fs f -> DownloadMethod fs typ
    NeverUpdated (Format FormatGz -> HasFormat (FormatGz :- ()) FormatGz
    forall b fs. Format b -> HasFormat (b :- fs) b
    HFZ Format FormatGz
    FGz)
          (RemoteIndex HasFormat fs FormatGz
    hasGz Formats fs (Trusted FileInfo)
    formats) -> ExceptT (DownloadMethod fs typ) IO (DownloadMethod fs typ)
    -> IO (DownloadMethod fs typ)
    forall (m :: * -> *) a. Monad m => ExceptT a m a -> m a
    multipleExitPoints (ExceptT (DownloadMethod fs typ) IO (DownloadMethod fs typ)
     -> IO (DownloadMethod fs typ))
    -> ExceptT (DownloadMethod fs typ) IO (DownloadMethod fs typ)
    -> IO (DownloadMethod fs typ)
    forall a b. (a -> b) -> a -> b
    $ do
            -- Server must support @Range@ with a byte-range
            rangeSupport <- ServerCapabilities
    -> (ServerCapabilities_ -> Bool)
    -> ExceptT (DownloadMethod fs typ) IO Bool
    forall (m :: * -> *) a.
    MonadIO m =>
    ServerCapabilities -> (ServerCapabilities_ -> a) -> m a
    checkServerCapability ServerCapabilities
    cfgCaps ServerCapabilities_ -> Bool
    serverAcceptRangesBytes
            unless rangeSupport $ exit $ CannotUpdate hasGz UpdateImpossibleUnsupported

            -- We must already have a local file to be updated
            mCachedIndex <- liftIO $ Cache.getCachedIndex cfgCache (hasFormatGet hasGz)
            cachedIndex  <- case mCachedIndex of
              Maybe (Path Absolute)
    Nothing -> DownloadMethod fs typ
    -> ExceptT (DownloadMethod fs typ) IO (Path Absolute)
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    exit (DownloadMethod fs typ
     -> ExceptT (DownloadMethod fs typ) IO (Path Absolute))
    -> DownloadMethod fs typ
    -> ExceptT (DownloadMethod fs typ) IO (Path Absolute)
    forall a b. (a -> b) -> a -> b
    $ HasFormat fs FormatGz -> UpdateFailure -> DownloadMethod fs Binary
    forall fs f.
    HasFormat fs f -> UpdateFailure -> DownloadMethod fs Binary
    CannotUpdate HasFormat fs FormatGz
    hasGz UpdateFailure
    UpdateImpossibleNoLocalCopy
              Just Path Absolute
    fp -> Path Absolute -> ExceptT (DownloadMethod fs typ) IO (Path Absolute)
    forall a. a -> ExceptT (DownloadMethod fs typ) IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Path Absolute
    fp

            -- We attempt an incremental update a maximum of 2 times
            -- See 'UpdateFailedTwice' for details.
            when (attemptNr >= 2) $ exit $ CannotUpdate hasGz UpdateFailedTwice

            -- If all these checks pass try to do an incremental update.
            return Update {
                 updateFormat = hasGz
               , updateInfo   = formatsLookup hasGz formats
               , updateLocal  = cachedIndex
               , updateTail   = 65536 -- max gzip block size
               }

    -- | Download the specified file using the given download method
    getFile :: forall fs typ. Throws SomeRemoteError
            => RemoteConfig          -- ^ Internal configuration
            -> AttemptNr             -- ^ Did a security check previously fail?
            -> RemoteFile fs typ     -- ^ File to get
            -> DownloadMethod fs typ -- ^ Selected format
            -> Verify (Some (HasFormat fs), RemoteTemp typ)
    getFile :: forall fs typ.
    Throws SomeRemoteError =>
    RemoteConfig
    -> AttemptNr
    -> RemoteFile fs typ
    -> DownloadMethod fs typ
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    getFile cfg :: RemoteConfig
    cfg@RemoteConfig{URI
    RepoLayout
    HttpLib
    Cache
    RepoOpts
    ServerCapabilities
    forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLayout :: RemoteConfig -> RepoLayout
    cfgHttpLib :: RemoteConfig -> HttpLib
    cfgBase :: RemoteConfig -> URI
    cfgCache :: RemoteConfig -> Cache
    cfgCaps :: RemoteConfig -> ServerCapabilities
    cfgLogger :: RemoteConfig
    -> forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgOpts :: RemoteConfig -> RepoOpts
    cfgLayout :: RepoLayout
    cfgHttpLib :: HttpLib
    cfgBase :: URI
    cfgCache :: Cache
    cfgCaps :: ServerCapabilities
    cfgLogger :: forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgOpts :: RepoOpts
    ..} AttemptNr
    attemptNr RemoteFile fs typ
    remoteFile DownloadMethod fs typ
    method =
        DownloadMethod fs typ
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    go DownloadMethod fs typ
    method
      where
        go :: DownloadMethod fs typ -> Verify (Some (HasFormat fs), RemoteTemp typ)
        go :: DownloadMethod fs typ
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    go NeverUpdated{HasFormat fs f
    neverUpdatedFormat :: ()
    neverUpdatedFormat :: HasFormat fs f
    ..} = do
            LogMessage -> Verify ()
    forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLogger (LogMessage -> Verify ()) -> LogMessage -> Verify ()
    forall a b. (a -> b) -> a -> b
    $ RemoteFile fs typ -> LogMessage
    forall fs typ. RemoteFile fs typ -> LogMessage
    LogDownloading RemoteFile fs typ
    remoteFile
            HasFormat fs f -> Verify (Some (HasFormat fs), RemoteTemp typ)
    forall f.
    HasFormat fs f -> Verify (Some (HasFormat fs), RemoteTemp typ)
    download HasFormat fs f
    neverUpdatedFormat
        go CannotUpdate{HasFormat fs f
    UpdateFailure
    cannotUpdateFormat :: ()
    cannotUpdateReason :: forall fs. DownloadMethod fs Binary -> UpdateFailure
    cannotUpdateFormat :: HasFormat fs f
    cannotUpdateReason :: UpdateFailure
    ..} = do
            LogMessage -> Verify ()
    forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLogger (LogMessage -> Verify ()) -> LogMessage -> Verify ()
    forall a b. (a -> b) -> a -> b
    $ RemoteFile fs Binary -> UpdateFailure -> LogMessage
    forall fs. RemoteFile fs Binary -> UpdateFailure -> LogMessage
    LogCannotUpdate RemoteFile fs typ
    RemoteFile fs Binary
    remoteFile UpdateFailure
    cannotUpdateReason
            LogMessage -> Verify ()
    forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLogger (LogMessage -> Verify ()) -> LogMessage -> Verify ()
    forall a b. (a -> b) -> a -> b
    $ RemoteFile fs typ -> LogMessage
    forall fs typ. RemoteFile fs typ -> LogMessage
    LogDownloading RemoteFile fs typ
    remoteFile
            HasFormat fs f -> Verify (Some (HasFormat fs), RemoteTemp typ)
    forall f.
    HasFormat fs f -> Verify (Some (HasFormat fs), RemoteTemp typ)
    download HasFormat fs f
    cannotUpdateFormat
        go Update{Path Absolute
    HasFormat fs f
    Int54
    Trusted FileInfo
    updateFormat :: ()
    updateInfo :: forall fs. DownloadMethod fs Binary -> Trusted FileInfo
    updateLocal :: forall fs. DownloadMethod fs Binary -> Path Absolute
    updateTail :: forall fs. DownloadMethod fs Binary -> Int54
    updateFormat :: HasFormat fs f
    updateInfo :: Trusted FileInfo
    updateLocal :: Path Absolute
    updateTail :: Int54
    ..} = do
            LogMessage -> Verify ()
    forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLogger (LogMessage -> Verify ()) -> LogMessage -> Verify ()
    forall a b. (a -> b) -> a -> b
    $ RemoteFile fs Binary -> LogMessage
    forall fs. RemoteFile fs Binary -> LogMessage
    LogUpdating RemoteFile fs typ
    RemoteFile fs Binary
    remoteFile
            HasFormat fs f
    -> Trusted FileInfo
    -> Path Absolute
    -> Int54
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    forall f.
    (typ ~ Binary) =>
    HasFormat fs f
    -> Trusted FileInfo
    -> Path Absolute
    -> Int54
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    update HasFormat fs f
    updateFormat Trusted FileInfo
    updateInfo Path Absolute
    updateLocal Int54
    updateTail

        headers :: [HttpRequestHeader]
        headers :: [HttpRequestHeader]
    headers = RemoteConfig -> AttemptNr -> [HttpRequestHeader]
    httpRequestHeaders RemoteConfig
    cfg AttemptNr
    attemptNr

        -- Get any file from the server, without using incremental updates
        download :: HasFormat fs f -> Verify (Some (HasFormat fs), RemoteTemp typ)
        download :: forall f.
    HasFormat fs f -> Verify (Some (HasFormat fs), RemoteTemp typ)
    download HasFormat fs f
    format = do
            (tempPath, h) <- Path Absolute -> String -> Verify (Path Absolute, Handle)
    forall root.
    FsRoot root =>
    Path root -> String -> Verify (Path Absolute, Handle)
    openTempFile (Cache -> Path Absolute
    Cache.cacheRoot Cache
    cfgCache) (URI -> String
    uriTemplate URI
    uri)
            liftIO $ do
              httpGet headers uri $ \[HttpResponseHeader]
    responseHeaders BodyReader
    bodyReader -> do
                ServerCapabilities -> [HttpResponseHeader] -> IO ()
    updateServerCapabilities ServerCapabilities
    cfgCaps [HttpResponseHeader]
    responseHeaders
                Throws SomeRemoteError =>
    TargetPath -> FileSize -> Handle -> BodyReader -> IO ()
    TargetPath -> FileSize -> Handle -> BodyReader -> IO ()
    execBodyReader TargetPath
    targetPath FileSize
    sz Handle
    h BodyReader
    bodyReader
              hClose h
            cacheIfVerified format $ DownloadedWhole tempPath
          where
            targetPath :: TargetPath
    targetPath = RepoPath -> TargetPath
    TargetPathRepo (RepoPath -> TargetPath) -> RepoPath -> TargetPath
    forall a b. (a -> b) -> a -> b
    $ RepoLayout -> RemoteFile fs typ -> HasFormat fs f -> RepoPath
    forall fs typ f.
    RepoLayout -> RemoteFile fs typ -> HasFormat fs f -> RepoPath
    remoteRepoPath' RepoLayout
    cfgLayout RemoteFile fs typ
    remoteFile HasFormat fs f
    format
            uri :: URI
    uri = HasFormat fs f -> Formats fs URI -> URI
    forall fs f a. HasFormat fs f -> Formats fs a -> a
    formatsLookup HasFormat fs f
    format (Formats fs URI -> URI) -> Formats fs URI -> URI
    forall a b. (a -> b) -> a -> b
    $ RepoLayout -> URI -> RemoteFile fs typ -> Formats fs URI
    forall fs typ.
    RepoLayout -> URI -> RemoteFile fs typ -> Formats fs URI
    remoteFileURI RepoLayout
    cfgLayout URI
    cfgBase RemoteFile fs typ
    remoteFile
            sz :: FileSize
    sz  = HasFormat fs f -> Formats fs FileSize -> FileSize
    forall fs f a. HasFormat fs f -> Formats fs a -> a
    formatsLookup HasFormat fs f
    format (Formats fs FileSize -> FileSize)
    -> Formats fs FileSize -> FileSize
    forall a b. (a -> b) -> a -> b
    $ RemoteFile fs typ -> Formats fs FileSize
    forall fs typ. RemoteFile fs typ -> Formats fs FileSize
    remoteFileSize RemoteFile fs typ
    remoteFile

        -- Get a file incrementally
        update :: (typ ~ Binary)
               => HasFormat fs f    -- ^ Selected format
               -> Trusted FileInfo  -- ^ Expected info
               -> Path Absolute     -- ^ Location of cached file (after callback)
               -> Int54             -- ^ How much of the tail to overwrite
               -> Verify (Some (HasFormat fs), RemoteTemp typ)
        update :: forall f.
    (typ ~ Binary) =>
    HasFormat fs f
    -> Trusted FileInfo
    -> Path Absolute
    -> Int54
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    update HasFormat fs f
    format Trusted FileInfo
    info Path Absolute
    cachedFile Int54
    fileTail = do
            currentSz <- IO Int54 -> Verify Int54
    forall a. IO a -> Verify a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Int54 -> Verify Int54) -> IO Int54 -> Verify Int54
    forall a b. (a -> b) -> a -> b
    $ Path Absolute -> IO Int54
    forall a root. (Num a, FsRoot root) => Path root -> IO a
    getFileSize Path Absolute
    cachedFile
            let fileSz    = Trusted FileInfo -> Int54
    fileLength' Trusted FileInfo
    info
                range     = (Int54
    0 Int54 -> Int54 -> Int54
    forall a. Ord a => a -> a -> a
    `max` (Int54
    currentSz Int54 -> Int54 -> Int54
    forall a. Num a => a -> a -> a
    - Int54
    fileTail), Int54
    fileSz)
                range'    = (Int54 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Int54, Int54) -> Int54
    forall a b. (a, b) -> a
    fst (Int54, Int54)
    range), Int54 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Int54, Int54) -> Int54
    forall a b. (a, b) -> b
    snd (Int54, Int54)
    range))
                cacheRoot = Cache -> Path Absolute
    Cache.cacheRoot Cache
    cfgCache
            (tempPath, h) <- openTempFile cacheRoot (uriTemplate uri)
            statusCode <- liftIO $
              httpGetRange headers uri range' $ \HttpStatus
    statusCode [HttpResponseHeader]
    responseHeaders BodyReader
    bodyReader -> do
                ServerCapabilities -> [HttpResponseHeader] -> IO ()
    updateServerCapabilities ServerCapabilities
    cfgCaps [HttpResponseHeader]
    responseHeaders
                let expectedSize :: FileSize
    expectedSize =
                      case HttpStatus
    statusCode of
                        HttpStatus
    HttpStatus206PartialContent ->
                          Int54 -> FileSize
    FileSizeExact ((Int54, Int54) -> Int54
    forall a b. (a, b) -> b
    snd (Int54, Int54)
    range Int54 -> Int54 -> Int54
    forall a. Num a => a -> a -> a
    - (Int54, Int54) -> Int54
    forall a b. (a, b) -> a
    fst (Int54, Int54)
    range)
                        HttpStatus
    HttpStatus200OK ->
                          Int54 -> FileSize
    FileSizeExact Int54
    fileSz
                Throws SomeRemoteError =>
    TargetPath -> FileSize -> Handle -> BodyReader -> IO ()
    TargetPath -> FileSize -> Handle -> BodyReader -> IO ()
    execBodyReader TargetPath
    targetPath FileSize
    expectedSize Handle
    h BodyReader
    bodyReader
                Handle -> IO ()
    hClose Handle
    h
                HttpStatus -> IO HttpStatus
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HttpStatus
    statusCode
            let downloaded =
                  case HttpStatus
    statusCode of
                    HttpStatus
    HttpStatus206PartialContent ->
                      DownloadedDelta {
                          deltaTemp :: Path Absolute
    deltaTemp     = Path Absolute
    tempPath
                        , deltaExisting :: Path Absolute
    deltaExisting = Path Absolute
    cachedFile
                        , deltaSeek :: Int54
    deltaSeek     = (Int54, Int54) -> Int54
    forall a b. (a, b) -> a
    fst (Int54, Int54)
    range
                        }
                    HttpStatus
    HttpStatus200OK ->
                      Path Absolute -> RemoteTemp Binary
    forall a. Path Absolute -> RemoteTemp a
    DownloadedWhole Path Absolute
    tempPath
            cacheIfVerified format downloaded
          where
            targetPath :: TargetPath
    targetPath = RepoPath -> TargetPath
    TargetPathRepo RepoPath
    repoPath
            uri :: URI
    uri        = URI -> (Path Web -> Path Web) -> URI
    modifyUriPath URI
    cfgBase (Path Web -> RepoPath -> Path Web
    `anchorRepoPathRemotely` RepoPath
    repoPath)
            repoPath :: RepoPath
    repoPath   = RepoLayout -> RemoteFile fs typ -> HasFormat fs f -> RepoPath
    forall fs typ f.
    RepoLayout -> RemoteFile fs typ -> HasFormat fs f -> RepoPath
    remoteRepoPath' RepoLayout
    cfgLayout RemoteFile fs typ
    remoteFile HasFormat fs f
    format

        cacheIfVerified :: HasFormat fs f -> RemoteTemp typ
                        -> Verify (Some (HasFormat fs), RemoteTemp typ)
        cacheIfVerified :: forall f.
    HasFormat fs f
    -> RemoteTemp typ -> Verify (Some (HasFormat fs), RemoteTemp typ)
    cacheIfVerified HasFormat fs f
    format RemoteTemp typ
    remoteTemp = do
            IO () -> Verify ()
    ifVerified (IO () -> Verify ()) -> IO () -> Verify ()
    forall a b. (a -> b) -> a -> b
    $
              Cache -> RemoteTemp typ -> Format f -> IsCached typ -> IO ()
    forall (down :: * -> *) typ f.
    DownloadedFile down =>
    Cache -> down typ -> Format f -> IsCached typ -> IO ()
    Cache.cacheRemoteFile Cache
    cfgCache
                                    RemoteTemp typ
    remoteTemp
                                    (HasFormat fs f -> Format f
    forall fs f. HasFormat fs f -> Format f
    hasFormatGet HasFormat fs f
    format)
                                    (RemoteFile fs typ -> IsCached typ
    forall fs typ. RemoteFile fs typ -> IsCached typ
    mustCache RemoteFile fs typ
    remoteFile)
            (Some (HasFormat fs), RemoteTemp typ)
    -> Verify (Some (HasFormat fs), RemoteTemp typ)
    forall a. a -> Verify a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HasFormat fs f -> Some (HasFormat fs)
    forall (f :: * -> *) a. f a -> Some f
    Some HasFormat fs f
    format, RemoteTemp typ
    remoteTemp)

        httpGetRange :: forall a. Throws SomeRemoteError
                     => [HttpRequestHeader]
                     -> URI
                     -> (Int, Int)
                     -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
                     -> IO a
        HttpLib{forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI
    -> (Int, Int)
    -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
    -> IO a
    forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a
    httpGet :: forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a
    httpGetRange :: forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI
    -> (Int, Int)
    -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
    -> IO a
    httpGetRange :: HttpLib
    -> forall a.
       Throws SomeRemoteError =>
       [HttpRequestHeader]
       -> URI
       -> (Int, Int)
       -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
       -> IO a
    httpGet :: HttpLib
    -> forall a.
       Throws SomeRemoteError =>
       [HttpRequestHeader]
       -> URI -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a
    ..} = HttpLib
    cfgHttpLib

    {-------------------------------------------------------------------------------
      Execute body reader
    -------------------------------------------------------------------------------}

    -- | Execute a body reader
    --
    -- TODO: Deal with minimum download rate.
    execBodyReader :: Throws SomeRemoteError
                   => TargetPath  -- ^ File source (for error msgs only)
                   -> FileSize    -- ^ Maximum file size
                   -> Handle      -- ^ Handle to write data too
                   -> BodyReader  -- ^ The action to give us blocks from the file
                   -> IO ()
    execBodyReader :: Throws SomeRemoteError =>
    TargetPath -> FileSize -> Handle -> BodyReader -> IO ()
    execBodyReader TargetPath
    file FileSize
    mlen Handle
    h BodyReader
    br = Int54 -> IO ()
    go Int54
    0
      where
        go :: Int54 -> IO ()
        go :: Int54 -> IO ()
    go Int54
    sz = do
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Int54
    sz Int54 -> FileSize -> Bool
    `fileSizeWithinBounds` FileSize
    mlen) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            SomeRemoteError -> IO ()
    forall e a. (Exception e, Throws e) => e -> IO a
    throwChecked (SomeRemoteError -> IO ()) -> SomeRemoteError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FileTooLarge -> SomeRemoteError
    forall e. Exception e => e -> SomeRemoteError
    SomeRemoteError (FileTooLarge -> SomeRemoteError)
    -> FileTooLarge -> SomeRemoteError
    forall a b. (a -> b) -> a -> b
    $ TargetPath -> FileSize -> FileTooLarge
    FileTooLarge TargetPath
    file FileSize
    mlen
          bs <- BodyReader
    br
          if BS.null bs
            then return ()
            else BS.hPut h bs >> go (sz + fromIntegral (BS.length bs))

    -- | The file we requested from the server was larger than expected
    -- (potential endless data attack)
    data FileTooLarge = FileTooLarge {
        FileTooLarge -> TargetPath
    fileTooLargePath     :: TargetPath
      , FileTooLarge -> FileSize
    fileTooLargeExpected :: FileSize
      }

    instance Pretty FileTooLarge where
      pretty :: FileTooLarge -> String
    pretty FileTooLarge{TargetPath
    FileSize
    fileTooLargePath :: FileTooLarge -> TargetPath
    fileTooLargeExpected :: FileTooLarge -> FileSize
    fileTooLargePath :: TargetPath
    fileTooLargeExpected :: FileSize
    ..} = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [
          String
    "file returned by server too large: "
        , TargetPath -> String
    forall a. Pretty a => a -> String
    pretty TargetPath
    fileTooLargePath
        , String
    " (expected " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FileSize -> String
    expected FileSize
    fileTooLargeExpected String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " bytes)"
        ]
        where
          expected :: FileSize -> String
          expected :: FileSize -> String
    expected (FileSizeExact Int54
    n) = String
    "exactly " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int54 -> String
    forall a. Show a => a -> String
    show Int54
    n
          expected (FileSizeBound Int54
    n) = String
    "at most " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int54 -> String
    forall a. Show a => a -> String
    show Int54
    n

    deriving instance Show FileTooLarge
    instance Exception FileTooLarge where displayException :: FileTooLarge -> String
    displayException = FileTooLarge -> String
    forall a. Pretty a => a -> String
    pretty

    {-------------------------------------------------------------------------------
      Information about remote files
    -------------------------------------------------------------------------------}

    remoteFileURI :: RepoLayout -> URI -> RemoteFile fs typ -> Formats fs URI
    remoteFileURI :: forall fs typ.
    RepoLayout -> URI -> RemoteFile fs typ -> Formats fs URI
    remoteFileURI RepoLayout
    repoLayout URI
    baseURI = (RepoPath -> URI) -> Formats fs RepoPath -> Formats fs URI
    forall a b. (a -> b) -> Formats fs a -> Formats fs b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap RepoPath -> URI
    aux (Formats fs RepoPath -> Formats fs URI)
    -> (RemoteFile fs typ -> Formats fs RepoPath)
    -> RemoteFile fs typ
    -> Formats fs URI
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RepoLayout -> RemoteFile fs typ -> Formats fs RepoPath
    forall fs typ.
    RepoLayout -> RemoteFile fs typ -> Formats fs RepoPath
    remoteRepoPath RepoLayout
    repoLayout
      where
        aux :: RepoPath -> URI
        aux :: RepoPath -> URI
    aux RepoPath
    repoPath = URI -> (Path Web -> Path Web) -> URI
    modifyUriPath URI
    baseURI (Path Web -> RepoPath -> Path Web
    `anchorRepoPathRemotely` RepoPath
    repoPath)

    -- | Extracting or estimating file sizes
    remoteFileSize :: RemoteFile fs typ -> Formats fs FileSize
    remoteFileSize :: forall fs typ. RemoteFile fs typ -> Formats fs FileSize
    remoteFileSize (RemoteFile fs typ
    RemoteTimestamp) =
        FileSize -> Formats (FormatUn :- ()) FileSize
    forall b. b -> Formats (FormatUn :- ()) b
    FsUn (FileSize -> Formats (FormatUn :- ()) FileSize)
    -> FileSize -> Formats (FormatUn :- ()) FileSize
    forall a b. (a -> b) -> a -> b
    $ Int54 -> FileSize
    FileSizeBound Int54
    fileSizeBoundTimestamp
    remoteFileSize (RemoteRoot Maybe (Trusted FileInfo)
    mLen) =
        FileSize -> Formats (FormatUn :- ()) FileSize
    forall b. b -> Formats (FormatUn :- ()) b
    FsUn (FileSize -> Formats (FormatUn :- ()) FileSize)
    -> FileSize -> Formats (FormatUn :- ()) FileSize
    forall a b. (a -> b) -> a -> b
    $ FileSize
    -> (Trusted FileInfo -> FileSize)
    -> Maybe (Trusted FileInfo)
    -> FileSize
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Int54 -> FileSize
    FileSizeBound Int54
    fileSizeBoundRoot)
                     (Int54 -> FileSize
    FileSizeExact (Int54 -> FileSize)
    -> (Trusted FileInfo -> Int54) -> Trusted FileInfo -> FileSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Trusted FileInfo -> Int54
    fileLength')
                     Maybe (Trusted FileInfo)
    mLen
    remoteFileSize (RemoteSnapshot Trusted FileInfo
    len) =
        FileSize -> Formats (FormatUn :- ()) FileSize
    forall b. b -> Formats (FormatUn :- ()) b
    FsUn (FileSize -> Formats (FormatUn :- ()) FileSize)
    -> FileSize -> Formats (FormatUn :- ()) FileSize
    forall a b. (a -> b) -> a -> b
    $ Int54 -> FileSize
    FileSizeExact (Trusted FileInfo -> Int54
    fileLength' Trusted FileInfo
    len)
    remoteFileSize (RemoteMirrors Trusted FileInfo
    len) =
        FileSize -> Formats (FormatUn :- ()) FileSize
    forall b. b -> Formats (FormatUn :- ()) b
    FsUn (FileSize -> Formats (FormatUn :- ()) FileSize)
    -> FileSize -> Formats (FormatUn :- ()) FileSize
    forall a b. (a -> b) -> a -> b
    $ Int54 -> FileSize
    FileSizeExact (Trusted FileInfo -> Int54
    fileLength' Trusted FileInfo
    len)
    remoteFileSize (RemoteIndex HasFormat fs FormatGz
    _ Formats fs (Trusted FileInfo)
    lens) =
        (Trusted FileInfo -> FileSize)
    -> Formats fs (Trusted FileInfo) -> Formats fs FileSize
    forall a b. (a -> b) -> Formats fs a -> Formats fs b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int54 -> FileSize
    FileSizeExact (Int54 -> FileSize)
    -> (Trusted FileInfo -> Int54) -> Trusted FileInfo -> FileSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Trusted FileInfo -> Int54
    fileLength') Formats fs (Trusted FileInfo)
    lens
    remoteFileSize (RemotePkgTarGz PackageIdentifier
    _pkgId Trusted FileInfo
    len) =
        FileSize -> Formats (FormatGz :- ()) FileSize
    forall b. b -> Formats (FormatGz :- ()) b
    FsGz (FileSize -> Formats (FormatGz :- ()) FileSize)
    -> FileSize -> Formats (FormatGz :- ()) FileSize
    forall a b. (a -> b) -> a -> b
    $ Int54 -> FileSize
    FileSizeExact (Trusted FileInfo -> Int54
    fileLength' Trusted FileInfo
    len)

    -- | Bound on the size of the timestamp
    --
    -- This is intended as a permissive rather than tight bound.
    --
    -- The timestamp signed with a single key is 420 bytes; the signature makes up
    -- just under 200 bytes of that. So even if the timestamp is signed with 10
    -- keys it would still only be 2420 bytes. Doubling this amount, an upper bound
    -- of 4kB should definitely be sufficient.
    fileSizeBoundTimestamp :: Int54
    fileSizeBoundTimestamp :: Int54
    fileSizeBoundTimestamp = Int54
    4096

    -- | Bound on the size of the root
    --
    -- This is intended as a permissive rather than tight bound.
    --
    -- The variable parts of the root metadata are
    --
    -- * Signatures, each of which are about 200 bytes
    -- * A key environment (mapping from key IDs to public keys), each is of
    --   which is also about 200 bytes
    -- * Mirrors, root, snapshot, targets, and timestamp role specifications.
    --   These contains key IDs, each of which is about 80 bytes.
    --
    -- A skeleton root metadata is about 580 bytes. Allowing for
    --
    -- * 100 signatures
    -- * 100 mirror keys, 1000 root keys, 100 snapshot keys, 1000 target keys,
    --   100 timestamp keys
    -- * the corresponding 2300 entries in the key environment
    --
    -- We end up with a bound of about 665,000 bytes. Doubling this amount, an
    -- upper bound of 2MB should definitely be sufficient.
    fileSizeBoundRoot :: Int54
    fileSizeBoundRoot :: Int54
    fileSizeBoundRoot = Int54
    2 Int54 -> Int54 -> Int54
    forall a. Num a => a -> a -> a
    * Int54
    1024 Int54 -> Int54 -> Int54
    forall a. Num a => a -> a -> a
    * Int54
    2014

    {-------------------------------------------------------------------------------
      Configuration
    -------------------------------------------------------------------------------}

    -- | Remote repository configuration
    --
    -- This is purely for internal convenience.
    data RemoteConfig = RemoteConfig {
          RemoteConfig -> RepoLayout
    cfgLayout   :: RepoLayout
        , RemoteConfig -> HttpLib
    cfgHttpLib  :: HttpLib
        , RemoteConfig -> URI
    cfgBase     :: URI
        , RemoteConfig -> Cache
    cfgCache    :: Cache
        , RemoteConfig -> ServerCapabilities
    cfgCaps     :: ServerCapabilities
        , RemoteConfig
    -> forall (m :: * -> *). MonadIO m => LogMessage -> m ()
    cfgLogger   :: forall m. MonadIO m => LogMessage -> m ()
        , RemoteConfig -> RepoOpts
    cfgOpts     :: RepoOpts
        }

    {-------------------------------------------------------------------------------
      Auxiliary
    -------------------------------------------------------------------------------}

    -- | Template for the local file we use to download a URI to
    uriTemplate :: URI -> String
    uriTemplate :: URI -> String
    uriTemplate = Path Web -> String
    forall a. Path a -> String
    takeFileName (Path Web -> String) -> (URI -> Path Web) -> URI -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . URI -> Path Web
    uriPath

    fileLength' :: Trusted FileInfo -> Int54
    fileLength' :: Trusted FileInfo -> Int54
    fileLength' = FileLength -> Int54
    fileLength (FileLength -> Int54)
    -> (Trusted FileInfo -> FileLength) -> Trusted FileInfo -> Int54
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FileInfo -> FileLength
    fileInfoLength (FileInfo -> FileLength)
    -> (Trusted FileInfo -> FileInfo) -> Trusted FileInfo -> FileLength
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Trusted FileInfo -> FileInfo
    forall a. Trusted a -> a
    trusted

    {-------------------------------------------------------------------------------
      Files downloaded from the remote repository
    -------------------------------------------------------------------------------}

    data RemoteTemp :: Type -> Type where
        DownloadedWhole :: {
            forall a. RemoteTemp a -> Path Absolute
    wholeTemp :: Path Absolute
          } -> RemoteTemp a

        -- If we download only the delta, we record both the path to where the
        -- "old" file is stored and the path to the temp file containing the delta.
        -- Then:
        --
        --   When we verify the file, we need both of these paths if we compute
        --   the hash from scratch, or only the path to the delta if we attempt
        --   to compute the hash incrementally (TODO: incremental verification
        --   not currently implemented).
        --
        --   When we copy a file over, we are additionally given a destination
        --   path. In this case, we expect that destination path to be equal to
        --   the path to the old file (and assert this to be the case).
        DownloadedDelta :: {
            RemoteTemp Binary -> Path Absolute
    deltaTemp     :: Path Absolute
          , RemoteTemp Binary -> Path Absolute
    deltaExisting :: Path Absolute
          , RemoteTemp Binary -> Int54
    deltaSeek     :: Int54       -- ^ How much of the existing file to keep
          } -> RemoteTemp Binary
    --TODO: ^^ older haddock doesn't support GADT doc comments :-(
    --      and add the '*' bullet points back in

    instance Pretty (RemoteTemp typ) where
        pretty :: RemoteTemp typ -> String
    pretty DownloadedWhole{Path Absolute
    wholeTemp :: forall a. RemoteTemp a -> Path Absolute
    wholeTemp :: Path Absolute
    ..} = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    " " ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [
            String
    "DownloadedWhole"
          , Path Absolute -> String
    forall a. Pretty a => a -> String
    pretty Path Absolute
    wholeTemp
          ]
        pretty DownloadedDelta{Path Absolute
    Int54
    deltaTemp :: RemoteTemp Binary -> Path Absolute
    deltaExisting :: RemoteTemp Binary -> Path Absolute
    deltaSeek :: RemoteTemp Binary -> Int54
    deltaTemp :: Path Absolute
    deltaExisting :: Path Absolute
    deltaSeek :: Int54
    ..} = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    " " ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [
            String
    "DownloadedDelta"
          , Path Absolute -> String
    forall a. Pretty a => a -> String
    pretty Path Absolute
    deltaTemp
          , Path Absolute -> String
    forall a. Pretty a => a -> String
    pretty Path Absolute
    deltaExisting
          , Int54 -> String
    forall a. Show a => a -> String
    show Int54
    deltaSeek
          ]

    instance DownloadedFile RemoteTemp where
      downloadedVerify :: forall a. RemoteTemp a -> Trusted FileInfo -> IO Bool
    downloadedVerify = RemoteTemp a -> Trusted FileInfo -> IO Bool
    forall a. RemoteTemp a -> Trusted FileInfo -> IO Bool
    verifyRemoteFile
      downloadedRead :: RemoteTemp Metadata -> IO ByteString
    downloadedRead   = Path Absolute -> IO ByteString
    forall root. FsRoot root => Path root -> IO ByteString
    readLazyByteString (Path Absolute -> IO ByteString)
    -> (RemoteTemp Metadata -> Path Absolute)
    -> RemoteTemp Metadata
    -> IO ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RemoteTemp Metadata -> Path Absolute
    forall a. RemoteTemp a -> Path Absolute
    wholeTemp
      downloadedCopyTo :: forall a. RemoteTemp a -> Path Absolute -> IO ()
    downloadedCopyTo = \RemoteTemp a
    f Path Absolute
    dest ->
        case RemoteTemp a
    f of
          DownloadedWhole{Path Absolute
    wholeTemp :: forall a. RemoteTemp a -> Path Absolute
    wholeTemp :: Path Absolute
    ..} ->
            Path Absolute -> Path Absolute -> IO ()
    forall root root'.
    (FsRoot root, FsRoot root') =>
    Path root -> Path root' -> IO ()
    renameFile Path Absolute
    wholeTemp Path Absolute
    dest
          DownloadedDelta{Path Absolute
    Int54
    deltaTemp :: RemoteTemp Binary -> Path Absolute
    deltaExisting :: RemoteTemp Binary -> Path Absolute
    deltaSeek :: RemoteTemp Binary -> Int54
    deltaTemp :: Path Absolute
    deltaExisting :: Path Absolute
    deltaSeek :: Int54
    ..} -> do
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Path Absolute
    deltaExisting Path Absolute -> Path Absolute -> Bool
    forall a. Eq a => a -> a -> Bool
    == Path Absolute
    dest) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              IOError -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (IOError -> IO ()) -> IOError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IOError
    userError String
    "Assertion failure: deltaExisting /= dest"
            -- We need ReadWriteMode in order to be able to seek
            Path Absolute -> IOMode -> (Handle -> IO ()) -> IO ()
    forall root r.
    FsRoot root =>
    Path root -> IOMode -> (Handle -> IO r) -> IO r
    withFile Path Absolute
    deltaExisting IOMode
    ReadWriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
              Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    h SeekMode
    AbsoluteSeek (Int54 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int54
    deltaSeek)
              Handle -> ByteString -> IO ()
    BS.L.hPut Handle
    h (ByteString -> IO ()) -> IO ByteString -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Path Absolute -> IO ByteString
    forall root. FsRoot root => Path root -> IO ByteString
    readLazyByteString Path Absolute
    deltaTemp

    -- | Verify a file downloaded from the remote repository
    --
    -- TODO: This currently still computes the hash for the whole file. If we cached
    -- the state of the hash generator we could compute the hash incrementally.
    -- However, profiling suggests that this would only be a minor improvement.
    verifyRemoteFile :: RemoteTemp typ -> Trusted FileInfo -> IO Bool
    verifyRemoteFile :: forall a. RemoteTemp a -> Trusted FileInfo -> IO Bool
    verifyRemoteFile RemoteTemp typ
    remoteTemp Trusted FileInfo
    trustedInfo = do
        sz <- Int54 -> FileLength
    FileLength (Int54 -> FileLength) -> IO Int54 -> IO FileLength
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RemoteTemp typ -> IO Int54
    forall typ. RemoteTemp typ -> IO Int54
    remoteSize RemoteTemp typ
    remoteTemp
        if sz /= fileInfoLength (trusted trustedInfo)
          then return False
          else withRemoteBS remoteTemp $
                 compareTrustedFileInfo (trusted trustedInfo) . fileInfo
      where
        remoteSize :: RemoteTemp typ -> IO Int54
        remoteSize :: forall typ. RemoteTemp typ -> IO Int54
    remoteSize DownloadedWhole{Path Absolute
    wholeTemp :: forall a. RemoteTemp a -> Path Absolute
    wholeTemp :: Path Absolute
    ..} = Path Absolute -> IO Int54
    forall a root. (Num a, FsRoot root) => Path root -> IO a
    getFileSize Path Absolute
    wholeTemp
        remoteSize DownloadedDelta{Path Absolute
    Int54
    deltaTemp :: RemoteTemp Binary -> Path Absolute
    deltaExisting :: RemoteTemp Binary -> Path Absolute
    deltaSeek :: RemoteTemp Binary -> Int54
    deltaTemp :: Path Absolute
    deltaExisting :: Path Absolute
    deltaSeek :: Int54
    ..} = do
            deltaSize <- Path Absolute -> IO Int54
    forall a root. (Num a, FsRoot root) => Path root -> IO a
    getFileSize Path Absolute
    deltaTemp
            return $ deltaSeek + deltaSize

        -- It is important that we close the file handles when we're done
        -- (esp. since we may not read the whole file)
        withRemoteBS :: RemoteTemp typ -> (BS.L.ByteString -> Bool) -> IO Bool
        withRemoteBS :: forall typ. RemoteTemp typ -> (ByteString -> Bool) -> IO Bool
    withRemoteBS DownloadedWhole{Path Absolute
    wholeTemp :: forall a. RemoteTemp a -> Path Absolute
    wholeTemp :: Path Absolute
    ..} ByteString -> Bool
    callback = do
            Path Absolute -> IOMode -> (Handle -> IO Bool) -> IO Bool
    forall root r.
    FsRoot root =>
    Path root -> IOMode -> (Handle -> IO r) -> IO r
    withFile Path Absolute
    wholeTemp IOMode
    ReadMode ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
              bs <- Handle -> IO ByteString
    BS.L.hGetContents Handle
    h
              evaluate $ callback bs
        withRemoteBS DownloadedDelta{Path Absolute
    Int54
    deltaTemp :: RemoteTemp Binary -> Path Absolute
    deltaExisting :: RemoteTemp Binary -> Path Absolute
    deltaSeek :: RemoteTemp Binary -> Int54
    deltaTemp :: Path Absolute
    deltaExisting :: Path Absolute
    deltaSeek :: Int54
    ..} ByteString -> Bool
    callback =
            Path Absolute -> IOMode -> (Handle -> IO Bool) -> IO Bool
    forall root r.
    FsRoot root =>
    Path root -> IOMode -> (Handle -> IO r) -> IO r
    withFile Path Absolute
    deltaExisting IOMode
    ReadMode ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Handle
    hExisting ->
              Path Absolute -> IOMode -> (Handle -> IO Bool) -> IO Bool
    forall root r.
    FsRoot root =>
    Path root -> IOMode -> (Handle -> IO r) -> IO r
    withFile Path Absolute
    deltaTemp IOMode
    ReadMode ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Handle
    hTemp -> do
                existing <- Handle -> IO ByteString
    BS.L.hGetContents Handle
    hExisting
                temp     <- BS.L.hGetContents hTemp
                evaluate $ callback $ BS.L.concat [
                    BS.L.take (fromIntegral deltaSeek) existing
                  , temp
                  ]