sha512

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

Arm.hs (4568B)

      1 {-# OPTIONS_HADDOCK hide #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 
      4 -- |
      5 -- Module: Crypto.Hash.SHA512.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-512.
     11 
     12 module Crypto.Hash.SHA512.Arm (
     13     sha512_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, Word64)
     24 import Foreign.Marshal.Alloc (allocaBytes)
     25 import Foreign.Ptr (Ptr, plusPtr)
     26 import Foreign.Storable (poke, peek)
     27 import Crypto.Hash.SHA512.Internal (unsafe_padding)
     28 import System.IO.Unsafe (unsafePerformIO)
     29 
     30 -- ffi -----------------------------------------------------------------------
     31 
     32 foreign import ccall unsafe "sha512_block_arm"
     33   c_sha512_block :: Ptr Word64 -> Ptr Word8 -> IO ()
     34 
     35 foreign import ccall unsafe "sha512_arm_available"
     36   c_sha512_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 sha512_arm_available :: Bool
     47 sha512_arm_available = unsafePerformIO c_sha512_arm_available /= 0
     48 {-# NOINLINE sha512_arm_available #-}
     49 
     50 hash_arm :: BS.ByteString -> BS.ByteString
     51 hash_arm = hash_arm_with mempty 0
     52 
     53 -- | Hash with optional 128-byte prefix and extra length for padding.
     54 hash_arm_with
     55   :: BS.ByteString  -- ^ optional 128-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 64 $ \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_sha512_block state (src `plusPtr` poff)
     67 
     68       go state 0
     69 
     70       let !remaining@(BI.PS _ _ rlen) = BU.unsafeDrop (l - l `rem` 128) m
     71           BI.PS padfp padoff _ = unsafe_padding remaining (el + fi l)
     72       BI.unsafeWithForeignPtr padfp $ \src -> do
     73         c_sha512_block state (src `plusPtr` padoff)
     74         when (rlen >= 112) $
     75           c_sha512_block state (src `plusPtr` (padoff + 128))
     76 
     77       read_state state
     78   where
     79     go !state !j
     80       | j + 128 <= l = do
     81           BI.unsafeWithForeignPtr fp $ \src ->
     82             c_sha512_block state (src `plusPtr` (off + j))
     83           go state (j + 128)
     84       | otherwise = pure ()
     85 
     86 -- arm helpers ---------------------------------------------------------------
     87 
     88 poke_iv :: Ptr Word64 -> IO ()
     89 poke_iv !state = do
     90   poke state                (0x6a09e667f3bcc908 :: Word64)
     91   poke (state `plusPtr` 8)  (0xbb67ae8584caa73b :: Word64)
     92   poke (state `plusPtr` 16) (0x3c6ef372fe94f82b :: Word64)
     93   poke (state `plusPtr` 24) (0xa54ff53a5f1d36f1 :: Word64)
     94   poke (state `plusPtr` 32) (0x510e527fade682d1 :: Word64)
     95   poke (state `plusPtr` 40) (0x9b05688c2b3e6c1f :: Word64)
     96   poke (state `plusPtr` 48) (0x1f83d9abfb41bd6b :: Word64)
     97   poke (state `plusPtr` 56) (0x5be0cd19137e2179 :: Word64)
     98 
     99 read_state :: Ptr Word64 -> IO BS.ByteString
    100 read_state !state = BI.create 64 $ \out -> do
    101   h0 <- peek state                :: IO Word64
    102   h1 <- peek (state `plusPtr` 8)  :: IO Word64
    103   h2 <- peek (state `plusPtr` 16) :: IO Word64
    104   h3 <- peek (state `plusPtr` 24) :: IO Word64
    105   h4 <- peek (state `plusPtr` 32) :: IO Word64
    106   h5 <- peek (state `plusPtr` 40) :: IO Word64
    107   h6 <- peek (state `plusPtr` 48) :: IO Word64
    108   h7 <- peek (state `plusPtr` 56) :: IO Word64
    109   poke_word64be out 0 h0
    110   poke_word64be out 8 h1
    111   poke_word64be out 16 h2
    112   poke_word64be out 24 h3
    113   poke_word64be out 32 h4
    114   poke_word64be out 40 h5
    115   poke_word64be out 48 h6
    116   poke_word64be out 56 h7
    117 
    118 poke_word64be :: Ptr Word8 -> Int -> Word64 -> IO ()
    119 poke_word64be !p !off !w = do
    120   poke (p `plusPtr` off)       (fi (w `B.unsafeShiftR` 56) :: Word8)
    121   poke (p `plusPtr` (off + 1)) (fi (w `B.unsafeShiftR` 48) :: Word8)
    122   poke (p `plusPtr` (off + 2)) (fi (w `B.unsafeShiftR` 40) :: Word8)
    123   poke (p `plusPtr` (off + 3)) (fi (w `B.unsafeShiftR` 32) :: Word8)
    124   poke (p `plusPtr` (off + 4)) (fi (w `B.unsafeShiftR` 24) :: Word8)
    125   poke (p `plusPtr` (off + 5)) (fi (w `B.unsafeShiftR` 16) :: Word8)
    126   poke (p `plusPtr` (off + 6)) (fi (w `B.unsafeShiftR` 8) :: Word8)
    127   poke (p `plusPtr` (off + 7)) (fi w :: Word8)