-- |
-- 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
newtype State = State ScrubbedBytes
    deriving (State -> Int
State -> Ptr p -> IO ()
State -> (Ptr p -> IO a) -> IO a
(State -> Int)
-> (forall p a. State -> (Ptr p -> IO a) -> IO a)
-> (forall p. State -> Ptr p -> IO ())
-> ByteArrayAccess State
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 :: State -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. State -> Ptr p -> IO ()
withByteArray :: 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
Auth -> Ptr p -> IO ()
Auth -> (Ptr p -> IO a) -> IO a
(Auth -> Int)
-> (forall p a. Auth -> (Ptr p -> IO a) -> IO a)
-> (forall p. Auth -> Ptr p -> IO ())
-> ByteArrayAccess Auth
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 :: Auth -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. Auth -> Ptr p -> IO ()
withByteArray :: 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 -> ()
(Auth -> ()) -> NFData Auth
forall a. (a -> ()) -> NFData a
rnf :: Auth -> ()
$crnf :: Auth -> ()
NFData)

authTag :: ByteArrayAccess b => b -> CryptoFailable Auth
authTag :: b -> CryptoFailable Auth
authTag b
b
    | b -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length b
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 = CryptoError -> CryptoFailable Auth
forall a. CryptoError -> CryptoFailable a
CryptoFailed (CryptoError -> CryptoFailable Auth)
-> CryptoError -> CryptoFailable Auth
forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_AuthenticationTagSizeInvalid
    | Bool
otherwise        = Auth -> CryptoFailable Auth
forall a. a -> CryptoFailable a
CryptoPassed (Auth -> CryptoFailable Auth) -> Auth -> CryptoFailable Auth
forall a b. (a -> b) -> a -> b
$ Bytes -> Auth
Auth (Bytes -> Auth) -> Bytes -> Auth
forall a b. (a -> b) -> a -> b
$ b -> Bytes
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) = Bytes -> Bytes -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
B.constEq Bytes
a1 Bytes
a2

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

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

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

-- | initialize a Poly1305 context
initialize :: ByteArrayAccess key
           => key
           -> CryptoFailable State
initialize :: key -> CryptoFailable State
initialize key
key
    | key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 = CryptoError -> CryptoFailable State
forall a. CryptoError -> CryptoFailable a
CryptoFailed (CryptoError -> CryptoFailable State)
-> CryptoError -> CryptoFailable State
forall a b. (a -> b) -> a -> b
$ CryptoError
CryptoError_MacKeyInvalid
    | Bool
otherwise          = State -> CryptoFailable State
forall a. a -> CryptoFailable a
CryptoPassed (State -> CryptoFailable State) -> State -> CryptoFailable State
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> State
State (ScrubbedBytes -> State) -> ScrubbedBytes -> State
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Any -> IO ()) -> ScrubbedBytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
84 ((Ptr Any -> IO ()) -> ScrubbedBytes)
-> (Ptr Any -> IO ()) -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ctxPtr ->
        key -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray key
key ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyPtr ->
            Ptr State -> Ptr Word8 -> IO ()
c_poly1305_init (Ptr Any -> Ptr State
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 :: State -> ba -> State
update (State ScrubbedBytes
prevCtx) ba
d = ScrubbedBytes -> State
State (ScrubbedBytes -> State) -> ScrubbedBytes -> State
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> (Ptr Any -> IO ()) -> ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ScrubbedBytes
prevCtx ((Ptr Any -> IO ()) -> ScrubbedBytes)
-> (Ptr Any -> IO ()) -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ctxPtr ->
    ba -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
d ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dataPtr ->
        Ptr State -> Ptr Word8 -> CUInt -> IO ()
c_poly1305_update (Ptr Any -> Ptr State
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ctxPtr) Ptr Word8
dataPtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ ba -> Int
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 :: State -> [ba] -> State
updates (State ScrubbedBytes
prevCtx) [ba]
d = ScrubbedBytes -> State
State (ScrubbedBytes -> State) -> ScrubbedBytes -> State
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> (Ptr State -> IO ()) -> ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ScrubbedBytes
prevCtx ([ba] -> Ptr State -> IO ()
forall ba. ByteArrayAccess ba => [ba] -> Ptr State -> IO ()
loop [ba]
d)
  where loop :: [ba] -> Ptr State -> IO ()
loop []     Ptr State
_      = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        loop (ba
x:[ba]
xs) Ptr State
ctxPtr = do
            ba -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
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 (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ ba -> Int
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 (Bytes -> Auth) -> Bytes -> Auth
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word8 -> IO ()) -> Bytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
16 ((Ptr Word8 -> IO ()) -> Bytes) -> (Ptr Word8 -> IO ()) -> Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
    ScrubbedBytes
_ <- ScrubbedBytes -> (Ptr Any -> IO ()) -> IO 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 (Ptr Any -> Ptr State
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ctxPtr)) :: IO ScrubbedBytes
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# NOINLINE finalize #-}

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