{-# LANGUAGE MagicHash, UnboxedTuples, OverloadedStrings, ScopedTypeVariables,
             BangPatterns, LambdaCase #-}

-------------------------------------------------------------------------------
-- |
-- Module:      Crypto.Sha256
-- Copyright:   (c) 2024 Auth Global
-- License:     Apache2
--
-- Binding to SHA256, supporting streaming, backtracking, bitstring inputs, and
-- (de)serialization of intermediate states.
--
-------------------------------------------------------------------------------

module Crypto.Sha256
  ( hash
  , hash'
  , Sha256Ctx()
  , sha256_init
  , sha256_update,  sha256_feed
  , sha256_updates, sha256_feeds
  , sha256_byteCount
  , sha256_blockCount
  , sha256_bufferLength
  , sha256_state
  , sha256_finalize     , sha256_finalize_toByteString
  , sha256_finalizeBits , sha256_finalizeBits_toByteString
  , sha256_finalizeBytes, sha256_finalizeBytes_toByteString
  ) where

import           Data.Array.Byte
import           Data.Bits((.&.), shiftR)
import           Data.ByteString(ByteString)
import qualified Data.ByteString as B
import           Data.ByteString.Internal (unsafeCreate)
import           Data.ByteString.Unsafe(unsafeUseAsCString, unsafeUseAsCStringLen)
import           Data.Foldable(foldl')
import           Data.Function((&))
import           Data.Word
import           GHC.Exts
import           GHC.IO

import           Crypto.HashString
import           Crypto.HashString.FFI (HashString(..))
import           Crypto.Sha256.Subtle

-- TODO: there are a number of magic literals scattered throughout that
-- really ought to refer to a symbolic constant of some sort

hash :: ByteString -> ByteString
hash :: ByteString -> ByteString
hash ByteString
x = Sha256Ctx
sha256_init Sha256Ctx -> (Sha256Ctx -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> Word64 -> Sha256Ctx -> ByteString
sha256_finalizeBits_toByteString ByteString
x Word64
forall a. Bounded a => a
maxBound

hash' :: ByteString -> HashString
hash' :: ByteString -> HashString
hash' ByteString
x = Sha256Ctx
sha256_init Sha256Ctx -> (Sha256Ctx -> HashString) -> HashString
forall a b. a -> (a -> b) -> b
& ByteString -> Word64 -> Sha256Ctx -> HashString
sha256_finalizeBits ByteString
x Word64
forall a. Bounded a => a
maxBound

sha256_init :: Sha256Ctx
sha256_init :: Sha256Ctx
sha256_init =
  IO Sha256Ctx -> Sha256Ctx
forall a. IO a -> a
unsafePerformIO (IO Sha256Ctx -> Sha256Ctx)
-> ((State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
    -> IO Sha256Ctx)
-> (State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
-> Sha256Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
-> IO Sha256Ctx
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
 -> Sha256Ctx)
-> (State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
-> Sha256Ctx
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
st ->
    let !(# State# RealWorld
st0, MutableByteArray# RealWorld
a #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
40# State# RealWorld
st
        !(# State# RealWorld
st1, ()
_ #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (MutableByteArray# RealWorld -> IO ()
c_sha256_init_ctx MutableByteArray# RealWorld
a) State# RealWorld
st0
        !(# State# RealWorld
st2, ByteArray#
b #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
a State# RealWorld
st1
     in (# State# RealWorld
st2, ByteArray -> Sha256Ctx
Sha256Ctx (ByteArray# -> ByteArray
ByteArray ByteArray#
b) #)

sha256_byteCount :: Sha256Ctx -> Word64
sha256_byteCount :: Sha256Ctx -> Word64
sha256_byteCount (Sha256Ctx (ByteArray ByteArray#
ctx)) = ByteArray# -> Word64
c_sha256_get_count ByteArray#
ctx

sha256_blockCount :: Sha256Ctx -> Word64
sha256_blockCount :: Sha256Ctx -> Word64
sha256_blockCount Sha256Ctx
ctx = Sha256Ctx -> Word64
sha256_byteCount Sha256Ctx
ctx Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
6

sha256_bufferLength :: Sha256Ctx -> Word8
sha256_bufferLength :: Sha256Ctx -> Word8
sha256_bufferLength Sha256Ctx
ctx = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Sha256Ctx -> Word64
sha256_byteCount Sha256Ctx
ctx Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x3F)

sha256_state :: Sha256Ctx -> HashString
sha256_state :: Sha256Ctx -> HashString
sha256_state = Sha256State -> HashString
sha256state_encode (Sha256State -> HashString)
-> (Sha256Ctx -> Sha256State) -> Sha256Ctx -> HashString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sha256Ctx -> Sha256State
sha256state_fromCtxInplace

sha256_update :: Sha256Ctx -> ByteString -> Sha256Ctx
sha256_update :: Sha256Ctx -> ByteString -> Sha256Ctx
sha256_update ctx0 :: Sha256Ctx
ctx0@(Sha256Ctx (ByteArray ByteArray#
ctx)) ByteString
bytes
  | ByteString -> Bool
B.null ByteString
bytes = Sha256Ctx
ctx0
  | Bool
otherwise =
    IO Sha256Ctx -> Sha256Ctx
forall a. IO a -> a
unsafePerformIO (IO Sha256Ctx -> Sha256Ctx) -> IO Sha256Ctx -> Sha256Ctx
forall a b. (a -> b) -> a -> b
$ do
      let count :: Word64
count = ByteArray# -> Word64
c_sha256_get_count ByteArray#
ctx Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bytes)
      let !(I# Int#
bufLen#) = Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
count Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x3F)
      ByteString -> (CStringLen -> IO Sha256Ctx) -> IO Sha256Ctx
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytes ((CStringLen -> IO Sha256Ctx) -> IO Sha256Ctx)
-> (CStringLen -> IO Sha256Ctx) -> IO Sha256Ctx
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bp,Int
bl) -> (State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
-> IO Sha256Ctx
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
 -> IO Sha256Ctx)
-> (State# RealWorld -> (# State# RealWorld, Sha256Ctx #))
-> IO Sha256Ctx
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
st ->
        let !(# State# RealWorld
st0, MutableByteArray# RealWorld
a #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bufLen# State# RealWorld
st
            !(# State# RealWorld
st1, ()
_ #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (ByteArray#
-> Ptr CChar -> CSize -> MutableByteArray# RealWorld -> IO ()
c_sha256_update_ctx ByteArray#
ctx Ptr CChar
bp (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bl) MutableByteArray# RealWorld
a) State# RealWorld
st0
            !(# State# RealWorld
st2, ByteArray#
b #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
a State# RealWorld
st1
         in  (# State# RealWorld
st2, ByteArray -> Sha256Ctx
Sha256Ctx (ByteArray# -> ByteArray
ByteArray ByteArray#
b) #)

sha256_updates :: Foldable f => Sha256Ctx -> f ByteString -> Sha256Ctx
sha256_updates :: forall (f :: * -> *).
Foldable f =>
Sha256Ctx -> f ByteString -> Sha256Ctx
sha256_updates = (Sha256Ctx -> ByteString -> Sha256Ctx)
-> Sha256Ctx -> f ByteString -> Sha256Ctx
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Sha256Ctx -> ByteString -> Sha256Ctx
sha256_update

sha256_feed :: ByteString -> Sha256Ctx -> Sha256Ctx
sha256_feed :: ByteString -> Sha256Ctx -> Sha256Ctx
sha256_feed = (Sha256Ctx -> ByteString -> Sha256Ctx)
-> ByteString -> Sha256Ctx -> Sha256Ctx
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sha256Ctx -> ByteString -> Sha256Ctx
sha256_update

sha256_feeds :: Foldable f => f ByteString -> Sha256Ctx -> Sha256Ctx
sha256_feeds :: forall (f :: * -> *).
Foldable f =>
f ByteString -> Sha256Ctx -> Sha256Ctx
sha256_feeds = (Sha256Ctx -> f ByteString -> Sha256Ctx)
-> f ByteString -> Sha256Ctx -> Sha256Ctx
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sha256Ctx -> f ByteString -> Sha256Ctx
forall (f :: * -> *).
Foldable f =>
Sha256Ctx -> f ByteString -> Sha256Ctx
sha256_updates

sha256_finalize :: Sha256Ctx -> HashString
sha256_finalize :: Sha256Ctx -> HashString
sha256_finalize = ByteString -> Word64 -> Sha256Ctx -> HashString
sha256_finalizeBits ByteString
B.empty Word64
0

sha256_finalize_toByteString :: Sha256Ctx -> ByteString
sha256_finalize_toByteString :: Sha256Ctx -> ByteString
sha256_finalize_toByteString = ByteString -> Word64 -> Sha256Ctx -> ByteString
sha256_finalizeBits_toByteString ByteString
B.empty Word64
0

sha256_finalizeBits :: ByteString -> Word64 -> Sha256Ctx -> HashString
sha256_finalizeBits :: ByteString -> Word64 -> Sha256Ctx -> HashString
sha256_finalizeBits ByteString
bits Word64
bitlen0 (Sha256Ctx (ByteArray ByteArray#
ctx)) =
    IO HashString -> HashString
forall a. IO a -> a
unsafePerformIO (IO HashString -> HashString)
-> ((Ptr CChar -> IO HashString) -> IO HashString)
-> (Ptr CChar -> IO HashString)
-> HashString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (Ptr CChar -> IO HashString) -> IO HashString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
unsafeUseAsCString ByteString
bits ((Ptr CChar -> IO HashString) -> HashString)
-> (Ptr CChar -> IO HashString) -> HashString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
bp -> (State# RealWorld -> (# State# RealWorld, HashString #))
-> IO HashString
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, HashString #))
 -> IO HashString)
-> (State# RealWorld -> (# State# RealWorld, HashString #))
-> IO HashString
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
st ->
      let !(# State# RealWorld
st0, MutableByteArray# RealWorld
a #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
32# State# RealWorld
st
          !(# State# RealWorld
st1, () #) = IO () -> State# RealWorld -> (# State# RealWorld, () #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (ByteArray#
-> Ptr CChar -> Word64 -> MutableByteArray# RealWorld -> IO ()
c_sha256_finalize_ctx_bits_ba ByteArray#
ctx Ptr CChar
bp Word64
bitlen MutableByteArray# RealWorld
a) State# RealWorld
st0
          !(# State# RealWorld
st2, ByteArray#
b #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
a State# RealWorld
st1
       in (# State# RealWorld
st2, ByteArray -> HashString
HashString (ByteArray# -> ByteArray
ByteArray ByteArray#
b) #)
  where
    bitlen :: Word64
bitlen = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bits) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
8) Word64
bitlen0

sha256_finalizeBits_toByteString :: ByteString -> Word64 -> Sha256Ctx -> ByteString
sha256_finalizeBits_toByteString :: ByteString -> Word64 -> Sha256Ctx -> ByteString
sha256_finalizeBits_toByteString ByteString
bits Word64
bitlen0 (Sha256Ctx (ByteArray ByteArray#
ctx)) =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
32 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
rp ->
      ByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
unsafeUseAsCString ByteString
bits ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
bp ->
        ByteArray# -> Ptr CChar -> Word64 -> Ptr Word8 -> IO ()
c_sha256_finalize_ctx_bits ByteArray#
ctx Ptr CChar
bp Word64
bitlen Ptr Word8
rp
  where
    bitlen :: Word64
bitlen = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bits) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
8) Word64
bitlen0

sha256_finalizeBytes :: ByteString -> Sha256Ctx -> HashString
sha256_finalizeBytes :: ByteString -> Sha256Ctx -> HashString
sha256_finalizeBytes = (ByteString -> Word64 -> Sha256Ctx -> HashString)
-> Word64 -> ByteString -> Sha256Ctx -> HashString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Word64 -> Sha256Ctx -> HashString
sha256_finalizeBits Word64
forall a. Bounded a => a
maxBound

sha256_finalizeBytes_toByteString :: ByteString -> Sha256Ctx -> ByteString
sha256_finalizeBytes_toByteString :: ByteString -> Sha256Ctx -> ByteString
sha256_finalizeBytes_toByteString = (ByteString -> Word64 -> Sha256Ctx -> ByteString)
-> Word64 -> ByteString -> Sha256Ctx -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Word64 -> Sha256Ctx -> ByteString
sha256_finalizeBits_toByteString Word64
forall a. Bounded a => a
maxBound