sha256

Pure Haskell SHA-256, HMAC-SHA256 (docs.ppad.tech/sha256).
git clone git://git.ppad.tech/sha256.git
Log | Files | Refs | README | LICENSE

Arm.hs (4228B)

      1 {-# OPTIONS_HADDOCK hide #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 
      4 -- |
      5 -- Module: Crypto.Hash.SHA256.Arm
      6 -- Copyright: (c) 2024 Jared Tobin
      7 -- License: MIT
      8 -- Maintainer: Jared Tobin <jared@ppad.tech>
      9 --
     10 -- ARM crypto extension support for SHA-256.
     11 
     12 module Crypto.Hash.SHA256.Arm (
     13     sha256_arm_available
     14   , hash_arm
     15   , hash_arm_with
     16   ) where
     17 
     18 import Control.Monad (unless, when)
     19 import qualified Data.Bits as B
     20 import qualified Data.ByteString as BS
     21 import qualified Data.ByteString.Internal as BI
     22 import qualified Data.ByteString.Unsafe as BU
     23 import Data.Word (Word8, Word32, Word64)
     24 import Foreign.Marshal.Alloc (allocaBytes)
     25 import Foreign.Ptr (Ptr, plusPtr)
     26 import Foreign.Storable (poke, peek)
     27 import Crypto.Hash.SHA256.Internal (unsafe_padding)
     28 import System.IO.Unsafe (unsafePerformIO)
     29 
     30 -- ffi -----------------------------------------------------------------------
     31 
     32 foreign import ccall unsafe "sha256_block_arm"
     33   c_sha256_block :: Ptr Word32 -> Ptr Word8 -> IO ()
     34 
     35 foreign import ccall unsafe "sha256_arm_available"
     36   c_sha256_arm_available :: IO Int
     37 
     38 -- utilities -----------------------------------------------------------------
     39 
     40 fi :: (Integral a, Num b) => a -> b
     41 fi = fromIntegral
     42 {-# INLINE fi #-}
     43 
     44 -- api -----------------------------------------------------------------------
     45 
     46 sha256_arm_available :: Bool
     47 sha256_arm_available = unsafePerformIO c_sha256_arm_available /= 0
     48 {-# NOINLINE sha256_arm_available #-}
     49 
     50 hash_arm :: BS.ByteString -> BS.ByteString
     51 hash_arm = hash_arm_with mempty 0
     52 
     53 -- | Hash with optional 64-byte prefix and extra length for padding.
     54 hash_arm_with
     55   :: BS.ByteString  -- ^ optional 64-byte prefix (or empty)
     56   -> Word64         -- ^ extra length to add for padding
     57   -> BS.ByteString  -- ^ message
     58   -> BS.ByteString
     59 hash_arm_with prefix el m@(BI.PS fp off l) = unsafePerformIO $
     60     allocaBytes 32 $ \state -> do
     61       poke_iv state
     62       -- process prefix block if provided
     63       unless (BS.null prefix) $ do
     64         let BI.PS pfp poff _ = prefix
     65         BI.unsafeWithForeignPtr pfp $ \src ->
     66           c_sha256_block state (src `plusPtr` poff)
     67 
     68       go state 0
     69 
     70       let !remaining@(BI.PS _ _ rlen) = BU.unsafeDrop (l - l `rem` 64) m
     71           BI.PS padfp padoff _ = unsafe_padding remaining (el + fi l)
     72       BI.unsafeWithForeignPtr padfp $ \src -> do
     73         c_sha256_block state (src `plusPtr` padoff)
     74         when (rlen >= 56) $
     75           c_sha256_block state (src `plusPtr` (padoff + 64))
     76 
     77       read_state state
     78   where
     79     go !state !j
     80       | j + 64 <= l = do
     81           BI.unsafeWithForeignPtr fp $ \src ->
     82             c_sha256_block state (src `plusPtr` (off + j))
     83           go state (j + 64)
     84       | otherwise = pure ()
     85 
     86 -- arm helpers ---------------------------------------------------------------
     87 
     88 poke_iv :: Ptr Word32 -> IO ()
     89 poke_iv !state = do
     90   poke state                (0x6a09e667 :: Word32)
     91   poke (state `plusPtr` 4)  (0xbb67ae85 :: Word32)
     92   poke (state `plusPtr` 8)  (0x3c6ef372 :: Word32)
     93   poke (state `plusPtr` 12) (0xa54ff53a :: Word32)
     94   poke (state `plusPtr` 16) (0x510e527f :: Word32)
     95   poke (state `plusPtr` 20) (0x9b05688c :: Word32)
     96   poke (state `plusPtr` 24) (0x1f83d9ab :: Word32)
     97   poke (state `plusPtr` 28) (0x5be0cd19 :: Word32)
     98 
     99 read_state :: Ptr Word32 -> IO BS.ByteString
    100 read_state !state = BI.create 32 $ \out -> do
    101   h0 <- peek state                :: IO Word32
    102   h1 <- peek (state `plusPtr` 4)  :: IO Word32
    103   h2 <- peek (state `plusPtr` 8)  :: IO Word32
    104   h3 <- peek (state `plusPtr` 12) :: IO Word32
    105   h4 <- peek (state `plusPtr` 16) :: IO Word32
    106   h5 <- peek (state `plusPtr` 20) :: IO Word32
    107   h6 <- peek (state `plusPtr` 24) :: IO Word32
    108   h7 <- peek (state `plusPtr` 28) :: IO Word32
    109   poke_word32be out 0 h0
    110   poke_word32be out 4 h1
    111   poke_word32be out 8 h2
    112   poke_word32be out 12 h3
    113   poke_word32be out 16 h4
    114   poke_word32be out 20 h5
    115   poke_word32be out 24 h6
    116   poke_word32be out 28 h7
    117 
    118 poke_word32be :: Ptr Word8 -> Int -> Word32 -> IO ()
    119 poke_word32be !p !off !w = do
    120   poke (p `plusPtr` off)       (fi (w `B.unsafeShiftR` 24) :: Word8)
    121   poke (p `plusPtr` (off + 1)) (fi (w `B.unsafeShiftR` 16) :: Word8)
    122   poke (p `plusPtr` (off + 2)) (fi (w `B.unsafeShiftR` 8) :: Word8)
    123   poke (p `plusPtr` (off + 3)) (fi w :: Word8)