-- SPDX-FileCopyrightText: 2020 Serokell
--
-- SPDX-License-Identifier: MPL-2.0

-- | Internals of @crypto_auth@.
module NaCl.Auth.Internal
  ( Key
  , toKey

  , Authenticator
  , toAuthenticator

  , create
  , verify
  ) where

import Prelude hiding (length)

import Data.ByteArray (ByteArray, ByteArrayAccess, length, withByteArray)
import Data.ByteArray.Sized (SizedByteArray, allocRet, sizedByteArray)
import Data.Proxy (Proxy (Proxy))

import qualified Libsodium as Na


-- | Secret key that can be used for Sea authentication.
--
-- This type is parametrised by the actual data type that contains
-- bytes. This can be, for example, a @ByteString@, but, since this
-- is a secret key, it is better to use @ScrubbedBytes@.
type Key a = SizedByteArray Na.CRYPTO_AUTH_KEYBYTES a

-- | Make a 'Key' from an arbitrary byte array.
--
-- This function returns @Just@ if and only if the byte array has
-- the right length to be used as a key for authentication.
toKey :: ByteArrayAccess ba => ba -> Maybe (Key ba)
toKey :: ba -> Maybe (Key ba)
toKey = ba -> Maybe (Key ba)
forall (n :: Nat) ba.
(KnownNat n, ByteArrayAccess ba) =>
ba -> Maybe (SizedByteArray n ba)
sizedByteArray


-- | A tag that confirms the authenticity of somde data.
type Authenticator a = SizedByteArray Na.CRYPTO_AUTH_BYTES a

-- | Convert raw bytes into an 'Authenticator'.
--
-- This function returns @Just@ if and only if the byte array has
-- the right length to be used as an authenticator.
toAuthenticator :: ByteArrayAccess ba => ba -> Maybe (Authenticator ba)
toAuthenticator :: ba -> Maybe (Authenticator ba)
toAuthenticator = ba -> Maybe (Authenticator ba)
forall (n :: Nat) ba.
(KnownNat n, ByteArrayAccess ba) =>
ba -> Maybe (SizedByteArray n ba)
sizedByteArray


-- | Create an authenticator.
create
  ::  ( ByteArrayAccess keyBytes
      , ByteArrayAccess msg
      , ByteArray authBytes
      )
  => Key keyBytes  -- ^ Secret key.
  -> msg  -- ^ Message to authenticate.
  -> IO (Authenticator authBytes)
create :: Key keyBytes -> msg -> IO (Authenticator authBytes)
create Key keyBytes
key msg
msg = do
    (CInt
_ret, Authenticator authBytes
auth) <-
      Proxy CRYPTO_AUTH_BYTES
-> (Ptr CUChar -> IO CInt) -> IO (CInt, Authenticator authBytes)
forall (n :: Nat) c p a.
ByteArrayN n c =>
Proxy n -> (Ptr p -> IO a) -> IO (a, c)
allocRet (Proxy CRYPTO_AUTH_BYTES
forall k (t :: k). Proxy t
Proxy @Na.CRYPTO_AUTH_BYTES) ((Ptr CUChar -> IO CInt) -> IO (CInt, Authenticator authBytes))
-> (Ptr CUChar -> IO CInt) -> IO (CInt, Authenticator authBytes)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
authPtr ->
      Key keyBytes -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Key keyBytes
key ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
keyPtr ->
      msg -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray msg
msg ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
msgPtr -> do
        Ptr CUChar
-> Ptr CUChar -> (Any ::: CULLong) -> Ptr CUChar -> IO CInt
forall k1 k2 k3 k4 (out :: k1) (in_ :: k2) (inlen :: k3)
       (k5 :: k4).
Ptr CUChar
-> Ptr CUChar -> (Any ::: CULLong) -> Ptr CUChar -> IO CInt
Na.crypto_auth Ptr CUChar
authPtr
          Ptr CUChar
msgPtr (Int -> Any ::: CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Any ::: CULLong) -> Int -> Any ::: CULLong
forall a b. (a -> b) -> a -> b
$ msg -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length msg
msg)
          Ptr CUChar
keyPtr
    -- _ret can be only 0, so we don’t check it
    Authenticator authBytes -> IO (Authenticator authBytes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Authenticator authBytes
auth


-- | Verify an authenticator.
verify
  ::  ( ByteArrayAccess keyBytes
      , ByteArrayAccess msg
      , ByteArrayAccess authBytes
      )
  => Key keyBytes  -- ^ Secret key.
  -> msg  -- ^ Authenticated message.
  -> Authenticator authBytes  -- ^ Authenticator tag.
  -> IO Bool
verify :: Key keyBytes -> msg -> Authenticator authBytes -> IO Bool
verify Key keyBytes
key msg
msg Authenticator authBytes
auth = do
    CInt
ret <-
      Key keyBytes -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Key keyBytes
key ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
keyPtr ->
      msg -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray msg
msg ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
msgPtr ->
      Authenticator authBytes -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Authenticator authBytes
auth ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
authPtr ->
        Ptr CUChar
-> Ptr CUChar -> (Any ::: CULLong) -> Ptr CUChar -> IO CInt
forall k1 k2 k3 k4 (out :: k1) (in_ :: k2) (inlen :: k3)
       (k5 :: k4).
Ptr CUChar
-> Ptr CUChar -> (Any ::: CULLong) -> Ptr CUChar -> IO CInt
Na.crypto_auth_verify Ptr CUChar
authPtr
          Ptr CUChar
msgPtr (Int -> Any ::: CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Any ::: CULLong) -> Int -> Any ::: CULLong
forall a b. (a -> b) -> a -> b
$ msg -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length msg
msg)
          Ptr CUChar
keyPtr
    Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0