module Hackage.Security.TUF.Layout.Index (
    -- * Repository layout
    IndexLayout(..)
  , IndexFile(..)
  , hackageIndexLayout
    -- ** Utility
  , indexLayoutPkgMetadata
  , indexLayoutPkgCabal
  , indexLayoutPkgPrefs
  ) where

import Prelude
import Data.Kind (Type)
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

{-------------------------------------------------------------------------------
  Index layout
-------------------------------------------------------------------------------}

-- | Layout of the files within the index tarball
data IndexLayout = IndexLayout  {
      -- | Translate an 'IndexFile' to a path
      IndexLayout -> forall dec. IndexFile dec -> IndexPath
indexFileToPath :: forall dec. IndexFile dec -> IndexPath

      -- | Parse an 'FilePath'
    , IndexLayout -> IndexPath -> Maybe (Some IndexFile)
indexFileFromPath :: IndexPath -> Maybe (Some IndexFile)
    }

-- | Files that we might request from the index
--
-- The type index tells us the type of the decoded file, if any. For files for
-- which the library does not support decoding this will be @()@.
-- NOTE: Clients should NOT rely on this type index being @()@, or they might
-- break if we add support for parsing additional file formats in the future.
--
-- TODO: If we wanted to support legacy Hackage, we should also have a case for
-- the global preferred-versions file. But supporting legacy Hackage will
-- probably require more work anyway..
data IndexFile :: Type -> Type where
    -- Package-specific metadata (@targets.json@)
    IndexPkgMetadata :: PackageIdentifier -> IndexFile (Signed Targets)

    -- Cabal file for a package
    IndexPkgCabal :: PackageIdentifier -> IndexFile ()

    -- Preferred versions a package
    IndexPkgPrefs :: PackageName -> IndexFile ()
--TODO: ^^ older haddock doesn't support GADT doc comments :-(

deriving instance Show (IndexFile dec)

instance Pretty (IndexFile dec) where
  pretty :: IndexFile dec -> String
pretty (IndexPkgMetadata PackageIdentifier
pkgId) = String
"metadata for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
display PackageIdentifier
pkgId
  pretty (IndexPkgCabal    PackageIdentifier
pkgId) = String
".cabal for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
display PackageIdentifier
pkgId
  pretty (IndexPkgPrefs    PackageName
pkgNm) = String
"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 :: forall a. DictShow (IndexFile a)
someShow   = DictShow (IndexFile a)
forall a. Show a => DictShow a
DictShow
instance SomePretty IndexFile where somePretty :: forall a. DictPretty (IndexFile a)
somePretty = DictPretty (IndexFile a)
forall a. Pretty a => DictPretty a
DictPretty

-- | The layout of the index as maintained on Hackage
hackageIndexLayout :: IndexLayout
hackageIndexLayout :: IndexLayout
hackageIndexLayout = IndexLayout {
      indexFileToPath :: forall dec. IndexFile dec -> IndexPath
indexFileToPath   = IndexFile dec -> IndexPath
forall dec. IndexFile dec -> IndexPath
toPath
    , indexFileFromPath :: IndexPath -> Maybe (Some IndexFile)
indexFileFromPath = IndexPath -> Maybe (Some IndexFile)
fromPath
    }
  where
    toPath :: IndexFile dec -> IndexPath
    toPath :: forall dec. IndexFile dec -> IndexPath
toPath (IndexPkgCabal    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]
++ String
".cabal"
                                        ]
    toPath (IndexPkgMetadata 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)
                                        , String
"package.json"
                                        ]
    toPath (IndexPkgPrefs    PackageName
pkgNm) = [String] -> IndexPath
fromFragments [
                                          PackageName -> String
forall a. Pretty a => a -> String
display PackageName
pkgNm
                                        , String
"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 IndexPath
fp = case Path Unrooted -> [String]
splitFragments (IndexPath -> Path Unrooted
forall root. Path root -> Path Unrooted
unrootPath IndexPath
fp) of
      [String
pkg, String
version, 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
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
version)
        case IndexPath -> String
forall a. Path a -> String
takeExtension IndexPath
fp of
          String
".cabal"   -> Some IndexFile -> Maybe (Some IndexFile)
forall a. a -> Maybe a
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
          String
".json"    -> Some IndexFile -> Maybe (Some IndexFile)
forall a. a -> Maybe a
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
          String
_otherwise -> Maybe (Some IndexFile)
forall a. Maybe a
Nothing
      [String
pkg, String
"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
      [String]
_otherwise -> Maybe (Some IndexFile)
forall a. Maybe a
Nothing

{-------------------------------------------------------------------------------
  Utility
-------------------------------------------------------------------------------}

indexLayoutPkgMetadata :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgMetadata :: IndexLayout -> PackageIdentifier -> IndexPath
indexLayoutPkgMetadata IndexLayout{IndexPath -> Maybe (Some IndexFile)
forall dec. IndexFile dec -> IndexPath
indexFileToPath :: IndexLayout -> forall dec. IndexFile dec -> IndexPath
indexFileFromPath :: IndexLayout -> IndexPath -> Maybe (Some IndexFile)
indexFileToPath :: forall dec. IndexFile dec -> IndexPath
indexFileFromPath :: IndexPath -> Maybe (Some IndexFile)
..} = 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{IndexPath -> Maybe (Some IndexFile)
forall dec. IndexFile dec -> IndexPath
indexFileToPath :: IndexLayout -> forall dec. IndexFile dec -> IndexPath
indexFileFromPath :: IndexLayout -> IndexPath -> Maybe (Some IndexFile)
indexFileToPath :: forall dec. IndexFile dec -> IndexPath
indexFileFromPath :: IndexPath -> Maybe (Some IndexFile)
..} = 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{IndexPath -> Maybe (Some IndexFile)
forall dec. IndexFile dec -> IndexPath
indexFileToPath :: IndexLayout -> forall dec. IndexFile dec -> IndexPath
indexFileFromPath :: IndexLayout -> IndexPath -> Maybe (Some IndexFile)
indexFileToPath :: forall dec. IndexFile dec -> IndexPath
indexFileFromPath :: IndexPath -> Maybe (Some IndexFile)
..} = 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