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