cabal-install/src/Distribution/Client/HashValue.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE DeriveGeneric #-}
   4
   5 module Distribution.Client.HashValue
   6   ( HashValue
   7   , hashValue
   8   , truncateHash
   9   , showHashValue
  10   , readFileHashValue
  11   , hashFromTUF
  12   ) where
  13
  14 import Distribution.Client.Compat.Prelude
  15 import Prelude ()
  16
  17 import qualified Hackage.Security.Client as Sec
  18
  19 import qualified Crypto.Hash.SHA256 as SHA256
  20 import qualified Data.ByteString.Base16 as Base16
  21 import qualified Data.ByteString.Char8 as BS
  22 import qualified Data.ByteString.Lazy.Char8 as LBS
  23
  24 import System.IO (IOMode (..), withBinaryFile)
  25
  26 -----------------------------------------------
  27 -- The specific choice of hash implementation
  28 --
  29
  30 -- Is a crypto hash necessary here? One thing to consider is who controls the
  31 -- inputs and what's the result of a hash collision. Obviously we should not
  32 -- install packages we don't trust because they can run all sorts of code, but
  33 -- if I've checked there's no TH, no custom Setup etc, is there still a
  34 -- problem? If someone provided us a tarball that hashed to the same value as
  35 -- some other package and we installed it, we could end up re-using that
  36 -- installed package in place of another one we wanted. So yes, in general
  37 -- there is some value in preventing intentional hash collisions in installed
  38 -- package ids.
  39
  40 newtype HashValue = HashValue BS.ByteString
  41   deriving (Eq, Generic, Show, Typeable)
  42
  43 -- Cannot do any sensible validation here. Although we use SHA256
  44 -- for stuff we hash ourselves, we can also get hashes from TUF
  45 -- and that can in principle use different hash functions in future.
  46 --
  47 -- Therefore, we simply derive this structurally.
  48 instance Binary HashValue
  49 instance Structured HashValue
  50
  51 -- | Hash some data. Currently uses SHA256.
  52 hashValue :: LBS.ByteString -> HashValue
  53 hashValue = HashValue . SHA256.hashlazy
  54
  55 showHashValue :: HashValue -> String
  56 showHashValue (HashValue digest) = BS.unpack (Base16.encode digest)
  57
  58 -- | Hash the content of a file. Uses SHA256.
  59 readFileHashValue :: FilePath -> IO HashValue
  60 readFileHashValue tarball =
  61   withBinaryFile tarball ReadMode $ \hnd ->
  62     evaluate . hashValue =<< LBS.hGetContents hnd
  63
  64 -- | Convert a hash from TUF metadata into a 'PackageSourceHash'.
  65 --
  66 -- Note that TUF hashes don't necessarily have to be SHA256, since it can
  67 -- support new algorithms in future.
  68 {- FOURMOLU_DISABLE -}
  69 hashFromTUF :: Sec.Hash -> HashValue
  70 hashFromTUF (Sec.Hash hashstr) =
  71   -- TODO: [code cleanup] either we should get TUF to use raw bytestrings or
  72   -- perhaps we should also just use a base16 string as the internal rep.
  73   case Base16.decode (BS.pack hashstr) of
  74 #if MIN_VERSION_base16_bytestring(1,0,0)
  75       Right hash -> HashValue hash
  76       Left _ -> error "hashFromTUF: cannot decode base16"
  77 #else
  78       (hash, trailing) | not (BS.null hash) && BS.null trailing
  79         -> HashValue hash
  80       _ -> error "hashFromTUF: cannot decode base16 hash"
  81 #endif
  82 {- FOURMOLU_ENABLE -}
  83
  84 -- | Truncate a 32 byte SHA256 hash to
  85 --
  86 -- For example 20 bytes render as 40 hex chars, which we use for unit-ids.
  87 -- Or even 4 bytes for 'hashedInstalledPackageIdShort'
  88 truncateHash :: Int -> HashValue -> HashValue
  89 truncateHash n (HashValue h) = HashValue (BS.take n h)