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

-- | Internals of @crypto_secretbox@.
module NaCl.Secretbox.Internal
  ( Key
  , toKey

  , Nonce
  , toNonce

  , create
  , open
  ) where

import Prelude hiding (length)

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

import qualified Libsodium as Na


-- | Encryption key that can be used for Secretbox.
--
-- 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_SECRETBOX_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 with a Secretbox.
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


-- | Nonce that can be used for Secretbox.
--
-- 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_SECRETBOX_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 Secretbox.
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 key, ByteArrayAccess nonce
      , ByteArrayAccess pt, ByteArray ct
      )
  => Key key  -- ^ Secret key
  -> Nonce nonce  -- ^ Nonce
  -> pt -- ^ Plaintext message
  -> IO ct
create :: Key key -> Nonce nonce -> pt -> IO ct
create Key key
key Nonce nonce
nonce 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 ->
      Key key -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Key key
key ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
keyPtr ->
      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
$ \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
$ \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
-> IO CInt
forall k1 k2 k3 k4 k5 (c :: k1) (m :: k2) (mlen :: k3) (n :: k4)
       (k6 :: k5).
Ptr CUChar
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> Ptr CUChar
-> IO CInt
Na.crypto_secretbox_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
keyPtr
    -- _ret can be only 0, so we don’t check it
    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_secretbox_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 key, ByteArrayAccess nonce
      , ByteArray pt, ByteArrayAccess ct
      )
  => Key key  -- ^ Secret key
  -> Nonce nonce  -- ^ Nonce
  -> ct -- ^ Cyphertext
  -> IO (Maybe pt)
open :: Key key -> Nonce nonce -> ct -> IO (Maybe pt)
open Key key
key Nonce nonce
nonce 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 ->
      Key key -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Key key
key ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
keyPtr ->
      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
$ \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
$ \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
-> IO CInt
forall k1 k2 k3 k4 k5 (c :: k1) (m :: k2) (mlen :: k3) (n :: k4)
       (k6 :: k5).
Ptr CUChar
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> Ptr CUChar
-> IO CInt
Na.crypto_secretbox_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
keyPtr
    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_secretbox_macbytes