-- |
-- Module      : Crypto.MAC.Poly1305
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Poly1305 implementation
--
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.MAC.Poly1305
    ( Ctx
    , State
    , Auth(..)
    , authTag
    -- * Incremental MAC Functions
    , initialize -- :: State
    , update     -- :: State -> ByteString -> State
    , updates    -- :: State -> [ByteString] -> State
    , finalize   -- :: State -> Auth
    -- * One-pass MAC function
    , auth
    ) where

import           Foreign.Ptr
import           Foreign.C.Types
import           Data.Word
import           Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes)
import qualified Crypto.Internal.ByteArray as B
import           Crypto.Internal.DeepSeq
import           Crypto.Error

-- | Poly1305 State
--
-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal
-- layout is architecture dependent, may contain uninitialized data fragments,
-- and change in future versions.  The bytearray should not be used as input to
-- cryptographic algorithms.
newtype State = State ScrubbedBytes
    deriving (State -> Int
forall p. State -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. State -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. State -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. State -> Ptr p -> IO ()
withByteArray :: forall p a. State -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. State -> (Ptr p -> IO a) -> IO a
length :: State -> Int
$clength :: State -> Int
ByteArrayAccess)

-- | Poly1305 State. use State instead of Ctx
type Ctx = State
{-# DEPRECATED Ctx "use Poly1305 State instead" #-}

-- | Poly1305 Auth
newtype Auth = Auth Bytes
    deriving (Auth -> Int
forall p. Auth -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Auth -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. Auth -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. Auth -> Ptr p -> IO ()
withByteArray :: forall p a. Auth -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. Auth -> (Ptr p -> IO a) -> IO a
length :: Auth -> Int
$clength :: Auth -> Int
ByteArrayAccess,Auth -> ()
forall a. (a -> ()) -> NFData a
rnf :: Auth -> ()
$crnf :: Auth -> ()
NFData)

authTag :: ByteArrayAccess b => b -> CryptoFailable Auth
authTag :: forall b. ByteArrayAccess b => b -> CryptoFailable Auth
authTag b
b
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length b
b forall a. Eq a => a -> a -> Bool
/= Int
16 = forall a. CryptoError -> CryptoFailable a
CryptoFailed forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_AuthenticationTagSizeInvalid
    | Bool
otherwise        = forall a. a -> CryptoFailable a
CryptoPassed forall a b. (a -> b) -> a -> b
$ Bytes -> Auth
Auth forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert b
b

instance Eq Auth where
    (Auth Bytes
a1) == :: Auth -> Auth -> Bool
== (Auth Bytes
a2) = forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
B.constEq Bytes
a1 Bytes
a2

foreign import ccall unsafe "crypton_poly1305.h crypton_poly1305_init"
    c_poly1305_init :: Ptr State -> Ptr Word8 -> IO ()

foreign import ccall "crypton_poly1305.h crypton_poly1305_update"
    c_poly1305_update :: Ptr State -> Ptr Word8 -> CUInt -> IO ()

foreign import ccall unsafe "crypton_poly1305.h crypton_poly1305_finalize"
    c_poly1305_finalize :: Ptr Word8 -> Ptr State -> IO ()

-- | initialize a Poly1305 context
initialize :: ByteArrayAccess key
           => key
           -> CryptoFailable State
initialize :: forall key. ByteArrayAccess key => key -> CryptoFailable State
initialize key
key
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key forall a. Eq a => a -> a -> Bool
/= Int
32 = forall a. CryptoError -> CryptoFailable a
CryptoFailed forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_MacKeyInvalid
    | Bool
otherwise          = forall a. a -> CryptoFailable a
CryptoPassed forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> State
State forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
84 forall a b. (a -> b) -> a -> b
$ \Ptr Any
ctxPtr ->
        forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray key
key forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyPtr ->
            Ptr State -> Ptr Word8 -> IO ()
c_poly1305_init (forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ctxPtr) Ptr Word8
keyPtr
{-# NOINLINE initialize #-}

-- | update a context with a bytestring
update :: ByteArrayAccess ba => State -> ba -> State
update :: forall ba. ByteArrayAccess ba => State -> ba -> State
update (State ScrubbedBytes
prevCtx) ba
d = ScrubbedBytes -> State
State forall a b. (a -> b) -> a -> b
$ forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ScrubbedBytes
prevCtx forall a b. (a -> b) -> a -> b
$ \Ptr Any
ctxPtr ->
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
d forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dataPtr ->
        Ptr State -> Ptr Word8 -> CUInt -> IO ()
c_poly1305_update (forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ctxPtr) Ptr Word8
dataPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
d)
{-# NOINLINE update #-}

-- | updates a context with multiples bytestring
updates :: ByteArrayAccess ba => State -> [ba] -> State
updates :: forall ba. ByteArrayAccess ba => State -> [ba] -> State
updates (State ScrubbedBytes
prevCtx) [ba]
d = ScrubbedBytes -> State
State forall a b. (a -> b) -> a -> b
$ forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ScrubbedBytes
prevCtx (forall {ba}. ByteArrayAccess ba => [ba] -> Ptr State -> IO ()
loop [ba]
d)
  where loop :: [ba] -> Ptr State -> IO ()
loop []     Ptr State
_      = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        loop (ba
x:[ba]
xs) Ptr State
ctxPtr = do
            forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dataPtr -> Ptr State -> Ptr Word8 -> CUInt -> IO ()
c_poly1305_update Ptr State
ctxPtr Ptr Word8
dataPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
x)
            [ba] -> Ptr State -> IO ()
loop [ba]
xs Ptr State
ctxPtr
{-# NOINLINE updates #-}

-- | finalize the context into a digest bytestring
finalize :: State -> Auth
finalize :: State -> Auth
finalize (State ScrubbedBytes
prevCtx) = Bytes -> Auth
Auth forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
16 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
    ScrubbedBytes
_ <- forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy ScrubbedBytes
prevCtx (\Ptr Any
ctxPtr -> Ptr Word8 -> Ptr State -> IO ()
c_poly1305_finalize Ptr Word8
dst (forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ctxPtr)) :: IO ScrubbedBytes
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# NOINLINE finalize #-}

-- | One-pass authorization creation
auth :: (ByteArrayAccess key, ByteArrayAccess ba) => key -> ba -> Auth
auth :: forall key ba.
(ByteArrayAccess key, ByteArrayAccess ba) =>
key -> ba -> Auth
auth key
key ba
d
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key forall a. Eq a => a -> a -> Bool
/= Int
32 = forall a. HasCallStack => [Char] -> a
error [Char]
"Poly1305: key length expected 32 bytes"
    | Bool
otherwise          = Bytes -> Auth
Auth forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
16 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
        ScrubbedBytes
_ <- forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
84 (forall {a}. Ptr Word8 -> Ptr a -> IO ()
onCtx Ptr Word8
dst) :: IO ScrubbedBytes
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
        onCtx :: Ptr Word8 -> Ptr a -> IO ()
onCtx Ptr Word8
dst Ptr a
ctxPtr =
            forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray key
key forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyPtr -> do
                Ptr State -> Ptr Word8 -> IO ()
c_poly1305_init (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ctxPtr) Ptr Word8
keyPtr
                forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
d forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dataPtr ->
                    Ptr State -> Ptr Word8 -> CUInt -> IO ()
c_poly1305_update (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ctxPtr) Ptr Word8
dataPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
d)
                Ptr Word8 -> Ptr State -> IO ()
c_poly1305_finalize Ptr Word8
dst (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ctxPtr)