{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE StaticPointers #-}
#endif
-- | Main entry point into the Hackage Security framework for clients
module Hackage.Security.Client (
    -- * Checking for updates
    checkForUpdates
  , HasUpdates(..)
    -- * Downloading targets
  , downloadPackage
  , downloadPackage'
    -- * Access to the Hackage index
  , Directory(..)
  , DirectoryEntry(..)
  , getDirectory
  , IndexFile(..)
  , IndexEntry(..)
  , IndexCallbacks(..)
  , withIndex
    -- * Bootstrapping
  , requiresBootstrap
  , bootstrap
    -- * Re-exports
  , module Hackage.Security.TUF
  , module Hackage.Security.Key
  , trusted
    -- ** We only a few bits from .Repository
    -- TODO: Maybe this is a sign that these should be in a different module?
  , Repository -- opaque
  , DownloadedFile(..)
  , SomeRemoteError(..)
  , LogMessage(..)
    -- * Exceptions
  , uncheckClientErrors
  , VerificationError(..)
  , VerificationHistory
  , RootUpdated(..)
  , InvalidPackageException(..)
  , InvalidFileInIndex(..)
  , LocalFileCorrupted(..)
  ) where

import MyPrelude hiding (log)
import Control.Arrow (first)
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.List (sortBy)
import Data.Maybe (isNothing)
import Data.Ord (comparing)
import Data.Time
import Data.Traversable (for)
import Data.Typeable (Typeable)
import qualified Codec.Archive.Tar          as Tar
import qualified Codec.Archive.Tar.Entry    as Tar
import qualified Codec.Archive.Tar.Index    as Tar
import qualified Data.ByteString.Lazy       as BS.L
import qualified Data.ByteString.Lazy.Char8 as BS.L.C8

import Distribution.Package (PackageIdentifier)
import Distribution.Text (display)

import Hackage.Security.Client.Formats
import Hackage.Security.Client.Repository
import Hackage.Security.Client.Verify
import Hackage.Security.JSON
import Hackage.Security.Key
import Hackage.Security.Key.Env (KeyEnv)
import Hackage.Security.Trusted
import Hackage.Security.Trusted.TCB
import Hackage.Security.TUF
import Hackage.Security.Util.Checked
import Hackage.Security.Util.Path
import Hackage.Security.Util.Pretty
import Hackage.Security.Util.Some
import Hackage.Security.Util.Stack
import qualified Hackage.Security.Key.Env as KeyEnv

{-------------------------------------------------------------------------------
  Checking for updates
-------------------------------------------------------------------------------}

data HasUpdates = HasUpdates | NoUpdates
  deriving (Int -> HasUpdates -> ShowS
[HasUpdates] -> ShowS
HasUpdates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HasUpdates] -> ShowS
$cshowList :: [HasUpdates] -> ShowS
show :: HasUpdates -> String
$cshow :: HasUpdates -> String
showsPrec :: Int -> HasUpdates -> ShowS
$cshowsPrec :: Int -> HasUpdates -> ShowS
Show, HasUpdates -> HasUpdates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HasUpdates -> HasUpdates -> Bool
$c/= :: HasUpdates -> HasUpdates -> Bool
== :: HasUpdates -> HasUpdates -> Bool
$c== :: HasUpdates -> HasUpdates -> Bool
Eq, Eq HasUpdates
HasUpdates -> HasUpdates -> Bool
HasUpdates -> HasUpdates -> Ordering
HasUpdates -> HasUpdates -> HasUpdates
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HasUpdates -> HasUpdates -> HasUpdates
$cmin :: HasUpdates -> HasUpdates -> HasUpdates
max :: HasUpdates -> HasUpdates -> HasUpdates
$cmax :: HasUpdates -> HasUpdates -> HasUpdates
>= :: HasUpdates -> HasUpdates -> Bool
$c>= :: HasUpdates -> HasUpdates -> Bool
> :: HasUpdates -> HasUpdates -> Bool
$c> :: HasUpdates -> HasUpdates -> Bool
<= :: HasUpdates -> HasUpdates -> Bool
$c<= :: HasUpdates -> HasUpdates -> Bool
< :: HasUpdates -> HasUpdates -> Bool
$c< :: HasUpdates -> HasUpdates -> Bool
compare :: HasUpdates -> HasUpdates -> Ordering
$ccompare :: HasUpdates -> HasUpdates -> Ordering
Ord)

-- | Generic logic for checking if there are updates
--
-- This implements the logic described in Section 5.1, "The client application",
-- of the TUF spec. It checks which of the server metadata has changed, and
-- downloads all changed metadata to the local cache. (Metadata here refers
-- both to the TUF security metadata as well as the Hackage package index.)
--
-- You should pass @Nothing@ for the UTCTime _only_ under exceptional
-- circumstances (such as when the main server is down for longer than the
-- expiry dates used in the timestamp files on mirrors).
checkForUpdates :: (Throws VerificationError, Throws SomeRemoteError)
                => Repository down
                -> Maybe UTCTime -- ^ To check expiry times against (if using)
                -> IO HasUpdates
checkForUpdates :: forall (down :: * -> *).
(Throws VerificationError, Throws SomeRemoteError) =>
Repository down -> Maybe UTCTime -> IO HasUpdates
checkForUpdates rep :: Repository down
rep@Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} Maybe UTCTime
mNow =
    forall (down :: * -> *) a. Repository down -> IO a -> IO a
withMirror Repository down
rep forall a b. (a -> b) -> a -> b
$ VerificationHistory -> IO HasUpdates
limitIterations []
  where
    -- More or less randomly chosen maximum iterations
    -- See <https://github.com/theupdateframework/tuf/issues/287>.
    maxNumIterations :: Int
    maxNumIterations :: Int
maxNumIterations = Int
5

    -- The spec stipulates that on a verification error we must download new
    -- root information and start over. However, in order to prevent DoS attacks
    -- we limit how often we go round this loop.
    -- See als <https://github.com/theupdateframework/tuf/issues/287>.
    limitIterations :: VerificationHistory -> IO HasUpdates
    limitIterations :: VerificationHistory -> IO HasUpdates
limitIterations VerificationHistory
history | forall (t :: * -> *) a. Foldable t => t a -> Int
length VerificationHistory
history forall a. Ord a => a -> a -> Bool
>= Int
maxNumIterations =
        forall e a. (Exception e, Throws e) => e -> IO a
throwChecked forall a b. (a -> b) -> a -> b
$ VerificationHistory -> VerificationError
VerificationErrorLoop (forall a. [a] -> [a]
reverse VerificationHistory
history)
    limitIterations VerificationHistory
history = do
        -- Get all cached info
        --
        -- NOTE: Although we don't normally update any cached files until the
        -- whole verification process successfully completes, in case of a
        -- verification error, or in case of a regular update of the root info,
        -- we DO update the local files. Hence, we must re-read all local files
        -- on each iteration.
        CachedInfo
cachedInfo <- forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m CachedInfo
getCachedInfo Repository down
rep

        Either VerificationError (Either RootUpdated HasUpdates)
mHasUpdates <- forall e a. Exception e => (Throws e => IO a) -> IO (Either e a)
tryChecked -- catch RootUpdated
                     forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => (Throws e => IO a) -> IO (Either e a)
tryChecked -- catch VerificationError
                     forall a b. (a -> b) -> a -> b
$ forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache
                     forall a b. (a -> b) -> a -> b
$ Throws RootUpdated => AttemptNr -> CachedInfo -> Verify HasUpdates
go AttemptNr
attemptNr CachedInfo
cachedInfo
        case Either VerificationError (Either RootUpdated HasUpdates)
mHasUpdates of
          Left VerificationError
ex -> do
            -- NOTE: This call to updateRoot is not itself protected by an
            -- exception handler, and may therefore throw a VerificationError.
            -- This is intentional: if we get verification errors during the
            -- update process, _and_ we cannot update the main root info, then
            -- we cannot do anything.
            forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> LogMessage -> m ()
log Repository down
rep forall a b. (a -> b) -> a -> b
$ VerificationError -> LogMessage
LogVerificationError VerificationError
ex
            let history' :: VerificationHistory
history'   = forall a b. b -> Either a b
Right VerificationError
ex forall a. a -> [a] -> [a]
: VerificationHistory
history
                attemptNr' :: AttemptNr
attemptNr' = AttemptNr
attemptNr forall a. Num a => a -> a -> a
+ AttemptNr
1
            forall (down :: * -> *).
(Throws VerificationError, Throws SomeRemoteError) =>
Repository down
-> Maybe UTCTime
-> AttemptNr
-> CachedInfo
-> Either VerificationError (Trusted FileInfo)
-> IO ()
updateRoot Repository down
rep Maybe UTCTime
mNow AttemptNr
attemptNr' CachedInfo
cachedInfo (forall a b. a -> Either a b
Left VerificationError
ex)
            VerificationHistory -> IO HasUpdates
limitIterations VerificationHistory
history'
          Right (Left RootUpdated
RootUpdated) -> do
            forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> LogMessage -> m ()
log Repository down
rep forall a b. (a -> b) -> a -> b
$ LogMessage
LogRootUpdated
            let history' :: VerificationHistory
history' = forall a b. a -> Either a b
Left RootUpdated
RootUpdated forall a. a -> [a] -> [a]
: VerificationHistory
history
            VerificationHistory -> IO HasUpdates
limitIterations VerificationHistory
history'
          Right (Right HasUpdates
hasUpdates) ->
            forall (m :: * -> *) a. Monad m => a -> m a
return HasUpdates
hasUpdates
      where
        attemptNr :: AttemptNr
        attemptNr :: AttemptNr
attemptNr = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length VerificationHistory
history

    -- The 'Verify' monad only caches the downloaded files after verification.
    -- See also <https://github.com/theupdateframework/tuf/issues/283>.
    go :: Throws RootUpdated => AttemptNr -> CachedInfo -> Verify HasUpdates
    go :: Throws RootUpdated => AttemptNr -> CachedInfo -> Verify HasUpdates
go AttemptNr
attemptNr cachedInfo :: CachedInfo
cachedInfo@CachedInfo{Maybe (Trusted Mirrors)
Maybe (Trusted FileInfo)
Maybe (Trusted Timestamp)
Maybe (Trusted Snapshot)
KeyEnv
Trusted Root
cachedInfoTarGz :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoMirrors :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoRoot :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoSnapshot :: CachedInfo -> Maybe (Trusted FileInfo)
cachedMirrors :: CachedInfo -> Maybe (Trusted Mirrors)
cachedSnapshot :: CachedInfo -> Maybe (Trusted Snapshot)
cachedTimestamp :: CachedInfo -> Maybe (Trusted Timestamp)
cachedKeyEnv :: CachedInfo -> KeyEnv
cachedRoot :: CachedInfo -> Trusted Root
cachedInfoTarGz :: Maybe (Trusted FileInfo)
cachedInfoMirrors :: Maybe (Trusted FileInfo)
cachedInfoRoot :: Maybe (Trusted FileInfo)
cachedInfoSnapshot :: Maybe (Trusted FileInfo)
cachedMirrors :: Maybe (Trusted Mirrors)
cachedSnapshot :: Maybe (Trusted Snapshot)
cachedTimestamp :: Maybe (Trusted Timestamp)
cachedKeyEnv :: KeyEnv
cachedRoot :: Trusted Root
..} = do
      -- Get the new timestamp
      Trusted Timestamp
newTS <- forall a f.
(VerifyRole a, FromJSON ReadJSON_Keys_Layout (Signed a)) =>
RemoteFile (f :- ()) Metadata -> Verify (Trusted a)
getRemoteFile' RemoteFile (FormatUn :- ()) Metadata
RemoteTimestamp
      let newInfoSS :: Trusted FileInfo
newInfoSS = static Timestamp -> FileInfo
timestampInfoSnapshot forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Timestamp
newTS

      -- Check if the snapshot has changed
      if Bool -> Bool
not (Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
fileChanged Maybe (Trusted FileInfo)
cachedInfoSnapshot Trusted FileInfo
newInfoSS)
        then forall (m :: * -> *) a. Monad m => a -> m a
return HasUpdates
NoUpdates
        else do
          -- Get the new snapshot
          Trusted Snapshot
newSS <- forall a f.
(VerifyRole a, FromJSON ReadJSON_Keys_Layout (Signed a)) =>
RemoteFile (f :- ()) Metadata -> Verify (Trusted a)
getRemoteFile' (Trusted FileInfo -> RemoteFile (FormatUn :- ()) Metadata
RemoteSnapshot Trusted FileInfo
newInfoSS)
          let newInfoRoot :: Trusted FileInfo
newInfoRoot    = static Snapshot -> FileInfo
snapshotInfoRoot    forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS
              newInfoMirrors :: Trusted FileInfo
newInfoMirrors = static Snapshot -> FileInfo
snapshotInfoMirrors forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS
              newInfoTarGz :: Trusted FileInfo
newInfoTarGz   = static Snapshot -> FileInfo
snapshotInfoTarGz   forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS
              mNewInfoTar :: Maybe (Trusted FileInfo)
mNewInfoTar    = forall (f :: * -> *) a.
Traversable f =>
Trusted (f a) -> f (Trusted a)
trustElems (static Snapshot -> Maybe FileInfo
snapshotInfoTar forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS)

          -- If root metadata changed, download and restart
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
rootChanged Maybe (Trusted FileInfo)
cachedInfoRoot Trusted FileInfo
newInfoRoot) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            forall (down :: * -> *).
(Throws VerificationError, Throws SomeRemoteError) =>
Repository down
-> Maybe UTCTime
-> AttemptNr
-> CachedInfo
-> Either VerificationError (Trusted FileInfo)
-> IO ()
updateRoot Repository down
rep Maybe UTCTime
mNow AttemptNr
attemptNr CachedInfo
cachedInfo (forall a b. b -> Either a b
Right Trusted FileInfo
newInfoRoot)
            -- By throwing 'RootUpdated' as an exception we make sure that
            -- any files previously downloaded (to temporary locations)
            -- will not be cached.
            forall e a. (Exception e, Throws e) => e -> IO a
throwChecked RootUpdated
RootUpdated

          -- If mirrors changed, download and verify
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
fileChanged Maybe (Trusted FileInfo)
cachedInfoMirrors Trusted FileInfo
newInfoMirrors) forall a b. (a -> b) -> a -> b
$
            Trusted Mirrors -> Verify ()
newMirrors forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a f.
(VerifyRole a, FromJSON ReadJSON_Keys_Layout (Signed a)) =>
RemoteFile (f :- ()) Metadata -> Verify (Trusted a)
getRemoteFile' (Trusted FileInfo -> RemoteFile (FormatUn :- ()) Metadata
RemoteMirrors Trusted FileInfo
newInfoMirrors)

          -- If index changed, download and verify
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
fileChanged Maybe (Trusted FileInfo)
cachedInfoTarGz Trusted FileInfo
newInfoTarGz) forall a b. (a -> b) -> a -> b
$
            Trusted FileInfo -> Maybe (Trusted FileInfo) -> Verify ()
updateIndex Trusted FileInfo
newInfoTarGz Maybe (Trusted FileInfo)
mNewInfoTar

          forall (m :: * -> *) a. Monad m => a -> m a
return HasUpdates
HasUpdates
      where
        getRemoteFile' :: ( VerifyRole a
                          , FromJSON ReadJSON_Keys_Layout (Signed a)
                          )
                       => RemoteFile (f :- ()) Metadata -> Verify (Trusted a)
        getRemoteFile' :: forall a f.
(VerifyRole a, FromJSON ReadJSON_Keys_Layout (Signed a)) =>
RemoteFile (f :- ()) Metadata -> Verify (Trusted a)
getRemoteFile' = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (down :: * -> *) f.
(Throws VerificationError, Throws SomeRemoteError, VerifyRole a,
 FromJSON ReadJSON_Keys_Layout (Signed a)) =>
Repository down
-> CachedInfo
-> AttemptNr
-> Maybe UTCTime
-> RemoteFile (f :- ()) Metadata
-> Verify (Trusted a, down Metadata)
getRemoteFile Repository down
rep CachedInfo
cachedInfo AttemptNr
attemptNr Maybe UTCTime
mNow

        -- Update the index and check against the appropriate hash
        updateIndex :: Trusted FileInfo         -- info about @.tar.gz@
                    -> Maybe (Trusted FileInfo) -- info about @.tar@
                    -> Verify ()
        updateIndex :: Trusted FileInfo -> Maybe (Trusted FileInfo) -> Verify ()
updateIndex Trusted FileInfo
newInfoTarGz Maybe (Trusted FileInfo)
Nothing = do
          (TargetPath
targetPath, down Binary
tempPath) <- forall f (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (TargetPath, down typ)
getRemote' Repository down
rep AttemptNr
attemptNr forall a b. (a -> b) -> a -> b
$
            forall fs.
HasFormat fs FormatGz
-> Formats fs (Trusted FileInfo) -> RemoteFile fs Binary
RemoteIndex (forall f fs. Format f -> HasFormat (f :- fs) f
HFZ Format FormatGz
FGz) (forall a. a -> Formats (FormatGz :- ()) a
FsGz Trusted FileInfo
newInfoTarGz)
          forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (forall a. a -> Maybe a
Just Trusted FileInfo
newInfoTarGz) TargetPath
targetPath down Binary
tempPath
        updateIndex Trusted FileInfo
newInfoTarGz (Just Trusted FileInfo
newInfoTar) = do
          (Some Format
format, TargetPath
targetPath, down Binary
tempPath) <- forall fs (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some Format, TargetPath, down typ)
getRemote Repository down
rep AttemptNr
attemptNr forall a b. (a -> b) -> a -> b
$
            forall fs.
HasFormat fs FormatGz
-> Formats fs (Trusted FileInfo) -> RemoteFile fs Binary
RemoteIndex (forall fs f f'. HasFormat fs f -> HasFormat (f' :- fs) f
HFS (forall f fs. Format f -> HasFormat (f :- fs) f
HFZ Format FormatGz
FGz)) (forall a. a -> a -> Formats (FormatUn :- (FormatGz :- ())) a
FsUnGz Trusted FileInfo
newInfoTar Trusted FileInfo
newInfoTarGz)
          case Some Format
format of
            Some Format a
FGz -> forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (forall a. a -> Maybe a
Just Trusted FileInfo
newInfoTarGz) TargetPath
targetPath down Binary
tempPath
            Some Format a
FUn -> forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (forall a. a -> Maybe a
Just Trusted FileInfo
newInfoTar)   TargetPath
targetPath down Binary
tempPath

    -- Unlike for other files, if we didn't have an old snapshot, consider the
    -- root info unchanged (otherwise we would loop indefinitely).
    -- See also <https://github.com/theupdateframework/tuf/issues/286>
    rootChanged :: Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
    rootChanged :: Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
rootChanged Maybe (Trusted FileInfo)
Nothing    Trusted FileInfo
_   = Bool
False
    rootChanged (Just Trusted FileInfo
old) Trusted FileInfo
new = Bool -> Bool
not (Trusted FileInfo -> Trusted FileInfo -> Bool
trustedFileInfoEqual Trusted FileInfo
old Trusted FileInfo
new)

    -- For any file other than the root we consider the file to have changed
    -- if we do not yet have a local snapshot to tell us the old info.
    fileChanged :: Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
    fileChanged :: Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
fileChanged Maybe (Trusted FileInfo)
Nothing    Trusted FileInfo
_   = Bool
True
    fileChanged (Just Trusted FileInfo
old) Trusted FileInfo
new = Bool -> Bool
not (Trusted FileInfo -> Trusted FileInfo -> Bool
trustedFileInfoEqual Trusted FileInfo
old Trusted FileInfo
new)

    -- We don't actually _do_ anything with the mirrors file until the next call
    -- to 'checkUpdates', because we want to use a single server for a single
    -- check-for-updates request. If validation was successful the repository
    -- will have cached the mirrors file and it will be available on the next
    -- request.
    newMirrors :: Trusted Mirrors -> Verify ()
    newMirrors :: Trusted Mirrors -> Verify ()
newMirrors Trusted Mirrors
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Update the root metadata
--
-- Note that the new root metadata is verified using the old root metadata,
-- and only then trusted.
--
-- We don't always have root file information available. If we notice during
-- the normal update process that the root information has changed then the
-- snapshot will give us the new file information; but if we need to update
-- the root information due to a verification error we do not.
--
-- We additionally delete the cached cached snapshot and timestamp. This is
-- necessary for two reasons:
--
-- 1. If during the normal update process we notice that the root info was
--    updated (because the hash of @root.json@ in the new snapshot is different
--    from the old snapshot) we download new root info and start over, without
--    (yet) downloading a (potential) new index. This means it is important that
--    we not overwrite our local cached snapshot, because if we did we would
--    then on the next iteration conclude there were no updates and we would
--    fail to notice that we should have updated the index. However, unless we
--    do something, this means that we would conclude on the next iteration once
--    again that the root info has changed (because the hash in the new shapshot
--    still doesn't match the hash in the cached snapshot), and we would loop
--    until we throw a 'VerificationErrorLoop' exception. By deleting the local
--    snapshot we basically reset the client to its initial state, and we will
--    not try to download the root info once again. The only downside of this is
--    that we will also re-download the index after every root info change.
--    However, this should be infrequent enough that this isn't an issue.
--    See also <https://github.com/theupdateframework/tuf/issues/285>.
--
-- 2. Additionally, deleting the local timestamp and snapshot protects against
--    an attack where an attacker has set the file version of the snapshot or
--    timestamp to MAX_INT, thereby making further updates impossible.
--    (Such an attack would require a timestamp/snapshot key compromise.)
--
-- However, we _ONLY_ do this when the root information has actually changed.
-- If we did this unconditionally it would mean that we delete the locally
-- cached timestamp whenever the version on the remote timestamp is invalid,
-- thereby rendering the file version on the timestamp and the snapshot useless.
-- See <https://github.com/theupdateframework/tuf/issues/283#issuecomment-115739521>
updateRoot :: (Throws VerificationError, Throws SomeRemoteError)
           => Repository down
           -> Maybe UTCTime
           -> AttemptNr
           -> CachedInfo
           -> Either VerificationError (Trusted FileInfo)
           -> IO ()
updateRoot :: forall (down :: * -> *).
(Throws VerificationError, Throws SomeRemoteError) =>
Repository down
-> Maybe UTCTime
-> AttemptNr
-> CachedInfo
-> Either VerificationError (Trusted FileInfo)
-> IO ()
updateRoot rep :: Repository down
rep@Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} Maybe UTCTime
mNow AttemptNr
isRetry CachedInfo
cachedInfo Either VerificationError (Trusted FileInfo)
eFileInfo = do
    Bool
rootReallyChanged <- forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache forall a b. (a -> b) -> a -> b
$ do
      (Trusted Root
_newRoot :: Trusted Root, down Metadata
rootTempFile) <- forall a (down :: * -> *) f.
(Throws VerificationError, Throws SomeRemoteError, VerifyRole a,
 FromJSON ReadJSON_Keys_Layout (Signed a)) =>
Repository down
-> CachedInfo
-> AttemptNr
-> Maybe UTCTime
-> RemoteFile (f :- ()) Metadata
-> Verify (Trusted a, down Metadata)
getRemoteFile
        Repository down
rep
        CachedInfo
cachedInfo
        AttemptNr
isRetry
        Maybe UTCTime
mNow
        (Maybe (Trusted FileInfo) -> RemoteFile (FormatUn :- ()) Metadata
RemoteRoot (forall a b. Either a b -> Maybe b
eitherToMaybe Either VerificationError (Trusted FileInfo)
eFileInfo))

      -- NOTE: It is important that we do this check within the evalContT,
      -- because the temporary file will be deleted once we leave its scope.
      case Either VerificationError (Trusted FileInfo)
eFileInfo of
        Right Trusted FileInfo
_ ->
          -- We are downloading the root info because the hash in the snapshot
          -- changed. In this case the root definitely changed.
          forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Left VerificationError
_e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          -- We are downloading the root because of a verification error. In
          -- this case the root info may or may not have changed. In most cases
          -- it would suffice to compare the file version now; however, in the
          -- (exceptional) circumstance where the root info has changed but
          -- the file version has not, this would result in the same infinite
          -- loop described above. Hence, we must compare file hashes, and they
          -- must be computed on the raw file, not the parsed file.
          Path Absolute
oldRootFile <- IO (Path Absolute)
repGetCachedRoot
          Trusted FileInfo
oldRootInfo <- forall a. a -> Trusted a
DeclareTrusted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall root. FsRoot root => Path root -> IO FileInfo
computeFileInfo Path Absolute
oldRootFile
          Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (down :: * -> *) a.
DownloadedFile down =>
down a -> Trusted FileInfo -> IO Bool
downloadedVerify down Metadata
rootTempFile Trusted FileInfo
oldRootInfo

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rootReallyChanged forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m ()
clearCache Repository down
rep

{-------------------------------------------------------------------------------
  Convenience functions for downloading and parsing various files
-------------------------------------------------------------------------------}

data CachedInfo = CachedInfo {
    CachedInfo -> Trusted Root
cachedRoot         :: Trusted Root
  , CachedInfo -> KeyEnv
cachedKeyEnv       :: KeyEnv
  , CachedInfo -> Maybe (Trusted Timestamp)
cachedTimestamp    :: Maybe (Trusted Timestamp)
  , CachedInfo -> Maybe (Trusted Snapshot)
cachedSnapshot     :: Maybe (Trusted Snapshot)
  , CachedInfo -> Maybe (Trusted Mirrors)
cachedMirrors      :: Maybe (Trusted Mirrors)
  , CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoSnapshot :: Maybe (Trusted FileInfo)
  , CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoRoot     :: Maybe (Trusted FileInfo)
  , CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoMirrors  :: Maybe (Trusted FileInfo)
  , CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoTarGz    :: Maybe (Trusted FileInfo)
  }

cachedVersion :: CachedInfo -> RemoteFile fs typ -> Maybe FileVersion
cachedVersion :: forall fs typ. CachedInfo -> RemoteFile fs typ -> Maybe FileVersion
cachedVersion CachedInfo{Maybe (Trusted Mirrors)
Maybe (Trusted FileInfo)
Maybe (Trusted Timestamp)
Maybe (Trusted Snapshot)
KeyEnv
Trusted Root
cachedInfoTarGz :: Maybe (Trusted FileInfo)
cachedInfoMirrors :: Maybe (Trusted FileInfo)
cachedInfoRoot :: Maybe (Trusted FileInfo)
cachedInfoSnapshot :: Maybe (Trusted FileInfo)
cachedMirrors :: Maybe (Trusted Mirrors)
cachedSnapshot :: Maybe (Trusted Snapshot)
cachedTimestamp :: Maybe (Trusted Timestamp)
cachedKeyEnv :: KeyEnv
cachedRoot :: Trusted Root
cachedInfoTarGz :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoMirrors :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoRoot :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoSnapshot :: CachedInfo -> Maybe (Trusted FileInfo)
cachedMirrors :: CachedInfo -> Maybe (Trusted Mirrors)
cachedSnapshot :: CachedInfo -> Maybe (Trusted Snapshot)
cachedTimestamp :: CachedInfo -> Maybe (Trusted Timestamp)
cachedKeyEnv :: CachedInfo -> KeyEnv
cachedRoot :: CachedInfo -> Trusted Root
..} RemoteFile fs typ
remoteFile =
    case forall fs typ. RemoteFile fs typ -> IsCached typ
mustCache RemoteFile fs typ
remoteFile of
      CacheAs CachedFile
CachedTimestamp -> Timestamp -> FileVersion
timestampVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Trusted a -> a
trusted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Trusted Timestamp)
cachedTimestamp
      CacheAs CachedFile
CachedSnapshot  -> Snapshot -> FileVersion
snapshotVersion  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Trusted a -> a
trusted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Trusted Snapshot)
cachedSnapshot
      CacheAs CachedFile
CachedMirrors   -> Mirrors -> FileVersion
mirrorsVersion   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Trusted a -> a
trusted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Trusted Mirrors)
cachedMirrors
      CacheAs CachedFile
CachedRoot      -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Root -> FileVersion
rootVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Trusted a -> a
trusted forall a b. (a -> b) -> a -> b
$ Trusted Root
cachedRoot
      IsCached typ
CacheIndex -> forall a. Maybe a
Nothing
      IsCached typ
DontCache  -> forall a. Maybe a
Nothing

-- | Get all cached info (if any)
getCachedInfo ::
#if __GLASGOW_HASKELL__ < 800
                 (Applicative m, MonadIO m)
#else
                 MonadIO m
#endif
              => Repository down -> m CachedInfo
getCachedInfo :: forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m CachedInfo
getCachedInfo Repository down
rep = do
    (Trusted Root
cachedRoot, KeyEnv
cachedKeyEnv) <- forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m (Trusted Root, KeyEnv)
readLocalRoot Repository down
rep
    Maybe (Trusted Timestamp)
cachedTimestamp <- forall a (m :: * -> *) (down :: * -> *).
(FromJSON ReadJSON_Keys_Layout (Signed a), MonadIO m) =>
Repository down -> KeyEnv -> CachedFile -> m (Maybe (Trusted a))
readLocalFile Repository down
rep KeyEnv
cachedKeyEnv CachedFile
CachedTimestamp
    Maybe (Trusted Snapshot)
cachedSnapshot  <- forall a (m :: * -> *) (down :: * -> *).
(FromJSON ReadJSON_Keys_Layout (Signed a), MonadIO m) =>
Repository down -> KeyEnv -> CachedFile -> m (Maybe (Trusted a))
readLocalFile Repository down
rep KeyEnv
cachedKeyEnv CachedFile
CachedSnapshot
    Maybe (Trusted Mirrors)
cachedMirrors   <- forall a (m :: * -> *) (down :: * -> *).
(FromJSON ReadJSON_Keys_Layout (Signed a), MonadIO m) =>
Repository down -> KeyEnv -> CachedFile -> m (Maybe (Trusted a))
readLocalFile Repository down
rep KeyEnv
cachedKeyEnv CachedFile
CachedMirrors

    let cachedInfoSnapshot :: Maybe (Trusted FileInfo)
cachedInfoSnapshot = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Timestamp -> FileInfo
timestampInfoSnapshot forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Timestamp)
cachedTimestamp
        cachedInfoRoot :: Maybe (Trusted FileInfo)
cachedInfoRoot     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Snapshot -> FileInfo
snapshotInfoRoot      forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Snapshot)
cachedSnapshot
        cachedInfoMirrors :: Maybe (Trusted FileInfo)
cachedInfoMirrors  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Snapshot -> FileInfo
snapshotInfoMirrors   forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Snapshot)
cachedSnapshot
        cachedInfoTarGz :: Maybe (Trusted FileInfo)
cachedInfoTarGz    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Snapshot -> FileInfo
snapshotInfoTarGz     forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Snapshot)
cachedSnapshot

    forall (m :: * -> *) a. Monad m => a -> m a
return CachedInfo{Maybe (Trusted Mirrors)
Maybe (Trusted FileInfo)
Maybe (Trusted Timestamp)
Maybe (Trusted Snapshot)
KeyEnv
Trusted Root
cachedInfoTarGz :: Maybe (Trusted FileInfo)
cachedInfoMirrors :: Maybe (Trusted FileInfo)
cachedInfoRoot :: Maybe (Trusted FileInfo)
cachedInfoSnapshot :: Maybe (Trusted FileInfo)
cachedMirrors :: Maybe (Trusted Mirrors)
cachedSnapshot :: Maybe (Trusted Snapshot)
cachedTimestamp :: Maybe (Trusted Timestamp)
cachedKeyEnv :: KeyEnv
cachedRoot :: Trusted Root
cachedInfoTarGz :: Maybe (Trusted FileInfo)
cachedInfoMirrors :: Maybe (Trusted FileInfo)
cachedInfoRoot :: Maybe (Trusted FileInfo)
cachedInfoSnapshot :: Maybe (Trusted FileInfo)
cachedMirrors :: Maybe (Trusted Mirrors)
cachedSnapshot :: Maybe (Trusted Snapshot)
cachedTimestamp :: Maybe (Trusted Timestamp)
cachedKeyEnv :: KeyEnv
cachedRoot :: Trusted Root
..}

readLocalRoot :: MonadIO m => Repository down -> m (Trusted Root, KeyEnv)
readLocalRoot :: forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m (Trusted Root, KeyEnv)
readLocalRoot Repository down
rep = do
    Path Absolute
cachedPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCachedRoot Repository down
rep
    Signed Root
signedRoot <- forall (m :: * -> *) e' e a.
(MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsUnchecked DeserializationError -> LocalFileCorrupted
LocalFileCorrupted forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    forall (m :: * -> *) a (down :: * -> *).
(MonadIO m, FromJSON ReadJSON_Keys_Layout a) =>
Repository down
-> KeyEnv -> Path Absolute -> m (Either DeserializationError a)
readCachedJSON Repository down
rep KeyEnv
KeyEnv.empty Path Absolute
cachedPath
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Signed a -> Trusted a
trustLocalFile Signed Root
signedRoot, Root -> KeyEnv
rootKeys (forall a. Signed a -> a
signed Signed Root
signedRoot))

readLocalFile :: ( FromJSON ReadJSON_Keys_Layout (Signed a), MonadIO m
#if __GLASGOW_HASKELL__ < 800
                 , Applicative m
#endif
                 )
              => Repository down -> KeyEnv -> CachedFile -> m (Maybe (Trusted a))
readLocalFile :: forall a (m :: * -> *) (down :: * -> *).
(FromJSON ReadJSON_Keys_Layout (Signed a), MonadIO m) =>
Repository down -> KeyEnv -> CachedFile -> m (Maybe (Trusted a))
readLocalFile Repository down
rep KeyEnv
cachedKeyEnv CachedFile
file = do
    Maybe (Path Absolute)
mCachedPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetCached Repository down
rep CachedFile
file
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (Path Absolute)
mCachedPath forall a b. (a -> b) -> a -> b
$ \Path Absolute
cachedPath -> do
      Signed a
signed <- forall (m :: * -> *) e' e a.
(MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsUnchecked DeserializationError -> LocalFileCorrupted
LocalFileCorrupted forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                  forall (m :: * -> *) a (down :: * -> *).
(MonadIO m, FromJSON ReadJSON_Keys_Layout a) =>
Repository down
-> KeyEnv -> Path Absolute -> m (Either DeserializationError a)
readCachedJSON Repository down
rep KeyEnv
cachedKeyEnv Path Absolute
cachedPath
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Signed a -> Trusted a
trustLocalFile Signed a
signed

getRemoteFile :: ( Throws VerificationError
                 , Throws SomeRemoteError
                 , VerifyRole a
                 , FromJSON ReadJSON_Keys_Layout (Signed a)
                 )
              => Repository down
              -> CachedInfo
              -> AttemptNr
              -> Maybe UTCTime
              -> RemoteFile (f :- ()) Metadata
              -> Verify (Trusted a, down Metadata)
getRemoteFile :: forall a (down :: * -> *) f.
(Throws VerificationError, Throws SomeRemoteError, VerifyRole a,
 FromJSON ReadJSON_Keys_Layout (Signed a)) =>
Repository down
-> CachedInfo
-> AttemptNr
-> Maybe UTCTime
-> RemoteFile (f :- ()) Metadata
-> Verify (Trusted a, down Metadata)
getRemoteFile rep :: Repository down
rep@Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} cachedInfo :: CachedInfo
cachedInfo@CachedInfo{Maybe (Trusted Mirrors)
Maybe (Trusted FileInfo)
Maybe (Trusted Timestamp)
Maybe (Trusted Snapshot)
KeyEnv
Trusted Root
cachedInfoTarGz :: Maybe (Trusted FileInfo)
cachedInfoMirrors :: Maybe (Trusted FileInfo)
cachedInfoRoot :: Maybe (Trusted FileInfo)
cachedInfoSnapshot :: Maybe (Trusted FileInfo)
cachedMirrors :: Maybe (Trusted Mirrors)
cachedSnapshot :: Maybe (Trusted Snapshot)
cachedTimestamp :: Maybe (Trusted Timestamp)
cachedKeyEnv :: KeyEnv
cachedRoot :: Trusted Root
cachedInfoTarGz :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoMirrors :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoRoot :: CachedInfo -> Maybe (Trusted FileInfo)
cachedInfoSnapshot :: CachedInfo -> Maybe (Trusted FileInfo)
cachedMirrors :: CachedInfo -> Maybe (Trusted Mirrors)
cachedSnapshot :: CachedInfo -> Maybe (Trusted Snapshot)
cachedTimestamp :: CachedInfo -> Maybe (Trusted Timestamp)
cachedKeyEnv :: CachedInfo -> KeyEnv
cachedRoot :: CachedInfo -> Trusted Root
..} AttemptNr
isRetry Maybe UTCTime
mNow RemoteFile (f :- ()) Metadata
file = do
    (TargetPath
targetPath, down Metadata
tempPath) <- forall f (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (TargetPath, down typ)
getRemote' Repository down
rep AttemptNr
isRetry RemoteFile (f :- ()) Metadata
file
    forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (forall fs typ. RemoteFile fs typ -> Maybe (Trusted FileInfo)
remoteFileDefaultInfo RemoteFile (f :- ()) Metadata
file) TargetPath
targetPath down Metadata
tempPath
    Signed a
signed   <- forall e' (m :: * -> *) e a.
(Throws e', MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsChecked (TargetPath -> DeserializationError -> VerificationError
VerificationErrorDeserialization TargetPath
targetPath) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                  forall (m :: * -> *) a (down :: * -> *).
(MonadIO m, FromJSON ReadJSON_Keys_Layout a) =>
Repository down
-> KeyEnv -> down Metadata -> m (Either DeserializationError a)
readDownloadedJSON Repository down
rep KeyEnv
cachedKeyEnv down Metadata
tempPath
    SignaturesVerified a
verified <- forall e' (m :: * -> *) e a.
(Throws e', MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsChecked forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a.
VerifyRole a =>
Trusted Root
-> TargetPath
-> Maybe FileVersion
-> Maybe UTCTime
-> Signed a
-> Either VerificationError (SignaturesVerified a)
verifyRole
                  Trusted Root
cachedRoot
                  TargetPath
targetPath
                  (forall fs typ. CachedInfo -> RemoteFile fs typ -> Maybe FileVersion
cachedVersion CachedInfo
cachedInfo RemoteFile (f :- ()) Metadata
file)
                  Maybe UTCTime
mNow
                  Signed a
signed
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. SignaturesVerified a -> Trusted a
trustVerified SignaturesVerified a
verified, down Metadata
tempPath)

{-------------------------------------------------------------------------------
  Downloading target files
-------------------------------------------------------------------------------}

-- | Download a package
downloadPackage :: ( Throws SomeRemoteError
                   , Throws VerificationError
                   , Throws InvalidPackageException
                   )
                => Repository down    -- ^ Repository
                -> PackageIdentifier  -- ^ Package to download
                -> Path Absolute      -- ^ Destination (see also 'downloadPackage'')
                -> IO ()
downloadPackage :: forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError,
 Throws InvalidPackageException) =>
Repository down -> PackageIdentifier -> Path Absolute -> IO ()
downloadPackage rep :: Repository down
rep@Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} PackageIdentifier
pkgId Path Absolute
dest =
    forall (down :: * -> *) a. Repository down -> IO a -> IO a
withMirror Repository down
rep forall a b. (a -> b) -> a -> b
$
      forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
withIndex Repository down
rep forall a b. (a -> b) -> a -> b
$ \IndexCallbacks{Directory
Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted ByteString)
Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted Targets)
(Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted Hash)
(Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
indexDirectory :: IndexCallbacks -> Directory
indexLookupHash :: IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
   PackageIdentifier -> IO (Trusted Hash)
indexLookupFileInfo :: IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
   PackageIdentifier -> IO (Trusted FileInfo)
indexLookupMetadata :: IndexCallbacks
-> Throws InvalidPackageException =>
   PackageIdentifier -> IO (Trusted Targets)
indexLookupCabal :: IndexCallbacks
-> Throws InvalidPackageException =>
   PackageIdentifier -> IO (Trusted ByteString)
indexLookupFileEntry :: IndexCallbacks
-> forall dec.
   DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
indexLookupFile :: IndexCallbacks
-> forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
indexLookupEntry :: IndexCallbacks
-> DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
indexDirectory :: Directory
indexLookupHash :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted Hash)
indexLookupFileInfo :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
indexLookupMetadata :: Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted Targets)
indexLookupCabal :: Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted ByteString)
indexLookupFileEntry :: forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
indexLookupFile :: forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
indexLookupEntry :: DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
..} -> forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache forall a b. (a -> b) -> a -> b
$ do
        -- Get the metadata (from the previously updated index)
        Trusted FileInfo
targetFileInfo <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
indexLookupFileInfo PackageIdentifier
pkgId

        -- TODO: should we check if cached package available? (spec says no)
        down Binary
tarGz <- do
          (TargetPath
targetPath, down Binary
downloaded) <- forall f (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (TargetPath, down typ)
getRemote' Repository down
rep (Int -> AttemptNr
AttemptNr Int
0) forall a b. (a -> b) -> a -> b
$
            PackageIdentifier
-> Trusted FileInfo -> RemoteFile (FormatGz :- ()) Binary
RemotePkgTarGz PackageIdentifier
pkgId Trusted FileInfo
targetFileInfo
          forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (forall a. a -> Maybe a
Just Trusted FileInfo
targetFileInfo) TargetPath
targetPath down Binary
downloaded
          forall (m :: * -> *) a. Monad m => a -> m a
return down Binary
downloaded

        -- If all checks succeed, copy file to its target location.
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (down :: * -> *) a.
DownloadedFile down =>
down a -> Path Absolute -> IO ()
downloadedCopyTo down Binary
tarGz Path Absolute
dest

-- | Variation on 'downloadPackage' that takes a FilePath instead.
downloadPackage' :: ( Throws SomeRemoteError
                    , Throws VerificationError
                    , Throws InvalidPackageException
                    )
                 => Repository down    -- ^ Repository
                 -> PackageIdentifier  -- ^ Package to download
                 -> FilePath           -- ^ Destination
                 -> IO ()
downloadPackage' :: forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError,
 Throws InvalidPackageException) =>
Repository down -> PackageIdentifier -> String -> IO ()
downloadPackage' Repository down
rep PackageIdentifier
pkgId String
dest =
    forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError,
 Throws InvalidPackageException) =>
Repository down -> PackageIdentifier -> Path Absolute -> IO ()
downloadPackage Repository down
rep PackageIdentifier
pkgId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FsPath -> IO (Path Absolute)
makeAbsolute (String -> FsPath
fromFilePath String
dest)

{-------------------------------------------------------------------------------
  Access to the tar index (the API is exported and used internally)

  NOTE: The files inside the index as evaluated lazily.

  1. The index tarball contains delegated target.json files for both unsigned
     and signed packages. We need to verify the signatures of all signed
     metadata (that is: the metadata for signed packages).

  2. Since the tarball also contains the .cabal files, we should also verify the
     hashes of those .cabal files against the hashes recorded in signed metadata
     (there is no point comparing against hashes recorded in unsigned metadata
     because attackers could just change those).

  Since we don't have author signing yet, we don't have any additional signed
  metadata and therefore we currently don't have to do anything here.

  TODO: If we have explicit, author-signed, lists of versions for a package (as
  described in @README.md@), then evaluating these "middle-level" delegation
  files lazily opens us up to a rollback attack: if we've never downloaded the
  delegations for a package before, then we have nothing to compare the version
  number in the file that we downloaded against. One option is to always
  download and verify all these middle level files (strictly); other is to
  include the version number of all of these files in the snapshot. This is
  described in more detail in
  <https://github.com/theupdateframework/tuf/issues/282#issuecomment-102468421>.

  TODO: Currently we hardcode the location of the package specific metadata. By
  rights we should read the global targets file and apply the delegation rules.
  Until we have author signing however this is unnecessary.
-------------------------------------------------------------------------------}

-- | Index directory
data Directory = Directory {
    -- | The first entry in the dictionary
    Directory -> DirectoryEntry
directoryFirst :: DirectoryEntry

    -- | The next available (i.e., one after last) directory entry
  , Directory -> DirectoryEntry
directoryNext :: DirectoryEntry

    -- | Lookup an entry in the dictionary
    --
    -- This is an efficient operation.
  , Directory -> forall dec. IndexFile dec -> Maybe DirectoryEntry
directoryLookup :: forall dec. IndexFile dec -> Maybe DirectoryEntry

    -- | An enumeration of all entries
    --
    -- This field is lazily constructed, so if you don't need it, it does not
    -- incur a performance overhead. Moreover, the 'IndexFile' is also created
    -- lazily so if you only need the raw 'IndexPath' there is no parsing
    -- overhead.
    --
    -- The entries are ordered by 'DirectoryEntry' so that the entries can
    -- efficiently be read in sequence.
    --
    -- NOTE: This means that there are two ways to enumerate all entries in the
    -- tar file, since when lookup an entry using 'indexLookupEntry' the
    -- 'DirectoryEntry' of the next entry is also returned. However, this
    -- involves reading through the entire @tar@ file. If you only need to read
    -- /some/ files, it is significantly more efficient to enumerate the tar
    -- entries using 'directoryEntries' instead and only call 'indexLookupEntry'
    -- when required.
  , Directory -> [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
directoryEntries :: [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
  }

-- | Entry into the Hackage index.
newtype DirectoryEntry = DirectoryEntry {
    -- | (Low-level) block number of the tar index entry
    --
    -- Exposed for the benefit of clients who read the @.tar@ file directly.
    -- For this reason also the 'Show' and 'Read' instances for 'DirectoryEntry'
    -- just print and parse the underlying 'TarEntryOffset'.
    DirectoryEntry -> TarEntryOffset
directoryEntryBlockNo :: Tar.TarEntryOffset
  }
  deriving (DirectoryEntry -> DirectoryEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirectoryEntry -> DirectoryEntry -> Bool
$c/= :: DirectoryEntry -> DirectoryEntry -> Bool
== :: DirectoryEntry -> DirectoryEntry -> Bool
$c== :: DirectoryEntry -> DirectoryEntry -> Bool
Eq, Eq DirectoryEntry
DirectoryEntry -> DirectoryEntry -> Bool
DirectoryEntry -> DirectoryEntry -> Ordering
DirectoryEntry -> DirectoryEntry -> DirectoryEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DirectoryEntry -> DirectoryEntry -> DirectoryEntry
$cmin :: DirectoryEntry -> DirectoryEntry -> DirectoryEntry
max :: DirectoryEntry -> DirectoryEntry -> DirectoryEntry
$cmax :: DirectoryEntry -> DirectoryEntry -> DirectoryEntry
>= :: DirectoryEntry -> DirectoryEntry -> Bool
$c>= :: DirectoryEntry -> DirectoryEntry -> Bool
> :: DirectoryEntry -> DirectoryEntry -> Bool
$c> :: DirectoryEntry -> DirectoryEntry -> Bool
<= :: DirectoryEntry -> DirectoryEntry -> Bool
$c<= :: DirectoryEntry -> DirectoryEntry -> Bool
< :: DirectoryEntry -> DirectoryEntry -> Bool
$c< :: DirectoryEntry -> DirectoryEntry -> Bool
compare :: DirectoryEntry -> DirectoryEntry -> Ordering
$ccompare :: DirectoryEntry -> DirectoryEntry -> Ordering
Ord)

instance Show DirectoryEntry where
  show :: DirectoryEntry -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectoryEntry -> TarEntryOffset
directoryEntryBlockNo

instance Read DirectoryEntry where
  readsPrec :: Int -> ReadS DirectoryEntry
readsPrec Int
p = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first TarEntryOffset -> DirectoryEntry
DirectoryEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => Int -> ReadS a
readsPrec Int
p

-- | Read the Hackage index directory
--
-- Should only be called after 'checkForUpdates'.
getDirectory :: Repository down -> IO Directory
getDirectory :: forall (down :: * -> *). Repository down -> IO Directory
getDirectory Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} = TarIndex -> Directory
mkDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TarIndex
repGetIndexIdx
  where
    mkDirectory :: Tar.TarIndex -> Directory
    mkDirectory :: TarIndex -> Directory
mkDirectory TarIndex
idx = Directory {
        directoryFirst :: DirectoryEntry
directoryFirst   = TarEntryOffset -> DirectoryEntry
DirectoryEntry TarEntryOffset
0
      , directoryNext :: DirectoryEntry
directoryNext    = TarEntryOffset -> DirectoryEntry
DirectoryEntry forall a b. (a -> b) -> a -> b
$ TarIndex -> TarEntryOffset
Tar.indexEndEntryOffset TarIndex
idx
      , directoryLookup :: forall dec. IndexFile dec -> Maybe DirectoryEntry
directoryLookup  = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM TarIndexEntry -> DirectoryEntry
dirEntry forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarIndex -> String -> Maybe TarIndexEntry
Tar.lookup TarIndex
idx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. IndexFile dec -> String
filePath
      , directoryEntries :: [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
directoryEntries = forall a b. (a -> b) -> [a] -> [b]
map (String, TarEntryOffset)
-> (DirectoryEntry, IndexPath, Maybe (Some IndexFile))
mkEntry forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd) (TarIndex -> [(String, TarEntryOffset)]
Tar.toList TarIndex
idx)
      }

    mkEntry :: (FilePath, Tar.TarEntryOffset)
            -> (DirectoryEntry, IndexPath, Maybe (Some IndexFile))
    mkEntry :: (String, TarEntryOffset)
-> (DirectoryEntry, IndexPath, Maybe (Some IndexFile))
mkEntry (String
fp, TarEntryOffset
off) = (TarEntryOffset -> DirectoryEntry
DirectoryEntry TarEntryOffset
off, IndexPath
path, IndexPath -> Maybe (Some IndexFile)
indexFile IndexPath
path)
      where
        path :: IndexPath
path = String -> IndexPath
indexPath String
fp

    dirEntry :: Tar.TarIndexEntry -> DirectoryEntry
    dirEntry :: TarIndexEntry -> DirectoryEntry
dirEntry (Tar.TarFileEntry TarEntryOffset
offset) = TarEntryOffset -> DirectoryEntry
DirectoryEntry TarEntryOffset
offset
    dirEntry (Tar.TarDir [(String, TarIndexEntry)]
_) = forall a. HasCallStack => String -> a
error String
"directoryLookup: unexpected directory"

    indexFile :: IndexPath -> Maybe (Some IndexFile)
    indexFile :: IndexPath -> Maybe (Some IndexFile)
indexFile = IndexLayout -> IndexPath -> Maybe (Some IndexFile)
indexFileFromPath IndexLayout
repIndexLayout

    indexPath :: FilePath -> IndexPath
    indexPath :: String -> IndexPath
indexPath = forall root. Path Unrooted -> Path root
rootPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath

    filePath :: IndexFile dec -> FilePath
    filePath :: forall dec. IndexFile dec -> String
filePath = Path Unrooted -> String
toUnrootedFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall root. Path root -> Path Unrooted
unrootPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexLayout -> forall dec. IndexFile dec -> IndexPath
indexFileToPath IndexLayout
repIndexLayout

-- | Entry from the Hackage index; see 'withIndex'.
data IndexEntry dec = IndexEntry {
    -- | The raw path in the tarfile
    forall dec. IndexEntry dec -> IndexPath
indexEntryPath :: IndexPath

    -- | The parsed file (if recognised)
  , forall dec. IndexEntry dec -> Maybe (IndexFile dec)
indexEntryPathParsed :: Maybe (IndexFile dec)

    -- | The raw contents
    --
    -- Although this is a lazy bytestring, this is actually read into memory
    -- strictly (i.e., it can safely be used outside the scope of withIndex and
    -- friends).
  , forall dec. IndexEntry dec -> ByteString
indexEntryContent :: BS.L.ByteString

    -- | The parsed contents
    --
    -- This field is lazily constructed; the parser is not unless you do a
    -- pattern match on this value.
  , forall dec. IndexEntry dec -> Either SomeException dec
indexEntryContentParsed :: Either SomeException dec

    -- | The time of the entry in the tarfile.
  , forall dec. IndexEntry dec -> EpochTime
indexEntryTime :: Tar.EpochTime
  }

-- | Various operations that we can perform on the index once its open
--
-- Note that 'IndexEntry' contains a fields both for the raw file contents and
-- the parsed file contents; clients can choose which to use.
--
-- In principle these callbacks will do verification (once we have implemented
-- author signing). Right now they don't need to do that, because the index as a
-- whole will have been verified.
data IndexCallbacks = IndexCallbacks {
    -- | Look up an entry by 'DirectoryEntry'
    --
    -- Since these 'DirectoryEntry's must come from somewhere (probably from the
    -- 'Directory'), it is assumed that they are valid; if they are not, an
    -- (unchecked) exception will be thrown.
    --
    -- This function also returns the 'DirectoryEntry' of the /next/ file in the
    -- index (if any) for the benefit of clients who wish to walk through the
    -- entire index.
    IndexCallbacks
-> DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
indexLookupEntry :: DirectoryEntry
                     -> IO (Some IndexEntry, Maybe DirectoryEntry)

    -- | Look up an entry by 'IndexFile'
    --
    -- Returns 'Nothing' if the 'IndexFile' does not refer to an existing file.
  , IndexCallbacks
-> forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
indexLookupFile :: forall dec.
                       IndexFile dec
                    -> IO (Maybe (IndexEntry dec))

    -- | Variation if both the 'DirectoryEntry' and the 'IndexFile' are known
    --
    -- You might use this when scanning the index using 'directoryEntries'.
  , IndexCallbacks
-> forall dec.
   DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
indexLookupFileEntry :: forall dec.
                            DirectoryEntry
                         -> IndexFile dec
                         -> IO (IndexEntry dec)

    -- | Get (raw) cabal file (wrapper around 'indexLookupFile')
  , IndexCallbacks
-> Throws InvalidPackageException =>
   PackageIdentifier -> IO (Trusted ByteString)
indexLookupCabal :: Throws InvalidPackageException
                     => PackageIdentifier
                     -> IO (Trusted BS.L.ByteString)

    -- | Lookup package metadata (wrapper around 'indexLookupFile')
    --
    -- This will throw an (unchecked) exception if the @targets.json@ file
    -- could not be parsed.
  , IndexCallbacks
-> Throws InvalidPackageException =>
   PackageIdentifier -> IO (Trusted Targets)
indexLookupMetadata :: Throws InvalidPackageException
                        => PackageIdentifier
                        -> IO (Trusted Targets)

    -- | Get file info (including hash) (wrapper around 'indexLookupFile')
  , IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
   PackageIdentifier -> IO (Trusted FileInfo)
indexLookupFileInfo :: ( Throws InvalidPackageException
                           , Throws VerificationError
                           )
                        => PackageIdentifier
                        -> IO (Trusted FileInfo)

    -- | Get the SHA256 hash for a package (wrapper around 'indexLookupInfo')
    --
    -- In addition to the exceptions thrown by 'indexLookupInfo', this will also
    -- throw an exception if the SHA256 is not listed in the 'FileMap' (again,
    -- this will not happen with a well-formed Hackage index.)
  , IndexCallbacks
-> (Throws InvalidPackageException, Throws VerificationError) =>
   PackageIdentifier -> IO (Trusted Hash)
indexLookupHash :: ( Throws InvalidPackageException
                       , Throws VerificationError
                       )
                    => PackageIdentifier
                    -> IO (Trusted Hash)

    -- | The 'Directory' for the index
    --
    -- We provide this here because 'withIndex' will have read this anyway.
  , IndexCallbacks -> Directory
indexDirectory :: Directory
  }

-- | Look up entries in the Hackage index
--
-- This is in 'withFile' style so that clients can efficiently look up multiple
-- files from the index.
--
-- Should only be called after 'checkForUpdates'.
withIndex :: Repository down -> (IndexCallbacks -> IO a) -> IO a
withIndex :: forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
withIndex rep :: Repository down
rep@Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} IndexCallbacks -> IO a
callback = do
    -- We need the cached root information in order to resolve key IDs and
    -- verify signatures. Note that whenever we read a JSON file, we verify
    -- signatures (even if we don't verify the keys); if this is a problem
    -- (for performance) we need to parameterize parseJSON.
    (Trusted Root
_cachedRoot, KeyEnv
keyEnv) <- forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m (Trusted Root, KeyEnv)
readLocalRoot Repository down
rep

    -- We need the directory to resolve 'IndexFile's and to know the index of
    -- the last entry.
    dir :: Directory
dir@Directory{[(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
DirectoryEntry
forall dec. IndexFile dec -> Maybe DirectoryEntry
directoryEntries :: [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
directoryLookup :: forall dec. IndexFile dec -> Maybe DirectoryEntry
directoryNext :: DirectoryEntry
directoryFirst :: DirectoryEntry
directoryEntries :: Directory -> [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
directoryLookup :: Directory -> forall dec. IndexFile dec -> Maybe DirectoryEntry
directoryNext :: Directory -> DirectoryEntry
directoryFirst :: Directory -> DirectoryEntry
..} <- forall (down :: * -> *). Repository down -> IO Directory
getDirectory Repository down
rep

    -- Open the index
    forall a. (Handle -> IO a) -> IO a
repWithIndex forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
      let getEntry :: DirectoryEntry
                   -> IO (Some IndexEntry, Maybe DirectoryEntry)
          getEntry :: DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
getEntry DirectoryEntry
entry = do
            (Entry
tarEntry, ByteString
content, Maybe DirectoryEntry
next) <- DirectoryEntry -> IO (Entry, ByteString, Maybe DirectoryEntry)
getTarEntry DirectoryEntry
entry
            let path :: IndexPath
path = Entry -> IndexPath
indexPath Entry
tarEntry
            case IndexPath -> Maybe (Some IndexFile)
indexFile IndexPath
path of
              Maybe (Some IndexFile)
Nothing ->
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. f a -> Some f
Some (forall dec.
Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content forall a. Maybe a
Nothing), Maybe DirectoryEntry
next)
              Just (Some IndexFile a
file) ->
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. f a -> Some f
Some (forall dec.
Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content (forall a. a -> Maybe a
Just IndexFile a
file)), Maybe DirectoryEntry
next)

          getFile :: IndexFile dec -> IO (Maybe (IndexEntry dec))
          getFile :: forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
getFile IndexFile dec
file =
            case forall dec. IndexFile dec -> Maybe DirectoryEntry
directoryLookup IndexFile dec
file of
              Maybe DirectoryEntry
Nothing       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              Just DirectoryEntry
dirEntry -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
getFileEntry DirectoryEntry
dirEntry IndexFile dec
file

          getFileEntry :: DirectoryEntry
                       -> IndexFile dec
                       -> IO (IndexEntry dec)
          getFileEntry :: forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
getFileEntry DirectoryEntry
dirEntry IndexFile dec
file = do
            (Entry
tarEntry, ByteString
content, Maybe DirectoryEntry
_next) <- DirectoryEntry -> IO (Entry, ByteString, Maybe DirectoryEntry)
getTarEntry DirectoryEntry
dirEntry
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall dec.
Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content (forall a. a -> Maybe a
Just IndexFile dec
file)

          mkEntry :: Tar.Entry
                  -> BS.L.ByteString
                  -> Maybe (IndexFile dec)
                  -> IndexEntry dec
          mkEntry :: forall dec.
Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content Maybe (IndexFile dec)
mFile = IndexEntry {
              indexEntryPath :: IndexPath
indexEntryPath          = Entry -> IndexPath
indexPath Entry
tarEntry
            , indexEntryPathParsed :: Maybe (IndexFile dec)
indexEntryPathParsed    = Maybe (IndexFile dec)
mFile
            , indexEntryContent :: ByteString
indexEntryContent       = ByteString
content
            , indexEntryContentParsed :: Either SomeException dec
indexEntryContentParsed = forall dec.
Maybe (IndexFile dec) -> ByteString -> Either SomeException dec
parseContent Maybe (IndexFile dec)
mFile ByteString
content
            , indexEntryTime :: EpochTime
indexEntryTime          = Entry -> EpochTime
Tar.entryTime Entry
tarEntry
            }

          parseContent :: Maybe (IndexFile dec)
                       -> BS.L.ByteString -> Either SomeException dec
          parseContent :: forall dec.
Maybe (IndexFile dec) -> ByteString -> Either SomeException dec
parseContent Maybe (IndexFile dec)
Nothing     ByteString
_   = forall a b. a -> Either a b
Left SomeException
pathNotRecognized
          parseContent (Just IndexFile dec
file) ByteString
raw = case IndexFile dec
file of
            IndexPkgPrefs PackageName
_ ->
              forall a b. b -> Either a b
Right () -- We don't currently parse preference files
            IndexPkgCabal PackageIdentifier
_ ->
              forall a b. b -> Either a b
Right () -- We don't currently parse .cabal files
            IndexPkgMetadata PackageIdentifier
_ ->
              let mkEx :: Either DeserializationError dec -> Either SomeException dec
mkEx = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                           (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
SomeException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec.
IndexFile dec
-> ByteString -> DeserializationError -> InvalidFileInIndex
InvalidFileInIndex IndexFile dec
file ByteString
raw)
                           forall a b. b -> Either a b
Right
              in Either DeserializationError dec -> Either SomeException dec
mkEx forall a b. (a -> b) -> a -> b
$ forall a.
FromJSON ReadJSON_Keys_NoLayout a =>
KeyEnv -> ByteString -> Either DeserializationError a
parseJSON_Keys_NoLayout KeyEnv
keyEnv ByteString
raw

          -- Read an entry from the tar file. Returns entry content separately,
          -- throwing an exception if the entry is not a regular file.
          -- Also throws an exception if the 'DirectoryEntry' is invalid.
          getTarEntry :: DirectoryEntry
                      -> IO (Tar.Entry, BS.L.ByteString, Maybe DirectoryEntry)
          getTarEntry :: DirectoryEntry -> IO (Entry, ByteString, Maybe DirectoryEntry)
getTarEntry (DirectoryEntry TarEntryOffset
offset) = do
            Entry
entry   <- Handle -> TarEntryOffset -> IO Entry
Tar.hReadEntry Handle
h TarEntryOffset
offset
            ByteString
content <- case Entry -> EntryContent
Tar.entryContent Entry
entry of
                         Tar.NormalFile ByteString
content EpochTime
_sz -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
                         EntryContent
_ -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"withIndex: unexpected entry"
            let next :: DirectoryEntry
next  = TarEntryOffset -> DirectoryEntry
DirectoryEntry forall a b. (a -> b) -> a -> b
$ Entry -> TarEntryOffset -> TarEntryOffset
Tar.nextEntryOffset Entry
entry TarEntryOffset
offset
                mNext :: Maybe DirectoryEntry
mNext = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (DirectoryEntry
next forall a. Ord a => a -> a -> Bool
< DirectoryEntry
directoryNext) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return DirectoryEntry
next
            forall (m :: * -> *) a. Monad m => a -> m a
return (Entry
entry, ByteString
content, Maybe DirectoryEntry
mNext)

          -- Get cabal file
          getCabal :: Throws InvalidPackageException
                   => PackageIdentifier -> IO (Trusted BS.L.ByteString)
          getCabal :: Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted ByteString)
getCabal PackageIdentifier
pkgId = do
            Maybe (IndexEntry ())
mCabal <- forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
getFile forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> IndexFile ()
IndexPkgCabal PackageIdentifier
pkgId
            case Maybe (IndexEntry ())
mCabal of
              Maybe (IndexEntry ())
Nothing ->
                forall e a. (Exception e, Throws e) => e -> IO a
throwChecked forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> InvalidPackageException
InvalidPackageException PackageIdentifier
pkgId
              Just IndexEntry{EpochTime
Maybe (IndexFile ())
Either SomeException ()
ByteString
IndexPath
indexEntryTime :: EpochTime
indexEntryContentParsed :: Either SomeException ()
indexEntryContent :: ByteString
indexEntryPathParsed :: Maybe (IndexFile ())
indexEntryPath :: IndexPath
indexEntryTime :: forall dec. IndexEntry dec -> EpochTime
indexEntryContentParsed :: forall dec. IndexEntry dec -> Either SomeException dec
indexEntryContent :: forall dec. IndexEntry dec -> ByteString
indexEntryPathParsed :: forall dec. IndexEntry dec -> Maybe (IndexFile dec)
indexEntryPath :: forall dec. IndexEntry dec -> IndexPath
..} ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Trusted a
DeclareTrusted ByteString
indexEntryContent

          -- Get package metadata
          getMetadata :: Throws InvalidPackageException
                      => PackageIdentifier -> IO (Trusted Targets)
          getMetadata :: Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted Targets)
getMetadata PackageIdentifier
pkgId = do
            Maybe (IndexEntry (Signed Targets))
mEntry <- forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
getFile forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> IndexFile (Signed Targets)
IndexPkgMetadata PackageIdentifier
pkgId
            case Maybe (IndexEntry (Signed Targets))
mEntry of
              Maybe (IndexEntry (Signed Targets))
Nothing ->
                forall e a. (Exception e, Throws e) => e -> IO a
throwChecked forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> InvalidPackageException
InvalidPackageException PackageIdentifier
pkgId
              Just IndexEntry{indexEntryContentParsed :: forall dec. IndexEntry dec -> Either SomeException dec
indexEntryContentParsed = Left SomeException
ex} ->
                forall e a. Exception e => e -> IO a
throwUnchecked forall a b. (a -> b) -> a -> b
$ SomeException
ex
              Just IndexEntry{indexEntryContentParsed :: forall dec. IndexEntry dec -> Either SomeException dec
indexEntryContentParsed = Right Signed Targets
signed} ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Signed a -> Trusted a
trustLocalFile Signed Targets
signed

          -- Get package info
          getFileInfo :: ( Throws InvalidPackageException
                         , Throws VerificationError
                         )
                      => PackageIdentifier -> IO (Trusted FileInfo)
          getFileInfo :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
getFileInfo PackageIdentifier
pkgId = do
            Trusted Targets
targets <- Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted Targets)
getMetadata PackageIdentifier
pkgId

            let mTargetMetadata :: Maybe (Trusted FileInfo)
                mTargetMetadata :: Maybe (Trusted FileInfo)
mTargetMetadata = forall (f :: * -> *) a.
Traversable f =>
Trusted (f a) -> f (Trusted a)
trustElems
                                forall a b. (a -> b) -> a -> b
$ forall a. StaticPtr a -> Trusted a
trustStatic (static TargetPath -> Targets -> Maybe FileInfo
targetsLookup)
                     forall a b. Trusted (a -> b) -> Trusted a -> Trusted b
`trustApply` forall a. a -> Trusted a
DeclareTrusted (PackageIdentifier -> TargetPath
targetPath PackageIdentifier
pkgId)
                     forall a b. Trusted (a -> b) -> Trusted a -> Trusted b
`trustApply` Trusted Targets
targets

            case Maybe (Trusted FileInfo)
mTargetMetadata of
              Maybe (Trusted FileInfo)
Nothing ->
                forall e a. (Exception e, Throws e) => e -> IO a
throwChecked forall a b. (a -> b) -> a -> b
$ TargetPath -> VerificationError
VerificationErrorUnknownTarget (PackageIdentifier -> TargetPath
targetPath PackageIdentifier
pkgId)
              Just Trusted FileInfo
info ->
                forall (m :: * -> *) a. Monad m => a -> m a
return Trusted FileInfo
info

          -- Get package SHA256
          getHash :: ( Throws InvalidPackageException
                     , Throws VerificationError
                     )
                  => PackageIdentifier -> IO (Trusted Hash)
          getHash :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted Hash)
getHash PackageIdentifier
pkgId = do
            Trusted FileInfo
info <- (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
getFileInfo PackageIdentifier
pkgId

            let mTrustedHash :: Maybe (Trusted Hash)
                mTrustedHash :: Maybe (Trusted Hash)
mTrustedHash = forall (f :: * -> *) a.
Traversable f =>
Trusted (f a) -> f (Trusted a)
trustElems
                             forall a b. (a -> b) -> a -> b
$ forall a. StaticPtr a -> Trusted a
trustStatic (static FileInfo -> Maybe Hash
fileInfoSHA256)
                  forall a b. Trusted (a -> b) -> Trusted a -> Trusted b
`trustApply` Trusted FileInfo
info

            case Maybe (Trusted Hash)
mTrustedHash of
              Maybe (Trusted Hash)
Nothing ->
                forall e a. (Exception e, Throws e) => e -> IO a
throwChecked forall a b. (a -> b) -> a -> b
$ TargetPath -> VerificationError
VerificationErrorMissingSHA256 (PackageIdentifier -> TargetPath
targetPath PackageIdentifier
pkgId)
              Just Trusted Hash
hash ->
                forall (m :: * -> *) a. Monad m => a -> m a
return Trusted Hash
hash

      IndexCallbacks -> IO a
callback IndexCallbacks{
          indexLookupEntry :: DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
indexLookupEntry     = DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry)
getEntry
        , indexLookupFile :: forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
indexLookupFile      = forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
getFile
        , indexLookupFileEntry :: forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
indexLookupFileEntry = forall dec. DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec)
getFileEntry
        , indexDirectory :: Directory
indexDirectory       = Directory
dir
        , indexLookupCabal :: Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted ByteString)
indexLookupCabal     = Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted ByteString)
getCabal
        , indexLookupMetadata :: Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted Targets)
indexLookupMetadata  = Throws InvalidPackageException =>
PackageIdentifier -> IO (Trusted Targets)
getMetadata
        , indexLookupFileInfo :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
indexLookupFileInfo  = (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
getFileInfo
        , indexLookupHash :: (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted Hash)
indexLookupHash      = (Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted Hash)
getHash
        }
  where
    indexPath :: Tar.Entry -> IndexPath
    indexPath :: Entry -> IndexPath
indexPath = forall root. Path Unrooted -> Path root
rootPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarPath -> String
Tar.fromTarPathToPosixPath
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> TarPath
Tar.entryTarPath

    indexFile :: IndexPath -> Maybe (Some IndexFile)
    indexFile :: IndexPath -> Maybe (Some IndexFile)
indexFile = IndexLayout -> IndexPath -> Maybe (Some IndexFile)
indexFileFromPath IndexLayout
repIndexLayout

    targetPath :: PackageIdentifier -> TargetPath
    targetPath :: PackageIdentifier -> TargetPath
targetPath = RepoPath -> TargetPath
TargetPathRepo forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoLayout -> PackageIdentifier -> RepoPath
repoLayoutPkgTarGz RepoLayout
repLayout

    pathNotRecognized :: SomeException
    pathNotRecognized :: SomeException
pathNotRecognized = forall e. Exception e => e -> SomeException
SomeException (String -> IOError
userError String
"Path not recognized")

{-------------------------------------------------------------------------------
  Bootstrapping
-------------------------------------------------------------------------------}

-- | Check if we need to bootstrap (i.e., if we have root info)
requiresBootstrap :: Repository down -> IO Bool
requiresBootstrap :: forall (down :: * -> *). Repository down -> IO Bool
requiresBootstrap Repository down
rep = forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetCached Repository down
rep CachedFile
CachedRoot

-- | Bootstrap the chain of trust
--
-- New clients might need to obtain a copy of the root metadata. This however
-- represents a chicken-and-egg problem: how can we verify the root metadata
-- we downloaded? The only possibility is to be provided with a set of an
-- out-of-band set of root keys and an appropriate threshold.
--
-- Clients who provide a threshold of 0 can do an initial "unsafe" update
-- of the root information, if they wish.
--
-- The downloaded root information will _only_ be verified against the
-- provided keys, and _not_ against previously downloaded root info (if any).
-- It is the responsibility of the client to call `bootstrap` only when this
-- is the desired behaviour.
bootstrap :: (Throws SomeRemoteError, Throws VerificationError)
          => Repository down -> [KeyId] -> KeyThreshold -> IO ()
bootstrap :: forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError) =>
Repository down -> [KeyId] -> KeyThreshold -> IO ()
bootstrap rep :: Repository down
rep@Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} [KeyId]
trustedRootKeys KeyThreshold
keyThreshold = forall (down :: * -> *) a. Repository down -> IO a -> IO a
withMirror Repository down
rep forall a b. (a -> b) -> a -> b
$ forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache forall a b. (a -> b) -> a -> b
$ do
    Trusted Root
_newRoot :: Trusted Root <- do
      (TargetPath
targetPath, down Metadata
tempPath) <- forall f (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (TargetPath, down typ)
getRemote' Repository down
rep (Int -> AttemptNr
AttemptNr Int
0) (Maybe (Trusted FileInfo) -> RemoteFile (FormatUn :- ()) Metadata
RemoteRoot forall a. Maybe a
Nothing)
      Signed Root
signed   <- forall e' (m :: * -> *) e a.
(Throws e', MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsChecked (TargetPath -> DeserializationError -> VerificationError
VerificationErrorDeserialization TargetPath
targetPath) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    forall (m :: * -> *) a (down :: * -> *).
(MonadIO m, FromJSON ReadJSON_Keys_Layout a) =>
Repository down
-> KeyEnv -> down Metadata -> m (Either DeserializationError a)
readDownloadedJSON Repository down
rep KeyEnv
KeyEnv.empty down Metadata
tempPath
      SignaturesVerified Root
verified <- forall e' (m :: * -> *) e a.
(Throws e', MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsChecked forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ [KeyId]
-> KeyThreshold
-> TargetPath
-> Signed Root
-> Either VerificationError (SignaturesVerified Root)
verifyFingerprints
                    [KeyId]
trustedRootKeys
                    KeyThreshold
keyThreshold
                    TargetPath
targetPath
                    Signed Root
signed
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. SignaturesVerified a -> Trusted a
trustVerified SignaturesVerified Root
verified

    forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m ()
clearCache Repository down
rep

{-------------------------------------------------------------------------------
  Wrapper around the Repository functions
-------------------------------------------------------------------------------}

getRemote :: forall fs down typ. Throws SomeRemoteError
          => Repository down
          -> AttemptNr
          -> RemoteFile fs typ
          -> Verify (Some Format, TargetPath, down typ)
getRemote :: forall fs (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some Format, TargetPath, down typ)
getRemote Repository down
r AttemptNr
attemptNr RemoteFile fs typ
file = do
    (Some HasFormat fs a
format, down typ
downloaded) <- forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repGetRemote Repository down
r AttemptNr
attemptNr RemoteFile fs typ
file
    let targetPath :: TargetPath
targetPath = RepoPath -> TargetPath
TargetPathRepo forall a b. (a -> b) -> a -> b
$ forall fs typ f.
RepoLayout -> RemoteFile fs typ -> HasFormat fs f -> RepoPath
remoteRepoPath' (forall (down :: * -> *). Repository down -> RepoLayout
repLayout Repository down
r) RemoteFile fs typ
file HasFormat fs a
format
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. f a -> Some f
Some (forall fs f. HasFormat fs f -> Format f
hasFormatGet HasFormat fs a
format), TargetPath
targetPath, down typ
downloaded)

-- | Variation on getRemote where we only expect one type of result
getRemote' :: forall f down typ. Throws SomeRemoteError
           => Repository down
           -> AttemptNr
           -> RemoteFile (f :- ()) typ
           -> Verify (TargetPath, down typ)
getRemote' :: forall f (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (TargetPath, down typ)
getRemote' Repository down
r AttemptNr
isRetry RemoteFile (f :- ()) typ
file = forall {a} {a} {b}. (a, a, b) -> (a, b)
ignoreFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall fs (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some Format, TargetPath, down typ)
getRemote Repository down
r AttemptNr
isRetry RemoteFile (f :- ()) typ
file
  where
    ignoreFormat :: (a, a, b) -> (a, b)
ignoreFormat (a
_format, a
targetPath, b
tempPath) = (a
targetPath, b
tempPath)

clearCache :: MonadIO m => Repository down -> m ()
clearCache :: forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m ()
clearCache Repository down
r = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (down :: * -> *). Repository down -> IO ()
repClearCache Repository down
r

log :: MonadIO m => Repository down -> LogMessage -> m ()
log :: forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> LogMessage -> m ()
log Repository down
r LogMessage
msg = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repLog Repository down
r LogMessage
msg

-- Tries to load the cached mirrors file
withMirror :: Repository down -> IO a -> IO a
withMirror :: forall (down :: * -> *) a. Repository down -> IO a -> IO a
withMirror Repository down
rep IO a
callback = do
    Maybe (Path Absolute)
mMirrors <- forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetCached Repository down
rep CachedFile
CachedMirrors
    Maybe [Mirror]
mirrors  <- case Maybe (Path Absolute)
mMirrors of
      Maybe (Path Absolute)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just Path Absolute
fp -> UninterpretedSignatures Mirrors -> Maybe [Mirror]
filterMirrors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   (forall (m :: * -> *) e' e a.
(MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsUnchecked DeserializationError -> LocalFileCorrupted
LocalFileCorrupted forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                     forall root a.
(FsRoot root, FromJSON ReadJSON_NoKeys_NoLayout a) =>
Path root -> IO (Either DeserializationError a)
readJSON_NoKeys_NoLayout Path Absolute
fp)
    forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repWithMirror Repository down
rep Maybe [Mirror]
mirrors forall a b. (a -> b) -> a -> b
$ IO a
callback
  where
    filterMirrors :: UninterpretedSignatures Mirrors -> Maybe [Mirror]
    filterMirrors :: UninterpretedSignatures Mirrors -> Maybe [Mirror]
filterMirrors = forall a. a -> Maybe a
Just
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (MirrorContent -> Bool
canUseMirror forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mirror -> MirrorContent
mirrorContent)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mirrors -> [Mirror]
mirrorsMirrors
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. UninterpretedSignatures a -> a
uninterpretedSigned

    -- Once we add support for partial mirrors, we wil need an additional
    -- argument to 'repWithMirror' (here, not in the Repository API itself)
    -- that tells us which files we will be requested from the mirror.
    -- We can then compare that against the specification of the partial mirror
    -- to see if all of those files are available from this mirror.
    canUseMirror :: MirrorContent -> Bool
    canUseMirror :: MirrorContent -> Bool
canUseMirror MirrorContent
MirrorFull = Bool
True

{-------------------------------------------------------------------------------
  Exceptions
-------------------------------------------------------------------------------}

-- | Re-throw all exceptions thrown by the client API as unchecked exceptions
uncheckClientErrors :: ( ( Throws VerificationError
                         , Throws SomeRemoteError
                         , Throws InvalidPackageException
                         ) => IO a )
                     -> IO a
uncheckClientErrors :: forall a.
((Throws VerificationError, Throws SomeRemoteError,
  Throws InvalidPackageException) =>
 IO a)
-> IO a
uncheckClientErrors (Throws VerificationError, Throws SomeRemoteError,
 Throws InvalidPackageException) =>
IO a
act = forall e a.
Exception e =>
(e -> IO a) -> (Throws e => IO a) -> IO a
handleChecked forall a. VerificationError -> IO a
rethrowVerificationError
                        forall a b. (a -> b) -> a -> b
$ forall e a.
Exception e =>
(e -> IO a) -> (Throws e => IO a) -> IO a
handleChecked forall a. SomeRemoteError -> IO a
rethrowSomeRemoteError
                        forall a b. (a -> b) -> a -> b
$ forall e a.
Exception e =>
(e -> IO a) -> (Throws e => IO a) -> IO a
handleChecked forall a. InvalidPackageException -> IO a
rethrowInvalidPackageException
                        forall a b. (a -> b) -> a -> b
$ (Throws VerificationError, Throws SomeRemoteError,
 Throws InvalidPackageException) =>
IO a
act
  where
     rethrowVerificationError :: VerificationError -> IO a
     rethrowVerificationError :: forall a. VerificationError -> IO a
rethrowVerificationError = forall e a. Exception e => e -> IO a
throwIO

     rethrowSomeRemoteError :: SomeRemoteError -> IO a
     rethrowSomeRemoteError :: forall a. SomeRemoteError -> IO a
rethrowSomeRemoteError = forall e a. Exception e => e -> IO a
throwIO

     rethrowInvalidPackageException :: InvalidPackageException -> IO a
     rethrowInvalidPackageException :: forall a. InvalidPackageException -> IO a
rethrowInvalidPackageException = forall e a. Exception e => e -> IO a
throwIO

data InvalidPackageException = InvalidPackageException PackageIdentifier
  deriving (Typeable)

data LocalFileCorrupted = LocalFileCorrupted DeserializationError
  deriving (Typeable)

data InvalidFileInIndex = forall dec. InvalidFileInIndex {
    ()
invalidFileInIndex      :: IndexFile dec
  , InvalidFileInIndex -> ByteString
invalidFileInIndexRaw   :: BS.L.ByteString
  , InvalidFileInIndex -> DeserializationError
invalidFileInIndexError :: DeserializationError
  }
  deriving (Typeable)

#if MIN_VERSION_base(4,8,0)
deriving instance Show InvalidPackageException
deriving instance Show LocalFileCorrupted
deriving instance Show InvalidFileInIndex
instance Exception InvalidPackageException where displayException :: InvalidPackageException -> String
displayException = forall a. Pretty a => a -> String
pretty
instance Exception LocalFileCorrupted where displayException :: LocalFileCorrupted -> String
displayException = forall a. Pretty a => a -> String
pretty
instance Exception InvalidFileInIndex where displayException :: InvalidFileInIndex -> String
displayException = forall a. Pretty a => a -> String
pretty
#else
instance Show InvalidPackageException where show = pretty
instance Show LocalFileCorrupted where show = pretty
instance Show InvalidFileInIndex where show = pretty
instance Exception InvalidPackageException
instance Exception LocalFileCorrupted
instance Exception InvalidFileInIndex
#endif

instance Pretty InvalidPackageException where
  pretty :: InvalidPackageException -> String
pretty (InvalidPackageException PackageIdentifier
pkgId) = String
"Invalid package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
display PackageIdentifier
pkgId

instance Pretty LocalFileCorrupted where
  pretty :: LocalFileCorrupted -> String
pretty (LocalFileCorrupted DeserializationError
err) = String
"Local file corrupted: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
pretty DeserializationError
err

instance Pretty InvalidFileInIndex where
  pretty :: InvalidFileInIndex -> String
pretty (InvalidFileInIndex IndexFile dec
file ByteString
raw DeserializationError
err) = [String] -> String
unlines [
      String
"Invalid file in index: "  forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
pretty IndexFile dec
file
    , String
"Error: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
pretty DeserializationError
err
    , String
"Unparsed file: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS.L.C8.unpack ByteString
raw
    ]

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

-- | Local files are assumed trusted
--
-- There is no point tracking chain of trust for local files because that chain
-- would necessarily have to start at an implicitly trusted (though unverified)
-- file: the root metadata.
trustLocalFile :: Signed a -> Trusted a
trustLocalFile :: forall a. Signed a -> Trusted a
trustLocalFile Signed{a
Signatures
signatures :: forall a. Signed a -> Signatures
signatures :: Signatures
signed :: a
signed :: forall a. Signed a -> a
..} = forall a. a -> Trusted a
DeclareTrusted a
signed

-- | Just a simple wrapper around 'verifyFileInfo'
--
-- Throws a VerificationError if verification failed.
verifyFileInfo' :: (MonadIO m, DownloadedFile down)
                => Maybe (Trusted FileInfo)
                -> TargetPath  -- ^ For error messages
                -> down typ    -- ^ File to verify
                -> m ()
verifyFileInfo' :: forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' Maybe (Trusted FileInfo)
Nothing     TargetPath
_          down typ
_        = forall (m :: * -> *) a. Monad m => a -> m a
return ()
verifyFileInfo' (Just Trusted FileInfo
info) TargetPath
targetPath down typ
tempPath = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Bool
verified <- forall (down :: * -> *) a.
DownloadedFile down =>
down a -> Trusted FileInfo -> IO Bool
downloadedVerify down typ
tempPath Trusted FileInfo
info
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
verified forall a b. (a -> b) -> a -> b
$ forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ TargetPath -> VerificationError
VerificationErrorFileInfo TargetPath
targetPath

readCachedJSON :: (MonadIO m, FromJSON ReadJSON_Keys_Layout a)
               => Repository down -> KeyEnv -> Path Absolute
               -> m (Either DeserializationError a)
readCachedJSON :: forall (m :: * -> *) a (down :: * -> *).
(MonadIO m, FromJSON ReadJSON_Keys_Layout a) =>
Repository down
-> KeyEnv -> Path Absolute -> m (Either DeserializationError a)
readCachedJSON Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} KeyEnv
keyEnv Path Absolute
fp = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- forall root. FsRoot root => Path root -> IO ByteString
readLazyByteString Path Absolute
fp
    forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a.
FromJSON ReadJSON_Keys_Layout a =>
KeyEnv -> RepoLayout -> ByteString -> Either DeserializationError a
parseJSON_Keys_Layout KeyEnv
keyEnv RepoLayout
repLayout ByteString
bs

readDownloadedJSON :: (MonadIO m, FromJSON ReadJSON_Keys_Layout a)
                   => Repository down -> KeyEnv -> down Metadata
                   -> m (Either DeserializationError a)
readDownloadedJSON :: forall (m :: * -> *) a (down :: * -> *).
(MonadIO m, FromJSON ReadJSON_Keys_Layout a) =>
Repository down
-> KeyEnv -> down Metadata -> m (Either DeserializationError a)
readDownloadedJSON Repository{String
IO ()
IO TarIndex
IO (Path Absolute)
RepoLayout
IndexLayout
IO () -> IO ()
LogMessage -> IO ()
CachedFile -> IO (Maybe (Path Absolute))
forall a. Maybe [Mirror] -> IO a -> IO a
forall a. (Handle -> IO a) -> IO a
forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: String
repIndexLayout :: IndexLayout
repLayout :: RepoLayout
repLog :: LogMessage -> IO ()
repWithMirror :: forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: IO () -> IO ()
repGetIndexIdx :: IO TarIndex
repWithIndex :: forall a. (Handle -> IO a) -> IO a
repClearCache :: IO ()
repGetCachedRoot :: IO (Path Absolute)
repGetCached :: CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall fs typ.
Throws SomeRemoteError =>
AttemptNr
-> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
repDescription :: forall (down :: * -> *). Repository down -> String
repIndexLayout :: forall (down :: * -> *). Repository down -> IndexLayout
repLayout :: forall (down :: * -> *). Repository down -> RepoLayout
repLog :: forall (down :: * -> *). Repository down -> LogMessage -> IO ()
repWithMirror :: forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repLockCache :: forall (down :: * -> *). Repository down -> IO () -> IO ()
repGetIndexIdx :: forall (down :: * -> *). Repository down -> IO TarIndex
repWithIndex :: forall (down :: * -> *).
Repository down -> forall a. (Handle -> IO a) -> IO a
repClearCache :: forall (down :: * -> *). Repository down -> IO ()
repGetCachedRoot :: forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCached :: forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetRemote :: forall (down :: * -> *).
Repository down
-> forall fs typ.
   Throws SomeRemoteError =>
   AttemptNr
   -> RemoteFile fs typ -> Verify (Some (HasFormat fs), down typ)
..} KeyEnv
keyEnv down Metadata
fp = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- forall (down :: * -> *).
DownloadedFile down =>
down Metadata -> IO ByteString
downloadedRead down Metadata
fp
    forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a.
FromJSON ReadJSON_Keys_Layout a =>
KeyEnv -> RepoLayout -> ByteString -> Either DeserializationError a
parseJSON_Keys_Layout KeyEnv
keyEnv RepoLayout
repLayout ByteString
bs

throwErrorsUnchecked :: ( MonadIO m
                        , Exception e'
                        )
                     => (e -> e') -> Either e a -> m a
throwErrorsUnchecked :: forall (m :: * -> *) e' e a.
(MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsUnchecked e -> e'
f (Left e
err) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwUnchecked (e -> e'
f e
err)
throwErrorsUnchecked e -> e'
_ (Right a
a)  = forall (m :: * -> *) a. Monad m => a -> m a
return a
a

throwErrorsChecked :: ( Throws e'
                      , MonadIO m
                      , Exception e'
                      )
                   => (e -> e') -> Either e a -> m a
throwErrorsChecked :: forall e' (m :: * -> *) e a.
(Throws e', MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsChecked e -> e'
f (Left e
err) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. (Exception e, Throws e) => e -> IO a
throwChecked (e -> e'
f e
err)
throwErrorsChecked e -> e'
_ (Right a
a)  = forall (m :: * -> *) a. Monad m => a -> m a
return a
a

eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe :: forall a b. Either a b -> Maybe b
eitherToMaybe (Left  a
_) = forall a. Maybe a
Nothing
eitherToMaybe (Right b
b) = forall a. a -> Maybe a
Just b
b