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 {
IndexLayout -> forall dec. IndexFile dec -> IndexPath
indexFileToPath :: forall dec. IndexFile dec -> IndexPath
, IndexLayout -> IndexPath -> Maybe (Some IndexFile)
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 :: IndexFile dec -> String
pretty (IndexPkgMetadata pkgId :: PackageIdentifier
pkgId) = "metadata for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
display PackageIdentifier
pkgId
pretty (IndexPkgCabal pkgId :: PackageIdentifier
pkgId) = ".cabal for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
display PackageIdentifier
pkgId
pretty (IndexPkgPrefs pkgNm :: PackageName
pkgNm) = "preferred-versions for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
display PackageName
pkgNm
instance SomeShow IndexFile where someShow :: DictShow (IndexFile a)
someShow = DictShow (IndexFile a)
forall a. Show a => DictShow a
DictShow
instance SomePretty IndexFile where somePretty :: DictPretty (IndexFile a)
somePretty = DictPretty (IndexFile a)
forall a. Pretty a => DictPretty a
DictPretty
hackageIndexLayout :: IndexLayout
hackageIndexLayout :: IndexLayout
hackageIndexLayout = IndexLayout :: (forall dec. IndexFile dec -> IndexPath)
-> (IndexPath -> Maybe (Some IndexFile)) -> IndexLayout
IndexLayout {
indexFileToPath :: forall dec. IndexFile dec -> IndexPath
indexFileToPath = forall dec. IndexFile dec -> IndexPath
toPath
, indexFileFromPath :: IndexPath -> Maybe (Some IndexFile)
indexFileFromPath = IndexPath -> Maybe (Some IndexFile)
fromPath
}
where
toPath :: IndexFile dec -> IndexPath
toPath :: IndexFile dec -> IndexPath
toPath (IndexPkgCabal pkgId :: PackageIdentifier
pkgId) = [String] -> IndexPath
fromFragments [
PackageName -> String
forall a. Pretty a => a -> String
display (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgId)
, Version -> String
forall a. Pretty a => a -> String
display (PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
pkgId)
, PackageName -> String
forall a. Pretty a => a -> String
display (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgId) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".cabal"
]
toPath (IndexPkgMetadata pkgId :: PackageIdentifier
pkgId) = [String] -> IndexPath
fromFragments [
PackageName -> String
forall a. Pretty a => a -> String
display (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgId)
, Version -> String
forall a. Pretty a => a -> String
display (PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
pkgId)
, "package.json"
]
toPath (IndexPkgPrefs pkgNm :: PackageName
pkgNm) = [String] -> IndexPath
fromFragments [
PackageName -> String
forall a. Pretty a => a -> String
display PackageName
pkgNm
, "preferred-versions"
]
fromFragments :: [String] -> IndexPath
fromFragments :: [String] -> IndexPath
fromFragments = 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
joinFragments
fromPath :: IndexPath -> Maybe (Some IndexFile)
fromPath :: IndexPath -> Maybe (Some IndexFile)
fromPath fp :: IndexPath
fp = case Path Unrooted -> [String]
splitFragments (IndexPath -> Path Unrooted
forall root. Path root -> Path Unrooted
unrootPath IndexPath
fp) of
[pkg :: String
pkg, version :: String
version, _file :: String
_file] -> do
PackageIdentifier
pkgId <- String -> Maybe PackageIdentifier
forall a. Parsec a => String -> Maybe a
simpleParse (String
pkg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
version)
case IndexPath -> String
forall a. Path a -> String
takeExtension IndexPath
fp of
".cabal" -> Some IndexFile -> Maybe (Some IndexFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Some IndexFile -> Maybe (Some IndexFile))
-> Some IndexFile -> Maybe (Some IndexFile)
forall a b. (a -> b) -> a -> b
$ IndexFile () -> Some IndexFile
forall (f :: * -> *) a. f a -> Some f
Some (IndexFile () -> Some IndexFile) -> IndexFile () -> Some IndexFile
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> IndexFile ()
IndexPkgCabal PackageIdentifier
pkgId
".json" -> Some IndexFile -> Maybe (Some IndexFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Some IndexFile -> Maybe (Some IndexFile))
-> Some IndexFile -> Maybe (Some IndexFile)
forall a b. (a -> b) -> a -> b
$ IndexFile (Signed Targets) -> Some IndexFile
forall (f :: * -> *) a. f a -> Some f
Some (IndexFile (Signed Targets) -> Some IndexFile)
-> IndexFile (Signed Targets) -> Some IndexFile
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> IndexFile (Signed Targets)
IndexPkgMetadata PackageIdentifier
pkgId
_otherwise :: String
_otherwise -> Maybe (Some IndexFile)
forall a. Maybe a
Nothing
[pkg :: String
pkg, "preferred-versions"] ->
IndexFile () -> Some IndexFile
forall (f :: * -> *) a. f a -> Some f
Some (IndexFile () -> Some IndexFile)
-> (PackageName -> IndexFile ()) -> PackageName -> Some IndexFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> IndexFile ()
IndexPkgPrefs (PackageName -> Some IndexFile)
-> Maybe PackageName -> Maybe (Some IndexFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe PackageName
forall a. Parsec a => String -> Maybe a
simpleParse String
pkg
_otherwise :: [String]
_otherwise -> Maybe (Some IndexFile)
forall a. Maybe a
Nothing
indexLayoutPkgMetadata :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgMetadata :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgMetadata IndexLayout{..} = IndexFile (Signed Targets) -> IndexPath
forall dec. IndexFile dec -> IndexPath
indexFileToPath (IndexFile (Signed Targets) -> IndexPath)
-> (PackageIdentifier -> IndexFile (Signed Targets))
-> PackageIdentifier
-> IndexPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> IndexFile (Signed Targets)
IndexPkgMetadata
indexLayoutPkgCabal :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgCabal :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgCabal IndexLayout{..} = IndexFile () -> IndexPath
forall dec. IndexFile dec -> IndexPath
indexFileToPath (IndexFile () -> IndexPath)
-> (PackageIdentifier -> IndexFile ())
-> PackageIdentifier
-> IndexPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> IndexFile ()
IndexPkgCabal
indexLayoutPkgPrefs :: IndexLayout -> PackageName -> IndexPath
indexLayoutPkgPrefs :: IndexLayout -> PackageName -> IndexPath
indexLayoutPkgPrefs IndexLayout{..} = IndexFile () -> IndexPath
forall dec. IndexFile dec -> IndexPath
indexFileToPath (IndexFile () -> IndexPath)
-> (PackageName -> IndexFile ()) -> PackageName -> IndexPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> IndexFile ()
IndexPkgPrefs