-- | 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 MyPrelude 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileMap] -> ShowS
$cshowList :: [FileMap] -> ShowS
show :: FileMap -> String
$cshow :: FileMap -> String
showsPrec :: Int -> FileMap -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetPath] -> ShowS
$cshowList :: [TargetPath] -> ShowS
show :: TargetPath -> String
$cshow :: TargetPath -> String
showsPrec :: Int -> TargetPath -> ShowS
$cshowsPrec :: Int -> TargetPath -> ShowS
Show, TargetPath -> TargetPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetPath -> TargetPath -> Bool
$c/= :: TargetPath -> TargetPath -> Bool
== :: TargetPath -> TargetPath -> Bool
$c== :: TargetPath -> TargetPath -> Bool
Eq, Eq 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
min :: TargetPath -> TargetPath -> TargetPath
$cmin :: TargetPath -> TargetPath -> TargetPath
max :: TargetPath -> TargetPath -> TargetPath
$cmax :: TargetPath -> TargetPath -> TargetPath
>= :: TargetPath -> TargetPath -> Bool
$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
compare :: TargetPath -> TargetPath -> Ordering
$ccompare :: TargetPath -> TargetPath -> Ordering
Ord)

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

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

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

lookup :: TargetPath -> FileMap -> Maybe FileInfo
lookup :: TargetPath -> FileMap -> Maybe FileInfo
lookup TargetPath
fp = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TargetPath
fp 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TargetPath
fp FileInfo
nfo 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileChange] -> ShowS
$cshowList :: [FileChange] -> ShowS
show :: FileChange -> String
$cshow :: FileChange -> String
showsPrec :: Int -> FileChange -> ShowS
$cshowsPrec :: Int -> 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) =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go (forall k a. Map k a -> [(k, a)]
Map.toList Map TargetPath FileInfo
a) (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 = forall a b. (a -> b) -> [a] -> [b]
map (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 [] = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (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 forall a. Ord a => a -> a -> Bool
< TargetPath
fp'  = (TargetPath
fp , FileChange
FileDeleted     ) forall a. a -> [a] -> [a]
: [(TargetPath, FileInfo)]
-> [(TargetPath, FileInfo)] -> [(TargetPath, FileChange)]
go [(TargetPath, FileInfo)]
old' [(TargetPath, FileInfo)]
new
      | TargetPath
fp forall a. Ord a => a -> a -> Bool
> TargetPath
fp'  = (TargetPath
fp', FileInfo -> FileChange
FileChanged FileInfo
nfo') 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') 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) = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc

instance Monad m => ToObjectKey m TargetPath where
  toObjectKey :: TargetPath -> m String
toObjectKey = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoPath -> TargetPath
TargetPathRepo  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall root. Path Unrooted -> Path root
rootPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath 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) =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexPath -> TargetPath
TargetPathIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall root. Path Unrooted -> Path root
rootPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath forall a b. (a -> b) -> a -> b
$ String
path
  fromObjectKey String
_str = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing