{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-|

Contexts are useful when computing message digests of streaming input,
i.e needs incremental processing. It consists of the internal state of the
primitive, a buffer for intermediate data, and a memory cell for keeping
track of the total number of data that is remaining.

-}

module Context ( Cxt(..)
               , cxtSize
               , cxtBlockCount
               , unsafeSetCxtEmpty
               , unsafeSetCxtFull
               , unsafeGenerateBlocks
               , unsafeConsumeBlocks
               , unsafeWriteTo
               , unsafeFillFrom
               , unsafeUpdate
               , unsafeFinalise
               ) where

import GHC.TypeLits

import Raaz.Core
import Implementation
import Buffer

----------------- Contexts ------------------------------
-- | There are two cases where incremental processing of bytes are
--   desired.
--
-- 1. For incremental message digest or message auth computation. We call this
--    the hashing mode.
--
-- 2. For CSPRG. We call this the csprg mode.
--
-- In both cases, we need a buffer, the internal memory state and a
-- count of how much data is remaining in the context. This is
-- captured by the Cxt type.

data Cxt n = Cxt { Cxt n -> Internals
cxtInternals       :: Internals
                 , Cxt n -> Buffer n
cxtBuf             :: Buffer n
                 , Cxt n -> MemoryCell (BYTES Int)
cxtAvailableBytes  :: MemoryCell (BYTES Int)
                 }

instance KnownNat n => Memory (Cxt n) where
  memoryAlloc :: Alloc (Cxt n)
memoryAlloc     = Internals -> Buffer n -> MemoryCell (BYTES Int) -> Cxt n
forall (n :: Nat).
Internals -> Buffer n -> MemoryCell (BYTES Int) -> Cxt n
Cxt (Internals -> Buffer n -> MemoryCell (BYTES Int) -> Cxt n)
-> TwistRF AllocField (BYTES Int) Internals
-> TwistRF
     AllocField
     (BYTES Int)
     (Buffer n -> MemoryCell (BYTES Int) -> Cxt n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwistRF AllocField (BYTES Int) Internals
forall m. Memory m => Alloc m
memoryAlloc TwistRF
  AllocField
  (BYTES Int)
  (Buffer n -> MemoryCell (BYTES Int) -> Cxt n)
-> TwistRF AllocField (BYTES Int) (Buffer n)
-> TwistRF AllocField (BYTES Int) (MemoryCell (BYTES Int) -> Cxt n)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwistRF AllocField (BYTES Int) (Buffer n)
forall m. Memory m => Alloc m
memoryAlloc TwistRF AllocField (BYTES Int) (MemoryCell (BYTES Int) -> Cxt n)
-> TwistRF AllocField (BYTES Int) (MemoryCell (BYTES Int))
-> Alloc (Cxt n)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TwistRF AllocField (BYTES Int) (MemoryCell (BYTES Int))
forall m. Memory m => Alloc m
memoryAlloc
  unsafeToPointer :: Cxt n -> Ptr Word8
unsafeToPointer = Buffer n -> Ptr Word8
forall m. Memory m => m -> Ptr Word8
unsafeToPointer (Buffer n -> Ptr Word8)
-> (Cxt n -> Buffer n) -> Cxt n -> Ptr Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cxt n -> Buffer n
forall (n :: Nat). Cxt n -> Buffer n
cxtBuf

{--

-- Unfortunately this require UndecidableInstances so we suppress
-- these instances.

instance (KnownNat n, Initialisable Internals v) =>
  Initialisable (Cxt n) v where
  initialise v cxt@Cxt{..} = initialise v cxtInternals
                             >> unsafeSetCxtEmpty cxt

instance (KnownNat n, Extractable Internals v) =>
  Extractable (Cxt n) v where
  extract = extract . cxtInternals

--}
-- | Gives the number of blocks that can fit in the context.
cxtBlockCount :: KnownNat n => Proxy (Cxt n) -> BlockCount Prim
cxtBlockCount :: Proxy (Cxt n) -> BlockCount Prim
cxtBlockCount = Proxy (Buffer n) -> BlockCount Prim
forall (n :: Nat).
KnownNat n =>
Proxy (Buffer n) -> BlockCount Prim
bufferSize (Proxy (Buffer n) -> BlockCount Prim)
-> (Proxy (Cxt n) -> Proxy (Buffer n))
-> Proxy (Cxt n)
-> BlockCount Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cxt n -> Buffer n) -> Proxy (Cxt n) -> Proxy (Buffer n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cxt n -> Buffer n
forall (n :: Nat). Cxt n -> Buffer n
cxtBuf

-- | Gives the size of the context buffer
cxtSize :: KnownNat n => Proxy (Cxt n) -> BYTES Int
cxtSize :: Proxy (Cxt n) -> BYTES Int
cxtSize = BlockCount Prim -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes (BlockCount Prim -> BYTES Int)
-> (Proxy (Cxt n) -> BlockCount Prim) -> Proxy (Cxt n) -> BYTES Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Cxt n) -> BlockCount Prim
forall (n :: Nat). KnownNat n => Proxy (Cxt n) -> BlockCount Prim
cxtBlockCount

-- | Total valid bytes (either generated or read) that is available at
-- the front of the buffer.
getCxtBytes :: KnownNat n => Cxt n -> IO (BYTES Int)
getCxtBytes :: Cxt n -> IO (BYTES Int)
getCxtBytes = MemoryCell (BYTES Int) -> IO (BYTES Int)
forall m v. Extractable m v => m -> IO v
extract (MemoryCell (BYTES Int) -> IO (BYTES Int))
-> (Cxt n -> MemoryCell (BYTES Int)) -> Cxt n -> IO (BYTES Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cxt n -> MemoryCell (BYTES Int)
forall (n :: Nat). Cxt n -> MemoryCell (BYTES Int)
cxtAvailableBytes

-- | Set the current number of bytes.
setBytes :: BYTES Int -> Cxt n -> IO ()
setBytes :: BYTES Int -> Cxt n -> IO ()
setBytes BYTES Int
nbytes = BYTES Int -> MemoryCell (BYTES Int) -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise BYTES Int
nbytes (MemoryCell (BYTES Int) -> IO ())
-> (Cxt n -> MemoryCell (BYTES Int)) -> Cxt n -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cxt n -> MemoryCell (BYTES Int)
forall (n :: Nat). Cxt n -> MemoryCell (BYTES Int)
cxtAvailableBytes

-- | Set the context to the empty state.
unsafeSetCxtEmpty :: Cxt n -> IO ()
unsafeSetCxtEmpty :: Cxt n -> IO ()
unsafeSetCxtEmpty Cxt{Internals
MemoryCell (BYTES Int)
Buffer n
cxtAvailableBytes :: MemoryCell (BYTES Int)
cxtBuf :: Buffer n
cxtInternals :: Internals
cxtAvailableBytes :: forall (n :: Nat). Cxt n -> MemoryCell (BYTES Int)
cxtBuf :: forall (n :: Nat). Cxt n -> Buffer n
cxtInternals :: forall (n :: Nat). Cxt n -> Internals
..} = BYTES Int -> MemoryCell (BYTES Int) -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise (BYTES Int
0 :: BYTES Int) MemoryCell (BYTES Int)
cxtAvailableBytes

-- | Set the context to the full state.
unsafeSetCxtFull :: KnownNat n => Cxt n -> IO ()
unsafeSetCxtFull :: Cxt n -> IO ()
unsafeSetCxtFull cxt :: Cxt n
cxt@Cxt{Internals
MemoryCell (BYTES Int)
Buffer n
cxtAvailableBytes :: MemoryCell (BYTES Int)
cxtBuf :: Buffer n
cxtInternals :: Internals
cxtAvailableBytes :: forall (n :: Nat). Cxt n -> MemoryCell (BYTES Int)
cxtBuf :: forall (n :: Nat). Cxt n -> Buffer n
cxtInternals :: forall (n :: Nat). Cxt n -> Internals
..} = BYTES Int -> MemoryCell (BYTES Int) -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise (Proxy (Cxt n) -> BYTES Int
forall (n :: Nat). KnownNat n => Proxy (Cxt n) -> BYTES Int
cxtSize (Proxy (Cxt n) -> BYTES Int) -> Proxy (Cxt n) -> BYTES Int
forall a b. (a -> b) -> a -> b
$ Cxt n -> Proxy (Cxt n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt n
cxt) MemoryCell (BYTES Int)
cxtAvailableBytes

------------------ NOTES ----------------------------------------------
--
-- There is a nice duality between the usage of context in the hashing
-- mode as opposed to csprg mode.
--
-- [Hashing mode:] Bytes are consumed by the block processor. For this
-- bytes needs to be supplied from the outside world.
--
-- [CSPRG mode:] Bytes are generated by the block processor. The
-- context supplies these bytes to the out side world.
--
-- You can see this duality reflected in the functions that exists in
-- both the case.

------------------  Generating/Consuming blocks ------------------------
--
-- The first visible duality in the two modes is in the way the two
-- primitives process blocks.
--
-- [HASH mode:] Block compressor should be called when the context
-- buffer is full and, as a result, should leave the context buffer
-- empty.
--
-- [CSPRG mode:] Block generator should be called when the context
-- buffer is empty and, as a result, should leave the context buffer full


-- | Process the entire buffer of the context using the given action.
unsafeProcessBlocks :: KnownNat n
                    => (BufferPtr -> BlockCount Prim -> Internals -> IO ())
                    -> Cxt n
                    -> IO ()
unsafeProcessBlocks :: (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
unsafeProcessBlocks BufferPtr -> BlockCount Prim -> Internals -> IO ()
action Cxt{Internals
MemoryCell (BYTES Int)
Buffer n
cxtAvailableBytes :: MemoryCell (BYTES Int)
cxtBuf :: Buffer n
cxtInternals :: Internals
cxtAvailableBytes :: forall (n :: Nat). Cxt n -> MemoryCell (BYTES Int)
cxtBuf :: forall (n :: Nat). Cxt n -> Buffer n
cxtInternals :: forall (n :: Nat). Cxt n -> Internals
..} = (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Buffer n -> Internals -> IO ()
forall (n :: Nat) a.
KnownNat n =>
(BufferPtr -> BlockCount Prim -> a) -> Buffer n -> a
withBufferPtr BufferPtr -> BlockCount Prim -> Internals -> IO ()
action Buffer n
cxtBuf Internals
cxtInternals

-- | Typically used in CSPRG mode, this combinator generates blocks to
-- fill the context buffer. All the current bytes in the context gets
-- overwritten and hence is an unsafe operation. The result of this
-- combinator is a context that is filled with generated bytes ready
-- to be given out.
unsafeGenerateBlocks :: KnownNat n
                     => (BufferPtr -> BlockCount Prim -> Internals -> IO ())
                     -- ^ Blocks generator
                     -> Cxt n
                     -> IO ()
unsafeGenerateBlocks :: (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
unsafeGenerateBlocks BufferPtr -> BlockCount Prim -> Internals -> IO ()
genBlocks Cxt n
cxt = (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
forall (n :: Nat).
KnownNat n =>
(BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
unsafeProcessBlocks BufferPtr -> BlockCount Prim -> Internals -> IO ()
genBlocks Cxt n
cxt IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Cxt n -> IO ()
forall (n :: Nat). KnownNat n => Cxt n -> IO ()
unsafeSetCxtFull Cxt n
cxt


-- | Typically used in the Hashing mode, this combinator assumes that
-- the context is full and consumes these blocks. This action does not
-- check whether the context is full and hence is unsafe. The result
-- of this action is an empty context ready to receive further bytes.
unsafeConsumeBlocks :: KnownNat n
                    => (BufferPtr -> BlockCount Prim -> Internals -> IO ())
                    -> Cxt n
                    -> IO ()
unsafeConsumeBlocks :: (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
unsafeConsumeBlocks BufferPtr -> BlockCount Prim -> Internals -> IO ()
action Cxt n
cxt = (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
forall (n :: Nat).
KnownNat n =>
(BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
unsafeProcessBlocks BufferPtr -> BlockCount Prim -> Internals -> IO ()
action Cxt n
cxt IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Cxt n -> IO ()
forall (n :: Nat). Cxt n -> IO ()
unsafeSetCxtEmpty Cxt n
cxt

--------------------------- DANGEROUS CODE ---------------------------------------
--
-- The picture below summarises the state of the buffer.
--
--
-- >  sptr                endPtr
-- >   |                  |
-- >   |<----available--->|<----remaining ----------------->|
--     V                  V                                 V
-- >   +----------------------------------------------------+
-- >   |                  |                                 |
-- >   +----------------------------------------------------+
-- >   ^                                                    ^
-- >   |<------------ buffer length (l)  ------------------>|
--
--

-- | Starting pointer of the context buffer.
startPtr :: Cxt n -> Ptr Word8
startPtr :: Cxt n -> Ptr Word8
startPtr = (Ptr Word8 -> Ptr Word8)
-> AlignedPtr BufferAlignment (Tuple 16 (LE Word32)) -> Ptr Word8
forall (ptr :: * -> *) a b something.
Pointer ptr =>
(Ptr a -> b) -> ptr something -> b
unsafeWithPointerCast  Ptr Word8 -> Ptr Word8
forall a. a -> a
id (AlignedPtr BufferAlignment (Tuple 16 (LE Word32)) -> Ptr Word8)
-> (Cxt n -> AlignedPtr BufferAlignment (Tuple 16 (LE Word32)))
-> Cxt n
-> Ptr Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer n -> AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
forall (n :: Nat). Buffer n -> BufferPtr
unsafeGetBufferPointer (Buffer n -> AlignedPtr BufferAlignment (Tuple 16 (LE Word32)))
-> (Cxt n -> Buffer n)
-> Cxt n
-> AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cxt n -> Buffer n
forall (n :: Nat). Cxt n -> Buffer n
cxtBuf


-- > startPtr             srcPtr
-- >   |<------------------- available -------------------->|
-- >   |                  |                                 |
-- >   |<----leftover --->|<---- satisfy  ----------------->|
-- >   V                  V                                 V
-- >   +----------------------------------------------------+
-- >   |                  |                                 |
-- >   +----------------------------------------------------+
-- >   ^                                                    ^
-- >   |<------------ buffer length (l)  ------------------>|
--
--


-- | This action writes out to the given pointer buffer, bytes from
-- the context. The copy of the bytes written in the context buffer is
-- wiped so that looking at the context it is impossible to predict
-- what was written out. The return value is the actual number of
-- bytes written out which may be less than the amount demanded.
unsafeWriteTo :: KnownNat n
              => BYTES Int         -- ^ How many bytes to send to destination.
              -> Dest (Ptr Word8)  -- ^ destination pointer
              -> Cxt n
              -> IO (BYTES Int)
unsafeWriteTo :: BYTES Int -> Dest (Ptr Word8) -> Cxt n -> IO (BYTES Int)
unsafeWriteTo BYTES Int
req Dest (Ptr Word8)
dbuf Cxt n
cxt = do
  BYTES Int
ava <- Cxt n -> IO (BYTES Int)
forall (n :: Nat). KnownNat n => Cxt n -> IO (BYTES Int)
getCxtBytes Cxt n
cxt           -- bytes available in the context
  let satisfy :: BYTES Int
satisfy  = BYTES Int -> BYTES Int -> BYTES Int
forall a. Ord a => a -> a -> a
min BYTES Int
req BYTES Int
ava    -- how much of the demand can be satisfied.
      leftover :: BYTES Int
leftover = BYTES Int
ava BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
- BYTES Int
satisfy  -- the leftover bytes.
      srcPtr :: Ptr Word8
srcPtr   = Cxt n -> Ptr Word8
forall (n :: Nat). Cxt n -> Ptr Word8
startPtr Cxt n
cxt Ptr Word8 -> BYTES Int -> Ptr Word8
forall l a. LengthUnit l => Ptr a -> l -> Ptr a
`movePtr` BYTES Int
leftover
    in do Dest (Ptr Word8) -> Src (Ptr Word8) -> BYTES Int -> IO ()
forall l (ptrS :: * -> *) (ptrD :: * -> *) dest src.
(LengthUnit l, Pointer ptrS, Pointer ptrD) =>
Dest (ptrD dest) -> Src (ptrS src) -> l -> IO ()
memcpy Dest (Ptr Word8)
dbuf (Ptr Word8 -> Src (Ptr Word8)
forall a. a -> Src a
source Ptr Word8
srcPtr) BYTES Int
satisfy -- transfer the actual bytes
          Ptr Word8 -> BYTES Int -> IO ()
forall l (ptr :: * -> *) a.
(LengthUnit l, Pointer ptr) =>
ptr a -> l -> IO ()
wipeMemory Ptr Word8
srcPtr BYTES Int
satisfy           -- wipe the copy
          BYTES Int -> Cxt n -> IO ()
forall (n :: Nat). BYTES Int -> Cxt n -> IO ()
setBytes BYTES Int
leftover Cxt n
cxt
          BYTES Int -> IO (BYTES Int)
forall (m :: * -> *) a. Monad m => a -> m a
return BYTES Int
satisfy



-- > startPtr             destPtr
-- >   |<------------------- bufSize   -------------------->|
-- >   |                  |                                 |
-- >   |<----available--->|<---- vacant   ----------------->|
-- >   V                  V                                 V
-- >   +----------------------------------------------------+
-- >   |                  |                                 |
-- >   +----------------------------------------------------+
-- >   ^                                                    ^
-- >   |<------------ buffer length (l)  ------------------>|
--
--

unsafeFillFrom :: (KnownNat n, ByteSource src)
               => src
               -> Cxt n
               -> IO (FillResult src)
unsafeFillFrom :: src -> Cxt n -> IO (FillResult src)
unsafeFillFrom src
src Cxt n
cxt = do
  BYTES Int
ava <- Cxt n -> IO (BYTES Int)
forall (n :: Nat). KnownNat n => Cxt n -> IO (BYTES Int)
getCxtBytes Cxt n
cxt           -- bytes available in the context
  let vacant :: BYTES Int
vacant  = Proxy (Cxt n) -> BYTES Int
forall (n :: Nat). KnownNat n => Proxy (Cxt n) -> BYTES Int
cxtSize (Cxt n -> Proxy (Cxt n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt n
cxt) BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
- BYTES Int
ava
      destPtr :: Ptr Word8
destPtr = Cxt n -> Ptr Word8
forall (n :: Nat). Cxt n -> Ptr Word8
startPtr Cxt n
cxt Ptr Word8 -> BYTES Int -> Ptr Word8
forall l a. LengthUnit l => Ptr a -> l -> Ptr a
`movePtr` BYTES Int
ava
      srcExhausted :: BYTES Int -> IO (FillResult src)
srcExhausted BYTES Int
trfed = BYTES Int -> Cxt n -> IO ()
forall (n :: Nat). BYTES Int -> Cxt n -> IO ()
setBytes (BYTES Int
ava BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
+ BYTES Int
trfed) Cxt n
cxt IO () -> IO (FillResult src) -> IO (FillResult src)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FillResult src -> IO (FillResult src)
forall (m :: * -> *) a. Monad m => a -> m a
return (BYTES Int -> FillResult src
forall a. BYTES Int -> FillResult a
Exhausted BYTES Int
trfed)
      srcRemaining :: src -> IO (FillResult src)
srcRemaining src
remSrc = Cxt n -> IO ()
forall (n :: Nat). KnownNat n => Cxt n -> IO ()
unsafeSetCxtFull Cxt n
cxt IO () -> IO (FillResult src) -> IO (FillResult src)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FillResult src -> IO (FillResult src)
forall (m :: * -> *) a. Monad m => a -> m a
return (src -> FillResult src
forall a. a -> FillResult a
Remaining src
remSrc)
    in BYTES Int -> src -> Ptr Word8 -> IO (FillResult src)
forall src a.
ByteSource src =>
BYTES Int -> src -> Ptr a -> IO (FillResult src)
fillBytes BYTES Int
vacant src
src Ptr Word8
destPtr IO (FillResult src)
-> (FillResult src -> IO (FillResult src)) -> IO (FillResult src)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (src -> IO (FillResult src))
-> (BYTES Int -> IO (FillResult src))
-> FillResult src
-> IO (FillResult src)
forall a b. (a -> b) -> (BYTES Int -> b) -> FillResult a -> b
withFillResult src -> IO (FillResult src)
srcRemaining BYTES Int -> IO (FillResult src)
srcExhausted


-- | Starting with an empty context, run the given action on the src
-- reading a full buffer at a time. Ends when the src is
-- exhausted. The last chunk of bytes that is read is not processed
-- and is left in the buffer for later processing when more bytes are
-- added or when finalising the context.
unsafeContinue :: (KnownNat n, ByteSource src)
               => (BufferPtr -> BlockCount Prim -> Internals -> IO ())
               -> src
               -> Cxt n
               -> IO ()
unsafeContinue :: (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> src -> Cxt n -> IO ()
unsafeContinue BufferPtr -> BlockCount Prim -> Internals -> IO ()
action src
src Cxt n
cxt = IO ()
-> (BYTES Int -> IO ()) -> src -> Ptr Word8 -> BYTES Int -> IO ()
forall (ptr :: * -> *) (m :: * -> *) chunkSize src a b something.
(Pointer ptr, MonadIO m, LengthUnit chunkSize, ByteSource src) =>
m a
-> (BYTES Int -> m b) -> src -> ptr something -> chunkSize -> m b
processChunks IO ()
actFilled BYTES Int -> IO ()
lastChunk src
src Ptr Word8
bufPtr BYTES Int
bufSize
  where actFilled :: IO ()
actFilled = (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
forall (n :: Nat).
KnownNat n =>
(BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
unsafeProcessBlocks BufferPtr -> BlockCount Prim -> Internals -> IO ()
action Cxt n
cxt
        lastChunk :: BYTES Int -> IO ()
lastChunk BYTES Int
nbytes = BYTES Int -> Cxt n -> IO ()
forall (n :: Nat). BYTES Int -> Cxt n -> IO ()
setBytes BYTES Int
nbytes Cxt n
cxt
        bufPtr :: Ptr Word8
bufPtr           = Cxt n -> Ptr Word8
forall (n :: Nat). Cxt n -> Ptr Word8
startPtr Cxt n
cxt
        bufSize :: BYTES Int
bufSize          = Proxy (Cxt n) -> BYTES Int
forall (n :: Nat). KnownNat n => Proxy (Cxt n) -> BYTES Int
cxtSize (Proxy (Cxt n) -> BYTES Int) -> Proxy (Cxt n) -> BYTES Int
forall a b. (a -> b) -> a -> b
$ Cxt n -> Proxy (Cxt n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt n
cxt


-- | Update the context with data coming from the byte source. Used
-- typically in the digest mode.
unsafeUpdate :: (KnownNat n, ByteSource src)
             => (BufferPtr -> BlockCount Prim -> Internals -> IO ())
             -> src
             -> Cxt n
             -> IO ()
unsafeUpdate :: (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> src -> Cxt n -> IO ()
unsafeUpdate BufferPtr -> BlockCount Prim -> Internals -> IO ()
action src
src Cxt n
cxt =
  src -> Cxt n -> IO (FillResult src)
forall (n :: Nat) src.
(KnownNat n, ByteSource src) =>
src -> Cxt n -> IO (FillResult src)
unsafeFillFrom src
src Cxt n
cxt IO (FillResult src) -> (FillResult src -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (src -> IO ()) -> (BYTES Int -> IO ()) -> FillResult src -> IO ()
forall a b. (a -> b) -> (BYTES Int -> b) -> FillResult a -> b
withFillResult src -> IO ()
process BYTES Int -> IO ()
forall b. b -> IO ()
doNothing
  where doNothing :: b -> IO ()
doNothing      = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        process :: src -> IO ()
process src
remSrc = (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
forall (n :: Nat).
KnownNat n =>
(BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Cxt n -> IO ()
unsafeConsumeBlocks BufferPtr -> BlockCount Prim -> Internals -> IO ()
action Cxt n
cxt IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> src -> Cxt n -> IO ()
forall (n :: Nat) src.
(KnownNat n, ByteSource src) =>
(BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> src -> Cxt n -> IO ()
unsafeContinue BufferPtr -> BlockCount Prim -> Internals -> IO ()
action src
remSrc Cxt n
cxt


unsafeFinalise :: KnownNat n
               => (BufferPtr -> BYTES Int -> Internals -> IO ())
               -> Cxt n
               -> IO ()
unsafeFinalise :: (BufferPtr -> BYTES Int -> Internals -> IO ()) -> Cxt n -> IO ()
unsafeFinalise BufferPtr -> BYTES Int -> Internals -> IO ()
action cxt :: Cxt n
cxt@Cxt{Internals
MemoryCell (BYTES Int)
Buffer n
cxtAvailableBytes :: MemoryCell (BYTES Int)
cxtBuf :: Buffer n
cxtInternals :: Internals
cxtAvailableBytes :: forall (n :: Nat). Cxt n -> MemoryCell (BYTES Int)
cxtBuf :: forall (n :: Nat). Cxt n -> Buffer n
cxtInternals :: forall (n :: Nat). Cxt n -> Internals
..} = do
  BYTES Int
ava <- Cxt n -> IO (BYTES Int)
forall (n :: Nat). KnownNat n => Cxt n -> IO (BYTES Int)
getCxtBytes Cxt n
cxt
  (BufferPtr -> BYTES Int -> Internals -> IO ())
-> Buffer n -> BYTES Int -> Internals -> IO ()
forall (n :: Nat) a.
KnownNat n =>
(BufferPtr -> a) -> Buffer n -> a
unsafeWithBufferPtr BufferPtr -> BYTES Int -> Internals -> IO ()
action Buffer n
cxtBuf BYTES Int
ava Internals
cxtInternals