Internal.hs

{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module: Crypto.DRBG.HMAC.Internal
-- Copyright: (c) 2024 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Internal HMAC-DRBG definitions.

module Crypto.DRBG.HMAC.Internal (
    Error(..)
  , _RESEED_COUNTER
  , _MAX_BYTES
  , _with_concat
  ) where

import Control.Monad.Primitive (PrimMonad)
import qualified Control.Monad.Primitive as Prim (unsafeIOToPrim)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import Data.Word (Word8, Word64)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Utils (copyBytes, fillBytes)
import Foreign.Ptr (Ptr, castPtr, plusPtr)

-- | A DRBG error.
data Error =
    MaxBytesExceeded -- ^ More than 65536 bytes have been requested.
  | ReseedRequired   -- ^ The DRBG must be reseeded (via 'reseed').
  deriving (Eq, Show)

-- see SP 800-90A table 2
_RESEED_COUNTER :: Word64
_RESEED_COUNTER = (2 :: Word64) ^ (48 :: Word64)
{-# INLINE _RESEED_COUNTER #-}

-- see SP 800-90A table 2
_MAX_BYTES :: Word64
_MAX_BYTES = 0x10000
{-# INLINE _MAX_BYTES #-}

-- | Run an action on the concatenation of the given strings, held in a
--   pinned buffer that is zeroed once the action completes, so that
--   (secret) seed material leaves no copy of the library's making
--   behind. The action must not retain its argument.
_with_concat
  :: PrimMonad m
  => [BS.ByteString]
  -> (BS.ByteString -> m a)
  -> m a
_with_concat bss act = do
  let !n = sum (fmap BS.length bss)
  fp <- Prim.unsafeIOToPrim $ do
    fp <- BI.mallocByteString n
    withForeignPtr fp $ \dst -> copy_all dst bss
    pure fp
  !r <- act (BI.BS fp n)
  Prim.unsafeIOToPrim $ withForeignPtr fp $ \p -> fillBytes p 0 n
  pure r
  where
    copy_all :: Ptr Word8 -> [BS.ByteString] -> IO ()
    copy_all _ [] = pure ()
    copy_all dst (b@(BI.PS _ _ l) : bs) = do
      BU.unsafeUseAsCString b $ \src -> copyBytes dst (castPtr src) l
      copy_all (dst `plusPtr` l) bs
{-# INLINE _with_concat #-}