saltine 0.0.1.0 → 0.1.0.0

raw patch · 21 files changed

+876/−207 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• saltine.cabal +13/−4
• src/Crypto/Saltine.hs +6/−9
• src/Crypto/Saltine/Core/AEAD.hs +256/−0
• src/Crypto/Saltine/Core/Auth.hs +4/−4
• src/Crypto/Saltine/Core/Box.hs +102/−95
• src/Crypto/Saltine/Core/Hash.hs +5/−5
• src/Crypto/Saltine/Core/OneTimeAuth.hs +4/−4
• src/Crypto/Saltine/Core/ScalarMult.hs +4/−4
• src/Crypto/Saltine/Core/SecretBox.hs +79/−6
• src/Crypto/Saltine/Core/Sign.hs +9/−9
• src/Crypto/Saltine/Core/Stream.hs +6/−6
• src/Crypto/Saltine/Core/Utils.hs +5/−0
• src/Crypto/Saltine/Internal/ByteSizes.hs +17/−1
• src/Crypto/Saltine/Internal/Util.hs +12/−13
• tests/AEADProperties.hs +132/−0
• tests/BoxProperties.hs +14/−12
• tests/Main.hs +23/−10
• tests/OneTimeAuthProperties.hs +1/−1
• tests/SealedBoxProperties.hs +73/−0
• tests/SecretBoxProperties.hs +75/−15
• tests/Util.hs +36/−9

@@ -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

@@ -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

@@ -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, <http://www-cse.ucsd.edu/~mihir/papers/oem.html>.+--+-- 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

@@ -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"

@@ -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.

@@ -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"

@@ -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 

@@ -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"

@@ -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

@@ -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

@@ -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 

@@ -0,0 +1,5 @@+module Crypto.Saltine.Core.Utils+    (Crypto.Saltine.Internal.Util.randomByteString+    ) where++import qualified Crypto.Saltine.Internal.Util

@@ -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

@@ -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

@@ -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++      ]+    ]

@@ -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

@@ -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+        ]

@@ -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

@@ -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) )+      ]+    ]

@@ -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        ]     ]

@@ -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