module Hackage.Security.Client.Repository.Local (
LocalRepo
, LocalFile
, withRepository
) where
import Hackage.Security.Client.Formats
import Hackage.Security.Client.Repository
import Hackage.Security.Client.Repository.Cache
import Hackage.Security.Client.Verify
import Hackage.Security.TUF
import Hackage.Security.Trusted
import Hackage.Security.Util.IO
import Hackage.Security.Util.Path
import Hackage.Security.Util.Pretty
import Hackage.Security.Util.Some
type LocalRepo = Path Absolute
withRepository
:: LocalRepo
-> Cache
-> RepoLayout
-> IndexLayout
-> (LogMessage -> IO ())
-> (Repository LocalFile -> IO a)
-> IO a
withRepository repo
cache
repLayout
repIndexLayout
logger
callback
=
callback Repository {
repGetRemote = getRemote repLayout repo cache
, repGetCached = getCached cache
, repGetCachedRoot = getCachedRoot cache
, repClearCache = clearCache cache
, repWithIndex = withIndex cache
, repGetIndexIdx = getIndexIdx cache
, repLockCache = lockCache cache
, repWithMirror = mirrorsUnsupported
, repLog = logger
, repLayout = repLayout
, repIndexLayout = repIndexLayout
, repDescription = "Local repository at " ++ pretty repo
}
getRemote :: RepoLayout -> LocalRepo -> Cache
-> AttemptNr
-> RemoteFile fs typ
-> Verify (Some (HasFormat fs), LocalFile typ)
getRemote repoLayout repo cache _attemptNr remoteFile = do
case remoteFileDefaultFormat remoteFile of
Some format -> do
let remotePath' = remoteRepoPath' repoLayout remoteFile format
remotePath = anchorRepoPathLocally repo remotePath'
localFile = LocalFile remotePath
ifVerified $
cacheRemoteFile cache
localFile
(hasFormatGet format)
(mustCache remoteFile)
return (Some format, localFile)
newtype LocalFile a = LocalFile (Path Absolute)
instance DownloadedFile LocalFile where
downloadedVerify = verifyLocalFile
downloadedRead = \(LocalFile local) -> readLazyByteString local
downloadedCopyTo = \(LocalFile local) -> copyFile local
verifyLocalFile :: LocalFile typ -> Trusted FileInfo -> IO Bool
verifyLocalFile (LocalFile fp) trustedInfo = do
sz <- FileLength <$> getFileSize fp
if sz /= fileInfoLength (trusted trustedInfo)
then return False
else compareTrustedFileInfo (trusted trustedInfo) <$> computeFileInfo fp