diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,12 @@ +# Change Log for crypton-box + +## Unreleased Changes + +## 1.1.0 + +- Migrate away from the deprecated `cryptonite` package to `crypton` +- Rename package from `shecretbox` to `crypton-box` for clarity + +## 1.0.0 + +- Implement CryptoBox and SecretBox create/open operations diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2022, Yuto Takano +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,23 @@ +# crypton-box + +`crypton-box` is a Haskell library that provides NaCl's [box](https://nacl.cr.yp.to/box.html) and [secretbox](https://nacl.cr.yp.to/secretbox.html) operations, using primitives provided in [`crypton`](https://hackage.haskell.org/package/crypton). + +**Important**: This library is provided as a proof of concept. Please carefully evaluate the security related to your requirements before using! No professional security review has taken place for the implementations, and I **strongly recommended** not to use this library for anything critical. + +## Usage + +Qualified imports are recommended for use: + +```hs +import qualified Crypto.PubKey.Curve25519 as X25519 +import qualified Crypto.Box as Box + +message, nonce :: B.ByteString +secret :: X25519.DhSecret + +encrypted :: B.ByteString +encrypted = Box.create message nonce secret + +decrypted :: B.ByteString +decrypted = Box.open encrypted nonce secret +``` diff --git a/crypton-box.cabal b/crypton-box.cabal new file mode 100644 --- /dev/null +++ b/crypton-box.cabal @@ -0,0 +1,74 @@ +cabal-version: 1.12 + +name: crypton-box +version: 1.1.0 +synopsis: NaCl crypto/secret box implementations based on crypton primitives. +description: + This library provides a high-level API for authenticated encryption and + decryption using the NaCl [crypto_box](https://nacl.cr.yp.to/box.html) and + [crypto_secretbox](https://nacl.cr.yp.to/secretbox.html) constructs. + . + The API is implemented in pure Haskell using XSalsa and Poly1305 primitives + provided by the [crypton](https://hackage.haskell.org/package/crypton) library. + . + __Important: This library has not been professionally reviewed. Side__ + __channel attacks and memory-related vulnerabilities may exist! Use at your__ + __own risk.__ + . + /(P.S. I would love to hear from you if you can audit this library and/ + /improve its security!)/ +category: Cryptography +homepage: https://github.com/yutotakano/crypton-box#readme +bug-reports: https://github.com/yutotakano/crypton-box/issues +author: Yuto Takano +maintainer: moa17stock@gmail.com +copyright: 2025 Yuto Takano +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +tested-with: + GHC == 9.4.8 + +source-repository head + type: git + location: https://github.com/yutotakano/crypton-box + +library + exposed-modules: + Crypto.Box + Crypto.SecretBox + hs-source-dirs: + src + default-extensions: + OverloadedStrings + build-depends: + base >=4.7 && <5 + , bytestring >= 0.9 && <1.0.0.0 + , crypton >= 1.0.0 && <2.0.0 + , memory >= 0.18 && <1.0 + default-language: Haskell2010 + +test-suite crypton-box-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Crypto.BoxSpec + Crypto.SecretBoxSpec + hs-source-dirs: + test + default-extensions: + OverloadedStrings + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + base >=4.7 && <5 + , bytestring + , crypton + , hspec + , memory + , crypton-box + default-language: Haskell2010 diff --git a/src/Crypto/Box.hs b/src/Crypto/Box.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Box.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- | This module provides the creation and opening of a crypto_box. +module Crypto.Box where + +import Crypto.Cipher.Salsa (State(..)) +import Crypto.Cipher.XSalsa qualified as XSalsa +import Crypto.ECC qualified as ECC +import Crypto.Error (CryptoFailable(..)) +import Crypto.MAC.Poly1305 qualified as Poly1305 +import Crypto.PubKey.Curve25519 qualified as X25519 +import Data.ByteArray qualified as BA +import Data.ByteString qualified as B +import Data.Data (Proxy(..)) +import Data.Function ((&)) +import Data.Foldable (traverse_) +import Foreign.Ptr qualified as Ptr +import Foreign.Storable qualified as Storable +import GHC.IO (unsafePerformIO) + +-- The implementation in this module is based off a small snippet of code from +-- the cryptonite library, which is licensed under the BSD3 license. +-- https://github.com/haskell-crypto/cryptonite/blob/master/Crypto/Tutorial.hs + +-- | Build a @crypto_box@ packet encrypting the specified content with a +-- 192-bit nonce, receiver public key and sender private key. +-- +-- This function performs no validation for the key pair, and will use an +-- all-zero shared secret if the Diffie hellman secret value is at infinity. +-- Use 'Box.beforeNM' to get only the precomputed secret if you want to verify +-- the key pair before use. +create + :: (BA.ByteArray content, BA.ByteArray nonce) + => content + -- ^ Message to encrypt + -> nonce + -- ^ 192-bit nonce + -> X25519.PublicKey + -- ^ Receiver's public key + -> X25519.SecretKey + -- ^ Sender's private key + -> content + -- ^ Ciphertext +create message nonce pk sk = BA.convert tag `BA.append` c + -- convert the tag from Auth to ByteString (reallocating), instead of + -- converting both of them to a polymorphic (ByteArrayAccess ciphertext), + -- preventing unnecessary conversion. People who need other byte access types + -- can convert it themselves. + where + shared = X25519.dh pk sk + (iv0, iv1) = BA.splitAt 8 nonce + zero = BA.zero 16 + state0 = XSalsa.initialize 20 shared (zero `BA.append` iv0) + state1 = XSalsa.derive state0 iv1 + (rs, state2) = XSalsa.generate state1 32 + (c, _) = XSalsa.combine state2 message + tag = Poly1305.auth (rs :: B.ByteString) c + +-- | Precompute the shared key for building a @crypto_box@ packet. +-- This function first computes the shared secret using the receiver public key +-- and sender private key. Then, a first-level key is computed using HSalsa20 +-- with the shared secret and a nonce of zero. This is as described in section +-- 7 (page 15) of https://cr.yp.to/highspeed/naclcrypto-20090310.pdf. +-- +-- The function returns a XSalsa State that contains the first-level key. +-- +-- May fail if the Diffie hellman secret value is at infinity. See 'ECC.ecdh' for +-- more information. +beforeNM + :: X25519.PublicKey + -- ^ Receiver public key + -> X25519.SecretKey + -- ^ Sender private key + -> CryptoFailable XSalsa.State + -- ^ XSalsa State that contains the precomputed first-level key to use with 'createAfterNM' or 'openAfterNM' +beforeNM pk sk = do + let zero = B.replicate 24 0 + shared <- ECC.ecdh (Proxy :: Proxy ECC.Curve_X25519) sk pk + pure $ XSalsa.initialize 20 shared zero + +-- | Build a @crypto_box@ packet that encrypts the specified content with a +-- 192-bit nonce and a state containing the precomputed first-level key. +-- Use 'beforeNM' to create such a state. +createAfterNM + :: (BA.ByteArray content, BA.ByteArray nonce) + => content + -- ^ Message to encrypt + -> nonce + -- ^ 192-bit nonce + -> XSalsa.State + -- ^ XSalsa State that contains the precomputed first-level key + -> content + -- ^ Ciphertext +createAfterNM message nonce (State state0) = BA.convert tag `BA.append` c + where + zero = B.replicate 16 0 + (iv0, iv1) = BA.splitAt 8 nonce + -- This is very hacky. The XSalsa.initialise that we performed in the beforeNM + -- stage has mostly what we need, except for state[6] and state[7] which is + -- where the first 8 bytes of the IV/nonce go to. Since those are currently + -- zero because we used zeros during the beforeNM (we didn't know the nonce), + -- we now need to poke into that pointer location and overwrite its contents. + state1 = unsafePerformIO $ do + memview <- BA.withByteArray state0 $ \state0Ptr -> do + -- We start writing at byte 24, this is 6*4 where 6 is the location + -- that the 16th byte of the 24-byte IV (the first 16 are zeros even + -- if we use cryptoBox) passed to xsalsa is written to, and 4 is + -- because the base type is uint32. + -- + -- TODO: This currently relies on the system endianness since we're + -- writing the nonce bytes one by one instead of as a little-endian + -- 32-bit chunk. This needs to be made system-agnostic. + BA.unpack iv0 + & zip [24..31] + & traverse_ (\(i, word) -> + Storable.poke (state0Ptr `Ptr.plusPtr` i) word) + -- Return the 132 bytes that is the size of the State struct + -- This is how much is allocated when you look at the source of + -- XSalsa.initialize, and the struct contents are defined here: + -- https://github.com/haskell-crypto/cryptonite/blob/cf89276b5cdd87fcd60cce2fb424e64f0de7016a/cbits/cryptonite_salsa.h + pure $ BA.MemView state0Ptr 132 + -- Convert from a pointer to Words to a pointer to State + pure $ State $ BA.convert $ memview + + state2 = XSalsa.derive state1 iv1 + (rs, state3) = XSalsa.generate state2 32 + (c, _) = XSalsa.combine state3 message + tag = Poly1305.auth (rs :: B.ByteString) c + +-- | Try to open a @crypto_box@ packet and recover the content using the +-- 192-bit nonce, sender public key and receiver private key. +-- +-- This function performs no validation for the key pair, and will use an +-- all-zero shared secret if the Diffie hellman secret value is at infinity. +-- Use 'Box.beforeNM' to get only the precomputed secret if you want to verify +-- the key pair before use. +open + :: (BA.ByteArray content, BA.ByteArray nonce) + => content + -- ^ Ciphertext to decrypt + -> nonce + -- ^ 192-bit nonce + -> X25519.PublicKey + -- ^ Sender's public key + -> X25519.SecretKey + -- ^ Receiver's private key + -> Maybe content + -- ^ Plaintext +open packet nonce pk sk + | BA.length packet < 16 = Nothing + | BA.constEq tag' tag = Just content + | otherwise = Nothing + where + (tag', c) = BA.splitAt 16 packet + zero = BA.zero 16 + shared = X25519.dh pk sk + (iv0, iv1) = BA.splitAt 8 nonce + state0 = XSalsa.initialize 20 shared (zero `BA.append` iv0) + state1 = XSalsa.derive state0 iv1 + (rs, state2) = XSalsa.generate state1 32 + (content, _) = XSalsa.combine state2 c + tag = Poly1305.auth (rs :: B.ByteString) c + +-- | Try to open a @crypto_box@ packet and recover the content using the +-- 192-bit nonce and a state containing the precomputed first-level key. +-- Use 'beforeNM' to create such a state. +openAfterNM + :: (BA.ByteArray content, BA.ByteArray nonce) + => content + -- ^ Ciphertext + -> nonce + -- ^ 192-bit nonce + -> XSalsa.State + -- ^ XSalsa State that contains the precomputed first-level key + -> Maybe content +openAfterNM packet nonce (State state0) + | BA.length packet < 16 = Nothing + | BA.constEq tag' tag = Just content + | otherwise = Nothing + where + (tag', c) = BA.splitAt 16 packet + (iv0, iv1) = BA.splitAt 8 nonce + + -- This is very hacky. The XSalsa.initialise that we performed in the beforeNM + -- stage has mostly what we need, except for state[6] and state[7] which is + -- where the first 8 bytes of the IV/nonce go to. Since those are currently + -- zero because we used zeros during the beforeNM (we didn't know the nonce), + -- we now need to poke into that pointer location and overwrite its contents. + state1 = unsafePerformIO $ do + memview <- BA.withByteArray state0 $ \state0Ptr -> do + -- We start writing at byte 24, this is 6*4 where 6 is the location + -- that the 16th byte of the 24-byte IV (the first 16 are zeros even + -- if we use cryptoBox) passed to xsalsa is written to, and 4 is + -- because the base type is uint32. + BA.unpack iv0 + & zip [24..31] + & traverse_ (\(i, word) -> + Storable.poke (state0Ptr `Ptr.plusPtr` i) word) + -- Return the 132 bytes that is the size of the State struct + -- This is how much is allocated when you look at the source of + -- XSalsa.initialize, and the struct contents are defined here: + -- https://github.com/haskell-crypto/cryptonite/blob/cf89276b5cdd87fcd60cce2fb424e64f0de7016a/cbits/cryptonite_salsa.h + pure $ BA.MemView state0Ptr 132 + -- Convert from a pointer to Words to a pointer to State + pure $ State $ BA.convert $ memview + + state2 = XSalsa.derive state1 iv1 + (rs, state3) = XSalsa.generate state2 32 + (content, _) = XSalsa.combine state3 c + tag = Poly1305.auth (rs :: B.ByteString) c diff --git a/src/Crypto/SecretBox.hs b/src/Crypto/SecretBox.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/SecretBox.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE ImportQualifiedPost #-} +-- | This module provides the creation and opening of a secret_box. +module Crypto.SecretBox where + +import Data.ByteArray qualified as BA +import Data.ByteString qualified as B + +import Crypto.Cipher.XSalsa qualified as XSalsa +import Crypto.MAC.Poly1305 qualified as Poly1305 +import Crypto.PubKey.Curve25519 qualified as X25519 + +-- | Build a @secret_box@ packet encrypting the specified content with a +-- 192-bit nonce and a 256-bit symmetric secret key. +create + :: (BA.ByteArray content, BA.ByteArray nonce) + => content + -- ^ Message to encrypt + -> nonce + -- ^ 192-bit nonce + -> X25519.DhSecret + -- ^ Symmetric secret key + -> content + -- ^ Ciphertext +create message nonce key = BA.convert tag `BA.append` c + where + -- No need to prepend 16 bytes of zero before the nonce and then call derive + -- with the rest. This is because secret_box directly calls + -- crypto_secretbox_xsalsa20poly1305 + -- which begins with the XOR-ing, while crypto_box calls + -- crypto_box_curve25519xsalsa20poly1305_beforenm + -- (which has a single HSalsa() round applied on the shared secret) before + -- calling + -- crypto_box_curve25519xsalsa20poly1305_afternm, which calls + -- crypto_secretbox_xsalsa20poly1305 + -- + -- + -- So, since we already have a symmetric secret key that has one layer of + -- HSalsa() performed on it, we can directly use that without calling "derive" + -- twice (once in init and once in derive) and start performing the xor after + -- the first HSalsa() in initialize. + state0 = XSalsa.initialize 20 key nonce + (rs, state1) = XSalsa.generate state0 32 + (c, _) = XSalsa.combine state1 message + tag = Poly1305.auth (rs :: B.ByteString) c + +-- | Try to open a @secret_box@ packet and recover the content using the +-- 192-bit nonce and a 256-bit symmetric secret key. +open + :: (BA.ByteArray content, BA.ByteArray nonce) + => content + -- ^ Ciphertext to decrypt + -> nonce + -- ^ 192-bit nonce + -> X25519.DhSecret + -- ^ Symmetric secret key + -> Maybe content + -- ^ Message +open packet nonce key + | BA.length packet < 16 = Nothing + | BA.constEq tag' tag = Just content + | otherwise = Nothing + where + (tag', c) = BA.splitAt 16 packet + state0 = XSalsa.initialize 20 key nonce + (rs, state1) = XSalsa.generate state0 32 + (content, _) = XSalsa.combine state1 c + tag = Poly1305.auth (rs :: B.ByteString) c diff --git a/test/Crypto/BoxSpec.hs b/test/Crypto/BoxSpec.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/BoxSpec.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +module Crypto.BoxSpec where + +import Data.ByteString qualified as B +import Data.Function ((&)) +import Test.Hspec +import Text.Printf (printf) +import Control.Monad.IO.Class (liftIO) +import Crypto.Error +import Crypto.PubKey.Curve25519 +import Data.Maybe (fromJust, isJust, isNothing) + +import qualified Crypto.Box as Box + +hexifier :: B.ByteString -> String +hexifier bytes = B.unpack bytes + & map (\word -> printf ",0x%02x" word) + & zip [0..] + & map (\(i, str) -> str <> (if i `mod` 8 == 7 then "\n" else "")) + & concat + +isCryptoPassed :: CryptoFailable a -> Bool +isCryptoPassed (CryptoPassed _) = True +isCryptoPassed _ = False + +isCryptoFailed :: CryptoFailable a -> Bool +isCryptoFailed (CryptoFailed _) = True +isCryptoFailed _ = False + +spec :: Spec +spec = do + -- Taken from https://github.com/jedisct1/libsodium/blob/master/test/default/box.c + describe "cryptobox check 1 (box.exp)" $ do + let aliceskFailable = secretKey $ B.pack + [ 0x77, 0x07, 0x6d, 0x0a, 0x73, 0x18, 0xa5, 0x7d, 0x3c, 0x16, 0xc1 + , 0x72, 0x51, 0xb2, 0x66, 0x45, 0xdf, 0x4c, 0x2f, 0x87, 0xeb, 0xc0 + , 0x99, 0x2a, 0xb1, 0x77, 0xfb, 0xa5, 0x1d, 0xb9, 0x2c, 0x2a + ] + let alicesk = fromJust $ maybeCryptoError aliceskFailable + let bobpkFailable = publicKey $ B.pack + [ 0xde, 0x9e, 0xdb, 0x7d, 0x7b, 0x7d, 0xc1, 0xb4, 0xd3, 0x5b, 0x61 + , 0xc2, 0xec, 0xe4, 0x35, 0x37, 0x3f, 0x83, 0x43, 0xc8, 0x5b, 0x78 + , 0x67, 0x4d, 0xad, 0xfc, 0x7e, 0x14, 0x6f, 0x88, 0x2b, 0x4f + ] + let bobpk = fromJust $ maybeCryptoError bobpkFailable + let smallOrderPFailable = publicKey $ B.pack + [ 0xe0, 0xeb, 0x7a, 0x7c, 0x3b, 0x41, 0xb8, 0xae, 0x16, 0x56, 0xe3 + , 0xfa, 0xf1, 0x9f, 0xc4, 0x6a, 0xda, 0x09, 0x8d, 0xeb, 0x9c, 0x32 + , 0xb1, 0xfd, 0x86, 0x62, 0x05, 0x16, 0x5f, 0x49, 0xb8, 0x00 + ] + let smallOrderP = fromJust $ maybeCryptoError smallOrderPFailable + let nonce = B.pack + [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 + , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 + , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 + , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 + ] + let m = B.pack + [ 0xbe, 0x07, 0x5f, 0xc5 + , 0x3c, 0x81, 0xf2, 0xd5, 0xcf, 0x14, 0x13, 0x16, 0xeb, 0xeb, 0x0c, 0x7b + , 0x52, 0x28, 0xc5, 0x2a, 0x4c, 0x62, 0xcb, 0xd4, 0x4b, 0x66, 0x84, 0x9b + , 0x64, 0x24, 0x4f, 0xfc, 0xe5, 0xec, 0xba, 0xaf, 0x33, 0xbd, 0x75, 0x1a + , 0x1a, 0xc7, 0x28, 0xd4, 0x5e, 0x6c, 0x61, 0x29, 0x6c, 0xdc, 0x3c, 0x01 + , 0x23, 0x35, 0x61, 0xf4, 0x1d, 0xb6, 0x6c, 0xce, 0x31, 0x4a, 0xdb, 0x31 + , 0x0e, 0x3b, 0xe8, 0x25, 0x0c, 0x46, 0xf0, 0x6d, 0xce, 0xea, 0x3a, 0x7f + , 0xa1, 0x34, 0x80, 0x57, 0xe2, 0xf6, 0x55, 0x6a, 0xd6, 0xb1, 0x31, 0x8a + , 0x02, 0x4a, 0x83, 0x8f, 0x21, 0xaf, 0x1f, 0xde, 0x04, 0x89, 0x77, 0xeb + , 0x48, 0xf5, 0x9f, 0xfd, 0x49, 0x24, 0xca, 0x1c, 0x60, 0x90, 0x2e, 0x52 + , 0xf0, 0xa0, 0x89, 0xbc, 0x76, 0x89, 0x70, 0x40, 0xe0, 0x82, 0xf9, 0x37 + , 0x76, 0x38, 0x48, 0x64, 0x5e, 0x07, 0x05 + ] + + -- We use `shouldBe` instead of `shouldSatisfy` because ECC.SharedSecret + -- has no Show instance. + it "checks Box.beforeNM doesn't fail with valid data" $ do + isCryptoPassed (Box.beforeNM bobpk alicesk) `shouldBe` True + + it "checks Box.beforeNM fails with small order p" $ do + isCryptoPassed (Box.beforeNM smallOrderP alicesk) `shouldBe` False + + it "checks Box.create and Box.createAfterNM match expected output" $ do + -- once with cryptoBox + let c1 = Box.create m nonce bobpk alicesk + + -- once with before/after split + let k = fromJust $ maybeCryptoError $ Box.beforeNM bobpk alicesk + let c2 = Box.createAfterNM m nonce k + + let output = hexifier c1 <> "\n" <> hexifier c2 <> "\n" + contents <- liftIO $ readFile "test/Crypto/box.exp" + output `shouldBe` contents + + -- Taken from https://github.com/jedisct1/libsodium/blob/master/test/default/box.c + describe "cryptobox check 2 (box2.exp)" $ do + let bobskFailable = secretKey $ B.pack + [ 0x5d, 0xab, 0x08, 0x7e, 0x62, 0x4a, 0x8a + , 0x4b, 0x79, 0xe1, 0x7f, 0x8b, 0x83, 0x80 + , 0x0e, 0xe6, 0x6f, 0x3b, 0xb1, 0x29, 0x26 + , 0x18, 0xb6, 0xfd, 0x1c, 0x2f, 0x8b, 0x27 + , 0xff, 0x88, 0xe0, 0xeb + ] + bobsk = fromJust $ maybeCryptoError bobskFailable + let alicepkFailable = publicKey $ B.pack + [ 0x85, 0x20, 0xf0, 0x09, 0x89, 0x30, 0xa7 + , 0x54, 0x74, 0x8b, 0x7d, 0xdc, 0xb4, 0x3e + , 0xf7, 0x5a, 0x0d, 0xbf, 0x3a, 0x0d, 0x26 + , 0x38, 0x1a, 0xf4, 0xeb, 0xa4, 0xa9, 0x8e + , 0xaa, 0x9b, 0x4e, 0x6a + ] + alicepk = fromJust $ maybeCryptoError alicepkFailable + let smallOrderPFailable = publicKey $ B.pack + [ 0xe0, 0xeb, 0x7a, 0x7c, 0x3b, 0x41, 0xb8, 0xae, 0x16, 0x56, 0xe3 + , 0xfa, 0xf1, 0x9f, 0xc4, 0x6a, 0xda, 0x09, 0x8d, 0xeb, 0x9c, 0x32 + , 0xb1, 0xfd, 0x86, 0x62, 0x05, 0x16, 0x5f, 0x49, 0xb8, 0x00 + ] + smallOrderP = fromJust $ maybeCryptoError smallOrderPFailable + let nonce = B.pack + [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 + , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 + , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 + , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 + ] + let c = B.pack + [ 0xf3, 0xff, 0xc7, 0x70, 0x3f, 0x94, 0x00, 0xe5 + , 0x2a, 0x7d, 0xfb, 0x4b, 0x3d, 0x33, 0x05, 0xd9, 0x8e, 0x99, 0x3b, 0x9f + , 0x48, 0x68, 0x12, 0x73, 0xc2, 0x96, 0x50, 0xba, 0x32, 0xfc, 0x76, 0xce + , 0x48, 0x33, 0x2e, 0xa7, 0x16, 0x4d, 0x96, 0xa4, 0x47, 0x6f, 0xb8, 0xc5 + , 0x31, 0xa1, 0x18, 0x6a, 0xc0, 0xdf, 0xc1, 0x7c, 0x98, 0xdc, 0xe8, 0x7b + , 0x4d, 0xa7, 0xf0, 0x11, 0xec, 0x48, 0xc9, 0x72, 0x71, 0xd2, 0xc2, 0x0f + , 0x9b, 0x92, 0x8f, 0xe2, 0x27, 0x0d, 0x6f, 0xb8, 0x63, 0xd5, 0x17, 0x38 + , 0xb4, 0x8e, 0xee, 0xe3, 0x14, 0xa7, 0xcc, 0x8a, 0xb9, 0x32, 0x16, 0x45 + , 0x48, 0xe5, 0x26, 0xae, 0x90, 0x22, 0x43, 0x68, 0x51, 0x7a, 0xcf, 0xea + , 0xbd, 0x6b, 0xb3, 0x73, 0x2b, 0xc0, 0xe9, 0xda, 0x99, 0x83, 0x2b, 0x61 + , 0xca, 0x01, 0xb6, 0xde, 0x56, 0x24, 0x4a, 0x9e, 0x88, 0xd5, 0xf9, 0xb3 + , 0x79, 0x73, 0xf6, 0x22, 0xa4, 0x3d, 0x14, 0xa6, 0x59, 0x9b, 0x1f, 0x65 + , 0x4c, 0xb4, 0x5a, 0x74, 0xe3, 0x55, 0xa5 + ] + it "checks Box.open doesn't fail with valid data" $ do + Box.open c nonce alicepk bobsk `shouldSatisfy` isJust + + it "checks Box.open fails with small order p" $ do + Box.open c nonce smallOrderP bobsk `shouldSatisfy` isNothing + + it "checks Box.beforeNM doesn't fail with valid data" $ do + isCryptoPassed (Box.beforeNM alicepk bobsk) `shouldBe` True + + it "checks Box.beforeNM fails with small order p" $ do + isCryptoPassed (Box.beforeNM smallOrderP bobsk) `shouldBe` False + + it "checks Box.open and Box.openAfterNM matches expected output" $ do + -- once with cryptoBoxOpen + let m1 = fromJust $ Box.open c nonce alicepk bobsk + + -- once with before/after split + let k = fromJust $ maybeCryptoError $ Box.beforeNM alicepk bobsk + let m2 = fromJust $ Box.openAfterNM c nonce k + + let output = hexifier m1 <> "\n" <> hexifier m2 <> "\n" + contents <- liftIO $ readFile "test/Crypto/box2.exp" + output `shouldBe` contents + diff --git a/test/Crypto/SecretBoxSpec.hs b/test/Crypto/SecretBoxSpec.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/SecretBoxSpec.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +module Crypto.SecretBoxSpec where + +import Data.ByteString qualified as B +import Data.Function ((&)) +import Test.Hspec +import Text.Printf (printf) +import Control.Monad.IO.Class (liftIO) +import Crypto.Error +import Crypto.PubKey.Curve25519 +import Data.Maybe (fromJust, isJust, isNothing) + +import qualified Crypto.SecretBox as SecretBox + +hexifier :: B.ByteString -> String +hexifier bytes = B.unpack bytes + & map (\word -> printf ",0x%02x" word) + & zip [0..] + & map (\(i, str) -> str <> (if i `mod` 8 == 7 then "\n" else "")) + & concat + +isCryptoPassed :: CryptoFailable a -> Bool +isCryptoPassed (CryptoPassed _) = True +isCryptoPassed _ = False + +isCryptoFailed :: CryptoFailable a -> Bool +isCryptoFailed (CryptoFailed _) = True +isCryptoFailed _ = False + +spec :: Spec +spec = do + -- Taken from https://github.com/jedisct1/libsodium/blob/master/test/default/secretbox.c + describe "secretbox check 1 (secretbox.exp)" $ do + let firstkeyFailable = dhSecret $ B.pack + [ 0x1b, 0x27, 0x55, 0x64, 0x73, 0xe9, 0x85 + , 0xd4, 0x62, 0xcd, 0x51, 0x19, 0x7a, 0x9a + , 0x46, 0xc7, 0x60, 0x09, 0x54, 0x9e, 0xac + , 0x64, 0x74, 0xf2, 0x06, 0xc4, 0xee, 0x08 + , 0x44, 0xf6, 0x83, 0x89 + ] + let firstkey = fromJust $ maybeCryptoError firstkeyFailable + let nonce = B.pack + [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 + , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 + , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 + , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 + ] + let m = B.pack + [ 0xbe, 0x07, 0x5f, 0xc5 + , 0x3c, 0x81, 0xf2, 0xd5, 0xcf, 0x14, 0x13, 0x16, 0xeb, 0xeb, 0x0c, 0x7b + , 0x52, 0x28, 0xc5, 0x2a, 0x4c, 0x62, 0xcb, 0xd4, 0x4b, 0x66, 0x84, 0x9b + , 0x64, 0x24, 0x4f, 0xfc, 0xe5, 0xec, 0xba, 0xaf, 0x33, 0xbd, 0x75, 0x1a + , 0x1a, 0xc7, 0x28, 0xd4, 0x5e, 0x6c, 0x61, 0x29, 0x6c, 0xdc, 0x3c, 0x01 + , 0x23, 0x35, 0x61, 0xf4, 0x1d, 0xb6, 0x6c, 0xce, 0x31, 0x4a, 0xdb, 0x31 + , 0x0e, 0x3b, 0xe8, 0x25, 0x0c, 0x46, 0xf0, 0x6d, 0xce, 0xea, 0x3a, 0x7f + , 0xa1, 0x34, 0x80, 0x57, 0xe2, 0xf6, 0x55, 0x6a, 0xd6, 0xb1, 0x31, 0x8a + , 0x02, 0x4a, 0x83, 0x8f, 0x21, 0xaf, 0x1f, 0xde, 0x04, 0x89, 0x77, 0xeb + , 0x48, 0xf5, 0x9f, 0xfd, 0x49, 0x24, 0xca, 0x1c, 0x60, 0x90, 0x2e, 0x52 + , 0xf0, 0xa0, 0x89, 0xbc, 0x76, 0x89, 0x70, 0x40, 0xe0, 0x82, 0xf9, 0x37 + , 0x76, 0x38, 0x48, 0x64, 0x5e, 0x07, 0x05 + ] + + it "checks SecretBox.create matches expected output" $ do + -- once with secretBox + let c1 = SecretBox.create m nonce firstkey + + -- once again + let c2 = SecretBox.create m nonce firstkey + + let output = hexifier c1 <> "\n" <> hexifier c2 <> "\n" + contents <- liftIO $ readFile "test/Crypto/secretbox.exp" + output `shouldBe` contents + + -- Taken from https://github.com/jedisct1/libsodium/blob/master/test/default/secretbox2.c + describe "secretbox check 2 (secretbox2.exp)" $ do + let firstkeyFailable = dhSecret $ B.pack + [ 0x1b, 0x27, 0x55, 0x64, 0x73, 0xe9, 0x85 + , 0xd4, 0x62, 0xcd, 0x51, 0x19, 0x7a, 0x9a + , 0x46, 0xc7, 0x60, 0x09, 0x54, 0x9e, 0xac + , 0x64, 0x74, 0xf2, 0x06, 0xc4, 0xee, 0x08 + , 0x44, 0xf6, 0x83, 0x89 + ] + firstkey = fromJust $ maybeCryptoError firstkeyFailable + let nonce = B.pack + [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 + , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 + , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 + , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 + ] + let c = B.pack + [ 0xf3, 0xff, 0xc7, 0x70, 0x3f, 0x94, 0x00, 0xe5 + , 0x2a, 0x7d, 0xfb, 0x4b, 0x3d, 0x33, 0x05, 0xd9, 0x8e, 0x99, 0x3b, 0x9f + , 0x48, 0x68, 0x12, 0x73, 0xc2, 0x96, 0x50, 0xba, 0x32, 0xfc, 0x76, 0xce + , 0x48, 0x33, 0x2e, 0xa7, 0x16, 0x4d, 0x96, 0xa4, 0x47, 0x6f, 0xb8, 0xc5 + , 0x31, 0xa1, 0x18, 0x6a, 0xc0, 0xdf, 0xc1, 0x7c, 0x98, 0xdc, 0xe8, 0x7b + , 0x4d, 0xa7, 0xf0, 0x11, 0xec, 0x48, 0xc9, 0x72, 0x71, 0xd2, 0xc2, 0x0f + , 0x9b, 0x92, 0x8f, 0xe2, 0x27, 0x0d, 0x6f, 0xb8, 0x63, 0xd5, 0x17, 0x38 + , 0xb4, 0x8e, 0xee, 0xe3, 0x14, 0xa7, 0xcc, 0x8a, 0xb9, 0x32, 0x16, 0x45 + , 0x48, 0xe5, 0x26, 0xae, 0x90, 0x22, 0x43, 0x68, 0x51, 0x7a, 0xcf, 0xea + , 0xbd, 0x6b, 0xb3, 0x73, 0x2b, 0xc0, 0xe9, 0xda, 0x99, 0x83, 0x2b, 0x61 + , 0xca, 0x01, 0xb6, 0xde, 0x56, 0x24, 0x4a, 0x9e, 0x88, 0xd5, 0xf9, 0xb3 + , 0x79, 0x73, 0xf6, 0x22, 0xa4, 0x3d, 0x14, 0xa6, 0x59, 0x9b, 0x1f, 0x65 + , 0x4c, 0xb4, 0x5a, 0x74, 0xe3, 0x55, 0xa5 + ] + it "checks SecretBox.open matches expected output" $ do + -- once with secretBoxOpen + let m = fromJust $ SecretBox.open c nonce firstkey + + let output = hexifier m <> "\n" + contents <- liftIO $ readFile "test/Crypto/secretbox2.exp" + output `shouldBe` contents + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}