sha512

Pure Haskell SHA-512, HMAC-SHA512 (docs.ppad.tech/sha512).
git clone git://git.ppad.tech/sha512.git
Log | Files | Refs | README | LICENSE

SHA512.hs (3717B)

      1 {-# OPTIONS_HADDOCK prune #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 
      4 -- |
      5 -- Module: Crypto.Hash.SHA512
      6 -- Copyright: (c) 2024 Jared Tobin
      7 -- License: MIT
      8 -- Maintainer: Jared Tobin <jared@ppad.tech>
      9 --
     10 -- SHA-512 and HMAC-SHA512 implementations for
     11 -- strict and lazy ByteStrings, as specified by RFC's
     12 -- [6234](https://datatracker.ietf.org/doc/html/rfc6234) and
     13 -- [2104](https://datatracker.ietf.org/doc/html/rfc2104).
     14 --
     15 -- The 'hash' and 'hmac' functions will use primitive instructions from
     16 -- the ARM cryptographic extensions via FFI if they're available, and
     17 -- will otherwise use a pure Haskell implementation.
     18 
     19 module Crypto.Hash.SHA512 (
     20   -- * SHA-512 message digest functions
     21     hash
     22   , Lazy.hash_lazy
     23 
     24   -- * SHA512-based MAC functions
     25   , MAC(..)
     26   , hmac
     27   , Lazy.hmac_lazy
     28   ) where
     29 
     30 import qualified Data.Bits as B
     31 import qualified Data.ByteString as BS
     32 import qualified Data.ByteString.Internal as BI
     33 import qualified Data.ByteString.Unsafe as BU
     34 import Data.Word (Word64)
     35 import Crypto.Hash.SHA512.Arm
     36 import Crypto.Hash.SHA512.Internal
     37 import qualified Crypto.Hash.SHA512.Lazy as Lazy
     38 
     39 -- utils ---------------------------------------------------------------------
     40 
     41 fi :: (Integral a, Num b) => a -> b
     42 fi = fromIntegral
     43 {-# INLINE fi #-}
     44 
     45 -- hash ----------------------------------------------------------------------
     46 
     47 -- | Compute a condensed representation of a strict bytestring via
     48 --   SHA-512.
     49 --
     50 --   The 512-bit output digest is returned as a strict bytestring.
     51 --
     52 --   >>> hash "strict bytestring input"
     53 --   "<strict 512-bit message digest>"
     54 hash :: BS.ByteString -> BS.ByteString
     55 hash m
     56   | sha512_arm_available = hash_arm m
     57   | otherwise            = cat (process m)
     58 
     59 -- process a message, given the specified iv
     60 process_with :: Registers -> Word64 -> BS.ByteString -> Registers
     61 process_with acc0 el m@(BI.PS _ _ l) = finalize (go acc0 0) where
     62   go !acc !j
     63     | j + 128 <= l = go (block_hash acc (prepare_schedule (parse_block m j)))
     64                         (j + 128)
     65     | otherwise    = acc
     66 
     67   finalize !acc
     68       | len < 112 = block_hash acc (prepare_schedule (parse_block padded 0))
     69       | otherwise = block_hash
     70           (block_hash acc (prepare_schedule (parse_block padded 0)))
     71           (prepare_schedule (parse_block padded 128))
     72     where
     73       !remaining@(BI.PS _ _ len) = BU.unsafeDrop (l - l `rem` 128) m
     74       !padded = unsafe_padding remaining (el + fi l)
     75 
     76 process :: BS.ByteString -> Registers
     77 process = process_with iv 0
     78 
     79 -- hmac ----------------------------------------------------------------------
     80 
     81 data KeyAndLen = KeyAndLen
     82   {-# UNPACK #-} !BS.ByteString
     83   {-# UNPACK #-} !Int
     84 
     85 -- | Produce a message authentication code for a strict bytestring,
     86 --   based on the provided (strict, bytestring) key, via SHA-512.
     87 --
     88 --   The 512-bit MAC is returned as a strict bytestring.
     89 --
     90 --   Per RFC 2104, the key /should/ be a minimum of 64 bytes long. Keys
     91 --   exceeding 128 bytes in length will first be hashed (via SHA-512).
     92 --
     93 --   >>> hmac "strict bytestring key" "strict bytestring input"
     94 --   "<strict 512-bit MAC>"
     95 hmac
     96   :: BS.ByteString -- ^ key
     97   -> BS.ByteString -- ^ text
     98   -> MAC
     99 hmac mk@(BI.PS _ _ l) text
    100     | sha512_arm_available =
    101         let !inner = hash_arm_with ipad 128 text
    102         in  MAC (hash_arm (opad <> inner))
    103     | otherwise =
    104         let !ipad_state = block_hash iv (prepare_schedule (parse_block ipad 0))
    105             !inner = cat (process_with ipad_state 128 text)
    106         in  MAC (hash (opad <> inner))
    107   where
    108     !step1 = k <> BS.replicate (128 - lk) 0x00
    109     !ipad  = BS.map (B.xor 0x36) step1
    110     !opad  = BS.map (B.xor 0x5C) step1
    111     !(KeyAndLen k lk)
    112       | l > 128   = KeyAndLen (hash mk) 64
    113       | otherwise = KeyAndLen mk l