-------------------------------------------------------------------------------
-- |
-- Module:      Crypto.PHKDF.Subtle
-- Copyright:   (c) 2024 Auth Global
-- License:     Apache2
--
-------------------------------------------------------------------------------

module Crypto.PHKDF.Subtle
  ( PhkdfCtx(..)
  , phkdfCtx_unsafeFeed
  , PhkdfGen(..)
  ) where

import           Prelude hiding (null)
import           Crypto.Sha256 as Sha256
import           Crypto.PHKDF.HMAC (HmacKeyLike)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.Foldable(foldl', null)
import           Data.Word

-- I should be using the counter inside the sha256 ctx.
-- While this project is rapidly approaching maturity, it's still somewhat
-- proof of concept.  See the new SHA256 bindings WIP.

data PhkdfCtx = PhkdfCtx
  { PhkdfCtx -> Word64
phkdfCtx_byteCount :: !Word64
  , PhkdfCtx -> Sha256Ctx
phkdfCtx_state :: !Sha256Ctx
  , PhkdfCtx -> HmacKeyLike
phkdfCtx_hmacKeyLike :: !HmacKeyLike
  }

data P = P !Word64 !Sha256Ctx

phkdfCtx_unsafeFeed :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_unsafeFeed :: forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_unsafeFeed f ByteString
strs PhkdfCtx
ctx0 =
  if f ByteString -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f ByteString
strs then PhkdfCtx
ctx0
  else PhkdfCtx
ctx0 {
    phkdfCtx_byteCount = byteCount',
    phkdfCtx_state = state'
  }
  where
    delta :: P -> ByteString -> P
delta (P Word64
len Sha256Ctx
ctx) ByteString
str = Word64 -> Sha256Ctx -> P
P (Word64
len 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
str))) (Sha256Ctx -> ByteString -> Sha256Ctx
sha256_update Sha256Ctx
ctx ByteString
str)

    p0 :: P
p0 = Word64 -> Sha256Ctx -> P
P (PhkdfCtx -> Word64
phkdfCtx_byteCount PhkdfCtx
ctx0) (PhkdfCtx -> Sha256Ctx
phkdfCtx_state PhkdfCtx
ctx0)

    P Word64
byteCount' Sha256Ctx
state' = (P -> ByteString -> P) -> P -> f ByteString -> P
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' P -> ByteString -> P
delta P
p0 f ByteString
strs

data PhkdfGen = PhkdfGen
  { PhkdfGen -> HmacKeyLike
phkdfGen_hmacKeyLike :: !HmacKeyLike
  , PhkdfGen -> ByteString
phkdfGen_extTag :: !ByteString
  , PhkdfGen -> Word32
phkdfGen_counter :: !Word32
  , PhkdfGen -> ByteString
phkdfGen_state :: !ByteString
  , PhkdfGen -> Maybe Sha256Ctx
phkdfGen_initCtx :: !(Maybe Sha256Ctx)
  }