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

import Prelude
import Data.Char (ord)
import Data.Kind (Type)
import Distribution.Package
import Distribution.Text
import Distribution.Types.Version (mkVersion)
import System.FilePath.Posix (isPathSeparator)

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

    -- This function is called in a hot loop, take care when modifying it.
    -- Especially avoid 'splitFragments' / 'splitDirectories' and other high-level helpers,
    -- they are very slow.
    fromPath :: IndexPath -> Maybe (Some IndexFile)
    fromPath :: IndexPath -> Maybe (Some IndexFile)
fromPath IndexPath
fp = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator (Path Unrooted -> String
toUnrootedFilePath (IndexPath -> Path Unrooted
forall root. Path root -> Path Unrooted
unrootPath IndexPath
fp)) of
      (String
pkg, String
"/preferred-versions") ->
        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
$ PackageName -> IndexFile ()
IndexPkgPrefs (PackageName -> IndexFile ()) -> PackageName -> IndexFile ()
forall a b. (a -> b) -> a -> b
$ String -> PackageName
mkPackageName String
pkg
      (String
pkg, String
rest) -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
rest) of
        (String
_, []) -> Maybe (Some IndexFile)
forall a. Maybe a
Nothing
        (String
version, String
basename) -> do
          let pkgName :: PackageName
pkgName = String -> PackageName
mkPackageName String
pkg
              pkgVersion :: Version
pkgVersion = [Int] -> Version
mkVersion ([Int] -> Version) -> [Int] -> Version
forall a b. (a -> b) -> a -> b
$ String -> [Int]
readVersion String
version
              pkgId :: PackageIdentifier
pkgId = PackageIdentifier { PackageName
pkgName :: PackageName
pkgName :: PackageName
pkgName, Version
pkgVersion :: Version
pkgVersion :: Version
pkgVersion }
          case ShowS
forall a. [a] -> [a]
reverse String
basename of
            -- ".cabal" reversed
            Char
'l' : Char
'a' : Char
'b' : Char
'a' : Char
'c' : Char
'.' : String
_ ->
              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
            -- ".json" reversed
            Char
'n' : Char
'o' : Char
's' : Char
'j' : Char
'.' : String
_ ->
              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
_ -> Maybe (Some IndexFile)
forall a. Maybe a
Nothing

-- Convert "3.12.1.0" to [3,12,1,0].
-- Copied from hackage-revdeps package.
readVersion :: String -> [Int]
readVersion :: String -> [Int]
readVersion = (\(Int
acc, Int
_mult, [Int]
rest) -> Int
acc Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
rest) ((Int, Int, [Int]) -> [Int])
-> (String -> (Int, Int, [Int])) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> (Int, Int, [Int]) -> (Int, Int, [Int]))
-> (Int, Int, [Int]) -> String -> (Int, Int, [Int])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> (Int, Int, [Int]) -> (Int, Int, [Int])
go (Int
0, Int
1, [])
  where
    go :: Char -> (Int, Int, [Int]) -> (Int, Int, [Int])
go Char
c (Int
acc, Int
mult, [Int]
rest)
      | Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Word
10 :: Word) = (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mult, Int
mult Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10, [Int]
rest)
      | Bool
otherwise = (Int
0, Int
1, Int
acc Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
rest)
      where
        d :: Int
d = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'

{-------------------------------------------------------------------------------
  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