module Hackage.Security.TUF.Layout.Repo (
    -- * Repository layout
    RepoLayout(..)
  , hackageRepoLayout
  , cabalLocalRepoLayout
  ) where

import MyPrelude
import Distribution.Package
import Distribution.Text

import Hackage.Security.TUF.Paths
import Hackage.Security.Util.Path

{-------------------------------------------------------------------------------
  Repository layout
-------------------------------------------------------------------------------}

-- | Layout of a repository
data RepoLayout = RepoLayout {
      -- | TUF root metadata
      RepoLayout -> RepoPath
repoLayoutRoot :: RepoPath

      -- | TUF timestamp
    , RepoLayout -> RepoPath
repoLayoutTimestamp :: RepoPath

      -- | TUF snapshot
    , RepoLayout -> RepoPath
repoLayoutSnapshot :: RepoPath

      -- | TUF mirrors list
    , RepoLayout -> RepoPath
repoLayoutMirrors :: RepoPath

      -- | Compressed index tarball
    , RepoLayout -> RepoPath
repoLayoutIndexTarGz :: RepoPath

      -- | Uncompressed index tarball
    , RepoLayout -> RepoPath
repoLayoutIndexTar :: RepoPath

      -- | Path to the package tarball
    , RepoLayout -> PackageIdentifier -> RepoPath
repoLayoutPkgTarGz :: PackageIdentifier -> RepoPath
    }

-- | The layout used on Hackage
hackageRepoLayout :: RepoLayout
hackageRepoLayout :: RepoLayout
hackageRepoLayout = RepoLayout :: RepoPath
-> RepoPath
-> RepoPath
-> RepoPath
-> RepoPath
-> RepoPath
-> (PackageIdentifier -> RepoPath)
-> RepoLayout
RepoLayout {
      repoLayoutRoot :: RepoPath
repoLayoutRoot       = Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ String -> Path Unrooted
fragment String
"root.json"
    , repoLayoutTimestamp :: RepoPath
repoLayoutTimestamp  = Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ String -> Path Unrooted
fragment String
"timestamp.json"
    , repoLayoutSnapshot :: RepoPath
repoLayoutSnapshot   = Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ String -> Path Unrooted
fragment String
"snapshot.json"
    , repoLayoutMirrors :: RepoPath
repoLayoutMirrors    = Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ String -> Path Unrooted
fragment String
"mirrors.json"
    , repoLayoutIndexTarGz :: RepoPath
repoLayoutIndexTarGz = Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ String -> Path Unrooted
fragment String
"01-index.tar.gz"
    , repoLayoutIndexTar :: RepoPath
repoLayoutIndexTar   = Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ String -> Path Unrooted
fragment String
"01-index.tar"
    , repoLayoutPkgTarGz :: PackageIdentifier -> RepoPath
repoLayoutPkgTarGz   = \PackageIdentifier
pkgId -> Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ String -> Path Unrooted
fragment String
"package" Path Unrooted -> Path Unrooted -> Path Unrooted
forall a. Path a -> Path Unrooted -> Path a
</> PackageIdentifier -> Path Unrooted
pkgFile PackageIdentifier
pkgId
    }
  where
    pkgFile :: PackageIdentifier -> Path Unrooted
    pkgFile :: PackageIdentifier -> Path Unrooted
pkgFile PackageIdentifier
pkgId = String -> Path Unrooted
fragment (PackageIdentifier -> String
forall a. Pretty a => a -> String
display PackageIdentifier
pkgId) Path Unrooted -> String -> Path Unrooted
forall a. Path a -> String -> Path a
<.> String
"tar.gz"

    rp :: Path Unrooted -> RepoPath
    rp :: Path Unrooted -> RepoPath
rp = Path Unrooted -> RepoPath
forall root. Path Unrooted -> Path root
rootPath

-- | 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 :: RepoLayout
cabalLocalRepoLayout = RepoLayout
hackageRepoLayout {
      repoLayoutPkgTarGz :: PackageIdentifier -> RepoPath
repoLayoutPkgTarGz = \PackageIdentifier
pkgId -> Path Unrooted -> RepoPath
rp (Path Unrooted -> RepoPath) -> Path Unrooted -> RepoPath
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> Path Unrooted
pkgLoc PackageIdentifier
pkgId Path Unrooted -> Path Unrooted -> Path Unrooted
forall a. Path a -> Path Unrooted -> Path a
</> PackageIdentifier -> Path Unrooted
pkgFile PackageIdentifier
pkgId
    }
  where
    pkgLoc :: PackageIdentifier -> Path Unrooted
    pkgLoc :: PackageIdentifier -> Path Unrooted
pkgLoc PackageIdentifier
pkgId = [String] -> Path Unrooted
joinFragments [
          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)
        ]

    pkgFile :: PackageIdentifier -> Path Unrooted
    pkgFile :: PackageIdentifier -> Path Unrooted
pkgFile PackageIdentifier
pkgId = String -> Path Unrooted
fragment (PackageIdentifier -> String
forall a. Pretty a => a -> String
display PackageIdentifier
pkgId) Path Unrooted -> String -> Path Unrooted
forall a. Path a -> String -> Path a
<.> String
"tar.gz"

    rp :: Path Unrooted -> RepoPath
    rp :: Path Unrooted -> RepoPath
rp = Path Unrooted -> RepoPath
forall root. Path Unrooted -> Path root
rootPath