{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric #-}

-- |
-- 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.Class
import           Crypto.Saltine.Internal.Util
import qualified Crypto.Saltine.Internal.ByteSizes as Bytes

import           Control.Applicative
import           Foreign.C
import           Foreign.Ptr
import qualified Data.ByteString                   as S
import           Data.ByteString                     (ByteString)
import           Data.Hashable (Hashable)
import           Data.Data (Data, Typeable)
import           GHC.Generics (Generic)

-- $types

-- | An opaque 'auth' cryptographic key.
newtype Key           = Key ByteString deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> Int
Key -> Int
(Int -> Key -> Int) -> (Key -> Int) -> Hashable Key
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Key -> Int
$chash :: Key -> Int
hashWithSalt :: Int -> Key -> Int
$chashWithSalt :: Int -> Key -> Int
Hashable, Typeable Key
DataType
Constr
Typeable Key
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Key -> c Key)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Key)
-> (Key -> Constr)
-> (Key -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Key))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key))
-> ((forall b. Data b => b -> b) -> Key -> Key)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall u. (forall d. Data d => d -> u) -> Key -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Key -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> Data Key
Key -> DataType
Key -> Constr
(forall b. Data b => b -> b) -> Key -> Key
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
forall u. (forall d. Data d => d -> u) -> Key -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cKey :: Constr
$tKey :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapMp :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapM :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapQi :: Int -> (forall d. Data d => d -> u) -> Key -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
gmapQ :: (forall d. Data d => d -> u) -> Key -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Key -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapT :: (forall b. Data b => b -> b) -> Key -> Key
$cgmapT :: (forall b. Data b => b -> b) -> Key -> Key
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Key)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
dataTypeOf :: Key -> DataType
$cdataTypeOf :: Key -> DataType
toConstr :: Key -> Constr
$ctoConstr :: Key -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cp1Data :: Typeable Key
Data, Typeable, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic)

-- | An opaque 'auth' authenticator.
newtype Authenticator = Au ByteString  deriving (Authenticator -> Authenticator -> Bool
(Authenticator -> Authenticator -> Bool)
-> (Authenticator -> Authenticator -> Bool) -> Eq Authenticator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Authenticator -> Authenticator -> Bool
$c/= :: Authenticator -> Authenticator -> Bool
== :: Authenticator -> Authenticator -> Bool
$c== :: Authenticator -> Authenticator -> Bool
Eq, Eq Authenticator
Eq Authenticator
-> (Authenticator -> Authenticator -> Ordering)
-> (Authenticator -> Authenticator -> Bool)
-> (Authenticator -> Authenticator -> Bool)
-> (Authenticator -> Authenticator -> Bool)
-> (Authenticator -> Authenticator -> Bool)
-> (Authenticator -> Authenticator -> Authenticator)
-> (Authenticator -> Authenticator -> Authenticator)
-> Ord Authenticator
Authenticator -> Authenticator -> Bool
Authenticator -> Authenticator -> Ordering
Authenticator -> Authenticator -> Authenticator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Authenticator -> Authenticator -> Authenticator
$cmin :: Authenticator -> Authenticator -> Authenticator
max :: Authenticator -> Authenticator -> Authenticator
$cmax :: Authenticator -> Authenticator -> Authenticator
>= :: Authenticator -> Authenticator -> Bool
$c>= :: Authenticator -> Authenticator -> Bool
> :: Authenticator -> Authenticator -> Bool
$c> :: Authenticator -> Authenticator -> Bool
<= :: Authenticator -> Authenticator -> Bool
$c<= :: Authenticator -> Authenticator -> Bool
< :: Authenticator -> Authenticator -> Bool
$c< :: Authenticator -> Authenticator -> Bool
compare :: Authenticator -> Authenticator -> Ordering
$ccompare :: Authenticator -> Authenticator -> Ordering
$cp1Ord :: Eq Authenticator
Ord, Int -> Authenticator -> Int
Authenticator -> Int
(Int -> Authenticator -> Int)
-> (Authenticator -> Int) -> Hashable Authenticator
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Authenticator -> Int
$chash :: Authenticator -> Int
hashWithSalt :: Int -> Authenticator -> Int
$chashWithSalt :: Int -> Authenticator -> Int
Hashable, Typeable Authenticator
DataType
Constr
Typeable Authenticator
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Authenticator -> c Authenticator)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Authenticator)
-> (Authenticator -> Constr)
-> (Authenticator -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Authenticator))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Authenticator))
-> ((forall b. Data b => b -> b) -> Authenticator -> Authenticator)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Authenticator -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Authenticator -> r)
-> (forall u. (forall d. Data d => d -> u) -> Authenticator -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Authenticator -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Authenticator -> m Authenticator)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Authenticator -> m Authenticator)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Authenticator -> m Authenticator)
-> Data Authenticator
Authenticator -> DataType
Authenticator -> Constr
(forall b. Data b => b -> b) -> Authenticator -> Authenticator
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authenticator -> c Authenticator
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authenticator
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Authenticator -> u
forall u. (forall d. Data d => d -> u) -> Authenticator -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Authenticator -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Authenticator -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authenticator
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authenticator -> c Authenticator
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Authenticator)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Authenticator)
$cAu :: Constr
$tAuthenticator :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
gmapMp :: (forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
gmapM :: (forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Authenticator -> m Authenticator
gmapQi :: Int -> (forall d. Data d => d -> u) -> Authenticator -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Authenticator -> u
gmapQ :: (forall d. Data d => d -> u) -> Authenticator -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Authenticator -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Authenticator -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Authenticator -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Authenticator -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Authenticator -> r
gmapT :: (forall b. Data b => b -> b) -> Authenticator -> Authenticator
$cgmapT :: (forall b. Data b => b -> b) -> Authenticator -> Authenticator
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Authenticator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Authenticator)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Authenticator)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Authenticator)
dataTypeOf :: Authenticator -> DataType
$cdataTypeOf :: Authenticator -> DataType
toConstr :: Authenticator -> Constr
$ctoConstr :: Authenticator -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authenticator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authenticator
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authenticator -> c Authenticator
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authenticator -> c Authenticator
$cp1Data :: Typeable Authenticator
Data, Typeable, (forall x. Authenticator -> Rep Authenticator x)
-> (forall x. Rep Authenticator x -> Authenticator)
-> Generic Authenticator
forall x. Rep Authenticator x -> Authenticator
forall x. Authenticator -> Rep Authenticator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Authenticator x -> Authenticator
$cfrom :: forall x. Authenticator -> Rep Authenticator x
Generic)

instance IsEncoding Key where
  decode :: ByteString -> Maybe Key
decode ByteString
v = if ByteString -> Int
S.length ByteString
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Bytes.onetimeKey
           then Key -> Maybe Key
forall a. a -> Maybe a
Just (ByteString -> Key
Key ByteString
v)
           else Maybe Key
forall a. Maybe a
Nothing
  {-# INLINE decode #-}
  encode :: Key -> ByteString
encode (Key ByteString
v) = ByteString
v
  {-# INLINE encode #-}

instance IsEncoding Authenticator where
  decode :: ByteString -> Maybe Authenticator
decode ByteString
v = if ByteString -> Int
S.length ByteString
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Bytes.onetime
           then Authenticator -> Maybe Authenticator
forall a. a -> Maybe a
Just (ByteString -> Authenticator
Au ByteString
v)
           else Maybe Authenticator
forall a. Maybe a
Nothing
  {-# INLINE decode #-}
  encode :: Authenticator -> ByteString
encode (Au ByteString
v) = ByteString
v
  {-# INLINE encode #-}

-- | 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.onetimeKey

-- | 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.onetime ((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 (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

foreign import ccall "crypto_onetimeauth"
  c_onetimeauth :: Ptr CChar
                -- ^ Authenticator output buffer
                -> Ptr CChar
                -- ^ Constant message buffer
                -> CULLong
                -- ^ Length of message buffer
                -> Ptr CChar
                -- ^ Constant key buffer
                -> IO CInt
                -- ^ Always 0

-- | We don't even include this in the IO monad since all of the
-- buffers are constant.
foreign import ccall "crypto_onetimeauth_verify"
  c_onetimeauth_verify :: Ptr CChar
                       -- ^ Constant authenticator buffer
                       -> Ptr CChar
                       -- ^ Constant message buffer
                       -> CULLong
                       -- ^ Length of message buffer
                       -> Ptr CChar
                       -- ^ Constant key buffer
                       -> CInt
                       -- ^ Success if 0, failure if -1