add cryptobox/open

src/Simplex/Messaging/Crypto/NaCl/Bindings.hs

@@ -1,31 +1,80 @@
+{-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Crypto.NaCl.Bindings where
 
-import Crypto.Hash (Digest, SHA256, hash)
+import Crypto.Error (CryptoError, eitherCryptoError)
+import Crypto.PubKey.Curve25519 (dhSecret)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
-import qualified Simplex.Messaging.Crypto as C
+import qualified Data.ByteString as B
+import Data.Memory.PtrMethods (memSet)
 import Foreign
 import Foreign.C.ConstPtr
 import Foreign.C.Types
 import GHC.IO (unsafePerformIO)
-import Crypto.PubKey.Curve25519 (dhSecret)
-import Crypto.Error (eitherCryptoError, CryptoError)
-import Data.Memory.PtrMethods (memSet)
+import qualified Simplex.Messaging.Crypto as C
+
+crypto_box_PUBLICKEYBYTES :: Num a => a
+crypto_box_PUBLICKEYBYTES = 32
+
+crypto_box_SECRETKEYBYTES :: Num a => a
+crypto_box_SECRETKEYBYTES = 32
+
+crypto_box_BEFORENMBYTES :: Num a => a
+crypto_box_BEFORENMBYTES = 32
+
+crypto_box_NONCEBYTES :: Num a => a
+crypto_box_NONCEBYTES = 24
+
+crypto_box_ZEROBYTES :: Num a => a
+crypto_box_ZEROBYTES = 32
+
+crypto_box_BOXZEROBYTES :: Num a => a
+crypto_box_BOXZEROBYTES = 16
+
+-- XXX: message should be ScrubbedBytes or something like that
+cryptoBox :: BA.ByteArrayAccess msg => C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> msg -> Either Int ByteString
+cryptoBox (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) msg = unsafePerformIO $ do
+  (r, c) <-
+    BA.withByteArray msg0 $ \mPtr ->
+      BA.withByteArray n $ \nPtr ->
+        BA.withByteArray pk $ \pkPtr ->
+          BA.withByteArray sk $ \skPtr ->
+            BA.allocRet (B.length msg0) $ \cPtr ->
+              c_crypto_box cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr)
+  pure $
+    if r /= 0
+      then Left (fromIntegral r)
+      else Right (B.drop crypto_box_BOXZEROBYTES c)
+  where
+    msg0 = B.replicate crypto_box_ZEROBYTES 0 <> BA.convert msg
+
+foreign import capi "tweetnacl.h crypto_box"
+  c_crypto_box :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
 
--- TODO:
--- foreign import capi "tweetnacl.h crypto_box"
---   c_crypto_box :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+cryptoBoxOpen :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> Either Int ByteString
+cryptoBoxOpen (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) ciphertext = unsafePerformIO $ do
+  (r, msg) <-
+    BA.withByteArray ciphertext0 $ \cPtr ->
+      BA.withByteArray n $ \nPtr ->
+        BA.withByteArray pk $ \pkPtr ->
+          BA.withByteArray sk $ \skPtr ->
+            BA.allocRet cLen $ \mPtr ->
+              c_crypto_box_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr)
+  pure $
+    if r /= 0
+      then Left (fromIntegral r)
+      else Right (B.drop crypto_box_ZEROBYTES msg)
+  where
+    ciphertext0 = B.replicate crypto_box_BOXZEROBYTES 0 <> ciphertext
+    cLen = B.length ciphertext0
 
--- TODO:
--- foreign import capi "crypto_box_open"
---   c_crypto_box_open :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+foreign import capi "crypto_box_open"
+  c_crypto_box_open :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
 
 -- XXX: requires randombytes extern symbol available. Not relevant as we can random it ourselves.
 -- foreign import ccall "crypto_box_keypair"
@@ -42,9 +91,10 @@ dh (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
       BA.allocRet 32 $ \sharedPtr -> do
         memSet sharedPtr 0 32
         crypto_scalarmult sharedPtr (ConstPtr privPtr) (ConstPtr pubPtr)
-  pure $ if r /= 0
-    then Left (toEnum $ fromIntegral r)
-    else C.DhSecretX25519 <$> eitherCryptoError (dhSecret ba)
+  pure $
+    if r /= 0
+      then Left (toEnum $ fromIntegral r)
+      else C.DhSecretX25519 <$> eitherCryptoError (dhSecret ba)
 
 -- XXX: does NOT result in the same DH key we/crypton use as it throws HSalsa20 at the result of the scalarmult op above
 foreign import capi "tweetnacl.h crypto_box_beforenm"

tests/CoreTests/CryptoTests.hs

@@ -233,4 +233,14 @@ testNaCl = do
   naclShared <- either (fail . show) pure $ NaCl.dh aPub bPriv
   naclShared `shouldBe` abShared
 
-  -- TODO: test the box
+  let msg = "hello long-enough world"
+  nonce <- atomically $ C.randomCbNonce drg
+  naclCiphertext <- either (fail . mappend "cryptoBox: " . show) pure $ NaCl.cryptoBox aPub bPriv nonce msg
+  let ourCiphertext = C.cbEncryptNoPad abShared nonce msg
+  (B.length naclCiphertext, naclCiphertext) `shouldBe` (B.length ourCiphertext, ourCiphertext)
+
+  ourMsg <- either (fail . show) pure $ C.cbDecryptNoPad baShared nonce naclCiphertext
+  ourMsg `shouldBe` msg
+
+  naclMsg <- either (fail . mappend "cryptoBoxOpen: " . show) pure $ NaCl.cryptoBoxOpen bPub aPriv nonce ourCiphertext
+  naclMsg `shouldBe` msg