-- |
-- Module      : Crypto.Saltine.Core.OneTimeAuth
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : MIT
--
-- Maintainer  : me@jspha.com
-- Stability   : experimental
-- Portability : non-portable
--
-- Secret-key single-message authentication:
-- "Crypto.Saltine.Core.OneTimeAuth"
--
-- The 'auth' function authenticates a message 'ByteString' using a
-- secret key The function returns an authenticator. The 'verify'
-- function checks if it's passed a correct authenticator of a message
-- under the given secret key.
--
-- The 'auth' function, viewed as a function of the message for a
-- uniform random key, is designed to meet the standard notion of
-- unforgeability after a single message. After the sender
-- authenticates one message, an attacker cannot find authenticators
-- for any other messages.
--
-- The sender must not use 'auth' to authenticate more than one
-- message under the same key. Authenticators for two messages under
-- the same key should be expected to reveal enough information to
-- allow forgeries of authenticators on other messages.
--
-- "Crypto.Saltine.Core.OneTimeAuth" is
-- @crypto_onetimeauth_poly1305@, an authenticator specified in
-- "Cryptography in NaCl" (<http://nacl.cr.yp.to/valid.html>), Section
-- 9. This authenticator is proven to meet the standard notion of
-- unforgeability after a single message.
--
-- This is version 2010.08.30 of the onetimeauth.html web page.
module Crypto.Saltine.Core.OneTimeAuth (
  Key, Authenticator,
  newKey,
  auth, verify
  ) where

import Crypto.Saltine.Internal.OneTimeAuth
            ( c_onetimeauth
            , c_onetimeauth_verify
            , Key(..)
            , Authenticator(..)
            )
import Crypto.Saltine.Internal.Util as U
import Data.ByteString              (ByteString)

import qualified Crypto.Saltine.Internal.OneTimeAuth as Bytes
import qualified Data.ByteString                   as S

-- | Creates a random key of the correct size for 'auth' and 'verify'.
newKey :: IO Key
newKey :: IO Key
newKey = ByteString -> Key
Key (ByteString -> Key) -> IO ByteString -> IO Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
randomByteString Int
Bytes.onetimeauth_keybytes

-- | Builds a keyed 'Authenticator' for a message. This
-- 'Authenticator' is /impossible/ to forge so long as the 'Key' is
-- never used twice.
auth :: Key
     -> ByteString
     -- ^ Message
     -> Authenticator
auth :: Key -> ByteString -> Authenticator
auth (Key ByteString
key) ByteString
msg =
  ByteString -> Authenticator
Au (ByteString -> Authenticator)
-> ((Ptr CChar -> IO CInt) -> ByteString)
-> (Ptr CChar -> IO CInt)
-> Authenticator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CInt, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((CInt, ByteString) -> ByteString)
-> ((Ptr CChar -> IO CInt) -> (CInt, ByteString))
-> (Ptr CChar -> IO CInt)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr CChar -> IO CInt) -> (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> (b, ByteString)
buildUnsafeByteString Int
Bytes.onetimeauth_bytes ((Ptr CChar -> IO CInt) -> Authenticator)
-> (Ptr CChar -> IO CInt) -> Authenticator
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pa ->
    [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
key, ByteString
msg] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \[(Ptr CChar
pk, Int
_), (Ptr CChar
pm, Int
_)] ->
      Ptr CChar -> Ptr CChar -> CULLong -> Ptr CChar -> IO CInt
c_onetimeauth Ptr CChar
pa Ptr CChar
pm (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
msg) Ptr CChar
pk

-- | Verifies that an 'Authenticator' matches a given message and key.
verify :: Key
       -> Authenticator
       -> ByteString
       -- ^ Message
       -> Bool
       -- ^ Is this message authentic?
verify :: Key -> Authenticator -> ByteString -> Bool
verify (Key ByteString
key) (Au ByteString
a) ByteString
msg =
  IO CInt -> Bool
unsafeDidSucceed (IO CInt -> Bool) -> IO CInt -> Bool
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
key, ByteString
msg, ByteString
a] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \
    [(Ptr CChar
pk, Int
_), (Ptr CChar
pm, Int
_), (Ptr CChar
pa, Int
_)] ->
      CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Ptr CChar -> CULLong -> Ptr CChar -> CInt
c_onetimeauth_verify Ptr CChar
pa Ptr CChar
pm (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
msg) Ptr CChar
pk