module Hackage.Security.TUF.Layout.Index (
IndexLayout(..)
, IndexFile(..)
, hackageIndexLayout
, indexLayoutPkgMetadata
, indexLayoutPkgCabal
, indexLayoutPkgPrefs
) where
import Distribution.Package
import Distribution.Text
import Hackage.Security.TUF.Paths
import Hackage.Security.TUF.Signed
import Hackage.Security.TUF.Targets
import Hackage.Security.Util.Path
import Hackage.Security.Util.Pretty
import Hackage.Security.Util.Some
data IndexLayout = IndexLayout {
indexFileToPath :: forall dec. IndexFile dec -> IndexPath
, indexFileFromPath :: IndexPath -> Maybe (Some IndexFile)
}
data IndexFile :: * -> * where
IndexPkgMetadata :: PackageIdentifier -> IndexFile (Signed Targets)
IndexPkgCabal :: PackageIdentifier -> IndexFile ()
IndexPkgPrefs :: PackageName -> IndexFile ()
deriving instance Show (IndexFile dec)
instance Pretty (IndexFile dec) where
pretty (IndexPkgMetadata pkgId) = "metadata for " ++ display pkgId
pretty (IndexPkgCabal pkgId) = ".cabal for " ++ display pkgId
pretty (IndexPkgPrefs pkgNm) = "preferred-versions for " ++ display pkgNm
instance SomeShow IndexFile where someShow = DictShow
instance SomePretty IndexFile where somePretty = DictPretty
hackageIndexLayout :: IndexLayout
hackageIndexLayout = IndexLayout {
indexFileToPath = toPath
, indexFileFromPath = fromPath
}
where
toPath :: IndexFile dec -> IndexPath
toPath (IndexPkgCabal pkgId) = fromFragments [
display (packageName pkgId)
, display (packageVersion pkgId)
, display (packageName pkgId) ++ ".cabal"
]
toPath (IndexPkgMetadata pkgId) = fromFragments [
display (packageName pkgId)
, display (packageVersion pkgId)
, "package.json"
]
toPath (IndexPkgPrefs pkgNm) = fromFragments [
display pkgNm
, "preferred-versions"
]
fromFragments :: [String] -> IndexPath
fromFragments = rootPath . joinFragments
fromPath :: IndexPath -> Maybe (Some IndexFile)
fromPath fp = case splitFragments (unrootPath fp) of
[pkg, version, _file] -> do
pkgId <- simpleParse (pkg ++ "-" ++ version)
case takeExtension fp of
".cabal" -> return $ Some $ IndexPkgCabal pkgId
".json" -> return $ Some $ IndexPkgMetadata pkgId
_otherwise -> Nothing
[pkg, "preferred-versions"] ->
Some . IndexPkgPrefs <$> simpleParse pkg
_otherwise -> Nothing
indexLayoutPkgMetadata :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgMetadata IndexLayout{..} = indexFileToPath . IndexPkgMetadata
indexLayoutPkgCabal :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgCabal IndexLayout{..} = indexFileToPath . IndexPkgCabal
indexLayoutPkgPrefs :: IndexLayout -> PackageName -> IndexPath
indexLayoutPkgPrefs IndexLayout{..} = indexFileToPath . IndexPkgPrefs