module Hackage.Security.TUF.Layout ( -- * Repository layout RepoRoot , RepoPath , RepoLayout(..) , hackageRepoLayout , cabalLocalRepoLayout , anchorRepoPathLocally , anchorRepoPathRemotely -- * Index tarball layout , IndexRoot , IndexPath , IndexLayout(..) , hackageIndexLayout -- * Cache layout , CacheRoot , CachePath , CacheLayout(..) , cabalCacheLayout , anchorCachePath ) where import Distribution.Package import Distribution.Text import Hackage.Security.Util.Path {------------------------------------------------------------------------------- Repository layout -------------------------------------------------------------------------------} -- | The root of the repository -- -- Repository roots can be anchored at a remote URL or a local directory. -- -- Note that even for remote repos 'RepoRoot' is (potentially) different from -- 'WebRoot' -- for a repository located at, say, @http://hackage.haskell.org@ -- they happen to coincide, but for one location at -- @http://example.com/some/subdirectory@ they do not. data RepoRoot -- | Paths relative to the root of the repository type RepoPath = Path (Rooted RepoRoot) instance IsRoot RepoRoot where showRoot _ = "" -- | Layout of a repository data RepoLayout = RepoLayout { -- | TUF root metadata repoLayoutRoot :: RepoPath -- | TUF timestamp , repoLayoutTimestamp :: RepoPath -- | TUF snapshot , repoLayoutSnapshot :: RepoPath -- | TUF mirrors list , repoLayoutMirrors :: RepoPath -- | Compressed index tarball , repoLayoutIndexTarGz :: RepoPath -- | Uncompressed index tarball , repoLayoutIndexTar :: RepoPath -- | Path to the package tarball , repoLayoutPkgTarGz :: PackageIdentifier -> RepoPath -- | Layout of the index -- -- Since the repository hosts the index, the layout of the index is -- not independent of the layout of the repository. , repoIndexLayout :: IndexLayout } -- | The layout used on Hackage hackageRepoLayout :: RepoLayout hackageRepoLayout = RepoLayout { repoLayoutRoot = rp $ fragment' "root.json" , repoLayoutTimestamp = rp $ fragment' "timestamp.json" , repoLayoutSnapshot = rp $ fragment' "snapshot.json" , repoLayoutMirrors = rp $ fragment' "mirrors.json" , repoLayoutIndexTarGz = rp $ fragment' "01-index.tar.gz" , repoLayoutIndexTar = rp $ fragment' "01-index.tar" , repoLayoutPkgTarGz = \pkgId -> rp $ fragment' "package" pkgFile pkgId , repoIndexLayout = hackageIndexLayout } where pkgFile :: PackageIdentifier -> UnrootedPath pkgFile pkgId = fragment' (display pkgId) <.> "tar.gz" rp :: UnrootedPath -> RepoPath rp = rootPath Rooted -- | Layout used by cabal for ("legacy") local repos -- -- Obviously, such repos do not normally contain any of the TUF files, so their -- location is more or less arbitrary here. cabalLocalRepoLayout :: RepoLayout cabalLocalRepoLayout = hackageRepoLayout { repoLayoutPkgTarGz = \pkgId -> rp $ pkgLoc pkgId pkgFile pkgId } where pkgLoc :: PackageIdentifier -> UnrootedPath pkgLoc pkgId = joinFragments [ mkFragment $ display (packageName pkgId) , mkFragment $ display (packageVersion pkgId) ] pkgFile :: PackageIdentifier -> UnrootedPath pkgFile pkgId = fragment' (display pkgId) <.> "tar.gz" rp :: UnrootedPath -> RepoPath rp = rootPath Rooted anchorRepoPathLocally :: IsFileSystemRoot root => Path (Rooted root) -> RepoPath -> Path (Rooted root) anchorRepoPathLocally localRoot repoPath = localRoot unrootPath' repoPath anchorRepoPathRemotely :: URIPath -> RepoPath -> URIPath anchorRepoPathRemotely remoteRoot repoPath = remoteRoot unrootPath' repoPath {------------------------------------------------------------------------------- Index layout -------------------------------------------------------------------------------} -- | The root of the index tarball data IndexRoot -- | Paths relative to the root of the index tarball type IndexPath = Path (Rooted RepoRoot) instance IsRoot IndexRoot where showRoot _ = "" -- | Layout of the files within the index tarball data IndexLayout = IndexLayout { -- | TUF metadata for a package indexLayoutPkgMetadata :: PackageIdentifier -> IndexPath -- | Package .cabal file , indexLayoutPkgCabal :: PackageIdentifier -> IndexPath } -- | The layout of the index as maintained on Hackage hackageIndexLayout :: IndexLayout hackageIndexLayout = IndexLayout { indexLayoutPkgMetadata = \pkgId -> rp $ pkgLoc pkgId pkgMetadata , indexLayoutPkgCabal = \pkgId -> rp $ pkgLoc pkgId pkgCabal pkgId } where pkgLoc :: PackageIdentifier -> UnrootedPath pkgLoc pkgId = joinFragments [ mkFragment $ display (packageName pkgId) , mkFragment $ display (packageVersion pkgId) ] pkgCabal :: PackageIdentifier -> UnrootedPath pkgCabal pkgId = fragment' (display (packageName pkgId)) <.> "cabal" pkgMetadata :: UnrootedPath pkgMetadata = fragment' "package" <.> "json" rp :: UnrootedPath -> IndexPath rp = rootPath Rooted {------------------------------------------------------------------------------- Cache layout -------------------------------------------------------------------------------} -- | The cache directory data CacheRoot type CachePath = Path (Rooted CacheRoot) instance IsRoot CacheRoot where showRoot _ = "" -- | Location of the various files we cache -- -- Although the generic TUF algorithms do not care how we organize the cache, -- we nonetheless specity this here because as long as there are tools which -- access files in the cache directly we need to define the cache layout. -- See also comments for 'defaultCacheLayout'. data CacheLayout = CacheLayout { -- | TUF root metadata cacheLayoutRoot :: CachePath -- | TUF timestamp , cacheLayoutTimestamp :: CachePath -- | TUF snapshot , cacheLayoutSnapshot :: CachePath -- | TUF mirrors list , cacheLayoutMirrors :: CachePath -- | Uncompressed index tarball , cacheLayoutIndexTar :: CachePath -- | Index to the uncompressed index tarball , cacheLayoutIndexIdx :: CachePath -- | Compressed index tarball (if cached) , cacheLayoutIndexTarGz :: Maybe CachePath } -- | The cache layout cabal-install uses -- -- We cache the index as @/00-index.tar@; this is important because -- `cabal-install` expects to find it there (and does not currently go through -- the hackage-security library to get files from the index). cabalCacheLayout :: CacheLayout cabalCacheLayout = CacheLayout { cacheLayoutRoot = rp $ fragment' "root.json" , cacheLayoutTimestamp = rp $ fragment' "timestamp.json" , cacheLayoutSnapshot = rp $ fragment' "snapshot.json" , cacheLayoutMirrors = rp $ fragment' "mirrors.json" , cacheLayoutIndexTar = rp $ fragment' "00-index.tar" , cacheLayoutIndexIdx = rp $ fragment' "00-index.tar.idx" , cacheLayoutIndexTarGz = Nothing } where rp :: UnrootedPath -> CachePath rp = rootPath Rooted -- | Anchor a cache path to the location of the cache anchorCachePath :: IsFileSystemRoot root => Path (Rooted root) -> CachePath -> Path (Rooted root) anchorCachePath cacheRoot cachePath = cacheRoot unrootPath' cachePath