{-# 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
(Int -> HasUpdates -> ShowS)
-> (HasUpdates -> String)
-> ([HasUpdates] -> ShowS)
-> Show HasUpdates
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
(HasUpdates -> HasUpdates -> Bool)
-> (HasUpdates -> HasUpdates -> Bool) -> Eq HasUpdates
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
Eq HasUpdates
-> (HasUpdates -> HasUpdates -> Ordering)
-> (HasUpdates -> HasUpdates -> Bool)
-> (HasUpdates -> HasUpdates -> Bool)
-> (HasUpdates -> HasUpdates -> Bool)
-> (HasUpdates -> HasUpdates -> Bool)
-> (HasUpdates -> HasUpdates -> HasUpdates)
-> (HasUpdates -> HasUpdates -> HasUpdates)
-> Ord 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
$cp1Ord :: Eq HasUpdates
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 packge 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 :: 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 =
    Repository down -> IO HasUpdates -> IO HasUpdates
forall (down :: * -> *) a. Repository down -> IO a -> IO a
withMirror Repository down
rep (IO HasUpdates -> IO HasUpdates) -> IO HasUpdates -> IO HasUpdates
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 | VerificationHistory -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length VerificationHistory
history Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxNumIterations =
        VerificationError -> IO HasUpdates
forall e a. (Exception e, Throws e) => e -> IO a
throwChecked (VerificationError -> IO HasUpdates)
-> VerificationError -> IO HasUpdates
forall a b. (a -> b) -> a -> b
$ VerificationHistory -> VerificationError
VerificationErrorLoop (VerificationHistory -> VerificationHistory
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 <- Repository down -> IO CachedInfo
forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m CachedInfo
getCachedInfo Repository down
rep

        Either VerificationError (Either RootUpdated HasUpdates)
mHasUpdates <- (Throws VerificationError => IO (Either RootUpdated HasUpdates))
-> IO (Either VerificationError (Either RootUpdated HasUpdates))
forall e a. Exception e => (Throws e => IO a) -> IO (Either e a)
tryChecked -- catch RootUpdated
                     ((Throws VerificationError => IO (Either RootUpdated HasUpdates))
 -> IO (Either VerificationError (Either RootUpdated HasUpdates)))
-> (Throws VerificationError => IO (Either RootUpdated HasUpdates))
-> IO (Either VerificationError (Either RootUpdated HasUpdates))
forall a b. (a -> b) -> a -> b
$ (Throws RootUpdated => IO HasUpdates)
-> IO (Either RootUpdated HasUpdates)
forall e a. Exception e => (Throws e => IO a) -> IO (Either e a)
tryChecked -- catch VerificationError
                     ((Throws RootUpdated => IO HasUpdates)
 -> IO (Either RootUpdated HasUpdates))
-> (Throws RootUpdated => IO HasUpdates)
-> IO (Either RootUpdated HasUpdates)
forall a b. (a -> b) -> a -> b
$ (IO () -> IO ()) -> Verify HasUpdates -> IO HasUpdates
forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache
                     (Verify HasUpdates -> IO HasUpdates)
-> Verify HasUpdates -> IO HasUpdates
forall a b. (a -> b) -> a -> b
$ Throws RootUpdated => AttemptNr -> CachedInfo -> Verify HasUpdates
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.
            Repository down -> LogMessage -> IO ()
forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> LogMessage -> m ()
log Repository down
rep (LogMessage -> IO ()) -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ VerificationError -> LogMessage
LogVerificationError VerificationError
ex
            let history' :: VerificationHistory
history'   = VerificationError -> Either RootUpdated VerificationError
forall a b. b -> Either a b
Right VerificationError
ex Either RootUpdated VerificationError
-> VerificationHistory -> VerificationHistory
forall a. a -> [a] -> [a]
: VerificationHistory
history
                attemptNr' :: AttemptNr
attemptNr' = AttemptNr
attemptNr AttemptNr -> AttemptNr -> AttemptNr
forall a. Num a => a -> a -> a
+ AttemptNr
1
            Repository down
-> Maybe UTCTime
-> AttemptNr
-> CachedInfo
-> Either VerificationError (Trusted FileInfo)
-> IO ()
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 (VerificationError -> Either VerificationError (Trusted FileInfo)
forall a b. a -> Either a b
Left VerificationError
ex)
            VerificationHistory -> IO HasUpdates
limitIterations VerificationHistory
history'
          Right (Left RootUpdated
RootUpdated) -> do
            Repository down -> LogMessage -> IO ()
forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> LogMessage -> m ()
log Repository down
rep (LogMessage -> IO ()) -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ LogMessage
LogRootUpdated
            let history' :: VerificationHistory
history' = RootUpdated -> Either RootUpdated VerificationError
forall a b. a -> Either a b
Left RootUpdated
RootUpdated Either RootUpdated VerificationError
-> VerificationHistory -> VerificationHistory
forall a. a -> [a] -> [a]
: VerificationHistory
history
            VerificationHistory -> IO HasUpdates
limitIterations VerificationHistory
history'
          Right (Right HasUpdates
hasUpdates) ->
            HasUpdates -> IO HasUpdates
forall (m :: * -> *) a. Monad m => a -> m a
return HasUpdates
hasUpdates
      where
        attemptNr :: AttemptNr
        attemptNr :: AttemptNr
attemptNr = Int -> AttemptNr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> AttemptNr) -> Int -> AttemptNr
forall a b. (a -> b) -> a -> b
$ VerificationHistory -> Int
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 :: 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 <- RemoteFile (FormatUn :- ()) Metadata -> Verify (Trusted Timestamp)
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 StaticPtr (Timestamp -> FileInfo)
-> Trusted Timestamp -> Trusted FileInfo
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 HasUpdates -> Verify HasUpdates
forall (m :: * -> *) a. Monad m => a -> m a
return HasUpdates
NoUpdates
        else do
          -- Get the new snapshot
          Trusted Snapshot
newSS <- RemoteFile (FormatUn :- ()) Metadata -> Verify (Trusted Snapshot)
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    StaticPtr (Snapshot -> FileInfo)
-> Trusted Snapshot -> Trusted FileInfo
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS
              newInfoMirrors :: Trusted FileInfo
newInfoMirrors = static Snapshot -> FileInfo
snapshotInfoMirrors StaticPtr (Snapshot -> FileInfo)
-> Trusted Snapshot -> Trusted FileInfo
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS
              newInfoTarGz :: Trusted FileInfo
newInfoTarGz   = static Snapshot -> FileInfo
snapshotInfoTarGz   StaticPtr (Snapshot -> FileInfo)
-> Trusted Snapshot -> Trusted FileInfo
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS
              mNewInfoTar :: Maybe (Trusted FileInfo)
mNewInfoTar    = Trusted (Maybe FileInfo) -> Maybe (Trusted FileInfo)
forall (f :: * -> *) a.
Traversable f =>
Trusted (f a) -> f (Trusted a)
trustElems (static Snapshot -> Maybe FileInfo
snapshotInfoTar StaticPtr (Snapshot -> Maybe FileInfo)
-> Trusted Snapshot -> Trusted (Maybe FileInfo)
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$> Trusted Snapshot
newSS)

          -- If root metadata changed, download and restart
          Bool -> Verify () -> Verify ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
rootChanged Maybe (Trusted FileInfo)
cachedInfoRoot Trusted FileInfo
newInfoRoot) (Verify () -> Verify ()) -> Verify () -> Verify ()
forall a b. (a -> b) -> a -> b
$ IO () -> Verify ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Verify ()) -> IO () -> Verify ()
forall a b. (a -> b) -> a -> b
$ do
            Repository down
-> Maybe UTCTime
-> AttemptNr
-> CachedInfo
-> Either VerificationError (Trusted FileInfo)
-> IO ()
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 (Trusted FileInfo -> Either VerificationError (Trusted FileInfo)
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.
            RootUpdated -> IO ()
forall e a. (Exception e, Throws e) => e -> IO a
throwChecked RootUpdated
RootUpdated

          -- If mirrors changed, download and verify
          Bool -> Verify () -> Verify ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
fileChanged Maybe (Trusted FileInfo)
cachedInfoMirrors Trusted FileInfo
newInfoMirrors) (Verify () -> Verify ()) -> Verify () -> Verify ()
forall a b. (a -> b) -> a -> b
$
            Trusted Mirrors -> Verify ()
newMirrors (Trusted Mirrors -> Verify ())
-> Verify (Trusted Mirrors) -> Verify ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RemoteFile (FormatUn :- ()) Metadata -> Verify (Trusted Mirrors)
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
          Bool -> Verify () -> Verify ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Trusted FileInfo) -> Trusted FileInfo -> Bool
fileChanged Maybe (Trusted FileInfo)
cachedInfoTarGz Trusted FileInfo
newInfoTarGz) (Verify () -> Verify ()) -> Verify () -> Verify ()
forall a b. (a -> b) -> a -> b
$
            Trusted FileInfo -> Maybe (Trusted FileInfo) -> Verify ()
updateIndex Trusted FileInfo
newInfoTarGz Maybe (Trusted FileInfo)
mNewInfoTar

          HasUpdates -> Verify HasUpdates
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' :: RemoteFile (f :- ()) Metadata -> Verify (Trusted a)
getRemoteFile' = ((Trusted a, down Metadata) -> Trusted a)
-> Verify (Trusted a, down Metadata) -> Verify (Trusted a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Trusted a, down Metadata) -> Trusted a
forall a b. (a, b) -> a
fst (Verify (Trusted a, down Metadata) -> Verify (Trusted a))
-> (RemoteFile (f :- ()) Metadata
    -> Verify (Trusted a, down Metadata))
-> RemoteFile (f :- ()) Metadata
-> Verify (Trusted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repository down
-> CachedInfo
-> AttemptNr
-> Maybe UTCTime
-> RemoteFile (f :- ()) Metadata
-> Verify (Trusted a, down Metadata)
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) <- Repository down
-> AttemptNr
-> RemoteFile (FormatGz :- ()) Binary
-> Verify (TargetPath, down Binary)
forall f (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (TargetPath, down typ)
getRemote' Repository down
rep AttemptNr
attemptNr (RemoteFile (FormatGz :- ()) Binary
 -> Verify (TargetPath, down Binary))
-> RemoteFile (FormatGz :- ()) Binary
-> Verify (TargetPath, down Binary)
forall a b. (a -> b) -> a -> b
$
            HasFormat (FormatGz :- ()) FormatGz
-> Formats (FormatGz :- ()) (Trusted FileInfo)
-> RemoteFile (FormatGz :- ()) Binary
forall fs.
HasFormat fs FormatGz
-> Formats fs (Trusted FileInfo) -> RemoteFile fs Binary
RemoteIndex (Format FormatGz -> HasFormat (FormatGz :- ()) FormatGz
forall f fs. Format f -> HasFormat (f :- fs) f
HFZ Format FormatGz
FGz) (Trusted FileInfo -> Formats (FormatGz :- ()) (Trusted FileInfo)
forall a. a -> Formats (FormatGz :- ()) a
FsGz Trusted FileInfo
newInfoTarGz)
          Maybe (Trusted FileInfo) -> TargetPath -> down Binary -> Verify ()
forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (Trusted FileInfo -> Maybe (Trusted FileInfo)
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) <- Repository down
-> AttemptNr
-> RemoteFile (FormatUn :- (FormatGz :- ())) Binary
-> Verify (Some Format, TargetPath, down Binary)
forall fs (down :: * -> *) typ.
Throws SomeRemoteError =>
Repository down
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some Format, TargetPath, down typ)
getRemote Repository down
rep AttemptNr
attemptNr (RemoteFile (FormatUn :- (FormatGz :- ())) Binary
 -> Verify (Some Format, TargetPath, down Binary))
-> RemoteFile (FormatUn :- (FormatGz :- ())) Binary
-> Verify (Some Format, TargetPath, down Binary)
forall a b. (a -> b) -> a -> b
$
            HasFormat (FormatUn :- (FormatGz :- ())) FormatGz
-> Formats (FormatUn :- (FormatGz :- ())) (Trusted FileInfo)
-> RemoteFile (FormatUn :- (FormatGz :- ())) Binary
forall fs.
HasFormat fs FormatGz
-> Formats fs (Trusted FileInfo) -> RemoteFile fs Binary
RemoteIndex (HasFormat (FormatGz :- ()) FormatGz
-> HasFormat (FormatUn :- (FormatGz :- ())) FormatGz
forall fs f f'. HasFormat fs f -> HasFormat (f' :- fs) f
HFS (Format FormatGz -> HasFormat (FormatGz :- ()) FormatGz
forall f fs. Format f -> HasFormat (f :- fs) f
HFZ Format FormatGz
FGz)) (Trusted FileInfo
-> Trusted FileInfo
-> Formats (FormatUn :- (FormatGz :- ())) (Trusted FileInfo)
forall a. a -> a -> Formats (FormatUn :- (FormatGz :- ())) a
FsUnGz Trusted FileInfo
newInfoTar Trusted FileInfo
newInfoTarGz)
          case Some Format
format of
            Some Format a
FGz -> Maybe (Trusted FileInfo) -> TargetPath -> down Binary -> Verify ()
forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (Trusted FileInfo -> Maybe (Trusted FileInfo)
forall a. a -> Maybe a
Just Trusted FileInfo
newInfoTarGz) TargetPath
targetPath down Binary
tempPath
            Some Format a
FUn -> Maybe (Trusted FileInfo) -> TargetPath -> down Binary -> Verify ()
forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (Trusted FileInfo -> Maybe (Trusted FileInfo)
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
_ = () -> Verify ()
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 :: 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 <- (IO () -> IO ()) -> Verify Bool -> IO Bool
forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache (Verify Bool -> IO Bool) -> Verify Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
      (Trusted Root
_newRoot :: Trusted Root, down Metadata
rootTempFile) <- Repository down
-> CachedInfo
-> AttemptNr
-> Maybe UTCTime
-> RemoteFile (FormatUn :- ()) Metadata
-> Verify (Trusted Root, down Metadata)
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 (Either VerificationError (Trusted FileInfo)
-> Maybe (Trusted FileInfo)
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.
          Bool -> Verify Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Left VerificationError
_e -> IO Bool -> Verify Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Verify Bool) -> IO Bool -> Verify Bool
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 <- FileInfo -> Trusted FileInfo
forall a. a -> Trusted a
DeclareTrusted (FileInfo -> Trusted FileInfo)
-> IO FileInfo -> IO (Trusted FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Absolute -> IO FileInfo
forall root. FsRoot root => Path root -> IO FileInfo
computeFileInfo Path Absolute
oldRootFile
          Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> down Metadata -> Trusted FileInfo -> IO Bool
forall (down :: * -> *) a.
DownloadedFile down =>
down a -> Trusted FileInfo -> IO Bool
downloadedVerify down Metadata
rootTempFile Trusted FileInfo
oldRootInfo

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rootReallyChanged (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository down -> IO ()
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 :: 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 RemoteFile fs typ -> IsCached typ
forall fs typ. RemoteFile fs typ -> IsCached typ
mustCache RemoteFile fs typ
remoteFile of
      CacheAs CachedFile
CachedTimestamp -> Timestamp -> FileVersion
timestampVersion (Timestamp -> FileVersion)
-> (Trusted Timestamp -> Timestamp)
-> Trusted Timestamp
-> FileVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trusted Timestamp -> Timestamp
forall a. Trusted a -> a
trusted (Trusted Timestamp -> FileVersion)
-> Maybe (Trusted Timestamp) -> Maybe FileVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Trusted Timestamp)
cachedTimestamp
      CacheAs CachedFile
CachedSnapshot  -> Snapshot -> FileVersion
snapshotVersion  (Snapshot -> FileVersion)
-> (Trusted Snapshot -> Snapshot)
-> Trusted Snapshot
-> FileVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trusted Snapshot -> Snapshot
forall a. Trusted a -> a
trusted (Trusted Snapshot -> FileVersion)
-> Maybe (Trusted Snapshot) -> Maybe FileVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Trusted Snapshot)
cachedSnapshot
      CacheAs CachedFile
CachedMirrors   -> Mirrors -> FileVersion
mirrorsVersion   (Mirrors -> FileVersion)
-> (Trusted Mirrors -> Mirrors) -> Trusted Mirrors -> FileVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trusted Mirrors -> Mirrors
forall a. Trusted a -> a
trusted (Trusted Mirrors -> FileVersion)
-> Maybe (Trusted Mirrors) -> Maybe FileVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Trusted Mirrors)
cachedMirrors
      CacheAs CachedFile
CachedRoot      -> FileVersion -> Maybe FileVersion
forall a. a -> Maybe a
Just (FileVersion -> Maybe FileVersion)
-> (Trusted Root -> FileVersion)
-> Trusted Root
-> Maybe FileVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Root -> FileVersion
rootVersion (Root -> FileVersion)
-> (Trusted Root -> Root) -> Trusted Root -> FileVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trusted Root -> Root
forall a. Trusted a -> a
trusted (Trusted Root -> Maybe FileVersion)
-> Trusted Root -> Maybe FileVersion
forall a b. (a -> b) -> a -> b
$ Trusted Root
cachedRoot
      IsCached typ
CacheIndex -> Maybe FileVersion
forall a. Maybe a
Nothing
      IsCached typ
DontCache  -> Maybe FileVersion
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 :: Repository down -> m CachedInfo
getCachedInfo Repository down
rep = do
    (Trusted Root
cachedRoot, KeyEnv
cachedKeyEnv) <- Repository down -> m (Trusted Root, KeyEnv)
forall (m :: * -> *) (down :: * -> *).
MonadIO m =>
Repository down -> m (Trusted Root, KeyEnv)
readLocalRoot Repository down
rep
    Maybe (Trusted Timestamp)
cachedTimestamp <- Repository down
-> KeyEnv -> CachedFile -> m (Maybe (Trusted Timestamp))
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  <- Repository down
-> KeyEnv -> CachedFile -> m (Maybe (Trusted Snapshot))
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   <- Repository down
-> KeyEnv -> CachedFile -> m (Maybe (Trusted Mirrors))
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 = (Trusted Timestamp -> Trusted FileInfo)
-> Maybe (Trusted Timestamp) -> Maybe (Trusted FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Timestamp -> FileInfo
timestampInfoSnapshot StaticPtr (Timestamp -> FileInfo)
-> Trusted Timestamp -> Trusted FileInfo
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Timestamp)
cachedTimestamp
        cachedInfoRoot :: Maybe (Trusted FileInfo)
cachedInfoRoot     = (Trusted Snapshot -> Trusted FileInfo)
-> Maybe (Trusted Snapshot) -> Maybe (Trusted FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Snapshot -> FileInfo
snapshotInfoRoot      StaticPtr (Snapshot -> FileInfo)
-> Trusted Snapshot -> Trusted FileInfo
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Snapshot)
cachedSnapshot
        cachedInfoMirrors :: Maybe (Trusted FileInfo)
cachedInfoMirrors  = (Trusted Snapshot -> Trusted FileInfo)
-> Maybe (Trusted Snapshot) -> Maybe (Trusted FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Snapshot -> FileInfo
snapshotInfoMirrors   StaticPtr (Snapshot -> FileInfo)
-> Trusted Snapshot -> Trusted FileInfo
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Snapshot)
cachedSnapshot
        cachedInfoTarGz :: Maybe (Trusted FileInfo)
cachedInfoTarGz    = (Trusted Snapshot -> Trusted FileInfo)
-> Maybe (Trusted Snapshot) -> Maybe (Trusted FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (static Snapshot -> FileInfo
snapshotInfoTarGz     StaticPtr (Snapshot -> FileInfo)
-> Trusted Snapshot -> Trusted FileInfo
forall a b. StaticPtr (a -> b) -> Trusted a -> Trusted b
<$$>) Maybe (Trusted Snapshot)
cachedSnapshot

    CachedInfo -> m CachedInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CachedInfo :: Trusted Root
-> KeyEnv
-> Maybe (Trusted Timestamp)
-> Maybe (Trusted Snapshot)
-> Maybe (Trusted Mirrors)
-> Maybe (Trusted FileInfo)
-> Maybe (Trusted FileInfo)
-> Maybe (Trusted FileInfo)
-> Maybe (Trusted FileInfo)
-> 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 :: 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 :: Repository down -> m (Trusted Root, KeyEnv)
readLocalRoot Repository down
rep = do
    Path Absolute
cachedPath <- IO (Path Absolute) -> m (Path Absolute)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Absolute) -> m (Path Absolute))
-> IO (Path Absolute) -> m (Path Absolute)
forall a b. (a -> b) -> a -> b
$ Repository down -> IO (Path Absolute)
forall (down :: * -> *). Repository down -> IO (Path Absolute)
repGetCachedRoot Repository down
rep
    Signed Root
signedRoot <- (DeserializationError -> LocalFileCorrupted)
-> Either DeserializationError (Signed Root) -> m (Signed Root)
forall (m :: * -> *) e' e a.
(MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsUnchecked DeserializationError -> LocalFileCorrupted
LocalFileCorrupted (Either DeserializationError (Signed Root) -> m (Signed Root))
-> m (Either DeserializationError (Signed Root)) -> m (Signed Root)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    Repository down
-> KeyEnv
-> Path Absolute
-> m (Either DeserializationError (Signed Root))
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
    (Trusted Root, KeyEnv) -> m (Trusted Root, KeyEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (Signed Root -> Trusted Root
forall a. Signed a -> Trusted a
trustLocalFile Signed Root
signedRoot, Root -> KeyEnv
rootKeys (Signed Root -> Root
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 :: Repository down -> KeyEnv -> CachedFile -> m (Maybe (Trusted a))
readLocalFile Repository down
rep KeyEnv
cachedKeyEnv CachedFile
file = do
    Maybe (Path Absolute)
mCachedPath <- IO (Maybe (Path Absolute)) -> m (Maybe (Path Absolute))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Path Absolute)) -> m (Maybe (Path Absolute)))
-> IO (Maybe (Path Absolute)) -> m (Maybe (Path Absolute))
forall a b. (a -> b) -> a -> b
$ Repository down -> CachedFile -> IO (Maybe (Path Absolute))
forall (down :: * -> *).
Repository down -> CachedFile -> IO (Maybe (Path Absolute))
repGetCached Repository down
rep CachedFile
file
    Maybe (Path Absolute)
-> (Path Absolute -> m (Trusted a)) -> m (Maybe (Trusted a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (Path Absolute)
mCachedPath ((Path Absolute -> m (Trusted a)) -> m (Maybe (Trusted a)))
-> (Path Absolute -> m (Trusted a)) -> m (Maybe (Trusted a))
forall a b. (a -> b) -> a -> b
$ \Path Absolute
cachedPath -> do
      Signed a
signed <- (DeserializationError -> LocalFileCorrupted)
-> Either DeserializationError (Signed a) -> m (Signed a)
forall (m :: * -> *) e' e a.
(MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsUnchecked DeserializationError -> LocalFileCorrupted
LocalFileCorrupted (Either DeserializationError (Signed a) -> m (Signed a))
-> m (Either DeserializationError (Signed a)) -> m (Signed a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                  Repository down
-> KeyEnv
-> Path Absolute
-> m (Either DeserializationError (Signed a))
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
      Trusted a -> m (Trusted a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Trusted a -> m (Trusted a)) -> Trusted a -> m (Trusted a)
forall a b. (a -> b) -> a -> b
$ Signed a -> Trusted a
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 :: 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) <- Repository down
-> AttemptNr
-> RemoteFile (f :- ()) Metadata
-> Verify (TargetPath, down Metadata)
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
    Maybe (Trusted FileInfo)
-> TargetPath -> down Metadata -> Verify ()
forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (RemoteFile (f :- ()) Metadata -> Maybe (Trusted FileInfo)
forall fs typ. RemoteFile fs typ -> Maybe (Trusted FileInfo)
remoteFileDefaultInfo RemoteFile (f :- ()) Metadata
file) TargetPath
targetPath down Metadata
tempPath
    Signed a
signed   <- (DeserializationError -> VerificationError)
-> Either DeserializationError (Signed a) -> Verify (Signed a)
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) (Either DeserializationError (Signed a) -> Verify (Signed a))
-> Verify (Either DeserializationError (Signed a))
-> Verify (Signed a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                  Repository down
-> KeyEnv
-> down Metadata
-> Verify (Either DeserializationError (Signed a))
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 <- (VerificationError -> VerificationError)
-> Either VerificationError (SignaturesVerified a)
-> Verify (SignaturesVerified a)
forall e' (m :: * -> *) e a.
(Throws e', MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsChecked VerificationError -> VerificationError
forall a. a -> a
id (Either VerificationError (SignaturesVerified a)
 -> Verify (SignaturesVerified a))
-> Either VerificationError (SignaturesVerified a)
-> Verify (SignaturesVerified a)
forall a b. (a -> b) -> a -> b
$ Trusted Root
-> TargetPath
-> Maybe FileVersion
-> Maybe UTCTime
-> Signed a
-> Either VerificationError (SignaturesVerified a)
forall a.
VerifyRole a =>
Trusted Root
-> TargetPath
-> Maybe FileVersion
-> Maybe UTCTime
-> Signed a
-> Either VerificationError (SignaturesVerified a)
verifyRole
                  Trusted Root
cachedRoot
                  TargetPath
targetPath
                  (CachedInfo -> RemoteFile (f :- ()) Metadata -> Maybe FileVersion
forall fs typ. CachedInfo -> RemoteFile fs typ -> Maybe FileVersion
cachedVersion CachedInfo
cachedInfo RemoteFile (f :- ()) Metadata
file)
                  Maybe UTCTime
mNow
                  Signed a
signed
    (Trusted a, down Metadata) -> Verify (Trusted a, down Metadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (SignaturesVerified a -> Trusted a
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 :: 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 =
    Repository down -> IO () -> IO ()
forall (down :: * -> *) a. Repository down -> IO a -> IO a
withMirror Repository down
rep (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Repository down -> (IndexCallbacks -> IO ()) -> IO ()
forall (down :: * -> *) a.
Repository down -> (IndexCallbacks -> IO a) -> IO a
withIndex Repository down
rep ((IndexCallbacks -> IO ()) -> IO ())
-> (IndexCallbacks -> IO ()) -> IO ()
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)
..} -> (IO () -> IO ()) -> Verify () -> IO ()
forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache (Verify () -> IO ()) -> Verify () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- Get the metadata (from the previously updated index)
        Trusted FileInfo
targetFileInfo <- IO (Trusted FileInfo) -> Verify (Trusted FileInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Trusted FileInfo) -> Verify (Trusted FileInfo))
-> IO (Trusted FileInfo) -> Verify (Trusted FileInfo)
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> IO (Trusted FileInfo)
(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) <- Repository down
-> AttemptNr
-> RemoteFile (FormatGz :- ()) Binary
-> Verify (TargetPath, down Binary)
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) (RemoteFile (FormatGz :- ()) Binary
 -> Verify (TargetPath, down Binary))
-> RemoteFile (FormatGz :- ()) Binary
-> Verify (TargetPath, down Binary)
forall a b. (a -> b) -> a -> b
$
            PackageIdentifier
-> Trusted FileInfo -> RemoteFile (FormatGz :- ()) Binary
RemotePkgTarGz PackageIdentifier
pkgId Trusted FileInfo
targetFileInfo
          Maybe (Trusted FileInfo) -> TargetPath -> down Binary -> Verify ()
forall (m :: * -> *) (down :: * -> *) typ.
(MonadIO m, DownloadedFile down) =>
Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' (Trusted FileInfo -> Maybe (Trusted FileInfo)
forall a. a -> Maybe a
Just Trusted FileInfo
targetFileInfo) TargetPath
targetPath down Binary
downloaded
          down Binary -> Verify (down Binary)
forall (m :: * -> *) a. Monad m => a -> m a
return down Binary
downloaded

        -- If all checks succeed, copy file to its target location.
        IO () -> Verify ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Verify ()) -> IO () -> Verify ()
forall a b. (a -> b) -> a -> b
$ down Binary -> Path Absolute -> IO ()
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' :: Repository down -> PackageIdentifier -> String -> IO ()
downloadPackage' Repository down
rep PackageIdentifier
pkgId String
dest =
    Repository down -> PackageIdentifier -> Path Absolute -> IO ()
forall (down :: * -> *).
(Throws SomeRemoteError, Throws VerificationError,
 Throws InvalidPackageException) =>
Repository down -> PackageIdentifier -> Path Absolute -> IO ()
downloadPackage Repository down
rep PackageIdentifier
pkgId (Path Absolute -> IO ()) -> IO (Path Absolute) -> IO ()
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
(DirectoryEntry -> DirectoryEntry -> Bool)
-> (DirectoryEntry -> DirectoryEntry -> Bool) -> Eq DirectoryEntry
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
Eq DirectoryEntry
-> (DirectoryEntry -> DirectoryEntry -> Ordering)
-> (DirectoryEntry -> DirectoryEntry -> Bool)
-> (DirectoryEntry -> DirectoryEntry -> Bool)
-> (DirectoryEntry -> DirectoryEntry -> Bool)
-> (DirectoryEntry -> DirectoryEntry -> Bool)
-> (DirectoryEntry -> DirectoryEntry -> DirectoryEntry)
-> (DirectoryEntry -> DirectoryEntry -> DirectoryEntry)
-> Ord 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
$cp1Ord :: Eq DirectoryEntry
Ord)

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

instance Read DirectoryEntry where
  readsPrec :: Int -> ReadS DirectoryEntry
readsPrec Int
p = ((TarEntryOffset, String) -> (DirectoryEntry, String))
-> [(TarEntryOffset, String)] -> [(DirectoryEntry, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((TarEntryOffset -> DirectoryEntry)
-> (TarEntryOffset, String) -> (DirectoryEntry, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first TarEntryOffset -> DirectoryEntry
DirectoryEntry) ([(TarEntryOffset, String)] -> [(DirectoryEntry, String)])
-> (String -> [(TarEntryOffset, String)]) -> ReadS DirectoryEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(TarEntryOffset, String)]
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 :: 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 (TarIndex -> Directory) -> IO TarIndex -> IO Directory
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 :: DirectoryEntry
-> DirectoryEntry
-> (forall dec. IndexFile dec -> Maybe DirectoryEntry)
-> [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
-> Directory
Directory {
        directoryFirst :: DirectoryEntry
directoryFirst   = TarEntryOffset -> DirectoryEntry
DirectoryEntry TarEntryOffset
0
      , directoryNext :: DirectoryEntry
directoryNext    = TarEntryOffset -> DirectoryEntry
DirectoryEntry (TarEntryOffset -> DirectoryEntry)
-> TarEntryOffset -> DirectoryEntry
forall a b. (a -> b) -> a -> b
$ TarIndex -> TarEntryOffset
Tar.indexEndEntryOffset TarIndex
idx
      , directoryLookup :: forall dec. IndexFile dec -> Maybe DirectoryEntry
directoryLookup  = (TarIndexEntry -> DirectoryEntry)
-> Maybe TarIndexEntry -> Maybe DirectoryEntry
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM TarIndexEntry -> DirectoryEntry
dirEntry (Maybe TarIndexEntry -> Maybe DirectoryEntry)
-> (IndexFile dec -> Maybe TarIndexEntry)
-> IndexFile dec
-> Maybe DirectoryEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarIndex -> String -> Maybe TarIndexEntry
Tar.lookup TarIndex
idx (String -> Maybe TarIndexEntry)
-> (IndexFile dec -> String)
-> IndexFile dec
-> Maybe TarIndexEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexFile dec -> String
forall dec. IndexFile dec -> String
filePath
      , directoryEntries :: [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
directoryEntries = ((String, TarEntryOffset)
 -> (DirectoryEntry, IndexPath, Maybe (Some IndexFile)))
-> [(String, TarEntryOffset)]
-> [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
forall a b. (a -> b) -> [a] -> [b]
map (String, TarEntryOffset)
-> (DirectoryEntry, IndexPath, Maybe (Some IndexFile))
mkEntry ([(String, TarEntryOffset)]
 -> [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))])
-> [(String, TarEntryOffset)]
-> [(DirectoryEntry, IndexPath, Maybe (Some IndexFile))]
forall a b. (a -> b) -> a -> b
$ ((String, TarEntryOffset) -> (String, TarEntryOffset) -> Ordering)
-> [(String, TarEntryOffset)] -> [(String, TarEntryOffset)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, TarEntryOffset) -> TarEntryOffset)
-> (String, TarEntryOffset) -> (String, TarEntryOffset) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (String, TarEntryOffset) -> TarEntryOffset
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)]
_) = String -> DirectoryEntry
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 = Path Unrooted -> IndexPath
forall root. Path Unrooted -> Path root
rootPath (Path Unrooted -> IndexPath)
-> (String -> Path Unrooted) -> String -> IndexPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath

    filePath :: IndexFile dec -> FilePath
    filePath :: IndexFile dec -> String
filePath = Path Unrooted -> String
toUnrootedFilePath (Path Unrooted -> String)
-> (IndexFile dec -> Path Unrooted) -> IndexFile dec -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexPath -> Path Unrooted
forall root. Path root -> Path Unrooted
unrootPath (IndexPath -> Path Unrooted)
-> (IndexFile dec -> IndexPath) -> IndexFile dec -> Path Unrooted
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
    IndexEntry dec -> IndexPath
indexEntryPath :: IndexPath

    -- | The parsed file (if recognised)
  , 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).
  , 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.
  , IndexEntry dec -> Either SomeException dec
indexEntryContentParsed :: Either SomeException dec

    -- | The time of the entry in the tarfile.
  , 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 :: 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) <- Repository down -> IO (Trusted Root, 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
..} <- Repository down -> IO Directory
forall (down :: * -> *). Repository down -> IO Directory
getDirectory Repository down
rep

    -- Open the index
    (Handle -> IO a) -> IO a
forall a. (Handle -> IO a) -> IO a
repWithIndex ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
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 ->
                (Some IndexEntry, Maybe DirectoryEntry)
-> IO (Some IndexEntry, Maybe DirectoryEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexEntry Any -> Some IndexEntry
forall (f :: * -> *) a. f a -> Some f
Some (Entry -> ByteString -> Maybe (IndexFile Any) -> IndexEntry Any
forall dec.
Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content Maybe (IndexFile Any)
forall a. Maybe a
Nothing), Maybe DirectoryEntry
next)
              Just (Some IndexFile a
file) ->
                (Some IndexEntry, Maybe DirectoryEntry)
-> IO (Some IndexEntry, Maybe DirectoryEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexEntry a -> Some IndexEntry
forall (f :: * -> *) a. f a -> Some f
Some (Entry -> ByteString -> Maybe (IndexFile a) -> IndexEntry a
forall dec.
Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content (IndexFile a -> Maybe (IndexFile a)
forall a. a -> Maybe a
Just IndexFile a
file)), Maybe DirectoryEntry
next)

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

          getFileEntry :: DirectoryEntry
                       -> IndexFile dec
                       -> IO (IndexEntry dec)
          getFileEntry :: 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
            IndexEntry dec -> IO (IndexEntry dec)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexEntry dec -> IO (IndexEntry dec))
-> IndexEntry dec -> IO (IndexEntry dec)
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
forall dec.
Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content (IndexFile dec -> Maybe (IndexFile dec)
forall a. a -> Maybe a
Just IndexFile dec
file)

          mkEntry :: Tar.Entry
                  -> BS.L.ByteString
                  -> Maybe (IndexFile dec)
                  -> IndexEntry dec
          mkEntry :: Entry -> ByteString -> Maybe (IndexFile dec) -> IndexEntry dec
mkEntry Entry
tarEntry ByteString
content Maybe (IndexFile dec)
mFile = IndexEntry :: forall dec.
IndexPath
-> Maybe (IndexFile dec)
-> ByteString
-> Either SomeException dec
-> EpochTime
-> IndexEntry dec
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 = Maybe (IndexFile dec) -> ByteString -> Either SomeException dec
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 :: Maybe (IndexFile dec) -> ByteString -> Either SomeException dec
parseContent Maybe (IndexFile dec)
Nothing     ByteString
_   = SomeException -> Either SomeException dec
forall a b. a -> Either a b
Left SomeException
pathNotRecognized
          parseContent (Just IndexFile dec
file) ByteString
raw = case IndexFile dec
file of
            IndexPkgPrefs PackageName
_ ->
              () -> Either SomeException ()
forall a b. b -> Either a b
Right () -- We don't currently parse preference files
            IndexPkgCabal PackageIdentifier
_ ->
              () -> Either SomeException ()
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 = (DeserializationError -> Either SomeException dec)
-> (dec -> Either SomeException dec)
-> Either DeserializationError dec
-> Either SomeException dec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                           (SomeException -> Either SomeException dec
forall a b. a -> Either a b
Left (SomeException -> Either SomeException dec)
-> (DeserializationError -> SomeException)
-> DeserializationError
-> Either SomeException dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidFileInIndex -> SomeException
forall e. Exception e => e -> SomeException
SomeException (InvalidFileInIndex -> SomeException)
-> (DeserializationError -> InvalidFileInIndex)
-> DeserializationError
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexFile dec
-> ByteString -> DeserializationError -> InvalidFileInIndex
forall dec.
IndexFile dec
-> ByteString -> DeserializationError -> InvalidFileInIndex
InvalidFileInIndex IndexFile dec
file ByteString
raw)
                           dec -> Either SomeException dec
forall a b. b -> Either a b
Right
              in Either DeserializationError dec -> Either SomeException dec
mkEx (Either DeserializationError dec -> Either SomeException dec)
-> Either DeserializationError dec -> Either SomeException dec
forall a b. (a -> b) -> a -> b
$ KeyEnv -> ByteString -> Either DeserializationError dec
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 -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
                         EntryContent
_ -> IOError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ByteString) -> IOError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"withIndex: unexpected entry"
            let next :: DirectoryEntry
next  = TarEntryOffset -> DirectoryEntry
DirectoryEntry (TarEntryOffset -> DirectoryEntry)
-> TarEntryOffset -> DirectoryEntry
forall a b. (a -> b) -> a -> b
$ Entry -> TarEntryOffset -> TarEntryOffset
Tar.nextEntryOffset Entry
entry TarEntryOffset
offset
                mNext :: Maybe DirectoryEntry
mNext = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (DirectoryEntry
next DirectoryEntry -> DirectoryEntry -> Bool
forall a. Ord a => a -> a -> Bool
< DirectoryEntry
directoryNext) Maybe () -> Maybe DirectoryEntry -> Maybe DirectoryEntry
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DirectoryEntry -> Maybe DirectoryEntry
forall (m :: * -> *) a. Monad m => a -> m a
return DirectoryEntry
next
            (Entry, ByteString, Maybe DirectoryEntry)
-> IO (Entry, ByteString, Maybe DirectoryEntry)
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 :: PackageIdentifier -> IO (Trusted ByteString)
getCabal PackageIdentifier
pkgId = do
            Maybe (IndexEntry ())
mCabal <- IndexFile () -> IO (Maybe (IndexEntry ()))
forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec))
getFile (IndexFile () -> IO (Maybe (IndexEntry ())))
-> IndexFile () -> IO (Maybe (IndexEntry ()))
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> IndexFile ()
IndexPkgCabal PackageIdentifier
pkgId
            case Maybe (IndexEntry ())
mCabal of
              Maybe (IndexEntry ())
Nothing ->
                InvalidPackageException -> IO (Trusted ByteString)
forall e a. (Exception e, Throws e) => e -> IO a
throwChecked (InvalidPackageException -> IO (Trusted ByteString))
-> InvalidPackageException -> IO (Trusted ByteString)
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
..} ->
                Trusted ByteString -> IO (Trusted ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Trusted ByteString -> IO (Trusted ByteString))
-> Trusted ByteString -> IO (Trusted ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Trusted ByteString
forall a. a -> Trusted a
DeclareTrusted ByteString
indexEntryContent

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

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

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

            case Maybe (Trusted FileInfo)
mTargetMetadata of
              Maybe (Trusted FileInfo)
Nothing ->
                VerificationError -> IO (Trusted FileInfo)
forall e a. (Exception e, Throws e) => e -> IO a
throwChecked (VerificationError -> IO (Trusted FileInfo))
-> VerificationError -> IO (Trusted FileInfo)
forall a b. (a -> b) -> a -> b
$ TargetPath -> VerificationError
VerificationErrorUnknownTarget (PackageIdentifier -> TargetPath
targetPath PackageIdentifier
pkgId)
              Just Trusted FileInfo
info ->
                Trusted FileInfo -> IO (Trusted FileInfo)
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 :: PackageIdentifier -> IO (Trusted Hash)
getHash PackageIdentifier
pkgId = do
            Trusted FileInfo
info <- PackageIdentifier -> IO (Trusted FileInfo)
(Throws InvalidPackageException, Throws VerificationError) =>
PackageIdentifier -> IO (Trusted FileInfo)
getFileInfo PackageIdentifier
pkgId

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

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

      IndexCallbacks -> IO a
callback IndexCallbacks :: (DirectoryEntry -> IO (Some IndexEntry, Maybe DirectoryEntry))
-> (forall dec. IndexFile dec -> IO (Maybe (IndexEntry dec)))
-> (forall dec.
    DirectoryEntry -> IndexFile dec -> IO (IndexEntry dec))
-> (Throws InvalidPackageException =>
    PackageIdentifier -> IO (Trusted ByteString))
-> (Throws InvalidPackageException =>
    PackageIdentifier -> IO (Trusted Targets))
-> ((Throws InvalidPackageException, Throws VerificationError) =>
    PackageIdentifier -> IO (Trusted FileInfo))
-> ((Throws InvalidPackageException, Throws VerificationError) =>
    PackageIdentifier -> IO (Trusted Hash))
-> Directory
-> IndexCallbacks
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 = Path Unrooted -> IndexPath
forall root. Path Unrooted -> Path root
rootPath (Path Unrooted -> IndexPath)
-> (Entry -> Path Unrooted) -> Entry -> IndexPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath
              (String -> Path Unrooted)
-> (Entry -> String) -> Entry -> Path Unrooted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarPath -> String
Tar.fromTarPathToPosixPath
              (TarPath -> String) -> (Entry -> TarPath) -> Entry -> String
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 (RepoPath -> TargetPath)
-> (PackageIdentifier -> RepoPath)
-> PackageIdentifier
-> TargetPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoLayout -> PackageIdentifier -> RepoPath
repoLayoutPkgTarGz RepoLayout
repLayout

    pathNotRecognized :: SomeException
    pathNotRecognized :: SomeException
pathNotRecognized = IOError -> SomeException
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 :: Repository down -> IO Bool
requiresBootstrap Repository down
rep = Maybe (Path Absolute) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Path Absolute) -> Bool)
-> IO (Maybe (Path Absolute)) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository down -> CachedFile -> IO (Maybe (Path Absolute))
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 :: 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 = Repository down -> IO () -> IO ()
forall (down :: * -> *) a. Repository down -> IO a -> IO a
withMirror Repository down
rep (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (IO () -> IO ()) -> Verify () -> IO ()
forall a. (IO () -> IO ()) -> Verify a -> IO a
runVerify IO () -> IO ()
repLockCache (Verify () -> IO ()) -> Verify () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Trusted Root
_newRoot :: Trusted Root <- do
      (TargetPath
targetPath, down Metadata
tempPath) <- Repository down
-> AttemptNr
-> RemoteFile (FormatUn :- ()) Metadata
-> Verify (TargetPath, down Metadata)
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 Maybe (Trusted FileInfo)
forall a. Maybe a
Nothing)
      Signed Root
signed   <- (DeserializationError -> VerificationError)
-> Either DeserializationError (Signed Root)
-> Verify (Signed Root)
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) (Either DeserializationError (Signed Root) -> Verify (Signed Root))
-> Verify (Either DeserializationError (Signed Root))
-> Verify (Signed Root)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    Repository down
-> KeyEnv
-> down Metadata
-> Verify (Either DeserializationError (Signed Root))
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 <- (VerificationError -> VerificationError)
-> Either VerificationError (SignaturesVerified Root)
-> Verify (SignaturesVerified Root)
forall e' (m :: * -> *) e a.
(Throws e', MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsChecked VerificationError -> VerificationError
forall a. a -> a
id (Either VerificationError (SignaturesVerified Root)
 -> Verify (SignaturesVerified Root))
-> Either VerificationError (SignaturesVerified Root)
-> Verify (SignaturesVerified Root)
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
      Trusted Root -> Verify (Trusted Root)
forall (m :: * -> *) a. Monad m => a -> m a
return (Trusted Root -> Verify (Trusted Root))
-> Trusted Root -> Verify (Trusted Root)
forall a b. (a -> b) -> a -> b
$ SignaturesVerified Root -> Trusted Root
forall a. SignaturesVerified a -> Trusted a
trustVerified SignaturesVerified Root
verified

    Repository down -> Verify ()
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 :: 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) <- Repository down
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some (HasFormat fs), down typ)
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 (RepoPath -> TargetPath) -> RepoPath -> TargetPath
forall a b. (a -> b) -> a -> b
$ RepoLayout -> RemoteFile fs typ -> HasFormat fs a -> RepoPath
forall fs typ f.
RepoLayout -> RemoteFile fs typ -> HasFormat fs f -> RepoPath
remoteRepoPath' (Repository down -> RepoLayout
forall (down :: * -> *). Repository down -> RepoLayout
repLayout Repository down
r) RemoteFile fs typ
file HasFormat fs a
format
    (Some Format, TargetPath, down typ)
-> Verify (Some Format, TargetPath, down typ)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format a -> Some Format
forall (f :: * -> *) a. f a -> Some f
Some (HasFormat fs a -> Format a
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' :: Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (TargetPath, down typ)
getRemote' Repository down
r AttemptNr
isRetry RemoteFile (f :- ()) typ
file = (Some Format, TargetPath, down typ) -> (TargetPath, down typ)
forall a a b. (a, a, b) -> (a, b)
ignoreFormat ((Some Format, TargetPath, down typ) -> (TargetPath, down typ))
-> Verify (Some Format, TargetPath, down typ)
-> Verify (TargetPath, down typ)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository down
-> AttemptNr
-> RemoteFile (f :- ()) typ
-> Verify (Some Format, TargetPath, down typ)
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 :: Repository down -> m ()
clearCache Repository down
r = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Repository down -> IO ()
forall (down :: * -> *). Repository down -> IO ()
repClearCache Repository down
r

log :: MonadIO m => Repository down -> LogMessage -> m ()
log :: Repository down -> LogMessage -> m ()
log Repository down
r LogMessage
msg = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Repository down -> LogMessage -> IO ()
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 :: Repository down -> IO a -> IO a
withMirror Repository down
rep IO a
callback = do
    Maybe (Path Absolute)
mMirrors <- Repository down -> CachedFile -> IO (Maybe (Path Absolute))
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 -> Maybe [Mirror] -> IO (Maybe [Mirror])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Mirror]
forall a. Maybe a
Nothing
      Just Path Absolute
fp -> UninterpretedSignatures Mirrors -> Maybe [Mirror]
filterMirrors (UninterpretedSignatures Mirrors -> Maybe [Mirror])
-> IO (UninterpretedSignatures Mirrors) -> IO (Maybe [Mirror])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   ((DeserializationError -> LocalFileCorrupted)
-> Either DeserializationError (UninterpretedSignatures Mirrors)
-> IO (UninterpretedSignatures Mirrors)
forall (m :: * -> *) e' e a.
(MonadIO m, Exception e') =>
(e -> e') -> Either e a -> m a
throwErrorsUnchecked DeserializationError -> LocalFileCorrupted
LocalFileCorrupted (Either DeserializationError (UninterpretedSignatures Mirrors)
 -> IO (UninterpretedSignatures Mirrors))
-> IO
     (Either DeserializationError (UninterpretedSignatures Mirrors))
-> IO (UninterpretedSignatures Mirrors)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                     Path Absolute
-> IO
     (Either DeserializationError (UninterpretedSignatures Mirrors))
forall root a.
(FsRoot root, FromJSON ReadJSON_NoKeys_NoLayout a) =>
Path root -> IO (Either DeserializationError a)
readJSON_NoKeys_NoLayout Path Absolute
fp)
    Repository down -> Maybe [Mirror] -> IO a -> IO a
forall (down :: * -> *).
Repository down -> forall a. Maybe [Mirror] -> IO a -> IO a
repWithMirror Repository down
rep Maybe [Mirror]
mirrors (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ IO a
callback
  where
    filterMirrors :: UninterpretedSignatures Mirrors -> Maybe [Mirror]
    filterMirrors :: UninterpretedSignatures Mirrors -> Maybe [Mirror]
filterMirrors = [Mirror] -> Maybe [Mirror]
forall a. a -> Maybe a
Just
                  ([Mirror] -> Maybe [Mirror])
-> (UninterpretedSignatures Mirrors -> [Mirror])
-> UninterpretedSignatures Mirrors
-> Maybe [Mirror]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mirror -> Bool) -> [Mirror] -> [Mirror]
forall a. (a -> Bool) -> [a] -> [a]
filter (MirrorContent -> Bool
canUseMirror (MirrorContent -> Bool)
-> (Mirror -> MirrorContent) -> Mirror -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mirror -> MirrorContent
mirrorContent)
                  ([Mirror] -> [Mirror])
-> (UninterpretedSignatures Mirrors -> [Mirror])
-> UninterpretedSignatures Mirrors
-> [Mirror]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mirrors -> [Mirror]
mirrorsMirrors
                  (Mirrors -> [Mirror])
-> (UninterpretedSignatures Mirrors -> Mirrors)
-> UninterpretedSignatures Mirrors
-> [Mirror]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UninterpretedSignatures Mirrors -> Mirrors
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 :: ((Throws VerificationError, Throws SomeRemoteError,
  Throws InvalidPackageException) =>
 IO a)
-> IO a
uncheckClientErrors (Throws VerificationError, Throws SomeRemoteError,
 Throws InvalidPackageException) =>
IO a
act = (VerificationError -> IO a)
-> (Throws VerificationError => IO a) -> IO a
forall e a.
Exception e =>
(e -> IO a) -> (Throws e => IO a) -> IO a
handleChecked VerificationError -> IO a
forall a. VerificationError -> IO a
rethrowVerificationError
                        ((Throws VerificationError => IO a) -> IO a)
-> (Throws VerificationError => IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ (SomeRemoteError -> IO a)
-> (Throws SomeRemoteError => IO a) -> IO a
forall e a.
Exception e =>
(e -> IO a) -> (Throws e => IO a) -> IO a
handleChecked SomeRemoteError -> IO a
forall a. SomeRemoteError -> IO a
rethrowSomeRemoteError
                        ((Throws SomeRemoteError => IO a) -> IO a)
-> (Throws SomeRemoteError => IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ (InvalidPackageException -> IO a)
-> (Throws InvalidPackageException => IO a) -> IO a
forall e a.
Exception e =>
(e -> IO a) -> (Throws e => IO a) -> IO a
handleChecked InvalidPackageException -> IO a
forall a. InvalidPackageException -> IO a
rethrowInvalidPackageException
                        ((Throws InvalidPackageException => IO a) -> IO a)
-> (Throws InvalidPackageException => IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ (Throws VerificationError, Throws SomeRemoteError,
 Throws InvalidPackageException) =>
IO a
Throws InvalidPackageException => IO a
act
  where
     rethrowVerificationError :: VerificationError -> IO a
     rethrowVerificationError :: VerificationError -> IO a
rethrowVerificationError = VerificationError -> IO a
forall e a. Exception e => e -> IO a
throwIO

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

     rethrowInvalidPackageException :: InvalidPackageException -> IO a
     rethrowInvalidPackageException :: InvalidPackageException -> IO a
rethrowInvalidPackageException = InvalidPackageException -> IO a
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 = InvalidPackageException -> String
forall a. Pretty a => a -> String
pretty
instance Exception LocalFileCorrupted where displayException :: LocalFileCorrupted -> String
displayException = LocalFileCorrupted -> String
forall a. Pretty a => a -> String
pretty
instance Exception InvalidFileInIndex where displayException :: InvalidFileInIndex -> String
displayException = InvalidFileInIndex -> String
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
display PackageIdentifier
pkgId

instance Pretty LocalFileCorrupted where
  pretty :: LocalFileCorrupted -> String
pretty (LocalFileCorrupted DeserializationError
err) = String
"Local file corrupted: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeserializationError -> String
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: "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ IndexFile dec -> String
forall a. Pretty a => a -> String
pretty IndexFile dec
file
    , String
"Error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeserializationError -> String
forall a. Pretty a => a -> String
pretty DeserializationError
err
    , String
"Unparsed file: " String -> ShowS
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 :: Signed a -> Trusted a
trustLocalFile Signed{a
Signatures
signatures :: forall a. Signed a -> Signatures
signatures :: Signatures
signed :: a
signed :: forall a. Signed a -> a
..} = a -> Trusted 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' :: Maybe (Trusted FileInfo) -> TargetPath -> down typ -> m ()
verifyFileInfo' Maybe (Trusted FileInfo)
Nothing     TargetPath
_          down typ
_        = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
verifyFileInfo' (Just Trusted FileInfo
info) TargetPath
targetPath down typ
tempPath = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
verified <- down typ -> Trusted FileInfo -> IO Bool
forall (down :: * -> *) a.
DownloadedFile down =>
down a -> Trusted FileInfo -> IO Bool
downloadedVerify down typ
tempPath Trusted FileInfo
info
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
verified (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ VerificationError -> IO ()
forall a e. Exception e => e -> a
throw (VerificationError -> IO ()) -> VerificationError -> IO ()
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 :: 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 = IO (Either DeserializationError a)
-> m (Either DeserializationError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DeserializationError a)
 -> m (Either DeserializationError a))
-> IO (Either DeserializationError a)
-> m (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- Path Absolute -> IO ByteString
forall root. FsRoot root => Path root -> IO ByteString
readLazyByteString Path Absolute
fp
    Either DeserializationError a -> IO (Either DeserializationError a)
forall a. a -> IO a
evaluate (Either DeserializationError a
 -> IO (Either DeserializationError a))
-> Either DeserializationError a
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ KeyEnv -> RepoLayout -> ByteString -> Either DeserializationError a
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 :: 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 = IO (Either DeserializationError a)
-> m (Either DeserializationError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DeserializationError a)
 -> m (Either DeserializationError a))
-> IO (Either DeserializationError a)
-> m (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- down Metadata -> IO ByteString
forall (down :: * -> *).
DownloadedFile down =>
down Metadata -> IO ByteString
downloadedRead down Metadata
fp
    Either DeserializationError a -> IO (Either DeserializationError a)
forall a. a -> IO a
evaluate (Either DeserializationError a
 -> IO (Either DeserializationError a))
-> Either DeserializationError a
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ KeyEnv -> RepoLayout -> ByteString -> Either DeserializationError a
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 :: (e -> e') -> Either e a -> m a
throwErrorsUnchecked e -> e'
f (Left e
err) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ e' -> IO a
forall e a. Exception e => e -> IO a
throwUnchecked (e -> e'
f e
err)
throwErrorsUnchecked e -> e'
_ (Right a
a)  = a -> m 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 :: (e -> e') -> Either e a -> m a
throwErrorsChecked e -> e'
f (Left e
err) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ e' -> IO a
forall e a. (Exception e, Throws e) => e -> IO a
throwChecked (e -> e'
f e
err)
throwErrorsChecked e -> e'
_ (Right a
a)  = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

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