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

-- | Internals of @crypto_sign@.
module NaCl.Sign.Internal
  ( SecretKey
  , toSecretKey
  , PublicKey
  , toPublicKey
  , keypair

  , create
  , open
  ) where

import Prelude hiding (length)

import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, allocRet, length, withByteArray)
import Data.ByteArray.Sized (SizedByteArray, sizedByteArray)
import Data.ByteString (ByteString)
import Data.Functor (void)
import Data.Proxy (Proxy (Proxy))
import Foreign.Ptr (nullPtr)

import qualified Data.ByteArray.Sized as Sized (alloc, allocRet)
import qualified Libsodium as Na


-- | Secret key that can be used for creating a signature.
--
-- 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 SecretKey a = SizedByteArray Na.CRYPTO_SIGN_SECRETKEYBYTES a

-- | Convert bytes to a secret key.
toSecretKey :: ByteArrayAccess bytes => bytes -> Maybe (SecretKey bytes)
toSecretKey :: bytes -> Maybe (SecretKey bytes)
toSecretKey = bytes -> Maybe (SecretKey bytes)
forall (n :: Nat) ba.
(KnownNat n, ByteArrayAccess ba) =>
ba -> Maybe (SizedByteArray n ba)
sizedByteArray

-- | Public key that can be used for verifyiing a signature.
--
-- This type is parametrised by the actual data type that contains
-- bytes. This can be, for example, a @ByteString@.
type PublicKey a = SizedByteArray Na.CRYPTO_SIGN_PUBLICKEYBYTES a

-- | Convert bytes to a public key.
toPublicKey :: ByteArrayAccess bytes => bytes -> Maybe (PublicKey bytes)
toPublicKey :: bytes -> Maybe (PublicKey bytes)
toPublicKey = bytes -> Maybe (PublicKey bytes)
forall (n :: Nat) ba.
(KnownNat n, ByteArrayAccess ba) =>
ba -> Maybe (SizedByteArray n ba)
sizedByteArray

-- | Generate a new 'SecretKey' together with its 'PublicKey'.
--
-- Note: this function is not thread-safe (since the underlying
-- C function is not thread-safe both in Sodium and in NaCl)!
-- Either make sure there are no concurrent calls or see
-- @Crypto.Sodium.Init@ in
-- <https://hackage.haskell.org/package/crypto-sodium crypto-sodium>
-- to learn how to make this function thread-safe.
keypair :: IO (PublicKey ByteString, SecretKey ScrubbedBytes)
keypair :: IO (PublicKey ByteString, SecretKey ScrubbedBytes)
keypair = do
  (PublicKey ByteString
pk, SecretKey ScrubbedBytes
sk) <-
    Proxy 64
-> (Ptr CUChar -> IO (PublicKey ByteString))
-> IO (PublicKey ByteString, SecretKey ScrubbedBytes)
forall (n :: Nat) c p a.
ByteArrayN n c =>
Proxy n -> (Ptr p -> IO a) -> IO (a, c)
Sized.allocRet Proxy 64
forall k (t :: k). Proxy t
Proxy ((Ptr CUChar -> IO (PublicKey ByteString))
 -> IO (PublicKey ByteString, SecretKey ScrubbedBytes))
-> (Ptr CUChar -> IO (PublicKey ByteString))
-> IO (PublicKey ByteString, SecretKey ScrubbedBytes)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
skPtr ->
    (Ptr CUChar -> IO ()) -> IO (PublicKey ByteString)
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
Sized.alloc ((Ptr CUChar -> IO ()) -> IO (PublicKey ByteString))
-> (Ptr CUChar -> IO ()) -> IO (PublicKey ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
pkPtr ->
    -- always returns 0, so we don’t check it
    IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CUChar -> Ptr CUChar -> IO CInt
forall k1 k2 (pk :: k1) (sk :: k2).
Ptr CUChar -> Ptr CUChar -> IO CInt
Na.crypto_sign_keypair Ptr CUChar
pkPtr Ptr CUChar
skPtr
  (PublicKey ByteString, SecretKey ScrubbedBytes)
-> IO (PublicKey ByteString, SecretKey ScrubbedBytes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey ByteString
pk, SecretKey ScrubbedBytes
sk)


-- | Sign a message.
create
  ::  ( ByteArrayAccess skBytes
      , ByteArrayAccess pt, ByteArray ct
      )
  => SecretKey skBytes  -- ^ Signer’s secret key
  -> pt  -- ^ Message to sign
  -> IO ct
create :: SecretKey skBytes -> pt -> IO ct
create SecretKey skBytes
sk pt
msg = do
    (CInt
_ret, ct
ct) <-
      Int -> (Ptr CUChar -> IO CInt) -> IO (CInt, ct)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
allocRet Int
clen ((Ptr CUChar -> IO CInt) -> IO (CInt, ct))
-> (Ptr CUChar -> IO CInt) -> IO (CInt, ct)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
ctPtr ->
      SecretKey skBytes -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray SecretKey skBytes
sk ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
skPtr ->
      pt -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray pt
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
-> (Any ::: Ptr CULLong)
-> Ptr CUChar
-> CULLong
-> Ptr CUChar
-> IO CInt
forall k1 k2 k3 k4 k5 (sm :: k1) (smlen_p :: k2) (m :: k3)
       (mlen :: k4) (sk :: k5).
Ptr CUChar
-> (Any ::: Ptr CULLong)
-> Ptr CUChar
-> CULLong
-> Ptr CUChar
-> IO CInt
Na.crypto_sign Ptr CUChar
ctPtr Any ::: Ptr CULLong
forall a. Ptr a
nullPtr
          Ptr CUChar
msgPtr (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ pt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length pt
msg)
          Ptr CUChar
skPtr
    -- _ret can be only 0, so we don’t check it
    -- TODO: Actually, it looks like this function can fail and return
    -- a -1, even though this is not documented :/.
    ct -> IO ct
forall (f :: * -> *) a. Applicative f => a -> f a
pure ct
ct
  where
    clen :: Int
    clen :: Int
clen = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
Na.crypto_sign_bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ pt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length pt
msg


-- | Verify the signature of a signed message.
open
  ::  ( ByteArrayAccess pkBytes
      , ByteArray pt, ByteArrayAccess ct
      )
  => PublicKey pkBytes  -- ^ Signer’s public key
  -> ct  -- ^ Signed message
  -> IO (Maybe pt)
open :: PublicKey pkBytes -> ct -> IO (Maybe pt)
open PublicKey pkBytes
pk ct
ct = do
    (CInt
ret, pt
msg) <-
      Int -> (Ptr CUChar -> IO CInt) -> IO (CInt, pt)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
allocRet Int
mlen ((Ptr CUChar -> IO CInt) -> IO (CInt, pt))
-> (Ptr CUChar -> IO CInt) -> IO (CInt, pt)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
msgPtr ->
      PublicKey pkBytes -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray PublicKey pkBytes
pk ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
pkPtr ->
      ct -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray ct
ct ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
ctPtr -> do
        Ptr CUChar
-> (Any ::: Ptr CULLong)
-> Ptr CUChar
-> CULLong
-> Ptr CUChar
-> IO CInt
forall k1 k2 k3 k4 k5 (sm :: k1) (smlen_p :: k2) (m :: k3)
       (mlen :: k4) (sk :: k5).
Ptr CUChar
-> (Any ::: Ptr CULLong)
-> Ptr CUChar
-> CULLong
-> Ptr CUChar
-> IO CInt
Na.crypto_sign_open Ptr CUChar
msgPtr Any ::: Ptr CULLong
forall a. Ptr a
nullPtr
          Ptr CUChar
ctPtr (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ ct -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length ct
ct)
          Ptr CUChar
pkPtr
    if CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then
      Maybe pt -> IO (Maybe pt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe pt -> IO (Maybe pt)) -> Maybe pt -> IO (Maybe pt)
forall a b. (a -> b) -> a -> b
$ pt -> Maybe pt
forall a. a -> Maybe a
Just pt
msg
    else
      Maybe pt -> IO (Maybe pt)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe pt
forall a. Maybe a
Nothing
  where
    mlen :: Int
    mlen :: Int
mlen = ct -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length ct
ct Int -> Int -> Int
forall a. Num a => a -> a -> a
- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
Na.crypto_sign_bytes