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

import MyPrelude 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashFn] -> ShowS
$cshowList :: [HashFn] -> ShowS
show :: HashFn -> String
$cshow :: HashFn -> String
showsPrec :: Int -> HashFn -> ShowS
$cshowsPrec :: Int -> HashFn -> ShowS
Show, HashFn -> HashFn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashFn -> HashFn -> Bool
$c/= :: HashFn -> HashFn -> Bool
== :: HashFn -> HashFn -> Bool
$c== :: HashFn -> HashFn -> Bool
Eq, Eq 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
min :: HashFn -> HashFn -> HashFn
$cmin :: HashFn -> HashFn -> HashFn
max :: HashFn -> HashFn -> HashFn
$cmax :: HashFn -> HashFn -> HashFn
>= :: HashFn -> HashFn -> Bool
$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
compare :: HashFn -> HashFn -> Ordering
$ccompare :: HashFn -> HashFn -> Ordering
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> String
$cshow :: FileInfo -> String
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BS.L.length ByteString
bs
    , fileInfoHashes :: Map HashFn Hash
fileInfoHashes = 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 forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.C8.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
                  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 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 = 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
fileInfoHashes :: Map HashFn Hash
fileInfoLength :: FileLength
fileInfoHashes :: FileInfo -> Map HashFn Hash
fileInfoLength :: FileInfo -> FileLength
..} = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return String
"sha256"
  toObjectKey HashFn
HashFnMD5    = 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" = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just HashFn
HashFnSHA256)
  fromObjectKey String
"md5"    = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just HashFn
HashFnMD5)
  fromObjectKey String
_        = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

instance Monad m => ToJSON m FileInfo where
  toJSON :: FileInfo -> m JSValue
toJSON FileInfo{Map HashFn Hash
FileLength
fileInfoHashes :: Map HashFn Hash
fileInfoLength :: FileLength
fileInfoHashes :: FileInfo -> Map HashFn Hash
fileInfoLength :: FileInfo -> FileLength
..} = forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
        (String
"length", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON FileLength
fileInfoLength)
      , (String
"hashes", 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 <- forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc String
"length"
    Map HashFn Hash
fileInfoHashes <- forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc String
"hashes"
    forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo{Map HashFn Hash
FileLength
fileInfoHashes :: Map HashFn Hash
fileInfoLength :: FileLength
fileInfoHashes :: Map HashFn Hash
fileInfoLength :: FileLength
..}