commit f38151800f1d442a06f91303b4b9ceeb6cf2a8b0
parent 6f45038cd9fd5c1d6e7fd9a4ae7d83a17fd1c08a
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 8 Jan 2026 15:09:43 +0400
lib: put arm stuff in own module
Diffstat:
4 files changed, 166 insertions(+), 127 deletions(-)
diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs
@@ -10,7 +10,7 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Pure SHA-256 and HMAC-SHA256 implementations for
+-- SHA-256 and HMAC-SHA256 implementations for
-- strict and lazy ByteStrings, as specified by RFC's
-- [6234](https://datatracker.ietf.org/doc/html/rfc6234) and
-- [2104](https://datatracker.ietf.org/doc/html/rfc2104).
@@ -25,147 +25,28 @@ module Crypto.Hash.SHA256 (
, Lazy.hmac_lazy
) where
-import Control.Monad (unless, when)
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
-import Data.Word (Word8, Word32, Word64)
-import Foreign.Marshal.Alloc (allocaBytes)
-import Foreign.Marshal.Utils (copyBytes, fillBytes)
-import Foreign.Ptr (Ptr, plusPtr)
-import Foreign.Storable (poke, peek)
+import Data.Word (Word64)
+import Crypto.Hash.SHA256.Arm
import Crypto.Hash.SHA256.Internal
import qualified Crypto.Hash.SHA256.Lazy as Lazy
-import System.IO.Unsafe (unsafePerformIO)
--- ffi ------------------------------------------------------------------------
+-- preliminary utils ---------------------------------------------------------
-foreign import ccall unsafe "sha256_block_arm"
- c_sha256_block :: Ptr Word32 -> Ptr Word8 -> IO ()
-
-foreign import ccall unsafe "sha256_arm_available"
- c_sha256_arm_available :: IO Int
-
--- preliminary utils ----------------------------------------------------------
-
--- keystroke saver
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
{-# INLINE fi #-}
--- hash -----------------------------------------------------------------------
+-- hash ----------------------------------------------------------------------
hash :: BS.ByteString -> BS.ByteString
hash m
| sha256_arm_available = hash_arm m
| otherwise = cat (process m)
-hash_arm :: BS.ByteString -> BS.ByteString
-hash_arm = hash_arm_with mempty 0
-
-sha256_arm_available :: Bool
-sha256_arm_available = unsafePerformIO c_sha256_arm_available /= 0
-{-# NOINLINE sha256_arm_available #-}
-
--- hash_arm, parameterized by optional 64-byte prefix and extra length
--- for padding
-hash_arm_with
- :: BS.ByteString -- ^ optional 64-byte prefix (or empty)
- -> Word64 -- ^ extra length to add for padding
- -> BS.ByteString -- ^ message
- -> BS.ByteString
-hash_arm_with prefix el m@(BI.PS fp off l) = unsafePerformIO $
- allocaBytes 32 $ \state -> do
- poke_iv state
- -- process prefix block if provided
- unless (BS.null prefix) $ do
- let BI.PS pfp poff _ = prefix
- BI.unsafeWithForeignPtr pfp $ \src ->
- c_sha256_block state (src `plusPtr` poff)
-
- go state 0
-
- let !remaining@(BI.PS _ _ rlen) = BU.unsafeDrop (l - l `rem` 64) m
- BI.PS padfp padoff _ = unsafe_padding remaining (el + fi l)
- BI.unsafeWithForeignPtr padfp $ \src -> do
- c_sha256_block state (src `plusPtr` padoff)
- when (rlen >= 56) $
- c_sha256_block state (src `plusPtr` (padoff + 64))
-
- read_state state
- where
- go !state !j
- | j + 64 <= l = do
- BI.unsafeWithForeignPtr fp $ \src ->
- c_sha256_block state (src `plusPtr` (off + j))
- go state (j + 64)
- | otherwise = pure ()
-
-poke_iv :: Ptr Word32 -> IO ()
-poke_iv !state = do
- poke state (0x6a09e667 :: Word32)
- poke (state `plusPtr` 4) (0xbb67ae85 :: Word32)
- poke (state `plusPtr` 8) (0x3c6ef372 :: Word32)
- poke (state `plusPtr` 12) (0xa54ff53a :: Word32)
- poke (state `plusPtr` 16) (0x510e527f :: Word32)
- poke (state `plusPtr` 20) (0x9b05688c :: Word32)
- poke (state `plusPtr` 24) (0x1f83d9ab :: Word32)
- poke (state `plusPtr` 28) (0x5be0cd19 :: Word32)
-
-read_state :: Ptr Word32 -> IO BS.ByteString
-read_state !state = BI.create 32 $ \out -> do
- h0 <- peek state :: IO Word32
- h1 <- peek (state `plusPtr` 4) :: IO Word32
- h2 <- peek (state `plusPtr` 8) :: IO Word32
- h3 <- peek (state `plusPtr` 12) :: IO Word32
- h4 <- peek (state `plusPtr` 16) :: IO Word32
- h5 <- peek (state `plusPtr` 20) :: IO Word32
- h6 <- peek (state `plusPtr` 24) :: IO Word32
- h7 <- peek (state `plusPtr` 28) :: IO Word32
- poke_word32be out 0 h0
- poke_word32be out 4 h1
- poke_word32be out 8 h2
- poke_word32be out 12 h3
- poke_word32be out 16 h4
- poke_word32be out 20 h5
- poke_word32be out 24 h6
- poke_word32be out 28 h7
-
-poke_word32be :: Ptr Word8 -> Int -> Word32 -> IO ()
-poke_word32be !p !off !w = do
- poke (p `plusPtr` off) (fi (w `B.unsafeShiftR` 24) :: Word8)
- poke (p `plusPtr` (off + 1)) (fi (w `B.unsafeShiftR` 16) :: Word8)
- poke (p `plusPtr` (off + 2)) (fi (w `B.unsafeShiftR` 8) :: Word8)
- poke (p `plusPtr` (off + 3)) (fi w :: Word8)
-
-unsafe_padding :: BS.ByteString -> Word64 -> BS.ByteString
-unsafe_padding (BI.PS fp off r) l
- | r < 56 = BI.unsafeCreate 64 $ \p -> do
- BI.unsafeWithForeignPtr fp $ \src ->
- copyBytes p (src `plusPtr` off) r
- poke (p `plusPtr` r) (0x80 :: Word8)
- fillBytes (p `plusPtr` (r + 1)) 0 (55 - r)
- poke_word64be (p `plusPtr` 56) (l * 8)
- | otherwise = BI.unsafeCreate 128 $ \p -> do
- BI.unsafeWithForeignPtr fp $ \src ->
- copyBytes p (src `plusPtr` off) r
- poke (p `plusPtr` r) (0x80 :: Word8)
- fillBytes (p `plusPtr` (r + 1)) 0 (63 - r)
- fillBytes (p `plusPtr` 64) 0 56
- poke_word64be (p `plusPtr` 120) (l * 8)
- where
- poke_word64be :: Ptr Word8 -> Word64 -> IO ()
- poke_word64be !p !w = do
- poke p (fi (w `B.unsafeShiftR` 56) :: Word8)
- poke (p `plusPtr` 1) (fi (w `B.unsafeShiftR` 48) :: Word8)
- poke (p `plusPtr` 2) (fi (w `B.unsafeShiftR` 40) :: Word8)
- poke (p `plusPtr` 3) (fi (w `B.unsafeShiftR` 32) :: Word8)
- poke (p `plusPtr` 4) (fi (w `B.unsafeShiftR` 24) :: Word8)
- poke (p `plusPtr` 5) (fi (w `B.unsafeShiftR` 16) :: Word8)
- poke (p `plusPtr` 6) (fi (w `B.unsafeShiftR` 8) :: Word8)
- poke (p `plusPtr` 7) (fi w :: Word8)
-
-- process message, parameterized by initial state and extra length for
-- padding
process_with :: Registers -> Word64 -> BS.ByteString -> Registers
@@ -186,7 +67,7 @@ process_with acc0 el m@(BI.PS _ _ l) = finalize (go acc0 0) where
process :: BS.ByteString -> Registers
process = process_with (iv ()) 0
--- hmac -----------------------------------------------------------------------
+-- hmac ----------------------------------------------------------------------
data KeyAndLen = KeyAndLen
{-# UNPACK #-} !BS.ByteString
@@ -211,4 +92,3 @@ hmac mk@(BI.PS _ _ l) text
!(KeyAndLen k lk)
| l > 64 = KeyAndLen (hash mk) 32
| otherwise = KeyAndLen mk l
-
diff --git a/lib/Crypto/Hash/SHA256/Arm.hs b/lib/Crypto/Hash/SHA256/Arm.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Module: Crypto.Hash.SHA256.Arm
+-- Copyright: (c) 2024 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- ARM crypto extension support for SHA-256.
+
+module Crypto.Hash.SHA256.Arm (
+ sha256_arm_available
+ , hash_arm
+ , hash_arm_with
+ ) where
+
+import Control.Monad (unless, when)
+import qualified Data.Bits as B
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Internal as BI
+import qualified Data.ByteString.Unsafe as BU
+import Data.Word (Word8, Word32, Word64)
+import Foreign.Marshal.Alloc (allocaBytes)
+import Foreign.Ptr (Ptr, plusPtr)
+import Foreign.Storable (poke, peek)
+import Crypto.Hash.SHA256.Internal (unsafe_padding)
+import System.IO.Unsafe (unsafePerformIO)
+
+-- ffi -----------------------------------------------------------------------
+
+foreign import ccall unsafe "sha256_block_arm"
+ c_sha256_block :: Ptr Word32 -> Ptr Word8 -> IO ()
+
+foreign import ccall unsafe "sha256_arm_available"
+ c_sha256_arm_available :: IO Int
+
+-- utilities -----------------------------------------------------------------
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+{-# INLINE fi #-}
+
+-- api -----------------------------------------------------------------------
+
+sha256_arm_available :: Bool
+sha256_arm_available = unsafePerformIO c_sha256_arm_available /= 0
+{-# NOINLINE sha256_arm_available #-}
+
+hash_arm :: BS.ByteString -> BS.ByteString
+hash_arm = hash_arm_with mempty 0
+
+-- | Hash with optional 64-byte prefix and extra length for padding.
+hash_arm_with
+ :: BS.ByteString -- ^ optional 64-byte prefix (or empty)
+ -> Word64 -- ^ extra length to add for padding
+ -> BS.ByteString -- ^ message
+ -> BS.ByteString
+hash_arm_with prefix el m@(BI.PS fp off l) = unsafePerformIO $
+ allocaBytes 32 $ \state -> do
+ poke_iv state
+ -- process prefix block if provided
+ unless (BS.null prefix) $ do
+ let BI.PS pfp poff _ = prefix
+ BI.unsafeWithForeignPtr pfp $ \src ->
+ c_sha256_block state (src `plusPtr` poff)
+
+ go state 0
+
+ let !remaining@(BI.PS _ _ rlen) = BU.unsafeDrop (l - l `rem` 64) m
+ BI.PS padfp padoff _ = unsafe_padding remaining (el + fi l)
+ BI.unsafeWithForeignPtr padfp $ \src -> do
+ c_sha256_block state (src `plusPtr` padoff)
+ when (rlen >= 56) $
+ c_sha256_block state (src `plusPtr` (padoff + 64))
+
+ read_state state
+ where
+ go !state !j
+ | j + 64 <= l = do
+ BI.unsafeWithForeignPtr fp $ \src ->
+ c_sha256_block state (src `plusPtr` (off + j))
+ go state (j + 64)
+ | otherwise = pure ()
+
+-- arm helpers ---------------------------------------------------------------
+
+poke_iv :: Ptr Word32 -> IO ()
+poke_iv !state = do
+ poke state (0x6a09e667 :: Word32)
+ poke (state `plusPtr` 4) (0xbb67ae85 :: Word32)
+ poke (state `plusPtr` 8) (0x3c6ef372 :: Word32)
+ poke (state `plusPtr` 12) (0xa54ff53a :: Word32)
+ poke (state `plusPtr` 16) (0x510e527f :: Word32)
+ poke (state `plusPtr` 20) (0x9b05688c :: Word32)
+ poke (state `plusPtr` 24) (0x1f83d9ab :: Word32)
+ poke (state `plusPtr` 28) (0x5be0cd19 :: Word32)
+
+read_state :: Ptr Word32 -> IO BS.ByteString
+read_state !state = BI.create 32 $ \out -> do
+ h0 <- peek state :: IO Word32
+ h1 <- peek (state `plusPtr` 4) :: IO Word32
+ h2 <- peek (state `plusPtr` 8) :: IO Word32
+ h3 <- peek (state `plusPtr` 12) :: IO Word32
+ h4 <- peek (state `plusPtr` 16) :: IO Word32
+ h5 <- peek (state `plusPtr` 20) :: IO Word32
+ h6 <- peek (state `plusPtr` 24) :: IO Word32
+ h7 <- peek (state `plusPtr` 28) :: IO Word32
+ poke_word32be out 0 h0
+ poke_word32be out 4 h1
+ poke_word32be out 8 h2
+ poke_word32be out 12 h3
+ poke_word32be out 16 h4
+ poke_word32be out 20 h5
+ poke_word32be out 24 h6
+ poke_word32be out 28 h7
+
+poke_word32be :: Ptr Word8 -> Int -> Word32 -> IO ()
+poke_word32be !p !off !w = do
+ poke (p `plusPtr` off) (fi (w `B.unsafeShiftR` 24) :: Word8)
+ poke (p `plusPtr` (off + 1)) (fi (w `B.unsafeShiftR` 16) :: Word8)
+ poke (p `plusPtr` (off + 2)) (fi (w `B.unsafeShiftR` 8) :: Word8)
+ poke (p `plusPtr` (off + 3)) (fi w :: Word8)
diff --git a/lib/Crypto/Hash/SHA256/Internal.hs b/lib/Crypto/Hash/SHA256/Internal.hs
@@ -26,12 +26,15 @@ module Crypto.Hash.SHA256.Internal (
, word32be
, parse_block
, unsafe_hash_alg
+ , unsafe_padding
) where
+import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
-import Data.Word (Word8)
+import Data.Word (Word8, Word64)
+import Foreign.Marshal.Utils (copyBytes, fillBytes)
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (poke)
import GHC.Exts (Int#)
@@ -420,3 +423,36 @@ cat (R h0 h1 h2 h3 h4 h5 h6 h7) = BI.unsafeCreate 32 $ \ptr -> do
byte :: Exts.Word32# -> Int# -> Word8
byte w n = GHC.Word.W8# (Exts.wordToWord8#
(Exts.word32ToWord# (Exts.uncheckedShiftRLWord32# w n)))
+
+-- keystroke saver
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+{-# INLINE fi #-}
+
+-- RFC 6234 4.1 message padding
+unsafe_padding :: BS.ByteString -> Word64 -> BS.ByteString
+unsafe_padding (BI.PS fp off r) len
+ | r < 56 = BI.unsafeCreate 64 $ \p -> do
+ BI.unsafeWithForeignPtr fp $ \src ->
+ copyBytes p (src `plusPtr` off) r
+ poke (p `plusPtr` r) (0x80 :: Word8)
+ fillBytes (p `plusPtr` (r + 1)) 0 (55 - r)
+ poke_word64be (p `plusPtr` 56) (len * 8)
+ | otherwise = BI.unsafeCreate 128 $ \p -> do
+ BI.unsafeWithForeignPtr fp $ \src ->
+ copyBytes p (src `plusPtr` off) r
+ poke (p `plusPtr` r) (0x80 :: Word8)
+ fillBytes (p `plusPtr` (r + 1)) 0 (63 - r)
+ fillBytes (p `plusPtr` 64) 0 56
+ poke_word64be (p `plusPtr` 120) (len * 8)
+ where
+ poke_word64be :: Ptr Word8 -> Word64 -> IO ()
+ poke_word64be p w = do
+ poke p (fi (w `B.unsafeShiftR` 56) :: Word8)
+ poke (p `plusPtr` 1) (fi (w `B.unsafeShiftR` 48) :: Word8)
+ poke (p `plusPtr` 2) (fi (w `B.unsafeShiftR` 40) :: Word8)
+ poke (p `plusPtr` 3) (fi (w `B.unsafeShiftR` 32) :: Word8)
+ poke (p `plusPtr` 4) (fi (w `B.unsafeShiftR` 24) :: Word8)
+ poke (p `plusPtr` 5) (fi (w `B.unsafeShiftR` 16) :: Word8)
+ poke (p `plusPtr` 6) (fi (w `B.unsafeShiftR` 8) :: Word8)
+ poke (p `plusPtr` 7) (fi w :: Word8)
diff --git a/ppad-sha256.cabal b/ppad-sha256.cabal
@@ -32,6 +32,7 @@ library
ghc-options: -fllvm -O2
exposed-modules:
Crypto.Hash.SHA256
+ Crypto.Hash.SHA256.Arm
Crypto.Hash.SHA256.Internal
Crypto.Hash.SHA256.Lazy
build-depends:
