{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
module Distribution.Client.HashValue (
    HashValue,
    hashValue,
    truncateHash,
    showHashValue,
    readFileHashValue,
    hashFromTUF,
    ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import qualified Hackage.Security.Client as Sec

import qualified Crypto.Hash.SHA256         as SHA256
import qualified Data.ByteString.Base16     as Base16
import qualified Data.ByteString.Char8      as BS
import qualified Data.ByteString.Lazy.Char8 as LBS

import System.IO         (IOMode (..), withBinaryFile)

-----------------------------------------------
-- The specific choice of hash implementation
--

-- Is a crypto hash necessary here? One thing to consider is who controls the
-- inputs and what's the result of a hash collision. Obviously we should not
-- install packages we don't trust because they can run all sorts of code, but
-- if I've checked there's no TH, no custom Setup etc, is there still a
-- problem? If someone provided us a tarball that hashed to the same value as
-- some other package and we installed it, we could end up re-using that
-- installed package in place of another one we wanted. So yes, in general
-- there is some value in preventing intentional hash collisions in installed
-- package ids.

newtype HashValue = HashValue BS.ByteString
  deriving (HashValue -> HashValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashValue -> HashValue -> Bool
$c/= :: HashValue -> HashValue -> Bool
== :: HashValue -> HashValue -> Bool
$c== :: HashValue -> HashValue -> Bool
Eq, forall x. Rep HashValue x -> HashValue
forall x. HashValue -> Rep HashValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HashValue x -> HashValue
$cfrom :: forall x. HashValue -> Rep HashValue x
Generic, Int -> HashValue -> ShowS
[HashValue] -> ShowS
HashValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashValue] -> ShowS
$cshowList :: [HashValue] -> ShowS
show :: HashValue -> String
$cshow :: HashValue -> String
showsPrec :: Int -> HashValue -> ShowS
$cshowsPrec :: Int -> HashValue -> ShowS
Show, Typeable)

-- Cannot do any sensible validation here. Although we use SHA256
-- for stuff we hash ourselves, we can also get hashes from TUF
-- and that can in principle use different hash functions in future.
--
-- Therefore, we simply derive this structurally.
instance Binary HashValue
instance Structured HashValue

-- | Hash some data. Currently uses SHA256.
--
hashValue :: LBS.ByteString -> HashValue
hashValue :: ByteString -> HashValue
hashValue = ByteString -> HashValue
HashValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA256.hashlazy

showHashValue :: HashValue -> String
showHashValue :: HashValue -> String
showHashValue (HashValue ByteString
digest) = ByteString -> String
BS.unpack (ByteString -> ByteString
Base16.encode ByteString
digest)

-- | Hash the content of a file. Uses SHA256.
--
readFileHashValue :: FilePath -> IO HashValue
readFileHashValue :: String -> IO HashValue
readFileHashValue String
tarball =
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
tarball IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
hnd ->
      forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HashValue
hashValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
LBS.hGetContents Handle
hnd

-- | Convert a hash from TUF metadata into a 'PackageSourceHash'.
--
-- Note that TUF hashes don't necessarily have to be SHA256, since it can
-- support new algorithms in future.
--
hashFromTUF :: Sec.Hash -> HashValue
hashFromTUF :: Hash -> HashValue
hashFromTUF (Sec.Hash String
hashstr) =
    --TODO: [code cleanup] either we should get TUF to use raw bytestrings or
    -- perhaps we should also just use a base16 string as the internal rep.
    case ByteString -> Either String ByteString
Base16.decode (String -> ByteString
BS.pack String
hashstr) of
#if MIN_VERSION_base16_bytestring(1,0,0)
      Right ByteString
hash -> ByteString -> HashValue
HashValue ByteString
hash
      Left String
_ -> forall a. HasCallStack => String -> a
error String
"hashFromTUF: cannot decode base16"
#else
      (hash, trailing) | not (BS.null hash) && BS.null trailing
        -> HashValue hash
      _ -> error "hashFromTUF: cannot decode base16 hash"
#endif

-- | Truncate a 32 byte SHA256 hash to
--
-- For example 20 bytes render as 40 hex chars, which we use for unit-ids.
-- Or even 4 bytes for 'hashedInstalledPackageIdShort'
--
truncateHash :: Int -> HashValue -> HashValue
truncateHash :: Int -> HashValue -> HashValue
truncateHash Int
n (HashValue ByteString
h) = ByteString -> HashValue
HashValue (Int -> ByteString -> ByteString
BS.take Int
n ByteString
h)