{-# LANGUAGE DataKinds                  #-}

-- | The portable C-implementation of Poly1305.
module Poly1305.CPortable
       ( name, description
       , Prim, Internals, BufferAlignment
       , BufferPtr
       , additionalBlocks
       , processBlocks
       , processLast
       , Key(..)
       ) where

import Raaz.Core
import Raaz.Core.Transfer.Unsafe
import Raaz.Primitive.Poly1305.Internal
import Poly1305.Memory

import Raaz.Verse.Poly1305.C.Portable

name :: String
name :: String
name = String
"poly1305-libverse-c"

description :: String
description :: String
description = String
"Poly1305 Implementation in C exposed by libverse"

type Prim                    = Poly1305
type Internals               = Mem
type BufferAlignment         = 32
type BufferPtr               = AlignedBlockPtr BufferAlignment Prim

additionalBlocks :: BlockCount Poly1305
additionalBlocks :: BlockCount Poly1305
additionalBlocks = Int -> Proxy Poly1305 -> BlockCount Poly1305
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 Proxy Poly1305
forall k (t :: k). Proxy t
Proxy


-- | Incrementally process poly1305 blocks.
processBlocks :: BufferPtr
              -> BlockCount Poly1305
              -> Internals
              -> IO ()
processBlocks :: BufferPtr -> BlockCount Poly1305 -> Internals -> IO ()
processBlocks BufferPtr
buf BlockCount Poly1305
blks = (Ptr Element -> Ptr (Tuple 2 Word64) -> IO ())
-> Internals -> IO ()
forall a.
(Ptr Element -> Ptr (Tuple 2 Word64) -> a) -> Internals -> a
withAccumR ((Ptr Element -> Ptr (Tuple 2 Word64) -> IO ())
 -> Internals -> IO ())
-> (Ptr Element -> Ptr (Tuple 2 Word64) -> IO ())
-> Internals
-> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr (Tuple 2 (LE Word64))
 -> Word64 -> Ptr Element -> Ptr (Tuple 2 Word64) -> IO ())
-> BufferPtr
-> BlockCount Poly1305
-> Ptr Element
-> Ptr (Tuple 2 Word64)
-> IO ()
forall a b.
(Ptr a -> Word64 -> b) -> BufferPtr -> BlockCount Poly1305 -> b
runWithBlocks Ptr (Tuple 2 (LE Word64))
-> Word64 -> Ptr Element -> Ptr (Tuple 2 Word64) -> IO ()
verse_poly1305_c_portable_incremental BufferPtr
buf BlockCount Poly1305
blks

-- | Process a message that is exactly a multiple of the blocks.
blocksMac :: BufferPtr
          -> BlockCount Poly1305
          -> Internals
          -> IO ()
blocksMac :: BufferPtr -> BlockCount Poly1305 -> Internals -> IO ()
blocksMac BufferPtr
buf BlockCount Poly1305
blks = (Ptr Element
 -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> IO ())
-> Internals -> IO ()
forall a.
(Ptr Element -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> a)
-> Internals -> a
withAccumRS ((Ptr Element
  -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> IO ())
 -> Internals -> IO ())
-> (Ptr Element
    -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> IO ())
-> Internals
-> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr (Tuple 2 (LE Word64))
 -> Word64
 -> Ptr Element
 -> Ptr (Tuple 2 Word64)
 -> Ptr (Tuple 2 Word64)
 -> IO ())
-> BufferPtr
-> BlockCount Poly1305
-> Ptr Element
-> Ptr (Tuple 2 Word64)
-> Ptr (Tuple 2 Word64)
-> IO ()
forall a b.
(Ptr a -> Word64 -> b) -> BufferPtr -> BlockCount Poly1305 -> b
runWithBlocks Ptr (Tuple 2 (LE Word64))
-> Word64
-> Ptr Element
-> Ptr (Tuple 2 Word64)
-> Ptr (Tuple 2 Word64)
-> IO ()
verse_poly1305_c_portable_blockmac BufferPtr
buf BlockCount Poly1305
blks

-- | Run an IO action with the pointers to the element, r and s cells.
withAccumRS :: ( Ptr Element ->
                 Ptr (Tuple 2 Word64) ->
                 Ptr (Tuple 2 Word64) ->
                 a
               )
            -> Internals
            -> a
withAccumRS :: (Ptr Element -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> a)
-> Internals -> a
withAccumRS Ptr Element -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> a
func Internals
mem = (Ptr Element -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> a)
-> Internals -> Ptr (Tuple 2 Word64) -> a
forall a.
(Ptr Element -> Ptr (Tuple 2 Word64) -> a) -> Internals -> a
withAccumR Ptr Element -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> a
func Internals
mem (Ptr (Tuple 2 Word64) -> a) -> Ptr (Tuple 2 Word64) -> a
forall a b. (a -> b) -> a -> b
$ Internals -> Ptr (Tuple 2 Word64)
sKeyPtr Internals
mem

withAccumR :: ( Ptr Element ->
                Ptr (Tuple 2 Word64) ->
                a
              )
           -> Internals
           -> a
withAccumR :: (Ptr Element -> Ptr (Tuple 2 Word64) -> a) -> Internals -> a
withAccumR Ptr Element -> Ptr (Tuple 2 Word64) -> a
func Internals
mem = Ptr Element -> Ptr (Tuple 2 Word64) -> a
func (Internals -> Ptr Element
accumPtr Internals
mem) (Ptr (Tuple 2 Word64) -> a) -> Ptr (Tuple 2 Word64) -> a
forall a b. (a -> b) -> a -> b
$ Internals -> Ptr (Tuple 2 Word64)
rKeyPtr Internals
mem

runWithBlocks :: ( Ptr a ->
                   Word64 ->
                   b
                 )
              -> BufferPtr
              -> BlockCount Poly1305
              -> b
runWithBlocks :: (Ptr a -> Word64 -> b) -> BufferPtr -> BlockCount Poly1305 -> b
runWithBlocks Ptr a -> Word64 -> b
func BufferPtr
buf = (Ptr a -> Word64 -> b)
-> AlignedPtr BufferAlignment (Tuple 16 Word8) -> Word64 -> b
forall (ptr :: * -> *) a b something.
Pointer ptr =>
(Ptr a -> b) -> ptr something -> b
unsafeWithPointerCast Ptr a -> Word64 -> b
func AlignedPtr BufferAlignment (Tuple 16 Word8)
BufferPtr
buf (Word64 -> b)
-> (BlockCount Poly1305 -> Word64) -> BlockCount Poly1305 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a. Enum a => Int -> a
toEnum (Int -> Word64)
-> (BlockCount Poly1305 -> Int) -> BlockCount Poly1305 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockCount Poly1305 -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Process a message that has its last block incomplete. The total
-- blocks argument here is the greatest multiple of the block that is
-- less that the message length.
partialBlockMac :: BufferPtr
                -> BlockCount Poly1305
                -> Internals
                -> IO ()
partialBlockMac :: BufferPtr -> BlockCount Poly1305 -> Internals -> IO ()
partialBlockMac BufferPtr
buf BlockCount Poly1305
blks Internals
mem = do
  BufferPtr -> BlockCount Poly1305 -> Internals -> IO ()
processBlocks BufferPtr
buf BlockCount Poly1305
blks Internals
mem
  (Ptr Element
 -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> IO ())
-> Internals -> IO ()
forall a.
(Ptr Element -> Ptr (Tuple 2 Word64) -> Ptr (Tuple 2 Word64) -> a)
-> Internals -> a
withAccumRS ((Ptr (Tuple 2 (LE Word64))
 -> Ptr Element
 -> Ptr (Tuple 2 Word64)
 -> Ptr (Tuple 2 Word64)
 -> IO ())
-> AlignedPtr BufferAlignment (Tuple 16 Word8)
-> Ptr Element
-> Ptr (Tuple 2 Word64)
-> Ptr (Tuple 2 Word64)
-> IO ()
forall (ptr :: * -> *) a b something.
Pointer ptr =>
(Ptr a -> b) -> ptr something -> b
unsafeWithPointerCast Ptr (Tuple 2 (LE Word64))
-> Ptr Element
-> Ptr (Tuple 2 Word64)
-> Ptr (Tuple 2 Word64)
-> IO ()
partialMac AlignedPtr BufferAlignment (Tuple 16 Word8)
BufferPtr
buf) Internals
mem
  where partialMac :: Ptr (Tuple 2 (LE Word64))
-> Ptr Element
-> Ptr (Tuple 2 Word64)
-> Ptr (Tuple 2 Word64)
-> IO ()
partialMac Ptr (Tuple 2 (LE Word64))
bufPtr = Ptr (Tuple 2 (LE Word64))
-> Ptr Element
-> Ptr (Tuple 2 Word64)
-> Ptr (Tuple 2 Word64)
-> IO ()
verse_poly1305_c_portable_partialmac (Ptr (Tuple 2 (LE Word64))
bufPtr Ptr (Tuple 2 (LE Word64))
-> BlockCount Poly1305 -> Ptr (Tuple 2 (LE Word64))
forall l a. LengthUnit l => Ptr a -> l -> Ptr a
`movePtr` BlockCount Poly1305
blks)

-- | Process the last bytes.
processLast :: BufferPtr
            -> BYTES Int
            -> Internals
            -> IO ()
processLast :: BufferPtr -> BYTES Int -> Internals -> IO ()
processLast BufferPtr
buf BYTES Int
nBytes Internals
mem
  | BlockCount Poly1305
blksC BlockCount Poly1305 -> BlockCount Poly1305 -> Bool
forall a. Eq a => a -> a -> Bool
== BlockCount Poly1305
blksF = BufferPtr -> BlockCount Poly1305 -> Internals -> IO ()
blocksMac BufferPtr
buf BlockCount Poly1305
blksC Internals
mem
  | Bool
otherwise      = do
      Transfer 'WriteToBuffer -> Ptr (Tuple 16 Word8) -> IO ()
forall (ptr :: * -> *) (t :: Mode) a.
Pointer ptr =>
Transfer t -> ptr a -> IO ()
unsafeTransfer Transfer 'WriteToBuffer
pad (AlignedPtr BufferAlignment (Tuple 16 Word8) -> Ptr (Tuple 16 Word8)
forall (n :: Nat) a. AlignedPtr n a -> Ptr a
forgetAlignment AlignedPtr BufferAlignment (Tuple 16 Word8)
BufferPtr
buf)
      BufferPtr -> BlockCount Poly1305 -> Internals -> IO ()
partialBlockMac BufferPtr
buf BlockCount Poly1305
blksF Internals
mem
  where blksC :: BlockCount Poly1305
blksC = BYTES Int -> BlockCount Poly1305
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atLeast BYTES Int
nBytes :: BlockCount Poly1305
        blksF :: BlockCount Poly1305
blksF = BYTES Int -> BlockCount Poly1305
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atMost  BYTES Int
nBytes :: BlockCount Poly1305
        pad :: Transfer 'WriteToBuffer
pad   = BYTES Int -> Transfer 'WriteToBuffer
padding BYTES Int
nBytes

-- | Poly1305 padding. Call this padding function if and only if the
-- message is not a multiple of the block length.
padding :: BYTES Int    -- Data in buffer.
        -> WriteTo
padding :: BYTES Int -> Transfer 'WriteToBuffer
padding BYTES Int
mLen = Word8
-> BlockCount Poly1305
-> Transfer 'WriteToBuffer
-> Transfer 'WriteToBuffer
forall n.
LengthUnit n =>
Word8 -> n -> Transfer 'WriteToBuffer -> Transfer 'WriteToBuffer
padWrite Word8
0 BlockCount Poly1305
boundary (Transfer 'WriteToBuffer -> Transfer 'WriteToBuffer)
-> Transfer 'WriteToBuffer -> Transfer 'WriteToBuffer
forall a b. (a -> b) -> a -> b
$ BYTES Int -> Transfer 'WriteToBuffer
forall l (t :: Mode). LengthUnit l => l -> Transfer t
skip BYTES Int
mLen Transfer 'WriteToBuffer
-> Transfer 'WriteToBuffer -> Transfer 'WriteToBuffer
forall a. Monoid a => a -> a -> a
`mappend` Transfer 'WriteToBuffer
one
  where one :: Transfer 'WriteToBuffer
one         = Word8 -> Transfer 'WriteToBuffer
forall a. Storable a => a -> Transfer 'WriteToBuffer
writeStorable (Word8
1::Word8)
        boundary :: BlockCount Poly1305
boundary    = Int -> Proxy Poly1305 -> BlockCount Poly1305
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 (Proxy Poly1305
forall k (t :: k). Proxy t
Proxy :: Proxy Poly1305)