-- | Information about files
module Hackage.Security.TUF.FileInfo (
    FileInfo(..)
  , HashFn(..)
  , Hash(..)
    -- * Utility
  , fileInfo
  , computeFileInfo
  , compareTrustedFileInfo
  , knownFileInfoEqual
  , fileInfoSHA256
    -- ** Re-exports
  , Int54
  ) where

import Prelude hiding (lookup)
import Data.Map (Map)
import qualified Crypto.Hash.SHA256   as SHA256
import qualified Data.Map             as Map
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Lazy as BS.L
import qualified Data.ByteString.Char8 as BS.C8

import Hackage.Security.JSON
import Hackage.Security.TUF.Common
import Hackage.Security.Util.Path

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

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

-- | File information
--
-- This intentionally does not have an 'Eq' instance; see 'knownFileInfoEqual'
-- and 'verifyFileInfo' instead.
--
-- NOTE: Throughout we compute file information always over the raw bytes.
-- For example, when @timestamp.json@ lists the hash of @snapshot.json@, this
-- hash is computed over the actual @snapshot.json@ file (as opposed to the
-- canonical form of the embedded JSON). This brings it in line with the hash
-- computed over target files, where that is the only choice available.
data FileInfo = FileInfo {
    FileInfo -> FileLength
fileInfoLength :: FileLength
  , FileInfo -> Map HashFn Hash
fileInfoHashes :: Map HashFn Hash
  }
  deriving (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> String
(Int -> FileInfo -> ShowS)
-> (FileInfo -> String) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileInfo -> ShowS
showsPrec :: Int -> FileInfo -> ShowS
$cshow :: FileInfo -> String
show :: FileInfo -> String
$cshowList :: [FileInfo] -> ShowS
showList :: [FileInfo] -> ShowS
Show)

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

-- | Compute 'FileInfo'
--
-- TODO: Currently this will load the entire input bytestring into memory.
-- We need to make this incremental, by computing the length and all hashes
-- in a single traversal over the input.
fileInfo :: BS.L.ByteString -> FileInfo
fileInfo :: ByteString -> FileInfo
fileInfo ByteString
bs = FileInfo {
      fileInfoLength :: FileLength
fileInfoLength = Int54 -> FileLength
FileLength (Int54 -> FileLength) -> (Int64 -> Int54) -> Int64 -> FileLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int54
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> FileLength) -> Int64 -> FileLength
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BS.L.length ByteString
bs
    , fileInfoHashes :: Map HashFn Hash
fileInfoHashes = [(HashFn, Hash)] -> Map HashFn Hash
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
          -- Note: if you add or change hash functions here and you want to
          -- make them compulsory then you also need to update
          -- 'compareTrustedFileInfo' below.
          (HashFn
HashFnSHA256, String -> Hash
Hash (String -> Hash) -> String -> Hash
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.C8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
SHA256.hashlazy ByteString
bs)
        ]
    }

-- | Compute 'FileInfo'
computeFileInfo :: FsRoot root => Path root -> IO FileInfo
computeFileInfo :: forall root. FsRoot root => Path root -> IO FileInfo
computeFileInfo Path root
fp = ByteString -> FileInfo
fileInfo (ByteString -> FileInfo) -> IO ByteString -> IO FileInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path root -> IO ByteString
forall root. FsRoot root => Path root -> IO ByteString
readLazyByteString Path root
fp

-- | Compare the expected trusted file info against the actual file info of a
-- target file.
--
-- This should be used only when the 'FileInfo' is already known. If we want
-- to compare known 'FileInfo' against a file on disk we should delay until we
-- have confirmed that the file lengths match (see 'downloadedVerify').
--
compareTrustedFileInfo :: FileInfo -- ^ expected (from trusted TUF files)
                       -> FileInfo -- ^ actual (from 'fileInfo' on target file)
                       -> Bool
compareTrustedFileInfo :: FileInfo -> FileInfo -> Bool
compareTrustedFileInfo FileInfo
expectedInfo FileInfo
actualInfo =
    -- The expected trusted file info may have hashes for several hash
    -- functions, including ones we do not care about and do not want to
    -- check. In particular the file info may have an md5 hash, but this
    -- is not one that we want to check.
    --
    -- Our current policy is to check sha256 only and ignore md5:
    FileInfo -> FileInfo -> Bool
sameLength FileInfo
expectedInfo FileInfo
actualInfo
 Bool -> Bool -> Bool
&& FileInfo -> FileInfo -> Bool
sameSHA256 FileInfo
expectedInfo FileInfo
actualInfo
  where
    sameLength :: FileInfo -> FileInfo -> Bool
sameLength FileInfo
a FileInfo
b = FileInfo -> FileLength
fileInfoLength FileInfo
a
                  FileLength -> FileLength -> Bool
forall a. Eq a => a -> a -> Bool
== FileInfo -> FileLength
fileInfoLength FileInfo
b

    sameSHA256 :: FileInfo -> FileInfo -> Bool
sameSHA256 FileInfo
a FileInfo
b = case (FileInfo -> Maybe Hash
fileInfoSHA256 FileInfo
a,
                           FileInfo -> Maybe Hash
fileInfoSHA256 FileInfo
b) of
                       (Just Hash
ha, Just Hash
hb) -> Hash
ha Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
hb
                       (Maybe Hash, Maybe Hash)
_                  -> Bool
False

knownFileInfoEqual :: FileInfo -> FileInfo -> Bool
knownFileInfoEqual :: FileInfo -> FileInfo -> Bool
knownFileInfoEqual FileInfo
a FileInfo
b = (FileLength, Map HashFn Hash)
-> (FileLength, Map HashFn Hash) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FileInfo -> FileLength
fileInfoLength FileInfo
a, FileInfo -> Map HashFn Hash
fileInfoHashes FileInfo
a)
                              (FileInfo -> FileLength
fileInfoLength FileInfo
b, FileInfo -> Map HashFn Hash
fileInfoHashes FileInfo
b)

-- | Extract SHA256 hash from 'FileInfo' (if present)
fileInfoSHA256 :: FileInfo -> Maybe Hash
fileInfoSHA256 :: FileInfo -> Maybe Hash
fileInfoSHA256 FileInfo{Map HashFn Hash
FileLength
fileInfoLength :: FileInfo -> FileLength
fileInfoHashes :: FileInfo -> Map HashFn Hash
fileInfoLength :: FileLength
fileInfoHashes :: Map HashFn Hash
..} = HashFn -> Map HashFn Hash -> Maybe Hash
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup HashFn
HashFnSHA256 Map HashFn Hash
fileInfoHashes

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

instance Monad m => ToObjectKey m HashFn where
  toObjectKey :: HashFn -> m String
toObjectKey HashFn
HashFnSHA256 = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"sha256"
  toObjectKey HashFn
HashFnMD5    = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"md5"

instance ReportSchemaErrors m => FromObjectKey m HashFn where
  fromObjectKey :: String -> m (Maybe HashFn)
fromObjectKey String
"sha256" = Maybe HashFn -> m (Maybe HashFn)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashFn -> Maybe HashFn
forall a. a -> Maybe a
Just HashFn
HashFnSHA256)
  fromObjectKey String
"md5"    = Maybe HashFn -> m (Maybe HashFn)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashFn -> Maybe HashFn
forall a. a -> Maybe a
Just HashFn
HashFnMD5)
  fromObjectKey String
_        = Maybe HashFn -> m (Maybe HashFn)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HashFn
forall a. Maybe a
Nothing

instance Monad m => ToJSON m FileInfo where
  toJSON :: FileInfo -> m JSValue
toJSON FileInfo{Map HashFn Hash
FileLength
fileInfoLength :: FileInfo -> FileLength
fileInfoHashes :: FileInfo -> Map HashFn Hash
fileInfoLength :: FileLength
fileInfoHashes :: Map HashFn Hash
..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
        (String
"length", FileLength -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON FileLength
fileInfoLength)
      , (String
"hashes", Map HashFn Hash -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Map HashFn Hash
fileInfoHashes)
      ]

instance ReportSchemaErrors m => FromJSON m FileInfo where
  fromJSON :: JSValue -> m FileInfo
fromJSON JSValue
enc = do
    FileLength
fileInfoLength <- JSValue -> String -> m FileLength
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc String
"length"
    Map HashFn Hash
fileInfoHashes <- JSValue -> String -> m (Map HashFn Hash)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc String
"hashes"
    FileInfo -> m FileInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo{Map HashFn Hash
FileLength
fileInfoLength :: FileLength
fileInfoHashes :: Map HashFn Hash
fileInfoLength :: FileLength
fileInfoHashes :: Map HashFn Hash
..}