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

-- | Internals of @crypto_box@.
module Crypto.Box.Internal
  ( SecretKey
  , toSecretKey
  , PublicKey
  , toPublicKey
  , keypair

  , Nonce
  , toNonce

  , 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 qualified Data.ByteArray.Sized as Sized (alloc, allocRet)
import qualified Libsodium as Na


-- | Secret key that can be used for Box.
type SecretKey = SizedByteArray Na.CRYPTO_BOX_SECRETKEYBYTES ScrubbedBytes

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

-- | Public key that can be used for Box.
type PublicKey = SizedByteArray Na.CRYPTO_BOX_PUBLICKEYBYTES ByteString

-- | Convert bytes to a public key.
toPublicKey :: ByteString -> Maybe PublicKey
toPublicKey :: ByteString -> Maybe PublicKey
toPublicKey = ByteString -> Maybe PublicKey
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.Init@ in
-- <https://hackage.haskell.org/package/crypto-sodium crypto-sodium>
-- to learn how to make this function thread-safe.
keypair :: IO (PublicKey, SecretKey)
keypair :: IO (PublicKey, SecretKey)
keypair = do
  (pk :: PublicKey
pk, sk :: SecretKey
sk) <-
    Proxy 32
-> (Ptr CUChar -> IO PublicKey) -> IO (PublicKey, SecretKey)
forall (n :: Nat) c p a.
ByteArrayN n c =>
Proxy n -> (Ptr p -> IO a) -> IO (a, c)
Sized.allocRet Proxy 32
forall k (t :: k). Proxy t
Proxy ((Ptr CUChar -> IO PublicKey) -> IO (PublicKey, SecretKey))
-> (Ptr CUChar -> IO PublicKey) -> IO (PublicKey, SecretKey)
forall a b. (a -> b) -> a -> b
$ \skPtr :: Ptr CUChar
skPtr ->
    (Ptr CUChar -> IO ()) -> IO PublicKey
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
Sized.alloc ((Ptr CUChar -> IO ()) -> IO PublicKey)
-> (Ptr CUChar -> IO ()) -> IO PublicKey
forall a b. (a -> b) -> a -> b
$ \pkPtr :: 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_box_keypair Ptr CUChar
pkPtr Ptr CUChar
skPtr
  (PublicKey, SecretKey) -> IO (PublicKey, SecretKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey
pk, SecretKey
sk)


-- | Nonce that can be used for Box.
--
-- This type is parametrised by the actual data type that contains
-- bytes. This can be, for example, a @ByteString@.
type Nonce a = SizedByteArray Na.CRYPTO_BOX_NONCEBYTES a

-- | Make a 'Nonce' 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 nonce with a Box.
toNonce :: ByteArrayAccess ba => ba -> Maybe (Nonce ba)
toNonce :: ba -> Maybe (Nonce ba)
toNonce = ba -> Maybe (Nonce ba)
forall (n :: Nat) ba.
(KnownNat n, ByteArrayAccess ba) =>
ba -> Maybe (SizedByteArray n ba)
sizedByteArray


-- | Encrypt a message.
create
  ::  ( ByteArrayAccess nonce
      , ByteArrayAccess pt, ByteArray ct
      )
  => PublicKey  -- ^ Receiver’s public key
  -> SecretKey  -- ^ Sender’s secret key
  -> Nonce nonce  -- ^ Nonce
  -> pt -- ^ Plaintext message
  -> IO ct
create :: PublicKey -> SecretKey -> Nonce nonce -> pt -> IO ct
create pk :: PublicKey
pk sk :: SecretKey
sk nonce :: Nonce nonce
nonce msg :: pt
msg = do
    (_ret :: CInt
_ret, ct :: 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
$ \ctPtr :: Ptr CUChar
ctPtr ->
      PublicKey -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray PublicKey
pk ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pkPtr :: Ptr CUChar
pkPtr ->
      SecretKey -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray SecretKey
sk ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \skPtr :: Ptr CUChar
skPtr ->
      Nonce nonce -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Nonce nonce
nonce ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \noncePtr :: Ptr CUChar
noncePtr ->
      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
$ \msgPtr :: Ptr CUChar
msgPtr -> do
        -- TODO: Maybe, reimplement this without _easy, to stay closer
        -- to the original NaCl.
        Ptr CUChar
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> Ptr CUChar
-> Ptr CUChar
-> IO CInt
forall k1 k2 k3 k4 k5 k6 (c :: k1) (m :: k2) (mlen :: k3) (n :: k4)
       (pk :: k5) (sk :: k6).
Ptr CUChar
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> Ptr CUChar
-> Ptr CUChar
-> IO CInt
Na.crypto_box_easy Ptr CUChar
ctPtr
          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
$ pt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length pt
msg)
          Ptr CUChar
noncePtr
          Ptr CUChar
pkPtr 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_box_macbytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ pt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length pt
msg


-- | Decrypt a message.
open
  ::  ( ByteArrayAccess nonce
      , ByteArray pt, ByteArrayAccess ct
      )
  => SecretKey  -- ^ Receiver’s secret key
  -> PublicKey  -- ^ Sender’s public key
  -> Nonce nonce  -- ^ Nonce
  -> ct -- ^ Cyphertext
  -> IO (Maybe pt)
open :: SecretKey -> PublicKey -> Nonce nonce -> ct -> IO (Maybe pt)
open sk :: SecretKey
sk pk :: PublicKey
pk nonce :: Nonce nonce
nonce ct :: ct
ct = do
    (ret :: CInt
ret, msg :: 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
$ \msgPtr :: Ptr CUChar
msgPtr ->
      SecretKey -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray SecretKey
sk ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \skPtr :: Ptr CUChar
skPtr ->
      PublicKey -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray PublicKey
pk ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \pkPtr :: Ptr CUChar
pkPtr ->
      Nonce nonce -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Nonce nonce
nonce ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \noncePtr :: Ptr CUChar
noncePtr ->
      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
$ \ctPtr :: Ptr CUChar
ctPtr -> do
        -- TODO: Maybe, reimplement this without _easy, to stay closer
        -- to the original NaCl.
        Ptr CUChar
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> Ptr CUChar
-> Ptr CUChar
-> IO CInt
forall k1 k2 k3 k4 k5 k6 (c :: k1) (m :: k2) (mlen :: k3) (n :: k4)
       (pk :: k5) (sk :: k6).
Ptr CUChar
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> Ptr CUChar
-> Ptr CUChar
-> IO CInt
Na.crypto_box_open_easy Ptr CUChar
msgPtr
          Ptr CUChar
ctPtr (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
$ ct -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length ct
ct)
          Ptr CUChar
noncePtr
          Ptr CUChar
pkPtr Ptr CUChar
skPtr
    if CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 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_box_macbytes