diff --git a/saltine.cabal b/saltine.cabal --- a/saltine.cabal +++ b/saltine.cabal @@ -1,5 +1,5 @@ name: saltine -version: 0.0.1.0 +version: 0.1.0.0 synopsis: Cryptography that's easy to digest (NaCl/libsodium bindings). description: @@ -27,7 +27,7 @@ category: Cryptography build-type: Simple cabal-version: >=1.10 -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 source-repository head type: git @@ -39,6 +39,7 @@ Crypto.Saltine Crypto.Saltine.Internal.ByteSizes Crypto.Saltine.Core.SecretBox + Crypto.Saltine.Core.AEAD Crypto.Saltine.Core.Box Crypto.Saltine.Core.Stream Crypto.Saltine.Core.Auth @@ -46,10 +47,16 @@ Crypto.Saltine.Core.Sign Crypto.Saltine.Core.Hash Crypto.Saltine.Core.ScalarMult + Crypto.Saltine.Core.Utils Crypto.Saltine.Class other-modules: - Crypto.Saltine.Internal.Util - extra-libraries: sodium + Crypto.Saltine.Internal.Util + + if os(windows) + extra-libraries: sodium + else + pkgconfig-depends: libsodium >= 1.0.13 + cc-options: -Wall ghc-options: -Wall -funbox-strict-fields default-language: Haskell2010 @@ -67,8 +74,10 @@ OneTimeAuthProperties ScalarMultProperties SecretBoxProperties + SealedBoxProperties SignProperties StreamProperties + AEADProperties Util ghc-options: -Wall -threaded -rtsopts hs-source-dirs: tests diff --git a/src/Crypto/Saltine.hs b/src/Crypto/Saltine.hs --- a/src/Crypto/Saltine.hs +++ b/src/Crypto/Saltine.hs @@ -2,18 +2,15 @@ {-# LANGUAGE TypeFamilies #-} module Crypto.Saltine ( - optimize, - module Crypto.Saltine.Core.SecretBox + sodiumInit ) where import Foreign.C -import Crypto.Saltine.Core.SecretBox --- | Runs Sodiums's initialization routine. This should be called before --- using any other function. It is thread-safe since libsodium 1.0.11, --- but not before. -optimize :: IO () -optimize = do +-- | Runs Sodiums's initialization routine. This must be called before +-- using any other function. It is thread-safe since libsodium 1.0.11. +sodiumInit :: IO () +sodiumInit = do err <- c_sodiumInit case err of 0 -> -- everything went well @@ -21,6 +18,6 @@ 1 -> -- already initialized, we're good return () _ -> -- some kind of failure - error "Crypto.Saltine.optimize" + error "Crypto.Saltine.sodiumInit" foreign import ccall "sodium_init" c_sodiumInit :: IO CInt diff --git a/src/Crypto/Saltine/Core/AEAD.hs b/src/Crypto/Saltine/Core/AEAD.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Core/AEAD.hs @@ -0,0 +1,256 @@ +-- | +-- Module : Crypto.Saltine.Core.AEAD +-- Copyright : (c) Thomas DuBuisson 2017 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key authenticated encryption with additional data (AEAD): +-- "Crypto.Saltine.Core.AEAD" +-- +-- The 'aead' function encrypts and authenticates a message +-- 'ByteString' and additional authenticated data 'ByteString' +-- using a secret key and a nonce. The 'aeadOpen' +-- function verifies and decrypts a ciphertext 'ByteString' using a +-- secret key and a nonce. If the ciphertext fails validation, +-- 'aeadOpen' returns 'Nothing'. +-- +-- The "Crypto.Saltine.Core.AEAD" module is designed to meet +-- the standard notions of privacy and authenticity for a secret-key +-- authenticated-encryption scheme using nonces. For formal +-- definitions see, e.g., Bellare and Namprempre, "Authenticated +-- encryption: relations among notions and analysis of the generic +-- composition paradigm," Lecture Notes in Computer Science 1976 +-- (2000), 531–545, . +-- +-- Note that the length is not hidden. Note also that it is the +-- caller's responsibility to ensure the uniqueness of nonces—for +-- example, by using nonce 1 for the first message, nonce 2 for the +-- second message, etc. Nonces are long enough that randomly generated +-- nonces have negligible risk of collision. + +module Crypto.Saltine.Core.AEAD ( + Key, Nonce, + aead, aeadOpen, + aeadDetached, aeadOpenDetached, + newKey, newNonce + ) where + +import Crypto.Saltine.Class +import Crypto.Saltine.Internal.Util +import qualified Crypto.Saltine.Internal.ByteSizes as Bytes + +import Control.Applicative +import Foreign.C +import Foreign.Ptr +import qualified Data.ByteString as S +import Data.ByteString (ByteString) + +-- $types + +-- | An opaque 'secretbox' cryptographic key. +newtype Key = Key ByteString deriving (Eq, Ord) + +instance IsEncoding Key where + decode v = if S.length v == Bytes.secretBoxKey + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'secretbox' nonce. +newtype Nonce = Nonce ByteString deriving (Eq, Ord) + +instance IsEncoding Nonce where + decode v = if S.length v == Bytes.secretBoxNonce + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +instance IsNonce Nonce where + zero = Nonce (S.replicate Bytes.secretBoxNonce 0) + nudge (Nonce n) = Nonce (nudgeBS n) + +-- | Creates a random key of the correct size for 'secretbox'. +newKey :: IO Key +newKey = Key <$> randomByteString Bytes.secretBoxKey + +-- | Creates a random nonce of the correct size for 'secretbox'. +newNonce :: IO Nonce +newNonce = Nonce <$> randomByteString Bytes.secretBoxNonce + + +-- | Encrypts a message. It is infeasible for an attacker to decrypt +-- the message so long as the 'Nonce' is never repeated. +aead :: Key -> Nonce + -> ByteString + -- ^ Message + -> ByteString + -- ^ AAD + -> ByteString + -- ^ Ciphertext +aead (Key key) (Nonce nonce) msg aad = + snd . buildUnsafeByteString clen $ \pc -> + constByteStrings [key, msg, aad, nonce] $ \ + [(pk, _), (pm, _), (pa, _), (pn, _)] -> + c_aead pc nullPtr pm (fromIntegral mlen) pa (fromIntegral alen) nullPtr pn pk + where mlen = S.length msg + alen = S.length aad + clen = mlen + Bytes.aead_xchacha20poly1305_ietf_ABYTES + +-- | Decrypts a message. Returns 'Nothing' if the keys and message do +-- not match. +aeadOpen :: Key -> Nonce + -> ByteString + -- ^ Ciphertext + -> ByteString + -- ^ AAD + -> Maybe ByteString + -- ^ Message +aeadOpen (Key key) (Nonce nonce) cipher aad = + let (err, vec) = buildUnsafeByteString mlen $ \pm -> + constByteStrings [key, cipher, aad, nonce] $ \ + [(pk, _), (pc, _), (pa, _), (pn, _)] -> + c_aead_open pm nullPtr nullPtr pc (fromIntegral clen) pa (fromIntegral alen) pn pk + in hush . handleErrno err $ vec + where clen = S.length cipher + alen = S.length aad + mlen = clen - Bytes.aead_xchacha20poly1305_ietf_ABYTES + +-- | Encrypts a message. It is infeasible for an attacker to decrypt +-- the message so long as the 'Nonce' is never repeated. +aeadDetached :: Key -> Nonce + -> ByteString + -- ^ Message + -> ByteString + -- ^ AAD + -> (ByteString,ByteString) + -- ^ Tag, Ciphertext +aeadDetached (Key key) (Nonce nonce) msg aad = + buildUnsafeByteString clen $ \pc -> + fmap snd . buildUnsafeByteString' tlen $ \pt -> + constByteStrings [key, msg, aad, nonce] $ \ + [(pk, _), (pm, _), (pa, _), (pn, _)] -> + c_aead_detached pc pt nullPtr pm (fromIntegral mlen) pa (fromIntegral alen) nullPtr pn pk + where mlen = S.length msg + alen = S.length aad + clen = mlen + tlen = Bytes.aead_xchacha20poly1305_ietf_ABYTES + +-- | Decrypts a message. Returns 'Nothing' if the keys and message do +-- not match. +aeadOpenDetached :: Key -> Nonce + -> ByteString + -- ^ Tag + -> ByteString + -- ^ Ciphertext + -> ByteString + -- ^ AAD + -> Maybe ByteString + -- ^ Message +aeadOpenDetached (Key key) (Nonce nonce) tag cipher aad + | S.length tag /= tlen = Nothing + | otherwise = + let (err, vec) = buildUnsafeByteString len $ \pm -> + constByteStrings [key, tag, cipher, aad, nonce] $ \ + [(pk, _), (pt, _), (pc, _), (pa, _), (pn, _)] -> + c_aead_open_detached pm nullPtr pc (fromIntegral len) pt pa (fromIntegral alen) pn pk + in hush . handleErrno err $ vec + where len = S.length cipher + alen = S.length aad + tlen = Bytes.aead_xchacha20poly1305_ietf_ABYTES + +-- | The aead C API uses C strings. Always returns 0. +foreign import ccall "crypto_aead_xchacha20poly1305_ietf_encrypt" + c_aead :: Ptr CChar + -- ^ Cipher output buffer + -> Ptr CULLong + -- ^ Cipher output bytes used + -> Ptr CChar + -- ^ Constant message input buffer + -> CULLong + -- ^ Length of message input buffer + -> Ptr CChar + -- ^ Constant aad input buffer + -> CULLong + -- ^ Length of aad input buffer + -> Ptr CChar + -- ^ Unused 'nsec' value (must be NULL) + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + +-- | The aead open C API uses C strings. Returns 0 if successful. +foreign import ccall "crypto_aead_xchacha20poly1305_ietf_decrypt" + c_aead_open :: Ptr CChar + -- ^ Message output buffer + -> Ptr CULLong + -- ^ Message output bytes used + -> Ptr CChar + -- ^ Unused 'nsec' value (must be NULL) + -> Ptr CChar + -- ^ Constant ciphertext input buffer + -> CULLong + -- ^ Length of ciphertext input buffer + -> Ptr CChar + -- ^ Constant aad input buffer + -> CULLong + -- ^ Length of aad input buffer + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + +-- | The aead C API uses C strings. Always returns 0. +foreign import ccall "crypto_aead_xchacha20poly1305_ietf_encrypt_detached" + c_aead_detached :: Ptr CChar + -- ^ Cipher output buffer + -> Ptr CChar + -- ^ Tag output buffer + -> Ptr CULLong + -- ^ Tag bytes used + -> Ptr CChar + -- ^ Constant message input buffer + -> CULLong + -- ^ Length of message input buffer + -> Ptr CChar + -- ^ Constant aad input buffer + -> CULLong + -- ^ Length of aad input buffer + -> Ptr CChar + -- ^ Unused 'nsec' value (must be NULL) + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + +-- | The aead open C API uses C strings. Returns 0 if successful. +foreign import ccall "crypto_aead_xchacha20poly1305_ietf_decrypt_detached" + c_aead_open_detached :: Ptr CChar + -- ^ Message output buffer + -> Ptr CChar + -- ^ Unused 'nsec' value (must be NULL) + -> Ptr CChar + -- ^ Constant ciphertext input buffer + -> CULLong + -- ^ Length of ciphertext input buffer + -> Ptr CChar + -- ^ Constant tag input buffer + -> Ptr CChar + -- ^ Constant aad input buffer + -> CULLong + -- ^ Length of aad input buffer + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt diff --git a/src/Crypto/Saltine/Core/Auth.hs b/src/Crypto/Saltine/Core/Auth.hs --- a/src/Crypto/Saltine/Core/Auth.hs +++ b/src/Crypto/Saltine/Core/Auth.hs @@ -79,7 +79,7 @@ -- | Creates a random key of the correct size for 'auth' and 'verify'. newKey :: IO Key -newKey = Key <$> randomVector Bytes.authKey +newKey = Key <$> randomByteString Bytes.authKey -- | Computes an keyed authenticator 'ByteString' from a message. It -- is infeasible to forge these authenticators without the key, even @@ -90,8 +90,8 @@ -- ^ Message -> Authenticator auth (Key key) msg = - Au . snd . buildUnsafeCVector Bytes.auth $ \pa -> - constVectors [key, msg] $ \[(pk, _), (pm, mlen)] -> + Au . snd . buildUnsafeByteString Bytes.auth $ \pa -> + constByteStrings [key, msg] $ \[(pk, _), (pm, mlen)] -> c_auth pa pm (fromIntegral mlen) pk -- | Checks to see if an authenticator is a correct proof that a @@ -103,7 +103,7 @@ -> Bool -- ^ Is this message authentic? verify (Key key) (Au a) msg = - unsafeDidSucceed $ constVectors [key, msg, a] $ \[(pk, _), (pm, mlen), (pa, _)] -> + unsafeDidSucceed $ constByteStrings [key, msg, a] $ \[(pk, _), (pm, mlen), (pa, _)] -> return $ c_auth_verify pa pm (fromIntegral mlen) pk foreign import ccall "crypto_auth" diff --git a/src/Crypto/Saltine/Core/Box.hs b/src/Crypto/Saltine/Core/Box.hs --- a/src/Crypto/Saltine/Core/Box.hs +++ b/src/Crypto/Saltine/Core/Box.hs @@ -154,118 +154,125 @@ newKeypair = do -- This is a little bizarre and a likely source of errors. -- _err ought to always be 0. - ((_err, sk), pk) <- buildUnsafeCVector' Bytes.boxPK $ \pkbuf -> - buildUnsafeCVector' Bytes.boxSK $ \skbuf -> + ((_err, sk), pk) <- buildUnsafeByteString' Bytes.boxPK $ \pkbuf -> + buildUnsafeByteString' Bytes.boxSK $ \skbuf -> c_box_keypair pkbuf skbuf return (SK sk, PK pk) -- | Randomly generates a nonce for usage with 'box' and 'boxOpen'. newNonce :: IO Nonce -newNonce = Nonce <$> randomVector Bytes.boxNonce +newNonce = Nonce <$> randomByteString Bytes.boxNonce -- | Build a 'CombinedKey' for sending from 'SecretKey' to -- 'PublicKey'. This is a precomputation step which can accelerate -- later encryption calls. beforeNM :: SecretKey -> PublicKey -> CombinedKey -beforeNM (SK sk) (PK pk) = CK $ snd $ buildUnsafeCVector Bytes.boxBeforeNM $ \ckbuf -> - constVectors [pk, sk] $ \[(ppk, _), (psk, _)] -> +beforeNM (SK sk) (PK pk) = CK $ snd $ buildUnsafeByteString Bytes.boxBeforeNM $ \ckbuf -> + constByteStrings [pk, sk] $ \[(ppk, _), (psk, _)] -> c_box_beforenm ckbuf ppk psk -- | Encrypts a message for sending to the owner of the public -- key. They must have your public key in order to decrypt the -- message. It is infeasible for an attacker to decrypt the message so -- long as the 'Nonce' is not repeated. -box :: PublicKey -> SecretKey -> Nonce +box :: PublicKey + -> SecretKey + -> Nonce -> ByteString -- ^ Message -> ByteString - -- ^ Ciphertext + -- ^ Ciphertext (incl. authentication tag) box (PK pk) (SK sk) (Nonce nonce) msg = - unpad' . snd . buildUnsafeCVector len $ \pc -> - constVectors [pk, sk, pad' msg, nonce] $ \ + snd . buildUnsafeByteString bufSize $ \pc -> + constByteStrings [pk, sk, msg, nonce] $ \ [(ppk, _), (psk, _), (pm, _), (pn, _)] -> - c_box pc pm (fromIntegral len) pn ppk psk - where len = S.length msg + Bytes.boxZero - pad' = pad Bytes.boxZero - unpad' = unpad Bytes.boxBoxZero + c_box_easy pc pm (fromIntegral msgLen) pn ppk psk + where + bufSize = S.length msg + Bytes.boxMac + msgLen = S.length msg -- | Decrypts a message sent from the owner of the public key. They -- must have encrypted it using your public key. Returns 'Nothing' if -- the keys and message do not match. boxOpen :: PublicKey -> SecretKey -> Nonce -> ByteString - -- ^ Ciphertext + -- ^ Ciphertext (incl. authentication tag) -> Maybe ByteString -- ^ Message boxOpen (PK pk) (SK sk) (Nonce nonce) cipher = - let (err, vec) = buildUnsafeCVector len $ \pm -> - constVectors [pk, sk, pad' cipher, nonce] $ \ + let (err, vec) = buildUnsafeByteString bufSize $ \pm -> + constByteStrings [pk, sk, cipher, nonce] $ \ [(ppk, _), (psk, _), (pc, _), (pn, _)] -> - c_box_open pm pc (fromIntegral len) pn ppk psk - in hush . handleErrno err $ unpad' vec - where len = S.length cipher + Bytes.boxBoxZero - pad' = pad Bytes.boxBoxZero - unpad' = unpad Bytes.boxZero + c_box_open_easy pm pc (fromIntegral msgLen) pn ppk psk + in hush . handleErrno err $ vec + where + bufSize = S.length cipher - Bytes.boxMac + msgLen = S.length cipher --- | 'box' using a 'CombinedKey' and is thus faster. -boxAfterNM :: CombinedKey -> Nonce +-- | 'box' using a 'CombinedKey' and thus faster. +boxAfterNM :: CombinedKey + -> Nonce -> ByteString -- ^ Message -> ByteString - -- ^ Ciphertext + -- ^ Ciphertext (incl. authentication tag) boxAfterNM (CK ck) (Nonce nonce) msg = - unpad' . snd . buildUnsafeCVector len $ \pc -> - constVectors [ck, pad' msg, nonce] $ \ + snd . buildUnsafeByteString bufSize $ \pc -> + constByteStrings [ck, msg, nonce] $ \ [(pck, _), (pm, _), (pn, _)] -> - c_box_afternm pc pm (fromIntegral len) pn pck - where len = S.length msg + Bytes.boxZero - pad' = pad Bytes.boxZero - unpad' = unpad Bytes.boxBoxZero + c_box_easy_afternm pc pm (fromIntegral msgLen) pn pck + where + bufSize = S.length msg + Bytes.boxMac + msgLen = S.length msg -- | 'boxOpen' using a 'CombinedKey' and is thus faster. -boxOpenAfterNM :: CombinedKey -> Nonce +boxOpenAfterNM :: CombinedKey + -> Nonce -> ByteString - -- ^ Ciphertext + -- ^ Ciphertext (incl. authentication tag) -> Maybe ByteString -- ^ Message boxOpenAfterNM (CK ck) (Nonce nonce) cipher = - let (err, vec) = buildUnsafeCVector len $ \pm -> - constVectors [ck, pad' cipher, nonce] $ \ + let (err, vec) = buildUnsafeByteString bufSize $ \pm -> + constByteStrings [ck, cipher, nonce] $ \ [(pck, _), (pc, _), (pn, _)] -> - c_box_open_afternm pm pc (fromIntegral len) pn pck - in hush . handleErrno err $ unpad' vec - where len = S.length cipher + Bytes.boxBoxZero - pad' = pad Bytes.boxBoxZero - unpad' = unpad Bytes.boxZero + c_box_open_easy_afternm pm pc (fromIntegral msgLen) pn pck + in hush . handleErrno err $ vec + where + bufSize = S.length cipher - Bytes.boxMac + msgLen = S.length cipher -- | Encrypts a message for sending to the owner of the public -- key. The message is unauthenticated, but permits integrity checking. boxSeal :: PublicKey -> ByteString -> IO ByteString -boxSeal (PK pk) msg = fmap snd . buildUnsafeCVector' strlen $ \pc -> - constVectors [pk, msg] $ \ +boxSeal (PK pk) msg = fmap snd . buildUnsafeByteString' bufSize $ \pc -> + constByteStrings [pk, msg] $ \ [(ppk, _), (pm, _)] -> - c_box_seal pc pm (fromIntegral len) ppk - where strlen = S.length msg + Bytes.sealedBox - len = S.length msg + c_box_seal pc pm (fromIntegral msgLen) ppk + where + bufSize = S.length msg + Bytes.sealedBox + msgLen = S.length msg -- | Decrypts a sealed box message. The message must have been -- encrypted using the receiver's public key. -- Returns 'Nothing' if keys and message do not match or integrity -- is violated. -boxSealOpen :: PublicKey -> SecretKey +boxSealOpen :: PublicKey + -> SecretKey -> ByteString -- ^ Ciphertext -> Maybe ByteString -- ^ Message boxSealOpen (PK pk) (SK sk) cipher = - let (err, vec) = buildUnsafeCVector strlen $ \pm -> - constVectors [pk, sk, cipher] $ \ + let (err, vec) = buildUnsafeByteString bufSize $ \pm -> + constByteStrings [pk, sk, cipher] $ \ [(ppk, _), (psk, _), (pc, _)] -> - c_box_seal_open pm pc (fromIntegral len) ppk psk + c_box_seal_open pm pc (fromIntegral msgLen) ppk psk in hush . handleErrno err $ vec - where strlen = S.length cipher - Bytes.sealedBox - len = S.length cipher + where + bufSize = S.length cipher - Bytes.sealedBox + msgLen = S.length cipher -- | Should always return a 0. @@ -277,31 +284,14 @@ -> IO CInt -- ^ Always 0 --- | The secretbox C API uses 0-padded C strings. -foreign import ccall "crypto_box" - c_box :: Ptr CChar - -- ^ Cipher 0-padded output buffer - -> Ptr CChar - -- ^ Constant 0-padded message input buffer - -> CULLong - -- ^ Length of message input buffer (incl. 0s) - -> Ptr CChar - -- ^ Constant nonce buffer - -> Ptr CChar - -- ^ Constant public key buffer - -> Ptr CChar - -- ^ Constant secret key buffer - -> IO CInt - -- ^ Always 0 - --- | The secretbox C API uses 0-padded C strings. -foreign import ccall "crypto_box_open" - c_box_open :: Ptr CChar - -- ^ Message 0-padded output buffer +-- | The secretbox C API uses C strings. +foreign import ccall "crypto_box_easy" + c_box_easy :: Ptr CChar + -- ^ Cipher output buffer -> Ptr CChar - -- ^ Constant 0-padded ciphertext input buffer + -- ^ Constant message input buffer -> CULLong - -- ^ Length of message input buffer (incl. 0s) + -- ^ Length of message input buffer -> Ptr CChar -- ^ Constant nonce buffer -> Ptr CChar @@ -309,8 +299,25 @@ -> Ptr CChar -- ^ Constant secret key buffer -> IO CInt - -- ^ 0 for success, -1 for failure to verify + -- ^ Always 0 +-- | The secretbox C API uses C strings. +foreign import ccall "crypto_box_open_easy" + c_box_open_easy :: Ptr CChar + -- ^ Message output buffer + -> Ptr CChar + -- ^ Constant ciphertext input buffer + -> CULLong + -- ^ Length of message input buffer + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant public key buffer + -> Ptr CChar + -- ^ Constant secret key buffer + -> IO CInt + -- ^ 0 for success, -1 for failure to verify + -- | Single target key precompilation. foreign import ccall "crypto_box_beforenm" c_box_beforenm :: Ptr CChar @@ -322,27 +329,12 @@ -> IO CInt -- ^ Always 0 --- | Precompiled key crypto box. Uses 0-padded C strings. -foreign import ccall "crypto_box_afternm" - c_box_afternm :: Ptr CChar - -- ^ Cipher 0-padded output buffer - -> Ptr CChar - -- ^ Constant 0-padded message input buffer - -> CULLong - -- ^ Length of message input buffer (incl. 0s) - -> Ptr CChar - -- ^ Constant nonce buffer - -> Ptr CChar - -- ^ Constant combined key buffer - -> IO CInt - -- ^ Always 0 - --- | The secretbox C API uses 0-padded C strings. -foreign import ccall "crypto_box_open_afternm" - c_box_open_afternm :: Ptr CChar - -- ^ Message 0-padded output buffer +-- | Precompiled key crypto box. Uses C strings. +foreign import ccall "crypto_box_easy_afternm" + c_box_easy_afternm :: Ptr CChar + -- ^ Cipher output buffer -> Ptr CChar - -- ^ Constant 0-padded ciphertext input buffer + -- ^ Constant message input buffer -> CULLong -- ^ Length of message input buffer (incl. 0s) -> Ptr CChar @@ -350,7 +342,22 @@ -> Ptr CChar -- ^ Constant combined key buffer -> IO CInt - -- ^ 0 for success, -1 for failure to verify + -- ^ Always 0 + +-- | The secretbox C API uses C strings. +foreign import ccall "crypto_box_open_easy_afternm" + c_box_open_easy_afternm :: Ptr CChar + -- ^ Message output buffer + -> Ptr CChar + -- ^ Constant ciphertext input buffer + -> CULLong + -- ^ Length of message input buffer (incl. 0s) + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant combined key buffer + -> IO CInt + -- ^ 0 for success, -1 for failure to verify -- | The sealedbox C API uses C strings. diff --git a/src/Crypto/Saltine/Core/Hash.hs b/src/Crypto/Saltine/Core/Hash.hs --- a/src/Crypto/Saltine/Core/Hash.hs +++ b/src/Crypto/Saltine/Core/Hash.hs @@ -63,8 +63,8 @@ -- ^ Message -> ByteString -- ^ Hash -hash m = snd . buildUnsafeCVector Bytes.hash $ \ph -> - constVectors [m] $ \[(pm, _)] -> c_hash ph pm (fromIntegral $ S.length m) +hash m = snd . buildUnsafeByteString Bytes.hash $ \ph -> + constByteStrings [m] $ \[(pm, _)] -> c_hash ph pm (fromIntegral $ S.length m) -- | An opaque 'shorthash' cryptographic secret key. newtype ShorthashKey = ShK ByteString deriving (Eq, Ord) @@ -79,7 +79,7 @@ -- | Randomly generates a new key for 'shorthash'. newShorthashKey :: IO ShorthashKey -newShorthashKey = ShK <$> randomVector Bytes.shorthashKey +newShorthashKey = ShK <$> randomByteString Bytes.shorthashKey -- | Computes a very short, fast keyed hash. shorthash :: ShorthashKey @@ -87,8 +87,8 @@ -- ^ Message -> ByteString -- ^ Hash -shorthash (ShK k) m = snd . buildUnsafeCVector Bytes.shorthash $ \ph -> - constVectors [k, m] $ \[(pk, _), (pm, _)] -> +shorthash (ShK k) m = snd . buildUnsafeByteString Bytes.shorthash $ \ph -> + constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> c_shorthash ph pm (fromIntegral $ S.length m) pk foreign import ccall "crypto_hash" diff --git a/src/Crypto/Saltine/Core/OneTimeAuth.hs b/src/Crypto/Saltine/Core/OneTimeAuth.hs --- a/src/Crypto/Saltine/Core/OneTimeAuth.hs +++ b/src/Crypto/Saltine/Core/OneTimeAuth.hs @@ -75,7 +75,7 @@ -- | Creates a random key of the correct size for 'auth' and 'verify'. newKey :: IO Key -newKey = Key <$> randomVector Bytes.onetimeKey +newKey = Key <$> randomByteString Bytes.onetimeKey -- | Builds a keyed 'Authenticator' for a message. This -- 'Authenticator' is /impossible/ to forge so long as the 'Key' is @@ -85,8 +85,8 @@ -- ^ Message -> Authenticator auth (Key key) msg = - Au . snd . buildUnsafeCVector Bytes.onetime $ \pa -> - constVectors [key, msg] $ \[(pk, _), (pm, _)] -> + Au . snd . buildUnsafeByteString Bytes.onetime $ \pa -> + constByteStrings [key, msg] $ \[(pk, _), (pm, _)] -> c_onetimeauth pa pm (fromIntegral $ S.length msg) pk -- | Verifies that an 'Authenticator' matches a given message and key. @@ -97,7 +97,7 @@ -> Bool -- ^ Is this message authentic? verify (Key key) (Au a) msg = - unsafeDidSucceed $ constVectors [key, msg, a] $ \ + unsafeDidSucceed $ constByteStrings [key, msg, a] $ \ [(pk, _), (pm, _), (pa, _)] -> return $ c_onetimeauth_verify pa pm (fromIntegral $ S.length msg) pk diff --git a/src/Crypto/Saltine/Core/ScalarMult.hs b/src/Crypto/Saltine/Core/ScalarMult.hs --- a/src/Crypto/Saltine/Core/ScalarMult.hs +++ b/src/Crypto/Saltine/Core/ScalarMult.hs @@ -89,13 +89,13 @@ {-# INLINE encode #-} mult :: Scalar -> GroupElement -> GroupElement -mult (Sc n) (GE p) = GE . snd . buildUnsafeCVector Bytes.mult $ \pq -> - constVectors [n, p] $ \[(pn, _), (pp, _)] -> +mult (Sc n) (GE p) = GE . snd . buildUnsafeByteString Bytes.mult $ \pq -> + constByteStrings [n, p] $ \[(pn, _), (pp, _)] -> c_scalarmult pq pn pp multBase :: Scalar -> GroupElement -multBase (Sc n) = GE . snd . buildUnsafeCVector Bytes.mult $ \pq -> - constVectors [n] $ \[(pn, _)] -> +multBase (Sc n) = GE . snd . buildUnsafeByteString Bytes.mult $ \pq -> + constByteStrings [n] $ \[(pn, _)] -> c_scalarmult_base pq pn foreign import ccall "crypto_scalarmult" diff --git a/src/Crypto/Saltine/Core/SecretBox.hs b/src/Crypto/Saltine/Core/SecretBox.hs --- a/src/Crypto/Saltine/Core/SecretBox.hs +++ b/src/Crypto/Saltine/Core/SecretBox.hs @@ -40,6 +40,7 @@ module Crypto.Saltine.Core.SecretBox ( Key, Nonce, secretbox, secretboxOpen, + secretboxDetached, secretboxOpenDetached, newKey, newNonce ) where @@ -83,11 +84,11 @@ -- | Creates a random key of the correct size for 'secretbox'. newKey :: IO Key -newKey = Key <$> randomVector Bytes.secretBoxKey +newKey = Key <$> randomByteString Bytes.secretBoxKey -- | Creates a random nonce of the correct size for 'secretbox'. newNonce :: IO Nonce -newNonce = Nonce <$> randomVector Bytes.secretBoxNonce +newNonce = Nonce <$> randomByteString Bytes.secretBoxNonce -- | Encrypts a message. It is infeasible for an attacker to decrypt -- the message so long as the 'Nonce' is never repeated. @@ -97,14 +98,32 @@ -> ByteString -- ^ Ciphertext secretbox (Key key) (Nonce nonce) msg = - unpad' . snd . buildUnsafeCVector len $ \pc -> - constVectors [key, pad' msg, nonce] $ \ + unpad' . snd . buildUnsafeByteString len $ \pc -> + constByteStrings [key, pad' msg, nonce] $ \ [(pk, _), (pm, _), (pn, _)] -> c_secretbox pc pm (fromIntegral len) pn pk where len = S.length msg + Bytes.secretBoxZero pad' = pad Bytes.secretBoxZero unpad' = unpad Bytes.secretBoxBoxZero +-- | Encrypts a message. In contrast with 'secretbox', the result is not +-- serialized as one element and instead provided as an authentication tag and +-- ciphertext. +secretboxDetached :: Key -> Nonce + -> ByteString + -- ^ Message + -> (ByteString,ByteString) + -- ^ (Authentication Tag, Ciphertext) +secretboxDetached (Key key) (Nonce nonce) msg = + buildUnsafeByteString ctLen $ \pc -> + fmap snd . buildUnsafeByteString' tagLen $ \ptag -> + constByteStrings [key, msg, nonce] $ \ + [(pk, _), (pmsg, _), (pn, _)] -> + c_secretbox_detached pc ptag pmsg (fromIntegral ptLen) pn pk + where ctLen = ptLen + ptLen = S.length msg + tagLen = Bytes.secretBoxMac + -- | Decrypts a message. Returns 'Nothing' if the keys and message do -- not match. secretboxOpen :: Key -> Nonce @@ -113,8 +132,8 @@ -> Maybe ByteString -- ^ Message secretboxOpen (Key key) (Nonce nonce) cipher = - let (err, vec) = buildUnsafeCVector len $ \pm -> - constVectors [key, pad' cipher, nonce] $ \ + let (err, vec) = buildUnsafeByteString len $ \pm -> + constByteStrings [key, pad' cipher, nonce] $ \ [(pk, _), (pc, _), (pn, _)] -> c_secretbox_open pm pc (fromIntegral len) pn pk in hush . handleErrno err $ unpad' vec @@ -122,6 +141,25 @@ pad' = pad Bytes.secretBoxBoxZero unpad' = unpad Bytes.secretBoxZero +-- | Decrypts a message. Returns 'Nothing' if the keys and message do +-- not match. +secretboxOpenDetached :: Key -> Nonce + -> ByteString + -- ^ Auth Tag + -> ByteString + -- ^ Ciphertext + -> Maybe ByteString + -- ^ Message +secretboxOpenDetached (Key key) (Nonce nonce) tag cipher + | S.length tag /= Bytes.secretBoxMac = Nothing + | otherwise = + let (err, vec) = buildUnsafeByteString len $ \pm -> + constByteStrings [key, cipher, tag, nonce] $ \ + [(pk, _), (pc, _), (pt, _), (pn, _)] -> + c_secretbox_open_detached pm pc pt (fromIntegral len) pn pk + in hush . handleErrno err $ vec + where len = S.length cipher + -- | The secretbox C API uses 0-padded C strings. Always returns 0. foreign import ccall "crypto_secretbox" c_secretbox :: Ptr CChar @@ -136,6 +174,23 @@ -- ^ Constant key buffer -> IO CInt +-- | The secretbox_detached C API uses C strings. Always returns 0. +foreign import ccall "crypto_secretbox_detached" + c_secretbox_detached + :: Ptr CChar + -- ^ Ciphertext output buffer + -> Ptr CChar + -- ^ Authentication tag output buffer + -> Ptr CChar + -- ^ Constant message input buffer + -> CULLong + -- ^ Length of message input buffer (incl. 0s) + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + -- | The secretbox C API uses 0-padded C strings. Returns 0 if -- successful or -1 if verification failed. foreign import ccall "crypto_secretbox_open" @@ -145,6 +200,24 @@ -- ^ Constant 0-padded message input buffer -> CULLong -- ^ Length of message input buffer (incl. 0s) + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + +-- | The secretbox C API uses C strings. Returns 0 if +-- successful or -1 if verification failed. +foreign import ccall "crypto_secretbox_open_detached" + c_secretbox_open_detached + :: Ptr CChar + -- ^ Message output buffer + -> Ptr CChar + -- ^ Constant ciphertext input buffer + -> Ptr CChar + -- ^ Constant auth tag input buffer + -> CULLong + -- ^ Length of ciphertext input buffer -> Ptr CChar -- ^ Constant nonce buffer -> Ptr CChar diff --git a/src/Crypto/Saltine/Core/Sign.hs b/src/Crypto/Saltine/Core/Sign.hs --- a/src/Crypto/Saltine/Core/Sign.hs +++ b/src/Crypto/Saltine/Core/Sign.hs @@ -77,8 +77,8 @@ newKeypair = do -- This is a little bizarre and a likely source of errors. -- _err ought to always be 0. - ((_err, sk), pk) <- buildUnsafeCVector' Bytes.signPK $ \pkbuf -> - buildUnsafeCVector' Bytes.signSK $ \skbuf -> + ((_err, sk), pk) <- buildUnsafeByteString' Bytes.signPK $ \pkbuf -> + buildUnsafeByteString' Bytes.signSK $ \skbuf -> c_sign_keypair pkbuf skbuf return (SK sk, PK pk) @@ -91,8 +91,8 @@ -- ^ Signed message sign (SK k) m = unsafePerformIO $ alloca $ \psmlen -> do - (_err, sm) <- buildUnsafeCVector' (len + Bytes.sign) $ \psmbuf -> - constVectors [k, m] $ \[(pk, _), (pm, _)] -> + (_err, sm) <- buildUnsafeByteString' (len + Bytes.sign) $ \psmbuf -> + constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> c_sign psmbuf psmlen pm (fromIntegral len) pk smlen <- peek psmlen return $ S.take (fromIntegral smlen) sm @@ -108,8 +108,8 @@ -- ^ Maybe the restored message signOpen (PK k) sm = unsafePerformIO $ alloca $ \pmlen -> do - (err, m) <- buildUnsafeCVector' smlen $ \pmbuf -> - constVectors [k, sm] $ \[(pk, _), (psm, _)] -> + (err, m) <- buildUnsafeByteString' smlen $ \pmbuf -> + constByteStrings [k, sm] $ \[(pk, _), (psm, _)] -> c_sign_open pmbuf pmlen psm (fromIntegral smlen) pk mlen <- peek pmlen case err of @@ -125,8 +125,8 @@ -- ^ Signature signDetached (SK k) m = unsafePerformIO $ alloca $ \psmlen -> do - (_err, sm) <- buildUnsafeCVector' Bytes.sign $ \sigbuf -> - constVectors [k, m] $ \[(pk, _), (pm, _)] -> + (_err, sm) <- buildUnsafeByteString' Bytes.sign $ \sigbuf -> + constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> c_sign_detached sigbuf psmlen pm (fromIntegral len) pk smlen <- peek psmlen return $ S.take (fromIntegral smlen) sm @@ -141,7 +141,7 @@ -- ^ Message -> Bool signVerifyDetached (PK k) sig sm = unsafePerformIO $ - constVectors [k, sig, sm] $ \[(pk, _), (psig, _), (psm, _)] -> do + constByteStrings [k, sig, sm] $ \[(pk, _), (psig, _), (psm, _)] -> do res <- c_sign_verify_detached psig psm (fromIntegral len) pk return (res == 0) where len = S.length sm diff --git a/src/Crypto/Saltine/Core/Stream.hs b/src/Crypto/Saltine/Core/Stream.hs --- a/src/Crypto/Saltine/Core/Stream.hs +++ b/src/Crypto/Saltine/Core/Stream.hs @@ -93,12 +93,12 @@ -- | Creates a random key of the correct size for 'stream' and 'xor'. newKey :: IO Key -newKey = Key <$> randomVector Bytes.streamKey +newKey = Key <$> randomByteString Bytes.streamKey -- | Creates a random nonce of the correct size for 'stream' and -- 'xor'. newNonce :: IO Nonce -newNonce = Nonce <$> randomVector Bytes.streamNonce +newNonce = Nonce <$> randomByteString Bytes.streamNonce -- | Generates a cryptographic random stream indexed by the 'Key' and -- 'Nonce'. These streams are indistinguishable from random noise so @@ -107,8 +107,8 @@ -> ByteString -- ^ Cryptographic stream stream (Key key) (Nonce nonce) n = - snd . buildUnsafeCVector n $ \ps -> - constVectors [key, nonce] $ \[(pk, _), (pn, _)] -> + snd . buildUnsafeByteString n $ \ps -> + constByteStrings [key, nonce] $ \[(pk, _), (pn, _)] -> c_stream ps (fromIntegral n) pn pk -- | Computes the exclusive-or between a message and a cryptographic @@ -124,8 +124,8 @@ -> ByteString -- ^ Ciphertext xor (Key key) (Nonce nonce) msg = - snd . buildUnsafeCVector len $ \pc -> - constVectors [key, nonce, msg] $ \[(pk, _), (pn, _), (pm, _)] -> + snd . buildUnsafeByteString len $ \pc -> + constByteStrings [key, nonce, msg] $ \[(pk, _), (pn, _), (pm, _)] -> c_stream_xor pc pm (fromIntegral len) pn pk where len = S.length msg diff --git a/src/Crypto/Saltine/Core/Utils.hs b/src/Crypto/Saltine/Core/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Core/Utils.hs @@ -0,0 +1,5 @@ +module Crypto.Saltine.Core.Utils + (Crypto.Saltine.Internal.Util.randomByteString + ) where + +import qualified Crypto.Saltine.Internal.Util diff --git a/src/Crypto/Saltine/Internal/ByteSizes.hs b/src/Crypto/Saltine/Internal/ByteSizes.hs --- a/src/Crypto/Saltine/Internal/ByteSizes.hs +++ b/src/Crypto/Saltine/Internal/ByteSizes.hs @@ -35,8 +35,10 @@ multScalar, secretBoxKey, secretBoxNonce, + secretBoxMac, secretBoxZero, secretBoxBoxZero, + aead_xchacha20poly1305_ietf_ABYTES, sign, signPK, signSK, @@ -56,7 +58,7 @@ boxMac, boxBeforeNM, sealedBox :: Int onetime, onetimeKey :: Int mult, multScalar :: Int -secretBoxKey, secretBoxNonce, secretBoxZero, secretBoxBoxZero :: Int +secretBoxKey, secretBoxNonce, secretBoxMac, secretBoxZero, secretBoxBoxZero :: Int sign, signPK, signSK :: Int streamKey, streamNonce :: Int hash, shorthash, shorthashKey :: Int @@ -109,6 +111,8 @@ secretBoxKey = fromIntegral c_crypto_secretbox_keybytes -- | Size of a @crypto_secretbox@ nonce secretBoxNonce = fromIntegral c_crypto_secretbox_noncebytes +-- | Size of a @crypto_secretbox@ mac +secretBoxMac = fromIntegral c_crypto_secretbox_macbytes -- | Size of 0-padding prepended to messages before using -- @crypto_secretbox@ or after using @crypto_secretbox_open@ secretBoxZero = fromIntegral c_crypto_secretbox_zerobytes @@ -116,6 +120,9 @@ -- @crypto_secretbox_open@ or after using @crypto_secretbox@ secretBoxBoxZero = fromIntegral c_crypto_secretbox_boxzerobytes +aead_xchacha20poly1305_ietf_ABYTES :: Int +aead_xchacha20poly1305_ietf_ABYTES = fromIntegral c_crypto_aead_xchacha20poly1305_ietf_ABYTES + -- Signatures -- | The maximum size of a signature prepended to a message to form a -- signed message. @@ -185,6 +192,8 @@ c_crypto_secretbox_keybytes :: CSize foreign import ccall "crypto_secretbox_noncebytes" c_crypto_secretbox_noncebytes :: CSize +foreign import ccall "crypto_secretbox_macbytes" + c_crypto_secretbox_macbytes :: CSize foreign import ccall "crypto_secretbox_zerobytes" c_crypto_secretbox_zerobytes :: CSize foreign import ccall "crypto_secretbox_boxzerobytes" @@ -200,6 +209,13 @@ -- HARDCODED -- --------- + +-- | The size of a @crypto_aead_tag@. +-- +-- HARDCODED to be @crypto_aead_xchacha20poly1305_ietf_ABYTES@ for now until Sodium +-- exports the C constant (is a macro). +c_crypto_aead_xchacha20poly1305_ietf_ABYTES :: CSize +c_crypto_aead_xchacha20poly1305_ietf_ABYTES = 16 -- | The size of a @crypto_stream@ or @crypto_stream_xor@ -- key. HARDCODED to be @crypto_stream_xsalsa20@ for now until Sodium diff --git a/src/Crypto/Saltine/Internal/Util.hs b/src/Crypto/Saltine/Internal/Util.hs --- a/src/Crypto/Saltine/Internal/Util.hs +++ b/src/Crypto/Saltine/Internal/Util.hs @@ -58,33 +58,32 @@ where go 0 = True go _ = False --- | Convenience function for accessing constant C vectors --- Manual unfold of: @constVectors = runContT . mapM (ContT . V.unsafeWith)@ -constVectors :: [ByteString] -> ([CStringLen] -> IO b) -> IO b -constVectors = +-- | Convenience function for accessing constant C strings +constByteStrings :: [ByteString] -> ([CStringLen] -> IO b) -> IO b +constByteStrings = foldr (\v kk -> \k -> (unsafeUseAsCStringLen v) (\a -> kk (\as -> k (a:as)))) ($ []) --- | Slightly safer cousin to 'buildUnsafeCVector' that remains in the +-- | Slightly safer cousin to 'buildUnsafeByteString' that remains in the -- 'IO' monad. -buildUnsafeCVector' :: Int -> (Ptr CChar -> IO b) -> IO (b, ByteString) -buildUnsafeCVector' n k = do +buildUnsafeByteString' :: Int -> (Ptr CChar -> IO b) -> IO (b, ByteString) +buildUnsafeByteString' n k = do ph <- mallocBytes n bs <- unsafePackMallocCStringLen (ph, fromIntegral n) out <- unsafeUseAsCString bs k return (out, bs) -- | Extremely unsafe function, use with utmost care! Builds a new --- Vector using a ccall which is given access to the raw underlying +-- ByteString using a ccall which is given access to the raw underlying -- pointer. Overwrites are UNCHECKED and 'unsafePerformIO' is used so -- it's difficult to predict the timing of the 'ByteString' creation. -buildUnsafeCVector :: Int -> (Ptr CChar -> IO b) -> (b, ByteString) -buildUnsafeCVector n = unsafePerformIO . buildUnsafeCVector' n +buildUnsafeByteString :: Int -> (Ptr CChar -> IO b) -> (b, ByteString) +buildUnsafeByteString n = unsafePerformIO . buildUnsafeByteString' n -- | Build a sized random 'ByteString' using Sodium's bindings to -- @/dev/urandom@. -randomVector :: Int -> IO ByteString -randomVector n = - snd <$> buildUnsafeCVector' n (`c_randombytes_buf` fromIntegral n) +randomByteString :: Int -> IO ByteString +randomByteString n = + snd <$> buildUnsafeByteString' n (`c_randombytes_buf` fromIntegral n) -- | To prevent a dependency on package 'errors' hush :: Either s a -> Maybe a diff --git a/tests/AEADProperties.hs b/tests/AEADProperties.hs new file mode 100644 --- /dev/null +++ b/tests/AEADProperties.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module AEADProperties ( + testAEAD + ) where + +import Util +import Crypto.Saltine.Core.AEAD +import Crypto.Saltine.Class (decode,encode) +import Crypto.Saltine.Internal.ByteSizes as Bytes + +import qualified Data.ByteString as S +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck (Property, (==>)) +import Test.QuickCheck.Arbitrary + +instance Arbitrary Nonce where + arbitrary = + do bs <- S.pack <$> vector Bytes.secretBoxNonce + maybe (fail "impossible arbitrary failure.") pure (decode bs) + +instance Arbitrary Key where + arbitrary = + do bs <- S.pack <$> vector Bytes.secretBoxKey + maybe (fail "impossible arbitrary failure.") pure (decode bs) + +instance Show Key where + show = show . encode +instance Show Nonce where + show = show . encode + +-- | Ciphertext can be decrypted +rightInverseProp :: Key -> Nonce -> Message -> Message -> Bool +rightInverseProp k n (Message bs) (Message aad) = + Just bs == aeadOpen k n (aead k n bs aad) aad + +-- | Detached ciphertext/tag can be decrypted +rightInverseDetachedProp :: Key -> Nonce -> Message -> Message -> Bool +rightInverseDetachedProp k n (Message bs) (Message aad) = + let (tag,ct) = aeadDetached k n bs aad + in Just bs == aeadOpenDetached k n tag ct aad + +-- | Ciphertext cannot be decrypted if the ciphertext is perturbed +rightInverseFailureProp :: Key -> Nonce -> Message -> Message -> Perturb -> Property +rightInverseFailureProp k n (Message bs) (Message aad) p = + S.length bs /= 0 ==> + let ct = aead k n bs aad + fakeCT = perturb ct p + in fakeCT /= ct ==> Nothing == aeadOpen k n fakeCT aad + +-- | Ciphertext cannot be decrypted if the aad is perturbed +rightInverseAADFailureProp :: Key -> Nonce -> Message -> Message -> Message -> Property +rightInverseAADFailureProp k n (Message bs) (Message aad) (Message aad2) = + aad /= aad2 ==> Nothing == aeadOpen k n (aead k n bs aad) aad2 + +-- | Ciphertext cannot be decrypted if the tag is perturbed +rightInverseTagFailureProp :: Key -> Nonce -> Message -> Message -> Message -> Property +rightInverseTagFailureProp k n (Message bs) (Message aad) (Message newTag) = + let (tag,ct) = aeadDetached k n bs aad + in newTag /= tag ==> Nothing == aeadOpenDetached k n newTag ct aad + +-- | Ciphertext cannot be decrypted if the ciphertext is perturbed +rightInverseFailureDetachedProp :: Key -> Nonce -> Message -> Message -> Perturb -> Property +rightInverseFailureDetachedProp k n (Message bs) (Message aad) p@(Perturb pBytes) = + let (tag,ct) = aeadDetached k n bs aad + in S.length bs > length pBytes ==> + Nothing == aeadOpenDetached k n tag (perturb ct p) aad + +-- | Ciphertext cannot be decrypted with a different key +cannotDecryptKeyProp :: Key -> Key -> Nonce -> Message -> Message -> Property +cannotDecryptKeyProp k1 k2 n (Message bs) (Message aad) = + let ct = aead k1 n bs aad + in k1 /= k2 ==> Nothing == aeadOpen k2 n ct aad + +-- | Ciphertext cannot be decrypted with a different key +cannotDecryptKeyDetachedProp :: Key -> Key -> Nonce -> Message -> Message -> Property +cannotDecryptKeyDetachedProp k1 k2 n (Message bs) (Message aad) = + let (tag,ct) = aeadDetached k1 n bs aad + in k1 /= k2 ==> Nothing == aeadOpenDetached k2 n tag ct aad + +-- | Ciphertext cannot be decrypted with a different nonce +cannotDecryptNonceProp :: Key -> Nonce -> Nonce -> Message -> Message -> Property +cannotDecryptNonceProp k n1 n2 (Message bs) (Message aad) = + n1 /= n2 ==> Nothing == aeadOpen k n2 (aead k n1 bs aad) aad + +-- | Ciphertext cannot be decrypted with a different nonce +cannotDecryptNonceDetachedProp :: Key -> Nonce -> Nonce -> Message -> Message -> Property +cannotDecryptNonceDetachedProp k n1 n2 (Message bs) (Message aad) = + let (tag,ct) = aeadDetached k n1 bs aad + in n1 /= n2 ==> Nothing == aeadOpenDetached k n2 tag ct aad + +testAEAD :: Test +testAEAD = buildTest $ do + + return $ testGroup "...Internal.AEAD" [ + + testProperty "Can decrypt ciphertext" + $ rightInverseProp, + + testProperty "Can decrypt ciphertext (detached)" + $ rightInverseDetachedProp, + + testGroup "Cannot decrypt ciphertext when..." [ + + testProperty "... ciphertext is perturbed" + $ rightInverseFailureProp, + + testProperty "... AAD is perturbed" + $ rightInverseAADFailureProp, + + testProperty "... ciphertext is perturbed (detached)" + $ rightInverseFailureDetachedProp, + + testProperty "... tag is perturbed (detached)" + $ rightInverseTagFailureProp, + + testProperty "... using the wrong key" + $ cannotDecryptKeyProp, + + testProperty "... using the wrong key (detached)" + $ cannotDecryptKeyDetachedProp, + + testProperty "... using the wrong nonce" + $ cannotDecryptNonceProp, + + testProperty "... using the wrong nonce (detached" + $ cannotDecryptNonceDetachedProp + + ] + ] diff --git a/tests/BoxProperties.hs b/tests/BoxProperties.hs --- a/tests/BoxProperties.hs +++ b/tests/BoxProperties.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} module BoxProperties ( testBox @@ -7,6 +8,7 @@ import Util import Crypto.Saltine.Core.Box import qualified Data.ByteString as S +import Data.Monoid import Test.Framework.Providers.QuickCheck2 import Test.Framework @@ -19,20 +21,20 @@ Just bs == boxOpen pk1 sk2 n (box pk2 sk1 n bs) -- | Cannot decrypt without the corrent secret key -rightInverseFailureProp1 :: Keypair -> Keypair -> Nonce -> Message -> Bool -rightInverseFailureProp1 (sk1, pk1) (sk2, pk2) n (Message bs) = - Nothing == boxOpen pk1 (perturb sk2) n (box pk2 sk1 n bs) +rightInverseFailureProp1 :: Keypair -> Keypair -> Nonce -> Message -> Perturb -> Bool +rightInverseFailureProp1 (sk1, pk1) (sk2, pk2) n (Message bs) p = + Nothing == boxOpen pk1 (perturb sk2 ([0] <> p)) n (box pk2 sk1 n bs) -- | Cannot decrypt when not sent to you -rightInverseFailureProp2 :: Keypair -> Keypair -> Nonce -> Message -> Bool -rightInverseFailureProp2 (sk1, pk1) (sk2, pk2) n (Message bs) = - Nothing == boxOpen pk1 sk2 n (box (perturb pk2) sk1 n bs) +rightInverseFailureProp2 :: Keypair -> Keypair -> Nonce -> Message -> Perturb -> Bool +rightInverseFailureProp2 (sk1, pk1) (sk2, pk2) n (Message bs) p = + Nothing == boxOpen pk1 sk2 n (box (perturb pk2 p) sk1 n bs) -- | Ciphertext cannot be decrypted (verification failure) if the -- ciphertext is perturbed -rightInverseFailureProp3 :: Keypair -> Keypair -> Nonce -> Message -> Bool -rightInverseFailureProp3 (sk1, pk1) (sk2, pk2) n (Message bs) = - Nothing == boxOpen pk1 sk2 n (S.reverse $ box pk2 sk1 n bs) +rightInverseFailureProp3 :: Keypair -> Keypair -> Nonce -> Message -> Perturb -> Bool +rightInverseFailureProp3 (sk1, pk1) (sk2, pk2) n (Message bs) p = + Nothing == boxOpen pk1 sk2 n (perturb (box pk2 sk1 n bs) p) -- | Ciphertext cannot be decrypted with a different nonce cannotDecryptNonceProp @@ -58,9 +60,9 @@ -- | Perturbed ciphertext cannot be decrypted using combined keys rightInverseFailureAfterNMProp1 - :: CombinedKey -> CombinedKey -> Nonce -> Message -> Bool -rightInverseFailureAfterNMProp1 ck_1for2 ck_2for1 n (Message bs) = - Nothing == boxOpenAfterNM ck_2for1 n (S.reverse $ boxAfterNM ck_1for2 n bs) + :: CombinedKey -> CombinedKey -> Nonce -> Message -> Perturb -> Bool +rightInverseFailureAfterNMProp1 ck_1for2 ck_2for1 n (Message bs) p = + Nothing == boxOpenAfterNM ck_2for1 n (perturb (boxAfterNM ck_1for2 n bs) p) testBox :: Test testBox = buildTest $ do diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -3,6 +3,7 @@ module Main where import SecretBoxProperties (testSecretBox) +import AEADProperties (testAEAD) import BoxProperties (testBox) import SealedBoxProperties (testSealedBox) import StreamProperties (testStream) @@ -10,17 +11,29 @@ import OneTimeAuthProperties (testOneTimeAuth) import SignProperties (testSign) import ScalarMultProperties (testScalarMult) +import Crypto.Saltine import Test.Framework +runOpts :: RunnerOptions +runOpts = mempty { ropt_color_mode = Just ColorAlways + , ropt_test_options = Just testOpts + } + +testOpts :: TestOptions +testOpts = mempty { topt_maximum_generated_tests = Just 20000 } + main :: IO () -main = defaultMain [ - testBox, - testSealedBox, - testSecretBox, - testStream, - testAuth, - testOneTimeAuth, - testSign, - testScalarMult - ] +main = do + sodiumInit + flip defaultMainWithOpts runOpts [ + testBox, + testSealedBox, + testSecretBox, + testAEAD, + testStream, + testAuth, + testOneTimeAuth, + testSign, + testScalarMult + ] diff --git a/tests/OneTimeAuthProperties.hs b/tests/OneTimeAuthProperties.hs --- a/tests/OneTimeAuthProperties.hs +++ b/tests/OneTimeAuthProperties.hs @@ -14,7 +14,7 @@ testOneTimeAuth :: Test testOneTimeAuth = buildTest $ do k <- newKey - return $ testGroup "...Internal.Auth" [ + return $ testGroup "...Internal.Auth (one-time)" [ testProperty "Authenticates message" $ \(Message bs) -> verify k (auth k bs) bs == True diff --git a/tests/SealedBoxProperties.hs b/tests/SealedBoxProperties.hs new file mode 100644 --- /dev/null +++ b/tests/SealedBoxProperties.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} + +module SealedBoxProperties ( + testSealedBox +) where + +import Util +import Crypto.Saltine.Core.Box +import Data.Monoid + +import qualified Data.ByteString as S +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck.Property (ioProperty) + +-- | Ciphertext can be decrypted +rightInverseProp :: Keypair -> Message -> IO Bool +rightInverseProp (sk1, pk1) (Message bs) = do + enc <- boxSeal pk1 bs + return (Just bs == boxSealOpen pk1 sk1 enc) + +-- | Cannot decrypt without the correct secret key +rightInverseFailureProp1 :: Keypair -> Message -> Perturb -> IO Bool +rightInverseFailureProp1 (sk1, pk1) (Message bs) p = do + enc <- boxSeal pk1 bs + return (Nothing == boxSealOpen pk1 (perturb sk1 ([0] <> p)) enc) + +-- | Cannot decrypt without the correct public key +rightInverseFailureProp2 :: Keypair -> Message -> Perturb -> IO Bool +rightInverseFailureProp2 (sk1, pk1) (Message bs) p = do + enc <- boxSeal pk1 bs + return (Nothing == boxSealOpen (perturb pk1 p) sk1 enc) + +-- | Cannot decrypt when not sent to you +rightInverseFailureProp3 :: Keypair -> Message -> Perturb -> IO Bool +rightInverseFailureProp3 (sk1, pk1) (Message bs) p = do + enc <- boxSeal (perturb pk1 p) bs + return (Nothing == boxSealOpen pk1 sk1 enc) + +-- | Ciphertext cannot be decrypted (verification failure) if the +-- ciphertext is perturbed +rightInverseFailureProp4 :: Keypair -> Message -> Perturb -> IO Bool +rightInverseFailureProp4 (sk1, pk1) (Message bs) p = do + enc <- boxSeal pk1 bs + return (Nothing == boxSealOpen pk1 sk1 (perturb enc p)) + +testSealedBox :: Test +testSealedBox = buildTest $ do + + (sk1, pk1) <- newKeypair + + return $ testGroup "... SealedBox" [ + + testGroup "Can decrypt ciphertext using..." [ + testProperty "... public key/secret key" + $ ioProperty . rightInverseProp (sk1, pk1) + ], + + testGroup "Fail to verify ciphertext when..." [ + testProperty "... not using proper secret key" + $ ioProperty . uncurry (rightInverseFailureProp1 (sk1, pk1)), + + testProperty "... not using proper public key" + $ ioProperty . uncurry (rightInverseFailureProp2 (sk1, pk1)), + + testProperty "... not actually sent to you" + $ ioProperty . uncurry (rightInverseFailureProp3 (sk1, pk1)), + + testProperty "... ciphertext has been perturbed" + $ ioProperty . uncurry ( rightInverseFailureProp4 (sk1, pk1) ) + ] + ] diff --git a/tests/SecretBoxProperties.hs b/tests/SecretBoxProperties.hs --- a/tests/SecretBoxProperties.hs +++ b/tests/SecretBoxProperties.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module SecretBoxProperties ( testSecretBox @@ -6,53 +7,112 @@ import Util import Crypto.Saltine.Core.SecretBox +import Crypto.Saltine.Class +import Crypto.Saltine.Internal.ByteSizes as Bytes import qualified Data.ByteString as S import Test.Framework.Providers.QuickCheck2 import Test.Framework +import Test.QuickCheck (Property, (==>)) +import Test.QuickCheck.Arbitrary +instance Arbitrary Nonce where + arbitrary = + do bs <- S.pack <$> vector Bytes.secretBoxNonce + maybe (fail "impossible arbitrary failure.") pure (decode bs) + +instance Arbitrary Key where + arbitrary = + do bs <- S.pack <$> vector Bytes.secretBoxKey + maybe (fail "impossible arbitrary failure.") pure (decode bs) +instance Show Key where + show = show . encode +instance Show Nonce where + show = show . encode + -- | Ciphertext can be decrypted rightInverseProp :: Key -> Nonce -> Message -> Bool rightInverseProp k n (Message bs) = Just bs == secretboxOpen k n (secretbox k n bs) +-- | Detached ciphertext/tag can be decrypted +rightInverseDetachedProp :: Key -> Nonce -> Message -> Bool +rightInverseDetachedProp k n (Message bs) = + Just bs == uncurry (secretboxOpenDetached k n) (secretboxDetached k n bs) + -- | Ciphertext cannot be decrypted if the ciphertext is perturbed -rightInverseFailureProp :: Key -> Nonce -> Message -> Bool -rightInverseFailureProp k n (Message bs) = - Nothing == secretboxOpen k n (S.reverse $ secretbox k n bs) +rightInverseFailureProp :: Key -> Nonce -> Message -> Perturb -> Property +rightInverseFailureProp k n (Message bs) p = + let ct = secretbox k n bs + fakeCT = perturb ct p + in ct /= fakeCT ==> Nothing == secretboxOpen k n fakeCT +-- | Ciphertext cannot be decrypted if the tag is perturbed +rightInverseTagFailureProp :: Key -> Nonce -> Message -> Message -> Property +rightInverseTagFailureProp k n (Message bs) (Message fakeTag) = + let (realTag, ct) = secretboxDetached k n bs + in realTag /= fakeTag ==> Nothing == secretboxOpenDetached k n fakeTag ct + +-- | Ciphertext cannot be decrypted if the ciphertext is perturbed +rightInverseFailureDetachedProp :: Key -> Nonce -> Message -> Perturb -> Property +rightInverseFailureDetachedProp k n (Message bs) p = + let (tag,ct) = secretboxDetached k n bs + fakeCT = perturb ct p + in fakeCT /= ct ==> Nothing == secretboxOpenDetached k n tag fakeCT + -- | Ciphertext cannot be decrypted with a different key -cannotDecryptKeyProp :: Key -> Key -> Nonce -> Message -> Bool +cannotDecryptKeyProp :: Key -> Key -> Nonce -> Message -> Property cannotDecryptKeyProp k1 k2 n (Message bs) = - Nothing == secretboxOpen k2 n (secretbox k1 n bs) + k1 /= k2 ==> Nothing == secretboxOpen k2 n (secretbox k1 n bs) +-- | Ciphertext cannot be decrypted with a different key +cannotDecryptKeyDetachedProp :: Key -> Key -> Nonce -> Message -> Property +cannotDecryptKeyDetachedProp k1 k2 n (Message bs) = + k1 /= k2 ==> Nothing == uncurry (secretboxOpenDetached k2 n) (secretboxDetached k1 n bs) + -- | Ciphertext cannot be decrypted with a different nonce -cannotDecryptNonceProp :: Key -> Nonce -> Nonce -> Message -> Bool +cannotDecryptNonceProp :: Key -> Nonce -> Nonce -> Message -> Property cannotDecryptNonceProp k n1 n2 (Message bs) = - Nothing == secretboxOpen k n2 (secretbox k n1 bs) + n1 /= n2 ==> Nothing == secretboxOpen k n2 (secretbox k n1 bs) +-- | Ciphertext cannot be decrypted with a different nonce +cannotDecryptNonceDetachedProp :: Key -> Nonce -> Nonce -> Message -> Property +cannotDecryptNonceDetachedProp k n1 n2 (Message bs) = + n1 /= n2 ==> Nothing == uncurry (secretboxOpenDetached k n2) (secretboxDetached k n1 bs) + testSecretBox :: Test testSecretBox = buildTest $ do - k1 <- newKey - k2 <- newKey - n1 <- newNonce - n2 <- newNonce return $ testGroup "...Internal.SecretBox" [ testProperty "Can decrypt ciphertext" - $ rightInverseProp k1 n1, + $ rightInverseProp, + testProperty "Can decrypt ciphertext (detached)" + $ rightInverseDetachedProp, + testGroup "Cannot decrypt ciphertext when..." [ testProperty "... ciphertext is perturbed" - $ rightInverseFailureProp k1 n1, + $ rightInverseFailureProp, + testProperty "... ciphertext is perturbed (detached)" + $ rightInverseFailureDetachedProp, + + testProperty "... tag is perturbed (detached)" + $ rightInverseTagFailureProp, + testProperty "... using the wrong key" - $ cannotDecryptKeyProp k1 k2 n1, + $ cannotDecryptKeyProp, + testProperty "... using the wrong key (detached)" + $ cannotDecryptKeyDetachedProp, + testProperty "... using the wrong nonce" - $ cannotDecryptNonceProp k1 n1 n2 + $ cannotDecryptNonceProp, + + testProperty "... using the wrong nonce (detached" + $ cannotDecryptNonceDetachedProp ] ] diff --git a/tests/Util.hs b/tests/Util.hs --- a/tests/Util.hs +++ b/tests/Util.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Util where import Crypto.Saltine.Class @@ -5,15 +8,42 @@ import Control.Applicative import Control.Monad (replicateM) import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 -import Data.Maybe (fromMaybe) +import Data.Monoid +import Data.Word (Word8) +import Data.Bits (xor) import Test.QuickCheck +import GHC.Exts (IsList(..)) +instance IsEncoding S.ByteString where + encode x = x + decode x = Just x -perturb :: IsEncoding a => a -> a -perturb a = fromMaybe (error "Util.perturb") - (decode (S.reverse (encode a))) +perturb :: IsEncoding a => a -> Perturb -> a +perturb a (Perturb p) = + let bytes = encode a + len = S.length bytes + plen = length p + fullP = p <> replicate (len - plen) 0 + newBytes = S.pack $ zipWith xor fullP (S.unpack bytes) + in case decode newBytes of + Nothing -> error "Invalid use of perturb on picky encoding." + Just x -> x +newtype Perturb = Perturb [Word8] + deriving (Show,Monoid) + +instance IsList Perturb where + type Item Perturb = Word8 + fromList = Perturb + toList (Perturb x) = x + +instance Arbitrary Perturb where + arbitrary = + do bs <- arbitrary + if all (==0) bs + then pure (Perturb (1:bs)) + else pure (Perturb bs) + newtype ByteString32 = ByteString32 S.ByteString deriving (Show) instance Arbitrary ByteString32 where @@ -22,7 +52,4 @@ newtype Message = Message S.ByteString deriving (Show) instance Arbitrary Message where - arbitrary = Message . S.intercalate (S8.pack " ") <$> listOf (oneof [ - return (S8.pack "word"), - return (S8.pack "other word") - ]) + arbitrary = Message . S.pack <$> arbitrary