-- | Information about files
--
-- Intended to be double imported
--
-- > import Hackage.Security.TUF.FileMap (FileMap)
-- > import qualified Hackage.Security.TUF.FileMap as FileMap
module Hackage.Security.TUF.FileMap (
    FileMap -- opaque
  , TargetPath(..)
    -- * Standard accessors
  , empty
  , lookup
  , (!)
  , insert
  , fromList
    -- * Comparing file maps
  , FileChange(..)
  , fileMapChanges
  ) where

import Prelude hiding (lookup)
import Control.Arrow (second)
import Data.Map (Map)
import qualified Data.Map as Map

import Hackage.Security.JSON
import Hackage.Security.TUF.FileInfo
import Hackage.Security.TUF.Paths
import Hackage.Security.Util.Path
import Hackage.Security.Util.Pretty

{-------------------------------------------------------------------------------
  Datatypes
-------------------------------------------------------------------------------}

-- | Mapping from paths to file info
--
-- File maps are used in target files; the paths are relative to the location
-- of the target files containing the file map.
newtype FileMap = FileMap { FileMap -> Map TargetPath FileInfo
fileMap :: Map TargetPath FileInfo }
  deriving (Int -> FileMap -> ShowS
[FileMap] -> ShowS
FileMap -> String
(Int -> FileMap -> ShowS)
-> (FileMap -> String) -> ([FileMap] -> ShowS) -> Show FileMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileMap -> ShowS
showsPrec :: Int -> FileMap -> ShowS
$cshow :: FileMap -> String
show :: FileMap -> String
$cshowList :: [FileMap] -> ShowS
showList :: [FileMap] -> ShowS
Show)

-- | Entries in 'FileMap' either talk about the repository or the index
data TargetPath =
    TargetPathRepo  RepoPath
  | TargetPathIndex IndexPath
  deriving (Int -> TargetPath -> ShowS
[TargetPath] -> ShowS
TargetPath -> String
(Int -> TargetPath -> ShowS)
-> (TargetPath -> String)
-> ([TargetPath] -> ShowS)
-> Show TargetPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TargetPath -> ShowS
showsPrec :: Int -> TargetPath -> ShowS
$cshow :: TargetPath -> String
show :: TargetPath -> String
$cshowList :: [TargetPath] -> ShowS
showList :: [TargetPath] -> ShowS
Show, TargetPath -> TargetPath -> Bool
(TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool) -> Eq TargetPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TargetPath -> TargetPath -> Bool
== :: TargetPath -> TargetPath -> Bool
$c/= :: TargetPath -> TargetPath -> Bool
/= :: TargetPath -> TargetPath -> Bool
Eq, Eq TargetPath
Eq TargetPath =>
(TargetPath -> TargetPath -> Ordering)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> Bool)
-> (TargetPath -> TargetPath -> TargetPath)
-> (TargetPath -> TargetPath -> TargetPath)
-> Ord TargetPath
TargetPath -> TargetPath -> Bool
TargetPath -> TargetPath -> Ordering
TargetPath -> TargetPath -> TargetPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TargetPath -> TargetPath -> Ordering
compare :: TargetPath -> TargetPath -> Ordering
$c< :: TargetPath -> TargetPath -> Bool
< :: TargetPath -> TargetPath -> Bool
$c<= :: TargetPath -> TargetPath -> Bool
<= :: TargetPath -> TargetPath -> Bool
$c> :: TargetPath -> TargetPath -> Bool
> :: TargetPath -> TargetPath -> Bool
$c>= :: TargetPath -> TargetPath -> Bool
>= :: TargetPath -> TargetPath -> Bool
$cmax :: TargetPath -> TargetPath -> TargetPath
max :: TargetPath -> TargetPath -> TargetPath
$cmin :: TargetPath -> TargetPath -> TargetPath
min :: TargetPath -> TargetPath -> TargetPath
Ord)

instance Pretty TargetPath where
  pretty :: TargetPath -> String
pretty (TargetPathRepo  RepoPath
path) = RepoPath -> String
forall a. Pretty a => a -> String
pretty RepoPath
path
  pretty (TargetPathIndex IndexPath
path) = IndexPath -> String
forall a. Pretty a => a -> String
pretty IndexPath
path

{-------------------------------------------------------------------------------
  Standard accessors
-------------------------------------------------------------------------------}

empty :: FileMap
empty :: FileMap
empty = Map TargetPath FileInfo -> FileMap
FileMap Map TargetPath FileInfo
forall k a. Map k a
Map.empty

lookup :: TargetPath -> FileMap -> Maybe FileInfo
lookup :: TargetPath -> FileMap -> Maybe FileInfo
lookup TargetPath
fp = TargetPath -> Map TargetPath FileInfo -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TargetPath
fp (Map TargetPath FileInfo -> Maybe FileInfo)
-> (FileMap -> Map TargetPath FileInfo)
-> FileMap
-> Maybe FileInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileMap -> Map TargetPath FileInfo
fileMap

(!) :: FileMap -> TargetPath -> FileInfo
FileMap
fm ! :: FileMap -> TargetPath -> FileInfo
! TargetPath
fp = FileMap -> Map TargetPath FileInfo
fileMap FileMap
fm Map TargetPath FileInfo -> TargetPath -> FileInfo
forall k a. Ord k => Map k a -> k -> a
Map.! TargetPath
fp

insert :: TargetPath -> FileInfo -> FileMap -> FileMap
insert :: TargetPath -> FileInfo -> FileMap -> FileMap
insert TargetPath
fp FileInfo
nfo = Map TargetPath FileInfo -> FileMap
FileMap (Map TargetPath FileInfo -> FileMap)
-> (FileMap -> Map TargetPath FileInfo) -> FileMap -> FileMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetPath
-> FileInfo -> Map TargetPath FileInfo -> Map TargetPath FileInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TargetPath
fp FileInfo
nfo (Map TargetPath FileInfo -> Map TargetPath FileInfo)
-> (FileMap -> Map TargetPath FileInfo)
-> FileMap
-> Map TargetPath FileInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileMap -> Map TargetPath FileInfo
fileMap

fromList :: [(TargetPath, FileInfo)] -> FileMap
fromList :: [(TargetPath, FileInfo)] -> FileMap
fromList = Map TargetPath FileInfo -> FileMap
FileMap (Map TargetPath FileInfo -> FileMap)
-> ([(TargetPath, FileInfo)] -> Map TargetPath FileInfo)
-> [(TargetPath, FileInfo)]
-> FileMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TargetPath, FileInfo)] -> Map TargetPath FileInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

{-------------------------------------------------------------------------------
  Comparing filemaps
-------------------------------------------------------------------------------}

data FileChange =
    -- | File got added or modified; we record the new file info
    FileChanged FileInfo

    -- | File got deleted
  | FileDeleted
  deriving (Int -> FileChange -> ShowS
[FileChange] -> ShowS
FileChange -> String
(Int -> FileChange -> ShowS)
-> (FileChange -> String)
-> ([FileChange] -> ShowS)
-> Show FileChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileChange -> ShowS
showsPrec :: Int -> FileChange -> ShowS
$cshow :: FileChange -> String
show :: FileChange -> String
$cshowList :: [FileChange] -> ShowS
showList :: [FileChange] -> ShowS
Show)

fileMapChanges :: FileMap  -- ^ Old
               -> FileMap  -- ^ New
               -> Map TargetPath FileChange
fileMapChanges :: FileMap -> FileMap -> Map TargetPath FileChange
fileMapChanges (FileMap Map TargetPath FileInfo
a) (FileMap Map TargetPath FileInfo
b) =
    [(TargetPath, FileChange)] -> Map TargetPath FileChange
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TargetPath, FileChange)] -> Map TargetPath FileChange)
-> [(TargetPath, FileChange)] -> Map TargetPath FileChange
forall a b. (a -> b) -> a -> b
$ [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go (Map TargetPath FileInfo -> [(TargetPath, FileInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TargetPath FileInfo
a) (Map TargetPath FileInfo -> [(TargetPath, FileInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TargetPath FileInfo
b)
  where
    -- Assumes the old and new lists are sorted alphabetically
    -- (Map.toList guarantees this)
    go :: [(TargetPath, FileInfo)]
       -> [(TargetPath, FileInfo)]
       -> [(TargetPath, FileChange)]
    go :: [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go [] [(TargetPath, FileInfo)]
new = ((TargetPath, FileInfo) -> (TargetPath, FileChange))
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
forall a b. (a -> b) -> [a] -> [b]
map ((FileInfo -> FileChange)
-> (TargetPath, FileInfo) -> (TargetPath, FileChange)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second FileInfo -> FileChange
FileChanged) [(TargetPath, FileInfo)]
new
    go [(TargetPath, FileInfo)]
old [] = ((TargetPath, FileInfo) -> (TargetPath, FileChange))
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
forall a b. (a -> b) -> [a] -> [b]
map ((FileInfo -> FileChange)
-> (TargetPath, FileInfo) -> (TargetPath, FileChange)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (FileChange -> FileInfo -> FileChange
forall a b. a -> b -> a
const FileChange
FileDeleted)) [(TargetPath, FileInfo)]
old
    go old :: [(TargetPath, FileInfo)]
old@((TargetPath
fp, FileInfo
nfo):[(TargetPath, FileInfo)]
old') new :: [(TargetPath, FileInfo)]
new@((TargetPath
fp', FileInfo
nfo'):[(TargetPath, FileInfo)]
new')
      | TargetPath
fp TargetPath -> TargetPath -> Bool
forall a. Ord a => a -> a -> Bool
< TargetPath
fp'  = (TargetPath
fp , FileChange
FileDeleted     ) (TargetPath, FileChange)
-> [(TargetPath, FileChange)] -> [(TargetPath, FileChange)]
forall a. a -> [a] -> [a]
: [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go [(TargetPath, FileInfo)]
old' [(TargetPath, FileInfo)]
new
      | TargetPath
fp TargetPath -> TargetPath -> Bool
forall a. Ord a => a -> a -> Bool
> TargetPath
fp'  = (TargetPath
fp', FileInfo -> FileChange
FileChanged FileInfo
nfo') (TargetPath, FileChange)
-> [(TargetPath, FileChange)] -> [(TargetPath, FileChange)]
forall a. a -> [a] -> [a]
: [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go [(TargetPath, FileInfo)]
old  [(TargetPath, FileInfo)]
new'
      | FileInfo -> FileInfo -> Bool
knownFileInfoEqual FileInfo
nfo FileInfo
nfo' = (TargetPath
fp , FileInfo -> FileChange
FileChanged FileInfo
nfo') (TargetPath, FileChange)
-> [(TargetPath, FileChange)] -> [(TargetPath, FileChange)]
forall a. a -> [a] -> [a]
: [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go [(TargetPath, FileInfo)]
old' [(TargetPath, FileInfo)]
new'
      | Bool
otherwise = [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go [(TargetPath, FileInfo)]
old' [(TargetPath, FileInfo)]
new'

{-------------------------------------------------------------------------------
  JSON
-------------------------------------------------------------------------------}

instance Monad m => ToJSON m FileMap where
  toJSON :: FileMap -> m JSValue
toJSON (FileMap Map TargetPath FileInfo
metaFiles) = Map TargetPath FileInfo -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Map TargetPath FileInfo
metaFiles

instance ReportSchemaErrors m => FromJSON m FileMap where
  fromJSON :: JSValue -> m FileMap
fromJSON JSValue
enc = Map TargetPath FileInfo -> FileMap
FileMap (Map TargetPath FileInfo -> FileMap)
-> m (Map TargetPath FileInfo) -> m FileMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> m (Map TargetPath FileInfo)
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc

instance Monad m => ToObjectKey m TargetPath where
  toObjectKey :: TargetPath -> m String
toObjectKey = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String)
-> (TargetPath -> String) -> TargetPath -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetPath -> String
forall a. Pretty a => a -> String
pretty

instance ReportSchemaErrors m => FromObjectKey m TargetPath where
  fromObjectKey :: String -> m (Maybe TargetPath)
fromObjectKey (Char
'<':Char
'r':Char
'e':Char
'p':Char
'o':Char
'>':Char
'/':String
path) =
    Maybe TargetPath -> m (Maybe TargetPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TargetPath -> m (Maybe TargetPath))
-> (String -> Maybe TargetPath) -> String -> m (Maybe TargetPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetPath -> Maybe TargetPath
forall a. a -> Maybe a
Just (TargetPath -> Maybe TargetPath)
-> (String -> TargetPath) -> String -> Maybe TargetPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoPath -> TargetPath
TargetPathRepo  (RepoPath -> TargetPath)
-> (String -> RepoPath) -> String -> TargetPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Unrooted -> RepoPath
forall root. Path Unrooted -> Path root
rootPath (Path Unrooted -> RepoPath)
-> (String -> Path Unrooted) -> String -> RepoPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath (String -> m (Maybe TargetPath)) -> String -> m (Maybe TargetPath)
forall a b. (a -> b) -> a -> b
$ String
path
  fromObjectKey (Char
'<':Char
'i':Char
'n':Char
'd':Char
'e':Char
'x':Char
'>':Char
'/':String
path) =
    Maybe TargetPath -> m (Maybe TargetPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TargetPath -> m (Maybe TargetPath))
-> (String -> Maybe TargetPath) -> String -> m (Maybe TargetPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetPath -> Maybe TargetPath
forall a. a -> Maybe a
Just (TargetPath -> Maybe TargetPath)
-> (String -> TargetPath) -> String -> Maybe TargetPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexPath -> TargetPath
TargetPathIndex (IndexPath -> TargetPath)
-> (String -> IndexPath) -> String -> TargetPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
fromUnrootedFilePath (String -> m (Maybe TargetPath)) -> String -> m (Maybe TargetPath)
forall a b. (a -> b) -> a -> b
$ String
path
  fromObjectKey String
_str = Maybe TargetPath -> m (Maybe TargetPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TargetPath
forall a. Maybe a
Nothing