diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,51 @@ +# Changelog +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) + +## [Unreleased] +### Added +### Changed + +## [0.2.2.0] - 2025-02-22 +### Added +- SHA256 support, thanks [@jmazon](https://github.com/jmazon) +- Ed25519 to Curve25519 conversion support, thanks [@jmazon](https://github.com/jmazon) +### Changed +- Version bounds relaxed + +## [0.2.1.0] - 2023-02-17 +### Changed +- Fix Show instances formatting, and add instances for Keypairs, thanks [@NicolasT](https://github.com/NicolasT) + +## [0.2.0.1] - 2022-04-30 +### Changed +- Relax version bounds on text and bytestring, thanks [@ysangkok](https://github.com/ysangkok) + +## [0.2.0.0] - 2021-05-27 +### Added +- All AEAD variants are now in saltine +- Key comparisons now use sodium_memcmp to prevent timing attacks +- Liberal use of Internal modules +- Benchmarks added +- Export Key/Nonce/… constructors from Internal module +- New password hashing module +- Show instances for most (all?) relevant data types +- Signature types for detached functions + +### Changed +- newtype accessor functions added, keypairs are separate data types now instead +of tuples + +## [0.1.1.1] - 2021-01-15 +### Changed +- Fix for running tests in `cabal repl` (thanks [@timds]) +- Allow newer profunctors + +## [0.1.1.0] - 2020-02-29 +### Added +- bindings to generichash (Blake2), thanks [@donatello](https://github.com/donatello) + +### Changed +- Don't use `fail` in tests to fix compilation with GHC 8.8 +- Windows install instructions added, thanks [@tmcl](https://github.com/tmcl) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,69 @@ +# Saltine 0.2.2.0 [![Hackage version](https://img.shields.io/hackage/v/saltine.svg?colorB=4FB900)](https://hackage.haskell.org/package/saltine) + +A Haskell binding for @jedisct1's portable binding for djb's +NaCl. **This is an early release.** Please try it out, but don't just +yet stake your life or job on it. + +It is imperative you call `sodiumInit` before using any other function. + +``` haskell +import Crypto.Saltine +import Crypto.Saltine.Core.SecretBox +import qualified Data.ByteString.Char8 as BSC8 + +main = do + sodiumInit + k <- newKey + n <- newNonce + let ciphertext = secretbox k n (BSC8.pack "foobar") + print $ secretboxOpen k n ciphertext + +-- Just "foobar" +``` + +In +[*The Security Impact of a New Cryptographic Library*](http://cryptojedi.org/papers/coolnacl-20111201.pdf) +Bernstein, Lange, and Schwabe argue that high-level cryptographic +libraries eliminate whole spaces of cryptographic disasters which are +nigh inevitable whenever programmers use low-level crypto primitives. + +* [Security Stack Exchange: Why Shouldn't We Roll Our Own?](http://security.stackexchange.com/questions/18197/why-shouldnt-we-roll-our-own) +* [Hacker News on "All the Crypto Code You've Ever Written is Probably Broken"](https://news.ycombinator.com/item?id=4779015) +* [Stack Overflow: When can you trust yourself to implement cryptography based solutions?](http://stackoverflow.com/questions/1914257/when-can-you-trust-yourself-to-implement-cryptography-based-solutions) +* [Coding Horror: Why isn't my encryption... encrypting?](http://www.codinghorror.com/blog/2009/05/why-isnt-my-encryption-encrypting.html) + +Crypto is complicated, so pre-rolled solutions are important +prevention mechanisms. + +[NaCl](http://nacl.cr.yp.to/) is Bernstein, Lange, and Schwabe's +solution: a high-level, performant cryptography library with a no-fuss +interface. [Saltine](http://github.com/tel/saltine) is a Haskell +binding to NaCl (via +[`libsodium`](https://github.com/jedisct1/libsodium)) which hopes to +provide even more simplicity and safety to the usage of cryptography. + +Note that it's still possible to shoot yourself in the foot pretty +easily using Saltine. Nonces must always be unique which must be managed +by the library user. +[`Crypto.Saltine.Core.Stream`](https://github.com/tel/saltine/blob/master/src/Crypto/Saltine/Core/Stream.hs) +produces messages which can beundetectably tampered with in-flight. +Keys are insecurely read from disk—they may be copied and then paged +back to disk. + +When uncertain, use [`Crypto.Saltine.Core.SecretBox`](https://github.com/tel/saltine/blob/master/src/Crypto/Saltine/Core/SecretBox.hs) +and [`Crypto.Saltine.Core.Box`](https://github.com/tel/saltine/blob/master/src/Crypto/Saltine/Core/Box.hs). +If you can think of ways to use Haskell's type system to enforce +security invariants, please suggest them. + +To use it on Windows systems, download +[a prebuild libsodium-\*-stable-mingw.tar.gz file](https://download.libsodium.org/libsodium/releases/) +and copy the files in `libsodium-win64` into the equivalent places +in `C:\Program Files\Haskell Platform\*\mingw`. Then just add saltine +to your cabal file and watch it go. + +Tested with [`libsodium-1.0.18`](https://download.libsodium.org/libsodium/releases/). + +Inspired by @thoughtpolice's +[`salt`](http://github.com/thoughtpolice/salt) library. `salt` also +binds to NaCl, but uses a Haskell managed version of djb's code +instead of `libsodium`. diff --git a/bench/AES256GCMBench.hs b/bench/AES256GCMBench.hs new file mode 100644 --- /dev/null +++ b/bench/AES256GCMBench.hs @@ -0,0 +1,68 @@ +module AES256GCMBench (benchAes256GCM, aes256GCMEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.AEAD.AES256GCM as G + +import BenchUtils + +aes256GCMEnv :: IO Key +aes256GCMEnv = newKey + +benchAes256GCM :: Key -> Benchmark +benchAes256GCM k = do + let encrypt :: ByteString -> ByteString -> IO ByteString + encrypt msg aad = newNonce >>= \n -> pure $ G.aead k n msg aad + + decrypt :: ByteString -> ByteString -> IO (Maybe ByteString) + decrypt msg aad = do + n <- newNonce + let ciphertext = G.aead k n msg aad + return $ G.aeadOpen k n ciphertext aad + + encryptDetached msg aad = newNonce >>= \n -> pure $ G.aeadDetached k n msg aad + decryptDetached msg aad = do + n <- newNonce + let (t,c) = G.aeadDetached k n msg aad + pure $ G.aeadOpenDetached k n t c aad + + bgroup "AES256GCM" + [ bench "newKey" $ nfIO newKey + , bgroup "aead" + [ bench "128 B + 128 B" $ nfIO $ encrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encrypt mb5 mb5 + ] + , bgroup "aead + open" + [ bench "128 B + 128 B" $ nfIO $ decrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decrypt mb5 mb5 + ] + , bgroup "aeadDetached" + [ bench "128 B + 128 B" $ nfIO $ encryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encryptDetached mb5 mb5 + ] + , bgroup "aeadDetached + openDetached" + [ bench "128 B + 128 B" $ nfIO $ decryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decryptDetached mb5 mb5 + ] + ] diff --git a/bench/AuthBench.hs b/bench/AuthBench.hs new file mode 100644 --- /dev/null +++ b/bench/AuthBench.hs @@ -0,0 +1,37 @@ +module AuthBench (benchAuth, authEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.Auth + +import BenchUtils + + +authEnv :: IO Key +authEnv = newKey + +benchAuth :: Key -> Benchmark +benchAuth k = do + let authVerify :: ByteString -> Bool + authVerify message = do + let authenticator = auth k message + verify k authenticator message + + bgroup "Auth" + [ bench "newKey" $ nfIO newKey + , bgroup "auth" + [ bench "128 B" $ nf (auth k) bs128 + , bench "1 MB" $ nf (auth k) mb1 + , bench "5 MB" $ nf (auth k) mb5 + ] + , bgroup "auth+verify" + [ bench "128 B" $ nf authVerify bs128 + , bench "1 MB" $ nf authVerify mb1 + , bench "5 MB" $ nf authVerify mb5 + ] + ] diff --git a/bench/BenchUtils.hs b/bench/BenchUtils.hs new file mode 100644 --- /dev/null +++ b/bench/BenchUtils.hs @@ -0,0 +1,15 @@ +module BenchUtils where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS + +import Data.Text as T + +bs128, kb2, mb1, mb5 :: ByteString +bs128 = BS.replicate 128 0 +kb2 = BS.replicate 2000 0 +mb1 = BS.replicate 1000000 0 +mb5 = BS.replicate 5000000 0 + +s128 = T.replicate 128 (T.pack "0") +s2000 = T.replicate 2000 (T.pack "0") diff --git a/bench/BoxBench.hs b/bench/BoxBench.hs new file mode 100644 --- /dev/null +++ b/bench/BoxBench.hs @@ -0,0 +1,45 @@ +module BoxBench (benchBox, boxEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.Box + +import BenchUtils + + +boxEnv :: IO (Keypair, Keypair) +boxEnv = do + alice <- newKeypair + bob <- newKeypair + return (alice, bob) + + +benchBox :: (Keypair, Keypair) -> Benchmark +benchBox (alice, bob) = do + let encrypt :: ByteString -> IO ByteString + encrypt b = newNonce >>= \n -> pure $ box (publicKey bob) (secretKey alice) n b + + decrypt :: ByteString -> IO (Maybe ByteString) + decrypt message = do + n <- newNonce + let ciphertext = box (publicKey alice) (secretKey bob) n message + return $ boxOpen (publicKey bob) (secretKey alice) n ciphertext + + bgroup "Box" + [ bench "newKeypair" $ nfIO newKeypair + , bgroup "encrypt" + [ bench "128 B" $ nfIO $ encrypt bs128 + , bench "1 MB" $ nfIO $ encrypt mb1 + , bench "5 MB" $ nfIO $ encrypt mb5 + ] + , bgroup "encrypt+decrypt" + [ bench "128 B" $ nfIO $ decrypt bs128 + , bench "1 MB" $ nfIO $ decrypt mb1 + , bench "5 MB" $ nfIO $ decrypt mb5 + ] + ] diff --git a/bench/ChaCha20Poly1305Bench.hs b/bench/ChaCha20Poly1305Bench.hs new file mode 100644 --- /dev/null +++ b/bench/ChaCha20Poly1305Bench.hs @@ -0,0 +1,68 @@ +module ChaCha20Poly1305Bench (benchChaCha20Poly1305, chaCha20Poly1305Env) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.AEAD.ChaCha20Poly1305 as C + +import BenchUtils + +chaCha20Poly1305Env :: IO Key +chaCha20Poly1305Env = newKey + +benchChaCha20Poly1305 :: Key -> Benchmark +benchChaCha20Poly1305 k = do + let encrypt :: ByteString -> ByteString -> IO ByteString + encrypt msg aad = newNonce >>= \n -> pure $ C.aead k n msg aad + + decrypt :: ByteString -> ByteString -> IO (Maybe ByteString) + decrypt msg aad = do + n <- newNonce + let ciphertext = C.aead k n msg aad + return $ C.aeadOpen k n ciphertext aad + + encryptDetached msg aad = newNonce >>= \n -> pure $ C.aeadDetached k n msg aad + decryptDetached msg aad = do + n <- newNonce + let (t,c) = C.aeadDetached k n msg aad + pure $ C.aeadOpenDetached k n t c aad + + bgroup "ChaCha20Poly1305" + [ bench "newKey" $ nfIO newKey + , bgroup "aead" + [ bench "128 B + 128 B" $ nfIO $ encrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encrypt mb5 mb5 + ] + , bgroup "aead + open" + [ bench "128 B + 128 B" $ nfIO $ decrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decrypt mb5 mb5 + ] + , bgroup "aeadDetached" + [ bench "128 B + 128 B" $ nfIO $ encryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encryptDetached mb5 mb5 + ] + , bgroup "aeadDetached + openDetached" + [ bench "128 B + 128 B" $ nfIO $ decryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decryptDetached mb5 mb5 + ] + ] diff --git a/bench/ChaCha20Poly1305IETFBench.hs b/bench/ChaCha20Poly1305IETFBench.hs new file mode 100644 --- /dev/null +++ b/bench/ChaCha20Poly1305IETFBench.hs @@ -0,0 +1,68 @@ +module ChaCha20Poly1305IETFBench (benchChaCha20Poly1305IETF, chaCha20Poly1305IETFEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.AEAD.ChaCha20Poly1305IETF as C + +import BenchUtils + +chaCha20Poly1305IETFEnv :: IO Key +chaCha20Poly1305IETFEnv = newKey + +benchChaCha20Poly1305IETF :: Key -> Benchmark +benchChaCha20Poly1305IETF k = do + let encrypt :: ByteString -> ByteString -> IO ByteString + encrypt msg aad = newNonce >>= \n -> pure $ C.aead k n msg aad + + decrypt :: ByteString -> ByteString -> IO (Maybe ByteString) + decrypt msg aad = do + n <- newNonce + let ciphertext = C.aead k n msg aad + return $ C.aeadOpen k n ciphertext aad + + encryptDetached msg aad = newNonce >>= \n -> pure $ C.aeadDetached k n msg aad + decryptDetached msg aad = do + n <- newNonce + let (t,c) = C.aeadDetached k n msg aad + pure $ C.aeadOpenDetached k n t c aad + + bgroup "ChaCha20Poly1305IETF" + [ bench "newKey" $ nfIO newKey + , bgroup "aead" + [ bench "128 B + 128 B" $ nfIO $ encrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encrypt mb5 mb5 + ] + , bgroup "aead + open" + [ bench "128 B + 128 B" $ nfIO $ decrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decrypt mb5 mb5 + ] + , bgroup "aeadDetached" + [ bench "128 B + 128 B" $ nfIO $ encryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encryptDetached mb5 mb5 + ] + , bgroup "aeadDetached + openDetached" + [ bench "128 B + 128 B" $ nfIO $ decryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decryptDetached mb5 mb5 + ] + ] diff --git a/bench/ConstantTimeBench.hs b/bench/ConstantTimeBench.hs new file mode 100644 --- /dev/null +++ b/bench/ConstantTimeBench.hs @@ -0,0 +1,29 @@ +module ConstantTimeBench (benchComparison) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.Auth as A +import Crypto.Saltine.Class +import Crypto.Saltine.Internal.Util as U + +import BenchUtils + +benchComparison :: Benchmark +benchComparison = + bgroup "ConstantTime" + [ bench "Compare two \"keys\" using ByteString comparison" $ nfIO $ do + k1 <- randomByteString (2^20) + k2 <- randomByteString (2^20) + + pure $ k1 == k2 + , bench "Compare two keys using constant-time comparison" $ nfIO $ do + k1 <- randomByteString (2^20) + k2 <- randomByteString (2^20) + + pure $ U.compare k1 k2 + ] diff --git a/bench/HashBench.hs b/bench/HashBench.hs new file mode 100644 --- /dev/null +++ b/bench/HashBench.hs @@ -0,0 +1,40 @@ +module HashBench (benchHash, hashEnv) where + +import Criterion + +import Control.Monad + +import Crypto.Saltine.Core.Hash +import Crypto.Saltine.Core.Utils + +import BenchUtils +import Data.Maybe (fromJust) + +hashEnv :: IO (ShorthashKey, GenerichashKey, GenerichashOutLen) +hashEnv = do + shk <- newShorthashKey + ghk <- fromJust <$> newGenerichashKey 48 + let ghol = fromJust (generichashOutLen 48) + + pure (shk,ghk,ghol) + +benchHash :: (ShorthashKey, GenerichashKey, GenerichashOutLen) -> Benchmark +benchHash (shk,ghk,ghol) = + bgroup "Hash" + [ bgroup "hash" + [ bench "128 B" $ nf hash bs128 + , bench "1 MB" $ nf hash mb1 + , bench "5 MB" $ nf hash mb5 + ] + , bgroup "shortHash" + [ bench "128 B" $ nf (shorthash shk) bs128 + , bench "2 KB" $ nf (shorthash shk) kb2 + , bench "1 MB" $ nf (shorthash shk) mb1 + ] + , bgroup "genericHash" + [ bench "128 B" $ nf (generichash ghk bs128) ghol + , bench "2 KB" $ nf (generichash ghk kb2 ) ghol + , bench "1 MB" $ nf (generichash ghk mb1 ) ghol + , bench "5 MB" $ nf (generichash ghk mb5 ) ghol + ] + ] diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,79 @@ +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception + +import AuthBench +import OneTimeAuthBench +import BoxBench +import SecretBoxBench +import ConstantTimeBench +import HashBench +import RandomBench +import ScalarMultBench +import SignBench +import StreamBench +import PasswordBench +import AES256GCMBench +import ChaCha20Poly1305Bench +import ChaCha20Poly1305IETFBench +import XChaCha20Poly1305Bench + +main :: IO () +main = do + authKeyToEval <- authEnv + authKey <- evaluate $ force authKeyToEval + + oneTimeAuthKeyToEval <- oneTimeAuthEnv + oneTimeAuthKey <- evaluate $ force oneTimeAuthKeyToEval + + boxToEval <- boxEnv + boxKeys <- evaluate $ force boxToEval + + secretboxKeyToEval <- secretboxEnv + secretboxKey <- evaluate $ force secretboxKeyToEval + + scmlToEval <- scalarMultEnv + scml <- evaluate $ force scmlToEval + + signToEval <- signEnv + signKey <- evaluate $ force signToEval + + streamKeyToEval <- streamEnv + streamKey <- evaluate $ force streamKeyToEval + + passwordSaltToEval <- passwordEnv + passwordSalt <- evaluate $ force passwordSaltToEval + + hashKeysToEval <- hashEnv + hashKeys <- evaluate $ force hashKeysToEval + + aes256GCMKeyToEval <- aes256GCMEnv + aes256GCMKey <- evaluate $ force aes256GCMKeyToEval + + chaCha20Poly1305KeyToEval <- chaCha20Poly1305Env + chaCha20Poly1305Key <- evaluate $ force chaCha20Poly1305KeyToEval + + chaCha20Poly1305IETFKeyToEval <- chaCha20Poly1305IETFEnv + chaCha20Poly1305IETFKey <- evaluate $ force chaCha20Poly1305IETFKeyToEval + + xChaCha20Poly1305KeyToEval <- xChaCha20Poly1305Env + xChaCha20Poly1305Key <- evaluate $ force xChaCha20Poly1305KeyToEval + + defaultMain [ + benchAuth authKey + , benchOneTimeAuth oneTimeAuthKey + , benchBox boxKeys + , benchSecretbox secretboxKey + , benchHash hashKeys + , benchScalarMult scml + , benchSign signKey + , benchStream streamKey + , benchPassword passwordSalt + , benchComparison + , benchAes256GCM aes256GCMKey + , benchChaCha20Poly1305 chaCha20Poly1305Key + , benchChaCha20Poly1305IETF chaCha20Poly1305IETFKey + , benchXChaCha20Poly1305 xChaCha20Poly1305Key + ] diff --git a/bench/OneTimeAuthBench.hs b/bench/OneTimeAuthBench.hs new file mode 100644 --- /dev/null +++ b/bench/OneTimeAuthBench.hs @@ -0,0 +1,37 @@ +module OneTimeAuthBench (benchOneTimeAuth, oneTimeAuthEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.OneTimeAuth + +import BenchUtils + + +oneTimeAuthEnv :: IO Key +oneTimeAuthEnv = newKey + +benchOneTimeAuth :: Key -> Benchmark +benchOneTimeAuth k = do + let authVerify :: ByteString -> Bool + authVerify message = do + let authenticator = auth k message + verify k authenticator message + + bgroup "OneTimeAuth" + [ bench "newKey" $ nfIO newKey + , bgroup "auth" + [ bench "128 B" $ nf (auth k) bs128 + , bench "1 MB" $ nf (auth k) mb1 + , bench "5 MB" $ nf (auth k) mb5 + ] + , bgroup "auth+verify" + [ bench "128 B" $ nf authVerify bs128 + , bench "1 MB" $ nf authVerify mb1 + , bench "5 MB" $ nf authVerify mb5 + ] + ] diff --git a/bench/PasswordBench.hs b/bench/PasswordBench.hs new file mode 100644 --- /dev/null +++ b/bench/PasswordBench.hs @@ -0,0 +1,87 @@ +module PasswordBench (benchPassword, passwordEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS +import Data.Maybe (fromJust) +import Data.Text (Text) + +import Crypto.Saltine.Core.Password as P + +import BenchUtils + +passwordEnv :: IO Salt +passwordEnv = newSalt + +benchPassword :: Salt -> Benchmark +benchPassword s = do + let hashAndVerify :: Text -> Policy -> IO Bool + hashAndVerify p pol = do + h <- pwhashStr p pol + pure $ pwhashStrVerify (fromJust h) p + + hashAndRehash :: Text -> Policy -> IO (Maybe Bool) + hashAndRehash p pol = do + h <- pwhashStr p pol + pure $ needsRehash (opsPolicy pol) (memPolicy pol) (fromJust h) + + bgroup "Password" + [ bench "newSalt" $ nfIO newSalt + , bgroup "hash + verify" + [ bgroup "interactive" + [ bench "128 B" $ nfIO $ hashAndVerify s128 interactivePolicy + , bench "2 KB" $ nfIO $ hashAndVerify s2000 interactivePolicy + ] + , bgroup "moderate" + [ bench "128 B" $ nfIO $ hashAndVerify s128 moderatePolicy + , bench "2 KB" $ nfIO $ hashAndVerify s2000 moderatePolicy + ] + , bgroup "sensitive" + [ bench "128 B" $ nfIO $ hashAndVerify s128 sensitivePolicy + , bench "2 KB" $ nfIO $ hashAndVerify s2000 sensitivePolicy + ] + ] + , bgroup "needsRehash" + [ bgroup "interactive" + [ bench "128 B" $ nfIO $ hashAndRehash s128 interactivePolicy + , bench "2 KB" $ nfIO $ hashAndRehash s2000 interactivePolicy + ] + , bgroup "moderate" + [ bench "128 B" $ nfIO $ hashAndRehash s128 moderatePolicy + , bench "2 KB" $ nfIO $ hashAndRehash s2000 moderatePolicy + ] + , bgroup "sensitive" + [ bench "128 B" $ nfIO $ hashAndRehash s128 sensitivePolicy + , bench "2 KB" $ nfIO $ hashAndRehash s2000 sensitivePolicy + ] + ] + , bgroup "pwhash" + [ bgroup "interactive" + [ bench "128 B + 256" $ nf (pwhash s128 (2^8 ) s) interactivePolicy + , bench "128 B + 512" $ nf (pwhash s128 (2^9 ) s) interactivePolicy + , bench "128 B + 1024" $ nf (pwhash s128 (2^10) s) interactivePolicy + , bench "128 B + 2048" $ nf (pwhash s128 (2^11) s) interactivePolicy + , bench "128 B + 4096" $ nf (pwhash s128 (2^12) s) interactivePolicy + , bench "128 B + 8192" $ nf (pwhash s128 (2^13) s) interactivePolicy + ] + , bgroup "moderate" + [ bench "128 B + 256" $ nf (pwhash s128 (2^8 ) s) moderatePolicy + , bench "128 B + 512" $ nf (pwhash s128 (2^9 ) s) moderatePolicy + , bench "128 B + 1024" $ nf (pwhash s128 (2^10) s) moderatePolicy + , bench "128 B + 2048" $ nf (pwhash s128 (2^11) s) moderatePolicy + , bench "128 B + 4096" $ nf (pwhash s128 (2^12) s) moderatePolicy + , bench "128 B + 8192" $ nf (pwhash s128 (2^13) s) moderatePolicy + ] + , bgroup "sensitive" + [ bench "128 B + 256" $ nf (pwhash s128 (2^8 ) s) sensitivePolicy + , bench "128 B + 512" $ nf (pwhash s128 (2^9 ) s) sensitivePolicy + , bench "128 B + 1024" $ nf (pwhash s128 (2^10) s) sensitivePolicy + , bench "128 B + 2048" $ nf (pwhash s128 (2^11) s) sensitivePolicy + , bench "128 B + 4096" $ nf (pwhash s128 (2^12) s) sensitivePolicy + , bench "128 B + 8192" $ nf (pwhash s128 (2^13) s) sensitivePolicy + ] + ] + ] diff --git a/bench/RandomBench.hs b/bench/RandomBench.hs new file mode 100644 --- /dev/null +++ b/bench/RandomBench.hs @@ -0,0 +1,21 @@ +module RandomBench (benchRandom) where + +import Criterion + +import Data.ByteString (ByteString) +import Crypto.Saltine.Core.Utils + +benchRandom = bgroup "random" + [ bench "32 B" $ nfIO (randomByteString 32 :: IO ByteString) + , bench "128 B" $ nfIO (randomByteString 128 :: IO ByteString) + , bench "512 B" $ nfIO (randomByteString 512 :: IO ByteString) + , bench "2 KB" $ nfIO (randomByteString 2000 :: IO ByteString) + , bench "8 KB" $ nfIO (randomByteString 8000 :: IO ByteString) + , bench "32 KB" $ nfIO (randomByteString 32000 :: IO ByteString) + , bench "128 KB" $ nfIO (randomByteString 128000 :: IO ByteString) + , bench "512 KB" $ nfIO (randomByteString 512000 :: IO ByteString) + , bench "2 MB" $ nfIO (randomByteString 2000000 :: IO ByteString) + , bench "8 MB" $ nfIO (randomByteString 8000000 :: IO ByteString) + , bench "32 MB" $ nfIO (randomByteString 32000000 :: IO ByteString) + , bench "128 MB" $ nfIO (randomByteString 128000000 :: IO ByteString) + ] diff --git a/bench/ScalarMultBench.hs b/bench/ScalarMultBench.hs new file mode 100644 --- /dev/null +++ b/bench/ScalarMultBench.hs @@ -0,0 +1,35 @@ +module ScalarMultBench (benchScalarMult, scalarMultEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Data.Maybe (fromJust) + +import Crypto.Saltine.Class +import Crypto.Saltine.Core.ScalarMult as S +import Crypto.Saltine.Internal.ScalarMult as Bytes +import Crypto.Saltine.Internal.Util + +import BenchUtils + +scalarMultEnv :: IO (GroupElement, Scalar) +scalarMultEnv = do + bsge <- randomByteString Bytes.scalarmult_bytes + bssc <- randomByteString Bytes.scalarmult_scalarbytes + + let ge = fromJust $ decode bsge + let sc = fromJust $ decode bssc + + pure (ge,sc) + + +benchScalarMult :: (GroupElement, Scalar) -> Benchmark +benchScalarMult (ge,sc) = + bgroup "ScalarMult" + [ bench "mult" $ nf (S.mult sc) ge + , bench "multBase" $ nf S.multBase sc + ] diff --git a/bench/SecretBoxBench.hs b/bench/SecretBoxBench.hs new file mode 100644 --- /dev/null +++ b/bench/SecretBoxBench.hs @@ -0,0 +1,57 @@ +module SecretBoxBench (benchSecretbox, secretboxEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.SecretBox + +import BenchUtils + + +secretboxEnv :: IO Key +secretboxEnv = newKey + +benchSecretbox :: Key -> Benchmark +benchSecretbox k = do + let encrypt :: ByteString -> IO ByteString + encrypt msg = newNonce >>= \n -> pure $ secretbox k n msg + + decrypt :: ByteString -> IO (Maybe ByteString) + decrypt msg = do + n <- newNonce + let ciphertext = secretbox k n msg + return $ secretboxOpen k n ciphertext + + encryptDetached msg = newNonce >>= \n -> pure $ secretboxDetached k n msg + decryptDetached msg = do + n <- newNonce + let (t,c) = secretboxDetached k n msg + pure $ secretboxOpenDetached k n t c + + bgroup "Box" + [ bench "newKey" $ nfIO newKey + , bgroup "encrypt" + [ bench "128 B" $ nfIO $ encrypt bs128 + , bench "1 MB" $ nfIO $ encrypt mb1 + , bench "5 MB" $ nfIO $ encrypt mb5 + ] + , bgroup "encrypt+decrypt" + [ bench "128 B" $ nfIO $ decrypt bs128 + , bench "1 MB" $ nfIO $ decrypt mb1 + , bench "5 MB" $ nfIO $ decrypt mb5 + ] + , bgroup "encryptDetached" + [ bench "128 B" $ nfIO $ encryptDetached bs128 + , bench "1 MB" $ nfIO $ encryptDetached mb1 + , bench "5 MB" $ nfIO $ encryptDetached mb5 + ] + , bgroup "encryptDetached+decryptDetached" + [ bench "128 B" $ nfIO $ decryptDetached bs128 + , bench "1 MB" $ nfIO $ decryptDetached mb1 + , bench "5 MB" $ nfIO $ decryptDetached mb5 + ] + ] diff --git a/bench/SignBench.hs b/bench/SignBench.hs new file mode 100644 --- /dev/null +++ b/bench/SignBench.hs @@ -0,0 +1,53 @@ +module SignBench (benchSign, signEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.Sign as S + +import BenchUtils + +signEnv :: IO Keypair +signEnv = newKeypair + +benchSign :: Keypair -> Benchmark +benchSign alice = do + let sign :: ByteString -> ByteString + sign = S.sign (secretKey alice) + + verify :: ByteString -> Bool + verify message = + let signed = sign message + in case S.signOpen (publicKey alice) signed of + Nothing -> False + Just ms -> True + + signDetached = S.signDetached (secretKey alice) + signVerifyDetached message = S.signVerifyDetached (publicKey alice) (signDetached message) + bgroup "Sign" + [ bench "newKeypair" $ nfIO newKeypair + , bgroup "sign" + [ bench "128 B" $ nf sign bs128 + , bench "1 MB" $ nf sign mb1 + , bench "5 MB" $ nf sign mb5 + ] + , bgroup "sign+verify" + [ bench "128 B" $ nf verify bs128 + , bench "1 MB" $ nf verify mb1 + , bench "5 MB" $ nf verify mb5 + ] + , bgroup "signDetached" + [ bench "128 B" $ nf signDetached bs128 + , bench "1 MB" $ nf signDetached mb1 + , bench "5 MB" $ nf signDetached mb5 + ] + , bgroup "signDetached+verifyDetached" + [ bench "128 B" $ nf signVerifyDetached bs128 + , bench "1 MB" $ nf signVerifyDetached mb1 + , bench "5 MB" $ nf signVerifyDetached mb5 + ] + ] diff --git a/bench/StreamBench.hs b/bench/StreamBench.hs new file mode 100644 --- /dev/null +++ b/bench/StreamBench.hs @@ -0,0 +1,37 @@ +module StreamBench (benchStream, streamEnv) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.Stream as S + +import BenchUtils + +streamEnv :: IO Key +streamEnv = newKey + +benchStream :: Key -> Benchmark +benchStream k = do + let stream :: Int -> IO ByteString + stream i = newNonce >>= \n -> pure $ S.stream k n i + + xor :: ByteString -> IO ByteString + xor m = newNonce >>= \n -> pure $ S.xor k n m + + bgroup "Stream" + [ bench "newKey" $ nfIO newKey + , bgroup "stream" + [ bench "128 B" $ nfIO $ stream (2^7) + , bench "1 MB" $ nfIO $ stream (2^20) + , bench "16 MB" $ nfIO $ stream (2^24) + ] + , bgroup "xor" + [ bench "128 B" $ nfIO $ xor bs128 + , bench "1 MB" $ nfIO $ xor mb1 + , bench "5 MB" $ nfIO $ xor mb5 + ] + ] diff --git a/bench/XChaCha20Poly1305Bench.hs b/bench/XChaCha20Poly1305Bench.hs new file mode 100644 --- /dev/null +++ b/bench/XChaCha20Poly1305Bench.hs @@ -0,0 +1,68 @@ +module XChaCha20Poly1305Bench (benchXChaCha20Poly1305, xChaCha20Poly1305Env) where + +import Criterion.Main + +import Control.Monad +import Control.DeepSeq +import Control.Exception +import Data.ByteString as BS + +import Crypto.Saltine.Core.AEAD.XChaCha20Poly1305 as C + +import BenchUtils + +xChaCha20Poly1305Env :: IO Key +xChaCha20Poly1305Env = newKey + +benchXChaCha20Poly1305 :: Key -> Benchmark +benchXChaCha20Poly1305 k = do + let encrypt :: ByteString -> ByteString -> IO ByteString + encrypt msg aad = newNonce >>= \n -> pure $ C.aead k n msg aad + + decrypt :: ByteString -> ByteString -> IO (Maybe ByteString) + decrypt msg aad = do + n <- newNonce + let ciphertext = C.aead k n msg aad + return $ C.aeadOpen k n ciphertext aad + + encryptDetached msg aad = newNonce >>= \n -> pure $ C.aeadDetached k n msg aad + decryptDetached msg aad = do + n <- newNonce + let (t,c) = C.aeadDetached k n msg aad + pure $ C.aeadOpenDetached k n t c aad + + bgroup "XChaCha20Poly1305" + [ bench "newKey" $ nfIO newKey + , bgroup "aead" + [ bench "128 B + 128 B" $ nfIO $ encrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encrypt mb5 mb5 + ] + , bgroup "aead + open" + [ bench "128 B + 128 B" $ nfIO $ decrypt bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decrypt bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decrypt mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decrypt mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decrypt mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decrypt mb5 mb5 + ] + , bgroup "aeadDetached" + [ bench "128 B + 128 B" $ nfIO $ encryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ encryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ encryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ encryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ encryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ encryptDetached mb5 mb5 + ] + , bgroup "aeadDetached + openDetached" + [ bench "128 B + 128 B" $ nfIO $ decryptDetached bs128 bs128 + , bench "128 B + 5 MB" $ nfIO $ decryptDetached bs128 mb5 + , bench "1 MB + 128 B" $ nfIO $ decryptDetached mb1 bs128 + , bench "1 MB + 5 B" $ nfIO $ decryptDetached mb1 mb5 + , bench "5 MB + 128 B" $ nfIO $ decryptDetached mb5 bs128 + , bench "5 MB + 5 MB" $ nfIO $ decryptDetached mb5 mb5 + ] + ] diff --git a/saltine.cabal b/saltine.cabal --- a/saltine.cabal +++ b/saltine.cabal @@ -1,5 +1,7 @@ +cabal-version: 2.0 + name: saltine -version: 0.1.0.1 +version: 0.2.2.0 synopsis: Cryptography that's easy to digest (NaCl/libsodium bindings). description: @@ -18,6 +20,10 @@ /Saltine/ is a Haskell binding to the NaCl primitives going through Sodium for build convenience and, eventually, portability. +extra-source-files: + README.md + CHANGELOG.md + license: MIT license-file: LICENSE author: Joseph Abrahamson @@ -26,8 +32,7 @@ copyright: Copyright (c) Joseph Abrahamson 2013 category: Cryptography build-type: Simple -cabal-version: >=1.10 -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 +tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.6, GHC==9.4.4 source-repository head type: git @@ -37,9 +42,13 @@ hs-source-dirs: src exposed-modules: Crypto.Saltine - Crypto.Saltine.Internal.ByteSizes + Crypto.Saltine.Class Crypto.Saltine.Core.SecretBox Crypto.Saltine.Core.AEAD + Crypto.Saltine.Core.AEAD.AES256GCM + Crypto.Saltine.Core.AEAD.ChaCha20Poly1305 + Crypto.Saltine.Core.AEAD.ChaCha20Poly1305IETF + Crypto.Saltine.Core.AEAD.XChaCha20Poly1305 Crypto.Saltine.Core.Box Crypto.Saltine.Core.Stream Crypto.Saltine.Core.Auth @@ -47,23 +56,40 @@ Crypto.Saltine.Core.Sign Crypto.Saltine.Core.Hash Crypto.Saltine.Core.ScalarMult + Crypto.Saltine.Core.Password Crypto.Saltine.Core.Utils - Crypto.Saltine.Class - other-modules: + Crypto.Saltine.Internal.AEAD.AES256GCM + Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305 + Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305IETF + Crypto.Saltine.Internal.AEAD.XChaCha20Poly1305 + Crypto.Saltine.Internal.Auth + Crypto.Saltine.Internal.Box + Crypto.Saltine.Internal.ByteSizes + Crypto.Saltine.Internal.Hash + Crypto.Saltine.Internal.OneTimeAuth + Crypto.Saltine.Internal.Password + Crypto.Saltine.Internal.ScalarMult + Crypto.Saltine.Internal.SecretBox + Crypto.Saltine.Internal.Sign + Crypto.Saltine.Internal.Stream Crypto.Saltine.Internal.Util + other-modules: if os(windows) extra-libraries: sodium else - pkgconfig-depends: libsodium >= 1.0.13 + pkgconfig-depends: libsodium >= 1.0.18 cc-options: -Wall ghc-options: -Wall -funbox-strict-fields default-language: Haskell2010 build-depends: - base >= 4.5 && < 5 - , bytestring - , profunctors + base >= 4.5 && < 5 + , bytestring >= 0.10.8 && < 0.13 + , deepseq >= 1.4 && < 1.6 + , profunctors >= 5.3 && < 5.7 + , hashable + , text ^>= 1.2 || >= 2.0 && < 2.2 test-suite tests type: exitcode-stdio-1.0 @@ -71,22 +97,63 @@ other-modules: AuthProperties BoxProperties + HashProperties OneTimeAuthProperties + PasswordProperties ScalarMultProperties SecretBoxProperties SealedBoxProperties SignProperties StreamProperties - AEADProperties + AEAD.AES256GCMProperties + AEAD.ChaCha20Poly1305IETFProperties + AEAD.ChaCha20Poly1305Properties + AEAD.XChaCha20Poly1305Properties Util + UtilProperties ghc-options: -Wall -threaded -rtsopts hs-source-dirs: tests default-language: Haskell2010 build-depends: - base >= 4.5 && < 5 + base >= 4.7 && < 5 , saltine , bytestring + , text , QuickCheck , test-framework-quickcheck2 , test-framework , semigroups + +benchmark benchmarks + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + bench + ghc-options: -rtsopts -threaded -with-rtsopts=-N -O2 + extra-libraries: + sodium + build-depends: + base + , bytestring + , text + , criterion + , deepseq + , saltine + other-modules: + AuthBench + OneTimeAuthBench + ConstantTimeBench + BoxBench + SecretBoxBench + HashBench + RandomBench + PasswordBench + ScalarMultBench + SignBench + StreamBench + BenchUtils + AES256GCMBench + ChaCha20Poly1305Bench + ChaCha20Poly1305IETFBench + XChaCha20Poly1305Bench + default-language: Haskell2010 diff --git a/src/Crypto/Saltine/Class.hs b/src/Crypto/Saltine/Class.hs --- a/src/Crypto/Saltine/Class.hs +++ b/src/Crypto/Saltine/Class.hs @@ -1,3 +1,5 @@ +-- {-# LANGUAGE FlexibleInstances #-} + -- | -- Module : Crypto.Saltine.Class -- Copyright : (c) Joseph Abrahamson 2013 @@ -13,9 +15,8 @@ IsNonce (..) ) where -import Control.Applicative -import Data.Profunctor -import Data.ByteString (ByteString) +import Data.Profunctor +import Data.ByteString (ByteString) -- | Class for all keys and nonces in Saltine which have a -- representation as ByteString. 'encoded' is a 'Prism' of diff --git a/src/Crypto/Saltine/Core/AEAD.hs b/src/Crypto/Saltine/Core/AEAD.hs --- a/src/Crypto/Saltine/Core/AEAD.hs +++ b/src/Crypto/Saltine/Core/AEAD.hs @@ -1,9 +1,10 @@ -- | -- Module : Crypto.Saltine.Core.AEAD -- Copyright : (c) Thomas DuBuisson 2017 +-- (c) Max Amanshauser 2021 -- License : MIT -- --- Maintainer : me@jspha.com +-- Maintainer : max@lambdalifting.org -- Stability : experimental -- Portability : non-portable -- @@ -28,229 +29,19 @@ -- 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. +-- second message, etc. With XChaCha20Poly1305 nonces are long enough +-- that you can also generate nonces randomly as they have negligible +-- risk of collision. +-- +-- The keysize is identical for all the *ChaCha20Poly1305* variants, +-- but the nonce length differs. Since libsodium keeps separate definitions, +-- we do the same. +-- +-- This module reexports the XChaCha20Poly1305 variant, which is the +-- recommended one. module Crypto.Saltine.Core.AEAD ( - Key, Nonce, - aead, aeadOpen, - aeadDetached, aeadOpenDetached, - newKey, newNonce + module X ) 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 +import Crypto.Saltine.Core.AEAD.XChaCha20Poly1305 as X diff --git a/src/Crypto/Saltine/Core/AEAD/AES256GCM.hs b/src/Crypto/Saltine/Core/AEAD/AES256GCM.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Core/AEAD/AES256GCM.hs @@ -0,0 +1,149 @@ +-- | +-- Module : Crypto.Saltine.Core.AEAD.AES256GCM +-- Copyright : (c) Thomas DuBuisson 2017 +-- (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key authenticated encryption with additional data (AEAD): +-- "Crypto.Saltine.Core.AEAD.AES256GCM" +-- +-- Using this module is not recommended. Don't use unless you have to. +-- Keep in mind its limitations: https://doc.libsodium.org/secret-key_cryptography/aead +-- +-- Unless you know for certain the CPU your program will run on supports +-- Intel SSSE3, AES-NI and CLMUL, you should run @aead_aes256gcm_available@ +-- first and only proceed if the result is True. +-- +-- Generating nonces for the functions in this module randomly +-- is not recommended, due to the risk of generating collisions. + +module Crypto.Saltine.Core.AEAD.AES256GCM ( + Key, Nonce, + aead_aes256gcm_available, + aead, aeadOpen, + aeadDetached, aeadOpenDetached, + newKey, newNonce + ) where + +import Crypto.Saltine.Internal.AEAD.AES256GCM + ( c_aead_aes256gcm_is_available + , c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Foreign.Ptr +import System.IO.Unsafe (unsafePerformIO) + +import qualified Crypto.Saltine.Internal.AEAD.AES256GCM as Bytes +import qualified Data.ByteString as S + +-- | Creates a random 'AES256GCM' key +newKey :: IO Key +newKey = Key <$> randomByteString Bytes.aead_aes256gcm_keybytes + +-- | Creates a random 'AES256GCM' nonce +newNonce :: IO Nonce +newNonce = Nonce <$> randomByteString Bytes.aead_aes256gcm_npubbytes + + +{-# NOINLINE aead_aes256gcm_available #-} +aead_aes256gcm_available :: Bool +aead_aes256gcm_available = + unsafePerformIO c_aead_aes256gcm_is_available == 1 + +-- | 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_aes256gcm_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 = do + let clen = S.length cipher + alen = S.length aad + mlen <- clen `safeSubtract` Bytes.aead_aes256gcm_abytes + 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 + hush . handleErrno err $ vec + +-- | 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_aes256gcm_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_aes256gcm_abytes diff --git a/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305.hs b/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305.hs @@ -0,0 +1,134 @@ +-- | +-- Module : Crypto.Saltine.Core.AEAD.ChaCha20Poly1305 +-- Copyright : (c) Thomas DuBuisson 2017 +-- (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key authenticated encryption with additional data (AEAD): +-- "Crypto.Saltine.Core.AEAD.ChaCha20Poly1305" +-- +-- Generating nonces for the functions in this module randomly +-- is not recommended, due to the risk of generating collisions. + +module Crypto.Saltine.Core.AEAD.ChaCha20Poly1305 ( + Key, Nonce, + aead, aeadOpen, + aeadDetached, aeadOpenDetached, + newKey, newNonce + ) where + +import Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305 + ( c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Foreign.Ptr + +import qualified Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305 as Bytes +import qualified Data.ByteString as S + +-- | Creates a random 'ChaCha20Poly1305' key +newKey :: IO Key +newKey = Key <$> randomByteString Bytes.aead_chacha20poly1305_keybytes + +-- | Creates a random 'ChaCha20Poly1305' nonce +newNonce :: IO Nonce +newNonce = Nonce <$> randomByteString Bytes.aead_chacha20poly1305_npubbytes + + +-- | 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_chacha20poly1305_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 = do + let clen = S.length cipher + alen = S.length aad + mlen <- clen `safeSubtract` Bytes.aead_chacha20poly1305_abytes + 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 + hush . handleErrno err $ vec + +-- | 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_chacha20poly1305_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_chacha20poly1305_abytes diff --git a/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305IETF.hs b/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305IETF.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305IETF.hs @@ -0,0 +1,134 @@ +-- | +-- Module : Crypto.Saltine.Core.AEAD.ChaCha20Poly1305IETF +-- Copyright : (c) Thomas DuBuisson 2017 +-- (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key authenticated encryption with additional data (AEAD): +-- "Crypto.Saltine.Core.AEAD.ChaCha20Poly1305IETF" +-- +-- Generating nonces for the functions in this module randomly +-- is not recommended, due to the risk of generating collisions. + +module Crypto.Saltine.Core.AEAD.ChaCha20Poly1305IETF ( + Key, Nonce, + aead, aeadOpen, + aeadDetached, aeadOpenDetached, + newKey, newNonce + ) where + +import Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305IETF + ( c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Foreign.Ptr + +import qualified Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305IETF as Bytes +import qualified Data.ByteString as S + +-- | Creates a random 'ChaCha20Poly1305IETF' key +newKey :: IO Key +newKey = Key <$> randomByteString Bytes.aead_chacha20poly1305_ietf_keybytes + +-- | Creates a random 'ChaCha20Poly1305IETF' nonce +newNonce :: IO Nonce +newNonce = Nonce <$> randomByteString Bytes.aead_chacha20poly1305_ietf_npubbytes + + +-- | 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_chacha20poly1305_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 = do + let clen = S.length cipher + alen = S.length aad + mlen <- clen `safeSubtract` Bytes.aead_chacha20poly1305_ietf_abytes + 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 + hush . handleErrno err $ vec + +-- | 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_chacha20poly1305_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_chacha20poly1305_ietf_abytes diff --git a/src/Crypto/Saltine/Core/AEAD/XChaCha20Poly1305.hs b/src/Crypto/Saltine/Core/AEAD/XChaCha20Poly1305.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Core/AEAD/XChaCha20Poly1305.hs @@ -0,0 +1,134 @@ +-- | +-- Module : Crypto.Saltine.Core.AEAD.XChaCha20Poly1305 +-- Copyright : (c) Thomas DuBuisson 2017 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key authenticated encryption with additional data (AEAD): +-- "Crypto.Saltine.Core.AEAD.XChaCha20Poly1305" +-- +-- Nonces are long enough that randomly generated +-- nonces have negligible risk of collision. + +module Crypto.Saltine.Core.AEAD.XChaCha20Poly1305 ( + Key, Nonce, + aead, aeadOpen, + aeadDetached, aeadOpenDetached, + newKey, newNonce + ) where + +import Crypto.Saltine.Internal.AEAD.XChaCha20Poly1305 + ( c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Foreign.Ptr + +import qualified Crypto.Saltine.Internal.AEAD.XChaCha20Poly1305 as Bytes +import qualified Data.ByteString as S + + +-- | Creates a random 'XChaCha20Poly1305' key +newKey :: IO Key +newKey = Key <$> randomByteString Bytes.aead_xchacha20poly1305_ietf_keybytes + +-- | Creates a random 'XChaCha20Poly1305' nonce +newNonce :: IO Nonce +newNonce = Nonce <$> randomByteString Bytes.aead_xchacha20poly1305_ietf_npubbytes + + +-- | 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 = do + let clen = S.length cipher + alen = S.length aad + mlen <- clen `safeSubtract` Bytes.aead_xchacha20poly1305_ietf_abytes + 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 + hush . handleErrno err $ vec + +-- | 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 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 @@ -11,7 +11,7 @@ -- "Crypto.Saltine.Core.Auth" -- -- The 'auth' function authenticates a message 'ByteString' using a --- secret key The function returns an authenticator. The 'verify' +-- secret key. The function returns an authenticator. The 'verify' -- function checks if it's passed a correct authenticator of a message -- under the given secret key. -- @@ -43,43 +43,20 @@ auth, verify ) 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 'auth' cryptographic key. -newtype Key = Key ByteString deriving (Eq, Ord) - --- | An opaque 'auth' authenticator. -newtype Authenticator = Au ByteString deriving (Eq, Ord) - -instance IsEncoding Key where - decode v = if S.length v == Bytes.authKey - then Just (Key v) - else Nothing - {-# INLINE decode #-} - encode (Key v) = v - {-# INLINE encode #-} +import Crypto.Saltine.Internal.Auth + ( c_auth + , c_auth_verify + , Key(..) + , Authenticator(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) -instance IsEncoding Authenticator where - decode v = if S.length v == Bytes.auth - then Just (Au v) - else Nothing - {-# INLINE decode #-} - encode (Au v) = v - {-# INLINE encode #-} +import qualified Crypto.Saltine.Internal.Auth as Bytes -- | Creates a random key of the correct size for 'auth' and 'verify'. newKey :: IO Key -newKey = Key <$> randomByteString Bytes.authKey +newKey = Key <$> randomByteString Bytes.auth_keybytes -- | Computes an keyed authenticator 'ByteString' from a message. It -- is infeasible to forge these authenticators without the key, even @@ -90,7 +67,7 @@ -- ^ Message -> Authenticator auth (Key key) msg = - Au . snd . buildUnsafeByteString Bytes.auth $ \pa -> + Au . snd . buildUnsafeByteString Bytes.auth_bytes $ \pa -> constByteStrings [key, msg] $ \[(pk, _), (pm, mlen)] -> c_auth pa pm (fromIntegral mlen) pk @@ -105,29 +82,3 @@ verify (Key key) (Au a) msg = unsafeDidSucceed $ constByteStrings [key, msg, a] $ \[(pk, _), (pm, mlen), (pa, _)] -> return $ c_auth_verify pa pm (fromIntegral mlen) pk - -foreign import ccall "crypto_auth" - c_auth :: Ptr CChar - -- ^ Authenticator output buffer - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Length of message buffer - -> Ptr CChar - -- ^ Constant key buffer - -> IO CInt - -- ^ Always 0 - --- | We don't even include this in the IO monad since all of the --- buffers are constant. -foreign import ccall "crypto_auth_verify" - c_auth_verify :: Ptr CChar - -- ^ Constant authenticator buffer - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Length of message buffer - -> Ptr CChar - -- ^ Constant key buffer - -> CInt - -- ^ Success if 0, failure if -1 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 @@ -78,96 +78,52 @@ -- -- This is version 2010.08.30 of the box.html web page. module Crypto.Saltine.Core.Box ( - SecretKey, PublicKey, Keypair, CombinedKey, Nonce, + SecretKey, PublicKey, Keypair(..), CombinedKey, Nonce, newKeypair, beforeNM, newNonce, box, boxOpen, boxAfterNM, boxOpenAfterNM, boxSeal, boxSealOpen ) 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 'box' cryptographic secret key. -newtype SecretKey = SK ByteString deriving (Eq, Ord) - -instance IsEncoding SecretKey where - decode v = if S.length v == Bytes.boxSK - then Just (SK v) - else Nothing - {-# INLINE decode #-} - encode (SK v) = v - {-# INLINE encode #-} - --- | An opaque 'box' cryptographic public key. -newtype PublicKey = PK ByteString deriving (Eq, Ord) - -instance IsEncoding PublicKey where - decode v = if S.length v == Bytes.boxPK - then Just (PK v) - else Nothing - {-# INLINE decode #-} - encode (PK v) = v - {-# INLINE encode #-} - --- | A convenience type for keypairs -type Keypair = (SecretKey, PublicKey) - --- | An opaque 'boxAfterNM' cryptographic combined key. -newtype CombinedKey = CK ByteString deriving (Eq, Ord) - -instance IsEncoding CombinedKey where - decode v = if S.length v == Bytes.boxBeforeNM - then Just (CK v) - else Nothing - {-# INLINE decode #-} - encode (CK v) = v - {-# INLINE encode #-} - --- | An opaque 'box' nonce. -newtype Nonce = Nonce ByteString deriving (Eq, Ord) - -instance IsEncoding Nonce where - decode v = if S.length v == Bytes.boxNonce - then Just (Nonce v) - else Nothing - {-# INLINE decode #-} - encode (Nonce v) = v - {-# INLINE encode #-} +import Crypto.Saltine.Internal.Box + ( c_box_keypair + , c_box_easy + , c_box_open_easy + , c_box_beforenm + , c_box_easy_afternm + , c_box_open_easy_afternm + , c_box_seal, c_box_seal_open + , SecretKey(..) + , PublicKey(..) + , Keypair(..) + , CombinedKey(..) + , Nonce(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) -instance IsNonce Nonce where - zero = Nonce (S.replicate Bytes.boxNonce 0) - nudge (Nonce n) = Nonce (nudgeBS n) +import qualified Crypto.Saltine.Internal.Box as Bytes +import qualified Data.ByteString as S -- | Randomly generates a secret key and a corresponding public key. newKeypair :: IO Keypair newKeypair = do -- This is a little bizarre and a likely source of errors. -- _err ought to always be 0. - ((_err, sk), pk) <- buildUnsafeByteString' Bytes.boxPK $ \pkbuf -> - buildUnsafeByteString' Bytes.boxSK $ \skbuf -> + ((_err, sk), pk) <- buildUnsafeByteString' Bytes.box_publickeybytes $ \pkbuf -> + buildUnsafeByteString' Bytes.box_secretkeybytes $ \skbuf -> c_box_keypair pkbuf skbuf - return (SK sk, PK pk) + return $ Keypair (SK sk) (PK pk) -- | Randomly generates a nonce for usage with 'box' and 'boxOpen'. newNonce :: IO Nonce -newNonce = Nonce <$> randomByteString Bytes.boxNonce +newNonce = Nonce <$> randomByteString Bytes.box_noncebytes -- | 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 $ buildUnsafeByteString Bytes.boxBeforeNM $ \ckbuf -> +beforeNM (SK sk) (PK pk) = CK $ snd $ buildUnsafeByteString Bytes.box_beforenmbytes $ \ckbuf -> constByteStrings [pk, sk] $ \[(ppk, _), (psk, _)] -> c_box_beforenm ckbuf ppk psk @@ -188,7 +144,7 @@ [(ppk, _), (psk, _), (pm, _), (pn, _)] -> c_box_easy pc pm (fromIntegral msgLen) pn ppk psk where - bufSize = S.length msg + Bytes.boxMac + bufSize = S.length msg + Bytes.box_macbytes msgLen = S.length msg -- | Decrypts a message sent from the owner of the public key. They @@ -199,16 +155,16 @@ -- ^ Ciphertext (incl. authentication tag) -> Maybe ByteString -- ^ Message -boxOpen (PK pk) (SK sk) (Nonce nonce) cipher = +boxOpen (PK pk) (SK sk) (Nonce nonce) cipher = do + let msgLen = S.length cipher + bufSize <- msgLen `safeSubtract` Bytes.box_macbytes let (err, vec) = buildUnsafeByteString bufSize $ \pm -> constByteStrings [pk, sk, cipher, nonce] $ \ [(ppk, _), (psk, _), (pc, _), (pn, _)] -> 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 + hush . handleErrno err $ vec + -- | 'box' using a 'CombinedKey' and thus faster. boxAfterNM :: CombinedKey -> Nonce @@ -222,7 +178,7 @@ [(pck, _), (pm, _), (pn, _)] -> c_box_easy_afternm pc pm (fromIntegral msgLen) pn pck where - bufSize = S.length msg + Bytes.boxMac + bufSize = S.length msg + Bytes.box_macbytes msgLen = S.length msg -- | 'boxOpen' using a 'CombinedKey' and is thus faster. @@ -232,26 +188,27 @@ -- ^ Ciphertext (incl. authentication tag) -> Maybe ByteString -- ^ Message -boxOpenAfterNM (CK ck) (Nonce nonce) cipher = +boxOpenAfterNM (CK ck) (Nonce nonce) cipher = do + let msgLen = S.length cipher + bufSize <- msgLen `safeSubtract` Bytes.box_macbytes let (err, vec) = buildUnsafeByteString bufSize $ \pm -> constByteStrings [ck, cipher, nonce] $ \ [(pck, _), (pc, _), (pn, _)] -> 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 + hush . handleErrno err $ vec -- | Encrypts a message for sending to the owner of the public -- key. The message is unauthenticated, but permits integrity checking. +-- This function is non-deterministic, it uses newly created ephemeral keys internally, +-- and thus in IO. boxSeal :: PublicKey -> ByteString -> IO ByteString boxSeal (PK pk) msg = fmap snd . buildUnsafeByteString' bufSize $ \pc -> constByteStrings [pk, msg] $ \ [(ppk, _), (pm, _)] -> c_box_seal pc pm (fromIntegral msgLen) ppk where - bufSize = S.length msg + Bytes.sealedBox + bufSize = S.length msg + Bytes.box_sealbytes msgLen = S.length msg -- | Decrypts a sealed box message. The message must have been @@ -264,126 +221,11 @@ -- ^ Ciphertext -> Maybe ByteString -- ^ Message -boxSealOpen (PK pk) (SK sk) cipher = +boxSealOpen (PK pk) (SK sk) cipher = do + let msgLen = S.length cipher + bufSize <- msgLen `safeSubtract` Bytes.box_sealbytes let (err, vec) = buildUnsafeByteString bufSize $ \pm -> constByteStrings [pk, sk, cipher] $ \ [(ppk, _), (psk, _), (pc, _)] -> c_box_seal_open pm pc (fromIntegral msgLen) ppk psk - in hush . handleErrno err $ vec - where - bufSize = S.length cipher - Bytes.sealedBox - msgLen = S.length cipher - - --- | Should always return a 0. -foreign import ccall "crypto_box_keypair" - c_box_keypair :: Ptr CChar - -- ^ Public key - -> Ptr CChar - -- ^ Secret key - -> IO CInt - -- ^ Always 0 - --- | The secretbox C API uses C strings. -foreign import ccall "crypto_box_easy" - c_box_easy :: Ptr CChar - -- ^ Cipher output buffer - -> Ptr CChar - -- ^ Constant message 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 - -- ^ 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 - -- ^ Combined key output buffer - -> Ptr CChar - -- ^ Constant public key buffer - -> Ptr CChar - -- ^ Constant secret key buffer - -> IO CInt - -- ^ Always 0 - --- | 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 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 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. -foreign import ccall "crypto_box_seal" - c_box_seal :: Ptr CChar - -- ^ Cipher output buffer - -> Ptr CChar - -- ^ Constant message input buffer - -> CULLong - -- ^ Length of message input buffer - -> Ptr CChar - -- ^ Constant public key buffer - -> IO CInt - -- ^ Always 0 - --- | The sealedbox C API uses C strings. -foreign import ccall "crypto_box_seal_open" - c_box_seal_open :: Ptr CChar - -- ^ Message output buffer - -> Ptr CChar - -- ^ Constant ciphertext input buffer - -> CULLong - -- ^ Length of message input buffer - -> Ptr CChar - -- ^ Constant public key buffer - -> Ptr CChar - -- ^ Constant secret key buffer - -> IO CInt - -- ^ 0 for success, -1 for failure to decrypt + hush . handleErrno err $ vec 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 @@ -1,4 +1,4 @@ --- | + -- | -- Module : Crypto.Saltine.Core.Hash -- Copyright : (c) Joseph Abrahamson 2013 -- License : MIT @@ -34,27 +34,45 @@ -- alternatives that inspire satisfactory levels of confidence. One -- can hope that NIST's SHA-3 competition will improve the situation. -- --- Sodium includes an implementation of the Blake2 hash --- () but since this is not standard NaCl nor was --- Blake2 selected to be SHA-3 the library doesn't bind it. +-- Sodium includes an implementation of the Blake2b hash function +-- () and is bound here as the 'generichash' +-- function. -- -- This is version 2010.08.30 of the hash.html web page. Information -- about SipHash has been added. module Crypto.Saltine.Core.Hash ( + -- * Documentation ShorthashKey, hash, - shorthash, newShorthashKey + shorthash, newShorthashKey, + GenerichashKey, + newGenerichashKey, + GenerichashOutLen, + generichashOutLen, generichash, + + -- * Advanced: SHA-2 + -- + -- | The SHA-256 function is provided for interoperability with + -- other applications. If you are looking for a generic hash + -- function and not specifically SHA-2, using 'generichash' + -- (BLAKE2b) might be a better choice. + sha256 ) where -import Crypto.Saltine.Class -import Crypto.Saltine.Internal.Util -import qualified Crypto.Saltine.Internal.ByteSizes as Bytes +import Crypto.Saltine.Internal.Hash + ( c_hash + , c_generichash + , c_hash_sha256 + , shorthash + , ShorthashKey(..) + , GenerichashKey(..) + , GenerichashOutLen(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) -import Control.Applicative -import Foreign.C -import Foreign.Ptr -import qualified Data.ByteString as S -import Data.ByteString (ByteString) +import qualified Crypto.Saltine.Internal.Hash as Bytes +import qualified Data.ByteString as S -- | Computes a cryptographically collision-resistant hash making -- @hash m == hash m' ==> m == m'@ highly likely even when under @@ -63,52 +81,38 @@ -- ^ Message -> ByteString -- ^ Hash -hash m = snd . buildUnsafeByteString Bytes.hash $ \ph -> +hash m = snd . buildUnsafeByteString Bytes.hash_bytes $ \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) - -instance IsEncoding ShorthashKey where - decode v = if S.length v == Bytes.shorthashKey - then Just (ShK v) - else Nothing - {-# INLINE decode #-} - encode (ShK v) = v - {-# INLINE encode #-} - -- | Randomly generates a new key for 'shorthash'. newShorthashKey :: IO ShorthashKey -newShorthashKey = ShK <$> randomByteString Bytes.shorthashKey +newShorthashKey = ShK <$> randomByteString Bytes.shorthash_keybytes --- | Computes a very short, fast keyed hash. -shorthash :: ShorthashKey - -> ByteString - -- ^ Message - -> ByteString - -- ^ Hash -shorthash (ShK k) m = snd . buildUnsafeByteString Bytes.shorthash $ \ph -> - constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> - c_shorthash ph pm (fromIntegral $ S.length m) pk +-- | Randomly generates a new key for 'generichash' of the given length. +newGenerichashKey :: Int -> IO (Maybe GenerichashKey) +newGenerichashKey n = if n >= 0 && n <= Bytes.generichash_keybytes_max + then Just . GhK <$> randomByteString n + else return Nothing -foreign import ccall "crypto_hash" - c_hash :: Ptr CChar - -- ^ Output hash buffer - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Constant message buffer length - -> IO CInt - -- ^ Always 0 +-- | Create a validated Generichash output length +generichashOutLen :: Int -> Maybe GenerichashOutLen +generichashOutLen n = if n > 0 && n <= Bytes.generichash_bytes_max + then Just $ GhOL $ fromIntegral n + else Nothing -foreign import ccall "crypto_shorthash" - c_shorthash :: Ptr CChar - -- ^ Output hash buffer - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Message buffer length - -> Ptr CChar - -- ^ Constant Key buffer - -> IO CInt - -- ^ Always 0 +-- | Computes a generic, keyed hash. +generichash :: GenerichashKey + -> ByteString + -- ^ Message + -> GenerichashOutLen + -- ^ Desired output hash length + -> ByteString + -- ^ Hash +generichash (GhK k) m (GhOL outLen) = snd . buildUnsafeByteString outLen $ \ph -> + constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> + c_generichash ph (fromIntegral outLen) pm (fromIntegral $ S.length m) pk (fromIntegral $ S.length k) + +-- | Computes a SHA256 hash. +sha256 :: ByteString -> ByteString +sha256 m = snd . buildUnsafeByteString Bytes.hash_sha256_bytes $ \ph -> + constByteStrings [m] $ \[(pm,_)] -> c_hash_sha256 ph pm (fromIntegral $ S.length m) 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 @@ -39,43 +39,21 @@ auth, verify ) where -import Crypto.Saltine.Class -import Crypto.Saltine.Internal.Util -import qualified Crypto.Saltine.Internal.ByteSizes as Bytes +import Crypto.Saltine.Internal.OneTimeAuth + ( c_onetimeauth + , c_onetimeauth_verify + , Key(..) + , Authenticator(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) -import Control.Applicative -import Foreign.C -import Foreign.Ptr +import qualified Crypto.Saltine.Internal.OneTimeAuth as Bytes import qualified Data.ByteString as S -import Data.ByteString (ByteString) --- $types - --- | An opaque 'auth' cryptographic key. -newtype Key = Key ByteString deriving (Eq, Ord) - --- | An opaque 'auth' authenticator. -newtype Authenticator = Au ByteString deriving (Eq, Ord) - -instance IsEncoding Key where - decode v = if S.length v == Bytes.onetimeKey - then Just (Key v) - else Nothing - {-# INLINE decode #-} - encode (Key v) = v - {-# INLINE encode #-} - -instance IsEncoding Authenticator where - decode v = if S.length v == Bytes.onetime - then Just (Au v) - else Nothing - {-# INLINE decode #-} - encode (Au v) = v - {-# INLINE encode #-} - -- | Creates a random key of the correct size for 'auth' and 'verify'. newKey :: IO Key -newKey = Key <$> randomByteString Bytes.onetimeKey +newKey = Key <$> randomByteString Bytes.onetimeauth_keybytes -- | Builds a keyed 'Authenticator' for a message. This -- 'Authenticator' is /impossible/ to forge so long as the 'Key' is @@ -85,7 +63,7 @@ -- ^ Message -> Authenticator auth (Key key) msg = - Au . snd . buildUnsafeByteString Bytes.onetime $ \pa -> + Au . snd . buildUnsafeByteString Bytes.onetimeauth_bytes $ \pa -> constByteStrings [key, msg] $ \[(pk, _), (pm, _)] -> c_onetimeauth pa pm (fromIntegral $ S.length msg) pk @@ -100,29 +78,3 @@ unsafeDidSucceed $ constByteStrings [key, msg, a] $ \ [(pk, _), (pm, _), (pa, _)] -> return $ c_onetimeauth_verify pa pm (fromIntegral $ S.length msg) pk - -foreign import ccall "crypto_onetimeauth" - c_onetimeauth :: Ptr CChar - -- ^ Authenticator output buffer - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Length of message buffer - -> Ptr CChar - -- ^ Constant key buffer - -> IO CInt - -- ^ Always 0 - --- | We don't even include this in the IO monad since all of the --- buffers are constant. -foreign import ccall "crypto_onetimeauth_verify" - c_onetimeauth_verify :: Ptr CChar - -- ^ Constant authenticator buffer - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Length of message buffer - -> Ptr CChar - -- ^ Constant key buffer - -> CInt - -- ^ Success if 0, failure if -1 diff --git a/src/Crypto/Saltine/Core/Password.hs b/src/Crypto/Saltine/Core/Password.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Core/Password.hs @@ -0,0 +1,247 @@ +-- | +-- Module : Crypto.Saltine.Core.Password +-- Description : Argon2 password hash +-- Copyright : (c) Promethea Raschke 2018 +-- Max Amanshauser 2021 +-- License : MIT +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Password hashing and key derivation +-- +-- When in doubt, just use one of [ interactivePolicy, moderatePolicy, sensitivePolicy ], +-- but this module also allows you to fine-tune parameters for specific circumstances. +-- +-- This module uses the @Text@ type for passwords, because this seems to be the only +-- reasonable way to get consistent encodings across locales and architectures, short of +-- letting users mess around with ByteStrings themselves. + +module Crypto.Saltine.Core.Password + ( Salt + , newSalt + + , needsRehash + + , pwhashStr + , pwhashStrVerify + , pwhash + + , Policy(..) + , interactivePolicy + , moderatePolicy + , sensitivePolicy + + , Opslimit + , opslimit + , getOpslimit + + , minOpslimit + , maxOpslimit + + , opslimitInteractive + , opslimitModerate + , opslimitSensitive + + , Memlimit + , memlimit + , getMemlimit + + , minMemlimit + , maxMemlimit + + , memlimitInteractive + , memlimitModerate + , memlimitSensitive + + , Algorithm + , defaultAlgorithm + ) where + +import Crypto.Saltine.Internal.Util +import Crypto.Saltine.Internal.Password as I +import Data.ByteString (ByteString) +import Data.Text (Text) +import Foreign.C +import System.IO.Unsafe + +import qualified Crypto.Saltine.Internal.Password as Bytes +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + + +newSalt :: IO Salt +newSalt = Salt <$> randomByteString Bytes.pwhash_saltbytes + +-- | Hashes a password according to the policy +-- This function is non-deterministic and hence in IO. +-- Since this function may cause a huge amount of memory to be allocated, it will return +-- Nothing if the allocation failed and on any other error. +pwhashStr :: Text -> Policy -> IO (Maybe PasswordHash) +pwhashStr pw policy = do + let (ops, mem, _alg) = unpackPolicy policy + + -- Hash is always ASCII, so no decoding needed + fmap (fmap (PasswordHash . T.pack)) $ allocaBytes pwhash_strbytes $ \pp -> + constByteStrings [TE.encodeUtf8 pw] $ \ [(ppw, ppwlen)] -> do + ret <- c_pwhash_str pp ppw (fromIntegral ppwlen) (fromIntegral ops) (fromIntegral mem) + + case ret of + 0 -> Just <$> peekCAString pp + _ -> pure Nothing + +-- | Verifies that a certain password hash was constructed from the supplied password +pwhashStrVerify :: PasswordHash -> Text -> Bool +pwhashStrVerify (PasswordHash h) pw = unsafePerformIO $ + constByteStrings [TE.encodeUtf8 $ T.snoc h '\NUL', TE.encodeUtf8 pw] $ \[(ph, _), (ppw, ppwlen)] -> do + res <- c_pwhash_str_verify ph ppw (fromIntegral ppwlen) + pure (res == 0) + +-- | Indicates whether a password needs to be rehashed, because the opslimit/memlimit parameters +-- used to hash the password are inconsistent with the supplied values. +-- Returns Nothing if the hash appears to be invalid. +-- Internally this function will always use the current DefaultAlgorithm and hence will give +-- undefined results if a different algorithm was used to hash the password. +needsRehash :: Opslimit -> Memlimit -> PasswordHash -> Maybe Bool +needsRehash (Opslimit ops) (Memlimit mem) (PasswordHash h) = + unsafePerformIO $ + constByteStrings [TE.encodeUtf8 $ T.snoc h '\NUL'] $ \[(ph,_)] -> do + res <- c_pwhash_str_needs_rehash ph (fromIntegral ops) (fromIntegral mem) + pure $ if res == -1 + then Nothing + else Just (res == 1) + +-- | Derives a key of the specified length from a password using a salt according to the provided policy. +-- Since this function may cause a huge amount of memory to be allocated, it will return +-- Nothing if the allocation failed and on any other error. +pwhash :: Text -> Int -> Salt -> Policy -> Maybe ByteString +pwhash pw len (Salt salt) policy = do + let (ops, mem, alg) = unpackPolicy policy + + let (e, hashed) = + buildUnsafeByteString len $ \hbuf -> + constByteStrings [TE.encodeUtf8 pw, salt] $ \[(ppw,ppwlen), (psalt,_)] -> + c_pwhash + hbuf (fromIntegral len) + ppw (fromIntegral ppwlen) + psalt + (fromIntegral ops) + (fromIntegral mem) + (fromIntegral $ fromEnum alg) + + if e == -1 + then Nothing + else Just hashed + + +-- | Smart constructor for opslimit +opslimit :: Algorithm -> Int -> Maybe Opslimit +opslimit alg x + | Opslimit x < minOpslimit alg = Nothing + | Opslimit x > maxOpslimit alg = Nothing + | otherwise = Just (Opslimit x) + +opslimitInteractive :: Algorithm -> Opslimit +opslimitInteractive DefaultAlgorithm = Opslimit (fromIntegral Bytes.pwhash_opslimit_interactive) +opslimitInteractive Argon2i13 = Opslimit (fromIntegral Bytes.pwhash_argon2i_opslimit_interactive) +opslimitInteractive Argon2id13 = Opslimit (fromIntegral Bytes.pwhash_argon2id_opslimit_interactive) + +opslimitModerate :: Algorithm -> Opslimit +opslimitModerate DefaultAlgorithm = Opslimit (fromIntegral Bytes.pwhash_opslimit_moderate) +opslimitModerate Argon2i13 = Opslimit (fromIntegral Bytes.pwhash_argon2i_opslimit_moderate) +opslimitModerate Argon2id13 = Opslimit (fromIntegral Bytes.pwhash_argon2id_opslimit_moderate) + +opslimitSensitive :: Algorithm -> Opslimit +opslimitSensitive DefaultAlgorithm = Opslimit (fromIntegral Bytes.pwhash_opslimit_sensitive) +opslimitSensitive Argon2i13 = Opslimit (fromIntegral Bytes.pwhash_argon2i_opslimit_sensitive) +opslimitSensitive Argon2id13 = Opslimit (fromIntegral Bytes.pwhash_argon2id_opslimit_sensitive) + + +-- | Smart constructor for memlimit +memlimit :: Algorithm -> Int -> Maybe Memlimit +memlimit alg x + | Memlimit x < minMemlimit alg = Nothing + | Memlimit x > maxMemlimit alg= Nothing + | otherwise = Just (Memlimit x) + +memlimitInteractive :: Algorithm -> Memlimit +memlimitInteractive DefaultAlgorithm = Memlimit (fromIntegral Bytes.pwhash_memlimit_interactive) +memlimitInteractive Argon2i13 = Memlimit (fromIntegral Bytes.pwhash_argon2i_memlimit_interactive) +memlimitInteractive Argon2id13 = Memlimit (fromIntegral Bytes.pwhash_argon2id_memlimit_interactive) + +memlimitModerate :: Algorithm -> Memlimit +memlimitModerate DefaultAlgorithm = Memlimit (fromIntegral Bytes.pwhash_memlimit_moderate) +memlimitModerate Argon2i13 = Memlimit (fromIntegral Bytes.pwhash_argon2i_memlimit_moderate) +memlimitModerate Argon2id13 = Memlimit (fromIntegral Bytes.pwhash_argon2id_memlimit_moderate) + +memlimitSensitive :: Algorithm -> Memlimit +memlimitSensitive DefaultAlgorithm = Memlimit (fromIntegral Bytes.pwhash_memlimit_sensitive) +memlimitSensitive Argon2i13 = Memlimit (fromIntegral Bytes.pwhash_argon2i_memlimit_sensitive) +memlimitSensitive Argon2id13 = Memlimit (fromIntegral Bytes.pwhash_argon2id_memlimit_sensitive) + +defaultAlgorithm :: Algorithm +defaultAlgorithm = DefaultAlgorithm + + +-- | Get raw C types from a policy, suitable for passing to FFI functions +unpackPolicy :: Policy -> (CULLong, CSize, CInt) +unpackPolicy (Policy ops mem alg) = + ( fromIntegral (getOpslimit ops) + , fromIntegral (getMemlimit mem) + , algorithm alg + ) + + +{- +Fast policy suitable for low-powered devices + +Takes approximately 0.1 seconds on a typical desktop computer +and requires 64 MiB of dedicated RAM +-} +interactivePolicy :: Policy +interactivePolicy = Policy (opslimitInteractive defaultAlgorithm) + (memlimitInteractive defaultAlgorithm) + defaultAlgorithm + +{-| +Moderate policy with a balance of speed and security + +Takes approximately 1 second on a typical desktop computer +and requires 256 MiB of dedicated RAM +-} +moderatePolicy :: Policy +moderatePolicy = Policy (opslimitModerate defaultAlgorithm) + (memlimitModerate defaultAlgorithm) + defaultAlgorithm + +{-| +High-security policy designed to make attacking the password extremely expensive + +Takes several seconds on a typical desktop computer +and requires 1024 MiB of dedicated RAM +-} +sensitivePolicy :: Policy +sensitivePolicy = Policy (opslimitSensitive defaultAlgorithm) + (memlimitSensitive defaultAlgorithm) + defaultAlgorithm + + +minOpslimit :: Algorithm -> Opslimit +minOpslimit DefaultAlgorithm = Opslimit $ fromIntegral Bytes.pwhash_opslimit_min +minOpslimit Argon2i13 = Opslimit $ fromIntegral Bytes.pwhash_argon2i_opslimit_min +minOpslimit Argon2id13 = Opslimit $ fromIntegral Bytes.pwhash_argon2id_opslimit_min + +maxOpslimit :: Algorithm -> Opslimit +maxOpslimit DefaultAlgorithm = Opslimit $ fromIntegral Bytes.pwhash_opslimit_max +maxOpslimit Argon2i13 = Opslimit $ fromIntegral Bytes.pwhash_argon2i_opslimit_max +maxOpslimit Argon2id13 = Opslimit $ fromIntegral Bytes.pwhash_argon2id_opslimit_max + +minMemlimit :: Algorithm -> Memlimit +minMemlimit DefaultAlgorithm = Memlimit $ fromIntegral Bytes.pwhash_memlimit_min +minMemlimit Argon2i13 = Memlimit $ fromIntegral Bytes.pwhash_argon2i_memlimit_min +minMemlimit Argon2id13 = Memlimit $ fromIntegral Bytes.pwhash_argon2id_memlimit_min + +maxMemlimit :: Algorithm -> Memlimit +maxMemlimit DefaultAlgorithm = Memlimit $ fromIntegral Bytes.pwhash_memlimit_max +maxMemlimit Argon2i13 = Memlimit $ fromIntegral Bytes.pwhash_argon2i_memlimit_max +maxMemlimit Argon2id13 = Memlimit $ fromIntegral Bytes.pwhash_argon2id_memlimit_max 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 @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric #-} + -- | -- Module : Crypto.Saltine.Core.ScalarMult -- Copyright : (c) Joseph Abrahamson 2013 @@ -55,63 +57,23 @@ mult, multBase ) where -import Crypto.Saltine.Class -import Crypto.Saltine.Internal.Util -import qualified Crypto.Saltine.Internal.ByteSizes as Bytes +import Crypto.Saltine.Internal.Util +import Crypto.Saltine.Internal.ScalarMult + ( c_scalarmult + , c_scalarmult_base + , GroupElement(..) + , Scalar(..) + ) -import Foreign.C -import Foreign.Ptr -import qualified Data.ByteString as S -import Data.ByteString (ByteString) +import qualified Crypto.Saltine.Internal.ScalarMult as Bytes --- $types --- | A group element. -newtype GroupElement = GE ByteString deriving (Eq) - --- | A scalar integer. -newtype Scalar = Sc ByteString deriving (Eq) - -instance IsEncoding GroupElement where - decode v = if S.length v == Bytes.mult - then Just (GE v) - else Nothing - {-# INLINE decode #-} - encode (GE v) = v - {-# INLINE encode #-} - -instance IsEncoding Scalar where - decode v = if S.length v == Bytes.multScalar - then Just (Sc v) - else Nothing - {-# INLINE decode #-} - encode (Sc v) = v - {-# INLINE encode #-} - mult :: Scalar -> GroupElement -> GroupElement -mult (Sc n) (GE p) = GE . snd . buildUnsafeByteString Bytes.mult $ \pq -> +mult (Sc n) (GE p) = GE . snd . buildUnsafeByteString Bytes.scalarmult_bytes $ \pq -> constByteStrings [n, p] $ \[(pn, _), (pp, _)] -> c_scalarmult pq pn pp multBase :: Scalar -> GroupElement -multBase (Sc n) = GE . snd . buildUnsafeByteString Bytes.mult $ \pq -> +multBase (Sc n) = GE . snd . buildUnsafeByteString Bytes.scalarmult_bytes $ \pq -> constByteStrings [n] $ \[(pn, _)] -> c_scalarmult_base pq pn - -foreign import ccall "crypto_scalarmult" - c_scalarmult :: Ptr CChar - -- ^ Output group element buffer - -> Ptr CChar - -- ^ Input integer buffer - -> Ptr CChar - -- ^ Input group element buffer - -> IO CInt - -- ^ Always 0 - -foreign import ccall "crypto_scalarmult_base" - c_scalarmult_base :: Ptr CChar - -- ^ Output group element buffer - -> Ptr CChar - -- ^ Input integer buffer - -> IO CInt - -- ^ Always 0 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 @@ -3,7 +3,7 @@ -- Copyright : (c) Joseph Abrahamson 2013 -- License : MIT -- --- Maintainer : me@jspha.com +-- Maintainer : max@lambdalifting.org -- Stability : experimental -- Portability : non-portable -- @@ -38,120 +38,105 @@ -- -- This is version 2010.08.30 of the secretbox.html web page. module Crypto.Saltine.Core.SecretBox ( - Key, Nonce, + Key, Nonce, Authenticator, secretbox, secretboxOpen, secretboxDetached, secretboxOpenDetached, newKey, newNonce ) where -import Crypto.Saltine.Class -import Crypto.Saltine.Internal.Util -import qualified Crypto.Saltine.Internal.ByteSizes as Bytes +import Crypto.Saltine.Internal.SecretBox + ( c_secretbox + , c_secretbox_detached + , c_secretbox_open + , c_secretbox_open_detached + , Key(..) + , Nonce(..) + , Authenticator(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) -import Control.Applicative -import Foreign.C -import Foreign.Ptr +import qualified Crypto.Saltine.Internal.SecretBox as Bytes 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 +newKey = Key <$> randomByteString Bytes.secretbox_keybytes -- | Creates a random nonce of the correct size for 'secretbox'. newNonce :: IO Nonce -newNonce = Nonce <$> randomByteString Bytes.secretBoxNonce +newNonce = Nonce <$> randomByteString Bytes.secretbox_noncebytes -- | Encrypts a message. It is infeasible for an attacker to decrypt -- the message so long as the 'Nonce' is never repeated. -secretbox :: Key -> Nonce - -> ByteString - -- ^ Message - -> ByteString - -- ^ Ciphertext +secretbox + :: Key + -> Nonce + -> ByteString + -- ^ Message + -> ByteString + -- ^ Ciphertext secretbox (Key key) (Nonce nonce) msg = 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 + where len = S.length msg + Bytes.secretbox_zerobytes + pad' = pad Bytes.secretbox_zerobytes + unpad' = unpad Bytes.secretbox_boxzerobytes -- | 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 + -> Nonce + -> ByteString + -- ^ Message + -> (Authenticator,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 + fmap (Au . 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 + tagLen = Bytes.secretbox_macbytes -- | Decrypts a message. Returns 'Nothing' if the keys and message do -- not match. -secretboxOpen :: Key -> Nonce - -> ByteString - -- ^ Ciphertext - -> Maybe ByteString - -- ^ Message +secretboxOpen + :: Key + -> Nonce + -> ByteString + -- ^ Ciphertext + -> Maybe ByteString + -- ^ Message secretboxOpen (Key key) (Nonce nonce) cipher = 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 - where len = S.length cipher + Bytes.secretBoxBoxZero - pad' = pad Bytes.secretBoxBoxZero - unpad' = unpad Bytes.secretBoxZero + where len = S.length cipher + Bytes.secretbox_boxzerobytes + pad' = pad Bytes.secretbox_boxzerobytes + unpad' = unpad Bytes.secretbox_zerobytes -- | 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 +secretboxOpenDetached + :: Key + -> Nonce + -> Authenticator + -- ^ Auth Tag + -> ByteString + -- ^ Ciphertext + -> Maybe ByteString + -- ^ Message +secretboxOpenDetached (Key key) (Nonce nonce) (Au tag) cipher + | S.length tag /= Bytes.secretbox_macbytes = Nothing | otherwise = let (err, vec) = buildUnsafeByteString len $ \pm -> constByteStrings [key, cipher, tag, nonce] $ \ @@ -159,67 +144,3 @@ 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 - -- ^ 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 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" - c_secretbox_open :: Ptr CChar - -- ^ Message 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 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 - -- ^ Constant key buffer - -> IO CInt 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 @@ -1,3 +1,4 @@ + -- | -- Module : Crypto.Saltine.Core.Sign -- Copyright : (c) Joseph Abrahamson 2013 @@ -26,50 +27,43 @@ -- This is current information as of 2013 June 6. module Crypto.Saltine.Core.Sign ( - SecretKey, PublicKey, Keypair, + -- * Documentation + SecretKey, PublicKey, Keypair(..), Signature, newKeypair, sign, signOpen, - signDetached, signVerifyDetached - ) where - -import Crypto.Saltine.Class -import Crypto.Saltine.Internal.Util -import qualified Crypto.Saltine.Internal.ByteSizes as Bytes - -import Foreign.C -import Foreign.Ptr -import Foreign.Marshal.Alloc -import Foreign.Storable -import System.IO.Unsafe -import qualified Data.ByteString as S -import Data.ByteString (ByteString) - --- $types - --- | An opaque 'box' cryptographic secret key. -newtype SecretKey = SK ByteString deriving (Eq, Ord) - -instance IsEncoding SecretKey where - decode v = if S.length v == Bytes.signSK - then Just (SK v) - else Nothing - {-# INLINE decode #-} - encode (SK v) = v - {-# INLINE encode #-} + signDetached, signVerifyDetached, --- | An opaque 'box' cryptographic public key. -newtype PublicKey = PK ByteString deriving (Eq, Ord) + -- * Advanced: Ed25519 to Curve25519 + -- + -- | Ed25519 keys can be converted to X25519 keys, so that the same + -- key pair can be used both for authenticated encryption + -- ("Crypto.Saltine.Core.Box") and for signatures + -- ("Crypto.Saltine.Core.Sign"). + signPublicKeyToScalarMult, signSecretKeyToScalarMult + ) where -instance IsEncoding PublicKey where - decode v = if S.length v == Bytes.signPK - then Just (PK v) - else Nothing - {-# INLINE decode #-} - encode (PK v) = v - {-# INLINE encode #-} +import Crypto.Saltine.Internal.Sign + ( c_sign_keypair + , c_sign + , c_sign_open + , c_sign_detached + , c_sign_verify_detached + , c_sign_ed25519_pk_to_curve25519 + , c_sign_ed25519_sk_to_curve25519 + , SecretKey(..) + , PublicKey(..) + , Keypair(..) + , Signature(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Foreign.Marshal.Alloc +import Foreign.Storable +import System.IO.Unsafe --- | A convenience type for keypairs -type Keypair = (SecretKey, PublicKey) +import qualified Crypto.Saltine.Internal.Sign as Bytes +import qualified Crypto.Saltine.Internal.ScalarMult as SM +import qualified Data.ByteString as S -- | Creates a random key of the correct size for 'sign' and -- 'signOpen' of form @(secretKey, publicKey)@. @@ -77,10 +71,10 @@ newKeypair = do -- This is a little bizarre and a likely source of errors. -- _err ought to always be 0. - ((_err, sk), pk) <- buildUnsafeByteString' Bytes.signPK $ \pkbuf -> - buildUnsafeByteString' Bytes.signSK $ \skbuf -> + ((_err, sk), pk) <- buildUnsafeByteString' Bytes.sign_publickeybytes $ \pkbuf -> + buildUnsafeByteString' Bytes.sign_secretkeybytes $ \skbuf -> c_sign_keypair pkbuf skbuf - return (SK sk, PK pk) + return $ Keypair (SK sk) (PK pk) -- | Augments a message with a signature forming a \"signed -- message\". @@ -91,7 +85,7 @@ -- ^ Signed message sign (SK k) m = unsafePerformIO $ alloca $ \psmlen -> do - (_err, sm) <- buildUnsafeByteString' (len + Bytes.sign) $ \psmbuf -> + (_err, sm) <- buildUnsafeByteString' (len + Bytes.sign_bytes) $ \psmbuf -> constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> c_sign psmbuf psmlen pm (fromIntegral len) pk smlen <- peek psmlen @@ -121,87 +115,47 @@ signDetached :: SecretKey -> ByteString -- ^ Message - -> ByteString + -> Signature -- ^ Signature signDetached (SK k) m = unsafePerformIO $ alloca $ \psmlen -> do - (_err, sm) <- buildUnsafeByteString' Bytes.sign $ \sigbuf -> + (_err, sm) <- buildUnsafeByteString' Bytes.sign_bytes $ \sigbuf -> constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> c_sign_detached sigbuf psmlen pm (fromIntegral len) pk smlen <- peek psmlen - return $ S.take (fromIntegral smlen) sm + return $ Signature $ S.take (fromIntegral smlen) sm where len = S.length m -- | Returns @True@ if the signature is valid for the given public key and -- message. signVerifyDetached :: PublicKey - -> ByteString + -> Signature -- ^ Signature -> ByteString - -- ^ Message + -- ^ Message (not signed) -> Bool -signVerifyDetached (PK k) sig sm = unsafePerformIO $ +signVerifyDetached (PK k) (Signature sig) sm = unsafePerformIO $ 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 - -foreign import ccall "crypto_sign_keypair" - c_sign_keypair :: Ptr CChar - -- ^ Public key output buffer - -> Ptr CChar - -- ^ Secret key output buffer - -> IO CInt - -- ^ Always 0 - -foreign import ccall "crypto_sign" - c_sign :: Ptr CChar - -- ^ Signed message output buffer - -> Ptr CULLong - -- ^ Length of signed message - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Length of message input buffer - -> Ptr CChar - -- ^ Constant secret key buffer - -> IO CInt - -- ^ Always 0 - -foreign import ccall "crypto_sign_open" - c_sign_open :: Ptr CChar - -- ^ Message output buffer - -> Ptr CULLong - -- ^ Length of message - -> Ptr CChar - -- ^ Constant signed message buffer - -> CULLong - -- ^ Length of signed message buffer - -> Ptr CChar - -- ^ Public key buffer - -> IO CInt - -- ^ 0 if signature is verifiable, -1 otherwise +-- | Converts an Ed25519 public key to an X25519 public key. +signPublicKeyToScalarMult :: PublicKey -> Maybe SM.GroupElement +signPublicKeyToScalarMult (PK pk) = unsafePerformIO $ do + (err,x) <- buildUnsafeByteString' SM.scalarmult_bytes $ \xbuf -> + constByteStrings [pk] $ \[(edbuf,_)] -> + c_sign_ed25519_pk_to_curve25519 xbuf edbuf + case err of + 0 -> return $ Just $ SM.GE x + _ -> return Nothing -foreign import ccall "crypto_sign_detached" - c_sign_detached :: Ptr CChar - -- ^ Signature output buffer - -> Ptr CULLong - -- ^ Length of the signature - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Length of message buffer - -> Ptr CChar - -- ^ Constant secret key buffer - -> IO CInt -foreign import ccall "crypto_sign_verify_detached" - c_sign_verify_detached :: Ptr CChar - -- ^ Signature buffer - -> Ptr CChar - -- ^ Constant signed message buffer - -> CULLong - -- ^ Length of signed message buffer - -> Ptr CChar - -- ^ Public key buffer - -> IO CInt +-- | Converts an Ed25519 secret key to an X25519 secret key. +signSecretKeyToScalarMult :: SecretKey -> Maybe SM.Scalar +signSecretKeyToScalarMult (SK sk) = unsafePerformIO $ do + (err,x) <- buildUnsafeByteString' SM.scalarmult_bytes $ \xbuf -> + constByteStrings [sk] $ \[(edbuf,_)] -> + c_sign_ed25519_sk_to_curve25519 xbuf edbuf + case err of + 0 -> return $ Just $ SM.Sc x + _ -> return Nothing 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 @@ -53,52 +53,25 @@ stream, xor ) 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 'stream' cryptographic key. -newtype Key = Key ByteString deriving (Eq, Ord) - -instance IsEncoding Key where - decode v = if S.length v == Bytes.streamKey - then Just (Key v) - else Nothing - {-# INLINE decode #-} - encode (Key v) = v - {-# INLINE encode #-} - --- | An opaque 'stream' nonce. -newtype Nonce = Nonce ByteString deriving (Eq, Ord) - -instance IsNonce Nonce where - zero = Nonce (S.replicate Bytes.streamNonce 0) - nudge (Nonce n) = Nonce (nudgeBS n) +import Crypto.Saltine.Internal.Stream ( c_stream + , c_stream_xor + , Key(..) + , Nonce(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) -instance IsEncoding Nonce where - decode v = if S.length v == Bytes.streamNonce - then Just (Nonce v) - else Nothing - {-# INLINE decode #-} - encode (Nonce v) = v - {-# INLINE encode #-} +import qualified Crypto.Saltine.Internal.Stream as Bytes +import qualified Data.ByteString as S -- | Creates a random key of the correct size for 'stream' and 'xor'. newKey :: IO Key -newKey = Key <$> randomByteString Bytes.streamKey +newKey = Key <$> randomByteString Bytes.stream_keybytes -- | Creates a random nonce of the correct size for 'stream' and -- 'xor'. newNonce :: IO Nonce -newNonce = Nonce <$> randomByteString Bytes.streamNonce +newNonce = Nonce <$> randomByteString Bytes.stream_noncebytes -- | Generates a cryptographic random stream indexed by the 'Key' and -- 'Nonce'. These streams are indistinguishable from random noise so @@ -128,29 +101,3 @@ constByteStrings [key, nonce, msg] $ \[(pk, _), (pn, _), (pm, _)] -> c_stream_xor pc pm (fromIntegral len) pn pk where len = S.length msg - -foreign import ccall "crypto_stream" - c_stream :: Ptr CChar - -- ^ Stream output buffer - -> CULLong - -- ^ Length of stream to generate - -> Ptr CChar - -- ^ Constant nonce buffer - -> Ptr CChar - -- ^ Constant key buffer - -> IO CInt - -- ^ Always 0 - -foreign import ccall "crypto_stream_xor" - c_stream_xor :: Ptr CChar - -- ^ Ciphertext output buffer - -> Ptr CChar - -- ^ Constant message buffer - -> CULLong - -- ^ Length of message buffer - -> Ptr CChar - -- ^ Constant nonce buffer - -> Ptr CChar - -- ^ Constant key buffer - -> IO CInt - -- ^ Always 0 diff --git a/src/Crypto/Saltine/Core/Utils.hs b/src/Crypto/Saltine/Core/Utils.hs --- a/src/Crypto/Saltine/Core/Utils.hs +++ b/src/Crypto/Saltine/Core/Utils.hs @@ -1,5 +1,6 @@ module Crypto.Saltine.Core.Utils - (Crypto.Saltine.Internal.Util.randomByteString + ( Crypto.Saltine.Internal.Util.randomByteString + , Crypto.Saltine.Internal.Util.bin2hex ) where import qualified Crypto.Saltine.Internal.Util diff --git a/src/Crypto/Saltine/Internal/AEAD/AES256GCM.hs b/src/Crypto/Saltine/Internal/AEAD/AES256GCM.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/AEAD/AES256GCM.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.AEAD.AES256GCM +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.AEAD.AES256GCM ( + aead_aes256gcm_keybytes + , aead_aes256gcm_npubbytes + , aead_aes256gcm_abytes + , c_aead_aes256gcm_is_available + , c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) +) where + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import GHC.Generics (Generic) +import Foreign.C +import Foreign.Ptr + +import qualified Data.ByteString as S + +-- | An opaque 'AES256GCM' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "AEAD.AES256GCM.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == aead_aes256gcm_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'AES256GCM' nonce. +newtype Nonce = Nonce { unNonce :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Nonce where + show k = "AEAD.AES256GCM.Nonce " <> bin2hex (encode k) + +instance IsEncoding Nonce where + decode v = if S.length v == aead_aes256gcm_npubbytes + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +instance IsNonce Nonce where + zero = Nonce (S.replicate aead_aes256gcm_npubbytes 0) + nudge (Nonce n) = Nonce (nudgeBS n) + + +aead_aes256gcm_keybytes, aead_aes256gcm_abytes, aead_aes256gcm_npubbytes :: Int + +-- | Size of an AES256 key +aead_aes256gcm_keybytes = fromIntegral c_crypto_aead_aes256gcm_keybytes +-- | Size of an AES256 nonce +aead_aes256gcm_npubbytes = fromIntegral c_crypto_aead_aes256gcm_npubbytes +-- | Size of an AES256 authentication tag +aead_aes256gcm_abytes = fromIntegral c_crypto_aead_aes256gcm_abytes + + +-- src/libsodium/crypto_aead/aes256gcm/sodium/aead_aes256gcm.c +-- src/libsodium/include/sodium/crypto_aead_aes256gcm.h +foreign import ccall "crypto_aead_aes256gcm_keybytes" + c_crypto_aead_aes256gcm_keybytes :: CSize +foreign import ccall "crypto_aead_aes256gcm_npubbytes" + c_crypto_aead_aes256gcm_npubbytes:: CSize +foreign import ccall "crypto_aead_aes256gcm_abytes" + c_crypto_aead_aes256gcm_abytes :: CSize + + +foreign import ccall "crypto_aead_aes256gcm_is_available" + c_aead_aes256gcm_is_available + :: IO CInt + +-- | The aead C API uses C strings. Always returns 0. +foreign import ccall "crypto_aead_aes256gcm_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_aes256gcm_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_aes256gcm_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_aes256gcm_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/Internal/AEAD/ChaCha20Poly1305.hs b/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305 +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305 ( + aead_chacha20poly1305_keybytes + , aead_chacha20poly1305_npubbytes + , aead_chacha20poly1305_abytes + , c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) +) where + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + + +-- | An opaque 'ChaCha20Poly1305' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "AEAD.ChaCha20Poly1305.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == aead_chacha20poly1305_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'ChaCha20Poly1305' nonce. +newtype Nonce = Nonce { unNonce :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Nonce where + show k = "AEAD.ChaCha20Poly1305.Nonce " <> bin2hex (encode k) + +instance IsEncoding Nonce where + decode v = if S.length v == aead_chacha20poly1305_npubbytes + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +instance IsNonce Nonce where + zero = Nonce (S.replicate aead_chacha20poly1305_npubbytes 0) + nudge (Nonce n) = Nonce (nudgeBS n) + + +aead_chacha20poly1305_keybytes, aead_chacha20poly1305_abytes, aead_chacha20poly1305_npubbytes :: Int + +-- | Size of a ChaCha20-Poly1305 key +aead_chacha20poly1305_keybytes = fromIntegral c_crypto_aead_chacha20poly1305_keybytes +-- | Size of a ChaCha20-Poly1305 nonce +aead_chacha20poly1305_npubbytes = fromIntegral c_crypto_aead_chacha20poly1305_npubbytes +-- | Size of a ChaCha20-Poly1305 authentication tag +aead_chacha20poly1305_abytes = fromIntegral c_crypto_aead_chacha20poly1305_abytes + + +-- src/libsodium/crypto_aead/xchacha20poly1305/sodium/aead_xchacha20poly1305.c +-- src/libsodium/include/sodium/crypto_aead_xchacha20poly1305.h +foreign import ccall "crypto_aead_chacha20poly1305_keybytes" + c_crypto_aead_chacha20poly1305_keybytes :: CSize +foreign import ccall "crypto_aead_chacha20poly1305_npubbytes" + c_crypto_aead_chacha20poly1305_npubbytes:: CSize +foreign import ccall "crypto_aead_chacha20poly1305_abytes" + c_crypto_aead_chacha20poly1305_abytes :: CSize + + +-- | The aead C API uses C strings. Always returns 0. +foreign import ccall "crypto_aead_chacha20poly1305_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_chacha20poly1305_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_chacha20poly1305_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_chacha20poly1305_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/Internal/AEAD/ChaCha20Poly1305IETF.hs b/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305IETF.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305IETF.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305IETF +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305IETF ( + aead_chacha20poly1305_ietf_keybytes + , aead_chacha20poly1305_ietf_npubbytes + , aead_chacha20poly1305_ietf_abytes + , c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) +) where + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + + +-- | An opaque 'ChaCha20Poly1305IETF' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "AEAD.ChaCha20Poly1305IETF.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == aead_chacha20poly1305_ietf_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'ChaCha20Poly1305IETF' nonce. +newtype Nonce = Nonce { unNonce :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Nonce where + show k = "AEAD.ChaCha20Poly1305IETF.Nonce " <> bin2hex (encode k) + +instance IsEncoding Nonce where + decode v = if S.length v == aead_chacha20poly1305_ietf_npubbytes + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +instance IsNonce Nonce where + zero = Nonce (S.replicate aead_chacha20poly1305_ietf_npubbytes 0) + nudge (Nonce n) = Nonce (nudgeBS n) + +aead_chacha20poly1305_ietf_keybytes, aead_chacha20poly1305_ietf_abytes, aead_chacha20poly1305_ietf_npubbytes :: Int + +-- | Size of a ChaCha20-Poly1305-IETF key +aead_chacha20poly1305_ietf_keybytes = fromIntegral c_crypto_aead_chacha20poly1305_ietf_keybytes +-- | Size of a ChaCha20-Poly1305-IETF nonce +aead_chacha20poly1305_ietf_npubbytes = fromIntegral c_crypto_aead_chacha20poly1305_ietf_npubbytes +-- | Size of a ChaCha20-Poly1305-IETF authentication tag +aead_chacha20poly1305_ietf_abytes = fromIntegral c_crypto_aead_chacha20poly1305_ietf_abytes + + +-- src/libsodium/crypto_aead/chacha20poly1305/sodium/aead_chacha20poly1305.c +-- src/libsodium/include/sodium/crypto_aead_chacha20poly1305.h +foreign import ccall "crypto_aead_chacha20poly1305_ietf_keybytes" + c_crypto_aead_chacha20poly1305_ietf_keybytes :: CSize +foreign import ccall "crypto_aead_chacha20poly1305_ietf_npubbytes" + c_crypto_aead_chacha20poly1305_ietf_npubbytes:: CSize +foreign import ccall "crypto_aead_chacha20poly1305_ietf_abytes" + c_crypto_aead_chacha20poly1305_ietf_abytes :: CSize + + +-- | The aead C API uses C strings. Always returns 0. +foreign import ccall "crypto_aead_chacha20poly1305_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_chacha20poly1305_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_chacha20poly1305_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_chacha20poly1305_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/Internal/AEAD/XChaCha20Poly1305.hs b/src/Crypto/Saltine/Internal/AEAD/XChaCha20Poly1305.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/AEAD/XChaCha20Poly1305.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.AEAD.XChaCha20Poly1305 +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.AEAD.XChaCha20Poly1305 ( + aead_xchacha20poly1305_ietf_keybytes + , aead_xchacha20poly1305_ietf_npubbytes + , aead_xchacha20poly1305_ietf_abytes + , c_aead + , c_aead_open + , c_aead_detached + , c_aead_open_detached + , Key(..) + , Nonce(..) +) where + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + +-- | An opaque 'XChaCha20Poly1305' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "AEAD.XChaCha20Poly1305.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == aead_xchacha20poly1305_ietf_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'XChaCha20Poly1305' nonce. +newtype Nonce = Nonce { unNonce :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Nonce where + show k = "AEAD.XChaCha20Poly1305.Nonce " <> bin2hex (encode k) + +instance IsEncoding Nonce where + decode v = if S.length v == aead_xchacha20poly1305_ietf_npubbytes + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +instance IsNonce Nonce where + zero = Nonce (S.replicate aead_xchacha20poly1305_ietf_npubbytes 0) + nudge (Nonce n) = Nonce (nudgeBS n) + + +aead_xchacha20poly1305_ietf_keybytes, aead_xchacha20poly1305_ietf_abytes, aead_xchacha20poly1305_ietf_npubbytes :: Int + +-- | Size of a XChaCha20-Poly1305 key +aead_xchacha20poly1305_ietf_keybytes = fromIntegral c_crypto_aead_xchacha20poly1305_ietf_keybytes +-- | Size of a XChaCha20-Poly1305 nonce +aead_xchacha20poly1305_ietf_npubbytes = fromIntegral c_crypto_aead_xchacha20poly1305_ietf_npubbytes +-- | Size of a XChaCha20-Poly1305 authentication tag +aead_xchacha20poly1305_ietf_abytes = fromIntegral c_crypto_aead_xchacha20poly1305_ietf_abytes + + +-- src/libsodium/crypto_aead/xchacha20poly1305/sodium/aead_xchacha20poly1305.c +-- src/libsodium/include/sodium/crypto_aead_xchacha20poly1305.h +foreign import ccall "crypto_aead_xchacha20poly1305_ietf_keybytes" + c_crypto_aead_xchacha20poly1305_ietf_keybytes :: CSize +foreign import ccall "crypto_aead_xchacha20poly1305_ietf_npubbytes" + c_crypto_aead_xchacha20poly1305_ietf_npubbytes:: CSize +foreign import ccall "crypto_aead_xchacha20poly1305_ietf_abytes" + c_crypto_aead_xchacha20poly1305_ietf_abytes :: CSize + + +-- | 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/Internal/Auth.hs b/src/Crypto/Saltine/Internal/Auth.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/Auth.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.Auth +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.Auth ( + auth_bytes + , auth_keybytes + , c_auth + , c_auth_verify + , Key(..) + , Authenticator(..) +) where + + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import GHC.Generics (Generic) +import Foreign.C +import Foreign.Ptr + +import qualified Data.ByteString as S + +-- | An opaque 'auth' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "Auth.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == auth_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'auth' authenticator. +newtype Authenticator = Au { unAu :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Authenticator where + show k = "Auth.Authenticator " <> bin2hex (encode k) + +instance IsEncoding Authenticator where + decode v = if S.length v == auth_bytes + then Just (Au v) + else Nothing + {-# INLINE decode #-} + encode (Au v) = v + {-# INLINE encode #-} + + +auth_bytes, auth_keybytes :: Int + +-- Authentication +-- | Size of a @crypto_auth@ authenticator. +auth_bytes = fromIntegral c_crypto_auth_bytes +-- | Size of a @crypto_auth@ authenticator key. +auth_keybytes = fromIntegral c_crypto_auth_keybytes + +-- src/libsodium/crypto_auth/crypto_auth.c +foreign import ccall "crypto_auth_bytes" + c_crypto_auth_bytes :: CSize +foreign import ccall "crypto_auth_keybytes" + c_crypto_auth_keybytes :: CSize + +foreign import ccall "crypto_auth" + c_auth :: Ptr CChar + -- ^ Authenticator output buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Length of message buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + -- ^ Always 0 + +-- | We don't even include this in the IO monad since all of the +-- buffers are constant. +foreign import ccall "crypto_auth_verify" + c_auth_verify :: Ptr CChar + -- ^ Constant authenticator buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Length of message buffer + -> Ptr CChar + -- ^ Constant key buffer + -> CInt + -- ^ Success if 0, failure if -1 diff --git a/src/Crypto/Saltine/Internal/Box.hs b/src/Crypto/Saltine/Internal/Box.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/Box.hs @@ -0,0 +1,285 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.Box +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.Box ( + box_publickeybytes + , box_secretkeybytes + , box_noncebytes + , box_zerobytes + , box_boxzerobytes + , box_macbytes + , box_beforenmbytes + , box_sealbytes + , c_box_keypair + , c_box_easy + , c_box_open_easy + , c_box_beforenm + , c_box_easy_afternm + , c_box_open_easy_afternm + , c_box_seal + , c_box_seal_open + , SecretKey(..) + , PublicKey(..) + , Keypair(..) + , CombinedKey(..) + , Nonce(..) +) where + +import Control.DeepSeq (NFData) +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + +-- | An opaque 'box' cryptographic secret key. +newtype SecretKey = SK { unSK :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq SecretKey where + SK a == SK b = U.compare a b +instance Show SecretKey where + show k = "Box.SecretKey {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding SecretKey where + decode v = if S.length v == box_secretkeybytes + then Just (SK v) + else Nothing + {-# INLINE decode #-} + encode (SK v) = v + {-# INLINE encode #-} + +-- | An opaque 'box' cryptographic public key. +newtype PublicKey = PK { unPK :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq PublicKey where + PK a == PK b = U.compare a b +instance Show PublicKey where + show k = "Box.PublicKey {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding PublicKey where + decode v = if S.length v == box_publickeybytes + then Just (PK v) + else Nothing + {-# INLINE decode #-} + encode (PK v) = v + {-# INLINE encode #-} + +-- | A convenience type for keypairs +data Keypair = Keypair { + secretKey :: SecretKey + , publicKey :: PublicKey +} deriving (Ord, Data, Typeable, Generic) + +instance Eq Keypair where + kp1 == kp2 = U.compare (encode $ secretKey kp1) (encode $ secretKey kp2) + !&&! U.compare (encode $ publicKey kp1) (encode $ publicKey kp2) + +instance Show Keypair where + show k = "Box.Keypair {secretKey = " <> show (secretKey k) <> ", publicKey = " <> show (publicKey k) <> "}" + +instance Hashable Keypair +instance NFData Keypair + +-- | An opaque 'boxAfterNM' cryptographic combined key. +newtype CombinedKey = CK { unCK :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq CombinedKey where + CK a == CK b = U.compare a b +instance Show CombinedKey where + show k = "Box.CombinedKey {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding CombinedKey where + decode v = if S.length v == box_beforenmbytes + then Just (CK v) + else Nothing + {-# INLINE decode #-} + encode (CK v) = v + {-# INLINE encode #-} + +-- | An opaque 'box' nonce. +newtype Nonce = Nonce { unNonce :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Nonce where + show k = "Box.Nonce " <> bin2hex (encode k) + +instance IsEncoding Nonce where + decode v = if S.length v == box_noncebytes + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +instance IsNonce Nonce where + zero = Nonce (S.replicate box_noncebytes 0) + nudge (Nonce n) = Nonce (nudgeBS n) + + +box_publickeybytes, box_secretkeybytes, box_noncebytes, box_zerobytes, box_boxzerobytes :: Int +box_macbytes, box_beforenmbytes, box_sealbytes :: Int + +-- Box +-- | Size of a @crypto_box@ public key +box_publickeybytes = fromIntegral c_crypto_box_publickeybytes +-- | Size of a @crypto_box@ secret key +box_secretkeybytes = fromIntegral c_crypto_box_secretkeybytes +-- | Size of a @crypto_box@ nonce +box_noncebytes = fromIntegral c_crypto_box_noncebytes +-- | Size of 0-padding prepended to messages before using @crypto_box@ +-- or after using @crypto_box_open@ +box_zerobytes = fromIntegral c_crypto_box_zerobytes +-- | Size of 0-padding prepended to ciphertext before using +-- @crypto_box_open@ or after using @crypto_box@. +box_boxzerobytes = fromIntegral c_crypto_box_boxzerobytes +box_macbytes = fromIntegral c_crypto_box_macbytes +-- | Size of a @crypto_box_beforenm@-generated combined key +box_beforenmbytes = fromIntegral c_crypto_box_beforenmbytes + +-- SealedBox +-- | Amount by which ciphertext is longer than plaintext +-- in sealed boxes +box_sealbytes = fromIntegral c_crypto_box_sealbytes + +-- src/libsodium/crypto_box/crypto_box.c +foreign import ccall "crypto_box_publickeybytes" + c_crypto_box_publickeybytes :: CSize +foreign import ccall "crypto_box_secretkeybytes" + c_crypto_box_secretkeybytes :: CSize +foreign import ccall "crypto_box_beforenmbytes" + c_crypto_box_beforenmbytes :: CSize +foreign import ccall "crypto_box_noncebytes" + c_crypto_box_noncebytes :: CSize +foreign import ccall "crypto_box_zerobytes" + c_crypto_box_zerobytes :: CSize +foreign import ccall "crypto_box_boxzerobytes" + c_crypto_box_boxzerobytes :: CSize +foreign import ccall "crypto_box_macbytes" + c_crypto_box_macbytes :: CSize + +-- src/libsodium/crypto_box_seal.c +foreign import ccall "crypto_box_sealbytes" + c_crypto_box_sealbytes :: CSize + +-- | Should always return a 0. +foreign import ccall "crypto_box_keypair" + c_box_keypair :: Ptr CChar + -- ^ Public key + -> Ptr CChar + -- ^ Secret key + -> IO CInt + -- ^ Always 0 + +-- | The secretbox C API uses C strings. +foreign import ccall "crypto_box_easy" + c_box_easy :: Ptr CChar + -- ^ Cipher output buffer + -> Ptr CChar + -- ^ Constant message 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 + -- ^ 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 + -- ^ Combined key output buffer + -> Ptr CChar + -- ^ Constant public key buffer + -> Ptr CChar + -- ^ Constant secret key buffer + -> IO CInt + -- ^ Always 0 + +-- | 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 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 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. +foreign import ccall "crypto_box_seal" + c_box_seal :: Ptr CChar + -- ^ Cipher output buffer + -> Ptr CChar + -- ^ Constant message input buffer + -> CULLong + -- ^ Length of message input buffer + -> Ptr CChar + -- ^ Constant public key buffer + -> IO CInt + -- ^ Always 0 + +-- | The sealedbox C API uses C strings. +foreign import ccall "crypto_box_seal_open" + c_box_seal_open :: Ptr CChar + -- ^ Message output buffer + -> Ptr CChar + -- ^ Constant ciphertext input buffer + -> CULLong + -- ^ Length of message input buffer + -> Ptr CChar + -- ^ Constant public key buffer + -> Ptr CChar + -- ^ Constant secret key buffer + -> IO CInt + -- ^ 0 for success, -1 for failure to decrypt 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 @@ -1,263 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -- | --- Module : Crypto.Saltine.Core.ScalarMult +-- Module : Crypto.Saltine.Internal.ByteSizes -- Copyright : (c) Joseph Abrahamson 2013 +-- (c) Max Amanshauser 2021 -- License : MIT -- --- Maintainer : me@jspha.com +-- Maintainer : max@lambdalifting.org -- Stability : experimental -- Portability : non-portable -- --- Various sizes --- --- While technically these sizes are hidden behind opaque newtype --- wrappers, they can be useful for computation and sizing and are --- thus exposed. --- --- As of @libsodium-4.1@ some of these sizes are not exported and thus --- are hardcoded here. This limitation should be removed in later --- versions of @libsodium@. module Crypto.Saltine.Internal.ByteSizes ( - - auth, - authKey, - boxPK, - boxSK, - boxNonce, - boxZero, - boxBoxZero, - boxMac, - boxBeforeNM, - sealedBox, - onetime, - onetimeKey, - mult, - multScalar, - secretBoxKey, - secretBoxNonce, - secretBoxMac, - secretBoxZero, - secretBoxBoxZero, - aead_xchacha20poly1305_ietf_ABYTES, - sign, - signPK, - signSK, - streamKey, - streamNonce, - hash, - shorthash, - shorthashKey ) where -import Foreign.C - --- Constants for - -auth, authKey :: Int -boxPK, boxSK, boxNonce, boxZero, boxBoxZero :: Int -boxMac, boxBeforeNM, sealedBox :: Int -onetime, onetimeKey :: Int -mult, multScalar :: Int -secretBoxKey, secretBoxNonce, secretBoxMac, secretBoxZero, secretBoxBoxZero :: Int -sign, signPK, signSK :: Int -streamKey, streamNonce :: Int -hash, shorthash, shorthashKey :: Int - - --- Authentication --- | Size of a @crypto_auth@ authenticator. -auth = fromIntegral c_crypto_auth_bytes --- | Size of a @crypto_auth@ authenticator key. -authKey = fromIntegral c_crypto_auth_keybytes - --- Box --- | Size of a @crypto_box@ public key -boxPK = fromIntegral c_crypto_box_publickeybytes --- | Size of a @crypto_box@ secret key -boxSK = fromIntegral c_crypto_box_secretkeybytes --- | Size of a @crypto_box@ nonce -boxNonce = fromIntegral c_crypto_box_noncebytes --- | Size of 0-padding prepended to messages before using @crypto_box@ --- or after using @crypto_box_open@ -boxZero = fromIntegral c_crypto_box_zerobytes --- | Size of 0-padding prepended to ciphertext before using --- @crypto_box_open@ or after using @crypto_box@. -boxBoxZero = fromIntegral c_crypto_box_boxzerobytes -boxMac = fromIntegral c_crypto_box_macbytes --- | Size of a @crypto_box_beforenm@-generated combined key -boxBeforeNM = - fromIntegral c_crypto_box_beforenmbytes - --- SealedBox --- | Amount by which ciphertext is longer than plaintext --- in sealed boxes -sealedBox = fromIntegral c_crypto_box_sealbytes - --- OneTimeAuth --- | Size of a @crypto_onetimeauth@ authenticator. -onetime = fromIntegral c_crypto_onetimeauth_bytes --- | Size of a @crypto_onetimeauth@ authenticator key. -onetimeKey = fromIntegral c_crypto_onetimeauth_keybytes - --- ScalarMult --- | Size of a group element string representation for --- @crypto_scalarmult@. -mult = fromIntegral c_crypto_scalarmult_bytes --- | Size of a integer string representation for @crypto_scalarmult@. -multScalar = fromIntegral c_crypto_scalarmult_scalarbytes - --- SecretBox --- | Size of a @crypto_secretbox@ secret key -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 --- | Size of 0-padding prepended to ciphertext before using --- @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. -sign = fromIntegral c_crypto_sign_bytes --- | The size of a public key for signing verification -signPK = fromIntegral c_crypto_sign_publickeybytes --- | The size of a secret key for signing -signSK = fromIntegral c_crypto_sign_secretkeybytes - --- Streams --- | The size of a key for the cryptographic stream generation -streamKey = fromIntegral c_crypto_stream_keybytes --- | The size of a nonce for the cryptographic stream generation -streamNonce = fromIntegral c_crypto_stream_noncebytes - --- Hashes --- | The size of a hash resulting from --- 'Crypto.Saltine.Internal.Hash.hash'. -hash = fromIntegral c_crypto_hash_bytes --- | The size of a keyed hash resulting from --- 'Crypto.Saltine.Internal.Hash.shorthash'. -shorthash = fromIntegral c_crypto_shorthash_bytes --- | The size of a hashing key for the keyed hash function --- 'Crypto.Saltine.Internal.Hash.shorthash'. -shorthashKey = fromIntegral c_crypto_shorthash_keybytes - --- src/libsodium/crypto_auth/crypto_auth.c -foreign import ccall "crypto_auth_bytes" - c_crypto_auth_bytes :: CSize -foreign import ccall "crypto_auth_keybytes" - c_crypto_auth_keybytes :: CSize - --- src/libsodium/crypto_box/crypto_box.c -foreign import ccall "crypto_box_publickeybytes" - c_crypto_box_publickeybytes :: CSize -foreign import ccall "crypto_box_secretkeybytes" - c_crypto_box_secretkeybytes :: CSize -foreign import ccall "crypto_box_beforenmbytes" - c_crypto_box_beforenmbytes :: CSize -foreign import ccall "crypto_box_noncebytes" - c_crypto_box_noncebytes :: CSize -foreign import ccall "crypto_box_zerobytes" - c_crypto_box_zerobytes :: CSize -foreign import ccall "crypto_box_boxzerobytes" - c_crypto_box_boxzerobytes :: CSize -foreign import ccall "crypto_box_macbytes" - c_crypto_box_macbytes :: CSize - --- src/libsodium/crypto_box_seal.c -foreign import ccall "crypto_box_sealbytes" - c_crypto_box_sealbytes :: CSize - --- src/libsodium/crypto_onetimeauth/crypto_onetimeauth.c -foreign import ccall "crypto_onetimeauth_bytes" - c_crypto_onetimeauth_bytes :: CSize -foreign import ccall "crypto_onetimeauth_keybytes" - c_crypto_onetimeauth_keybytes :: CSize - --- src/libsodium/crypto_scalarmult/crypto_scalarmult.c -foreign import ccall "crypto_scalarmult_bytes" - c_crypto_scalarmult_bytes :: CSize -foreign import ccall "crypto_scalarmult_scalarbytes" - c_crypto_scalarmult_scalarbytes :: CSize - --- src/libsodium/crypto_secretbox/crypto_secretbox.c -foreign import ccall "crypto_secretbox_keybytes" - 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" - c_crypto_secretbox_boxzerobytes :: CSize - --- src/libsodium/crypto_sign/crypto_sign.c -foreign import ccall "crypto_sign_bytes" - c_crypto_sign_bytes :: CSize -foreign import ccall "crypto_sign_publickeybytes" - c_crypto_sign_publickeybytes :: CSize -foreign import ccall "crypto_sign_secretkeybytes" - c_crypto_sign_secretkeybytes :: CSize - --- 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 --- exports the C constant. -c_crypto_stream_keybytes :: CSize -c_crypto_stream_keybytes = 32 - --- | The size of a @crypto_stream@ or @crypto_stream_xor@ --- nonce. HARDCODED to be @crypto_stream_xsalsa20@ for now until --- Sodium exports the C constant. -c_crypto_stream_noncebytes :: CSize -c_crypto_stream_noncebytes = 24 - --- | The size of a @crypto_hash@ output hash. HARDCODED to be --- @crypto_hash_sha512@ for now until Sodium exports the C constant. -c_crypto_hash_bytes :: CSize -c_crypto_hash_bytes = 64 - --- | The size of a @crypto_shorthash@ output hash. HARDCODED to be --- @crypto_shorthash_siphash24@ for now until Sodium exports the C --- constant. -c_crypto_shorthash_bytes :: CSize -c_crypto_shorthash_bytes = 8 - --- | The size of a @crypto_shorthash@ key. HARDCODED to be --- @crypto_shorthash_siphash24@ for now until Sodium exports the C --- constant. -c_crypto_shorthash_keybytes :: CSize -c_crypto_shorthash_keybytes = 16 - - --- src/libsodium/crypto_stream/crypto_stream.c --- foreign import ccall "crypto_stream_keybytes" --- c_crypto_stream_keybytes :: CSize --- foreign import ccall "crypto_stream_noncebytes" --- c_crypto_stream_noncebytes :: CSize - --- src/libsodium/crypto_shorthash/crypto_shorthash.c --- foreign import ccall "crypto_shorthash_bytes" --- c_crypto_shorthash_bytes :: CSize --- foreign import ccall "crypto_shorthash_keybytes" --- c_crypto_shorthash_keybytes :: CSize -- Others -- ------ diff --git a/src/Crypto/Saltine/Internal/Hash.hs b/src/Crypto/Saltine/Internal/Hash.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/Hash.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.Hash +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.Hash ( + hash_bytes + , shorthash_bytes + , shorthash_keybytes + , generichash_bytes_max + , generichash_keybytes_max + , hash_sha256_bytes + , c_hash + , c_shorthash + , c_generichash + , c_hash_sha256 + , nullShKey + , shorthash + , ShorthashKey(..) + , GenerichashKey(..) + , GenerichashOutLen(..) +) where + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 + +-- | An opaque 'shorthash' cryptographic secret key. +newtype ShorthashKey = ShK { unShK :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq ShorthashKey where + ShK a == ShK b = U.compare a b +instance Show ShorthashKey where + show k = "Hash.ShorthashKey {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +-- | Used for our `Show` instances +nullShKey :: ShorthashKey +nullShKey = ShK (S8.replicate shorthash_keybytes '\NUL') + +-- | Computes a very short, fast keyed hash. +-- This function is defined here to break circulat module imports +shorthash :: ShorthashKey + -> ByteString + -- ^ Message + -> ByteString + -- ^ Hash +shorthash (ShK k) m = snd . buildUnsafeByteString shorthash_bytes $ \ph -> + constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> + c_shorthash ph pm (fromIntegral $ S.length m) pk + +instance IsEncoding ShorthashKey where + decode v = if S.length v == shorthash_keybytes + then Just (ShK v) + else Nothing + {-# INLINE decode #-} + encode (ShK v) = v + {-# INLINE encode #-} + +-- | An opaque 'generichash' cryptographic secret key. +newtype GenerichashKey = GhK { unGhK :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq GenerichashKey where + GhK a == GhK b = U.compare a b +instance Show GenerichashKey where + show k = "Hash.GenerichashKey {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding GenerichashKey where + decode v = if S.length v <= generichash_keybytes_max + then Just (GhK v) + else Nothing + {-# INLINE decode #-} + encode (GhK v) = v + {-# INLINE encode #-} + +newtype GenerichashOutLen = GhOL { unGhOL :: Int } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) + +hash_bytes, shorthash_bytes, shorthash_keybytes, generichash_bytes_max, generichash_keybytes_max, hash_sha256_bytes :: Int + +-- Hashes +-- | The size of a hash resulting from +-- 'Crypto.Saltine.Internal.Hash.hash'. +hash_bytes = fromIntegral c_crypto_hash_bytes +-- | The size of a keyed hash resulting from +-- 'Crypto.Saltine.Internal.Hash.shorthash'. +shorthash_bytes = fromIntegral c_crypto_shorthash_bytes +-- | The size of a hashing key for the keyed hash function +-- 'Crypto.Saltine.Internal.Hash.shorthash'. +shorthash_keybytes = fromIntegral c_crypto_shorthash_keybytes +-- | The maximum output size of the generic hash function +-- 'Crypto.Saltine.Core.Hash.generichash' +generichash_bytes_max = fromIntegral c_crypto_generichash_bytes_max +-- | The maximum key size of the generic hash function +-- 'Crypto.Saltine.Core.Hash.generichash' +generichash_keybytes_max = fromIntegral c_crypto_generichash_keybytes_max +-- | The size of a hash resulting from +-- 'Crypto.Saltine.Core.Hash.sha256'. +hash_sha256_bytes = fromIntegral c_crypto_hash_sha256_bytes + +-- src/libsodium/crypto_generichash/crypto_generichash.c +foreign import ccall "crypto_generichash_bytes_max" + c_crypto_generichash_bytes_max :: CSize +foreign import ccall "crypto_generichash_keybytes_max" + c_crypto_generichash_keybytes_max :: CSize + +-- src/libsodium/crypto_hash/crypto_hash.c +-- src/libsodium/include/sodium/crypto_hash.h +foreign import ccall "crypto_hash_bytes" + c_crypto_hash_bytes :: CSize + +-- src/libsodium/crypto_shorthash/crypto_shorthash.c +-- src/libsodium/include/sodium/crypto_shorthash.h +foreign import ccall "crypto_shorthash_bytes" + c_crypto_shorthash_bytes :: CSize +foreign import ccall "crypto_shorthash_keybytes" + c_crypto_shorthash_keybytes :: CSize + +-- src/libsodium/crypto_hash/sha256/hash_sha256.c +-- src/libsodium/include/sodium/crypto_hash_sha256.h +foreign import ccall "crypto_hash_sha256_bytes" + c_crypto_hash_sha256_bytes :: CSize + + +foreign import ccall "crypto_hash" + c_hash :: Ptr CChar + -- ^ Output hash buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Constant message buffer length + -> IO CInt + -- ^ Always 0 + +foreign import ccall "crypto_shorthash" + c_shorthash :: Ptr CChar + -- ^ Output hash buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Message buffer length + -> Ptr CChar + -- ^ Constant Key buffer + -> IO CInt + -- ^ Always 0 + +foreign import ccall "crypto_generichash" + c_generichash :: Ptr CChar + -- ^ Output hash buffer + -> CULLong + -- ^ Output hash length + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Message buffer length + -> Ptr CChar + -- ^ Constant Key buffer + -> CULLong + -- ^ Key buffer length + -> IO CInt + -- ^ Always 0 + +foreign import ccall "crypto_hash_sha256" + c_hash_sha256 :: Ptr CChar + -- ^ Output hash buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Message buffer length + -> IO CInt + -- ^ Always 0 diff --git a/src/Crypto/Saltine/Internal/OneTimeAuth.hs b/src/Crypto/Saltine/Internal/OneTimeAuth.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/OneTimeAuth.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.OneTimeAuth +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.OneTimeAuth ( + onetimeauth_bytes + , onetimeauth_keybytes + , c_onetimeauth + , c_onetimeauth_verify + , Key(..) + , Authenticator(..) +) where + + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + +-- | An opaque 'auth' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "OneTimeAuth.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == onetimeauth_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'auth' authenticator. +newtype Authenticator = Au { unAu :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Authenticator where + show k = "OneTimeAuth.Authenticator " <> bin2hex (encode k) + +instance IsEncoding Authenticator where + decode v = if S.length v == onetimeauth_bytes + then Just (Au v) + else Nothing + {-# INLINE decode #-} + encode (Au v) = v + {-# INLINE encode #-} + + +onetimeauth_bytes, onetimeauth_keybytes :: Int + +-- OneTimeAuth +-- | Size of a @crypto_onetimeauth@ authenticator. +onetimeauth_bytes = fromIntegral c_crypto_onetimeauth_bytes +-- | Size of a @crypto_onetimeauth@ authenticator key. +onetimeauth_keybytes = fromIntegral c_crypto_onetimeauth_keybytes + +-- src/libsodium/crypto_onetimeauth/crypto_onetimeauth.c +foreign import ccall "crypto_onetimeauth_bytes" + c_crypto_onetimeauth_bytes :: CSize +foreign import ccall "crypto_onetimeauth_keybytes" + c_crypto_onetimeauth_keybytes :: CSize + + +foreign import ccall "crypto_onetimeauth" + c_onetimeauth :: Ptr CChar + -- ^ Authenticator output buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Length of message buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + -- ^ Always 0 + +-- | We don't even include this in the IO monad since all of the +-- buffers are constant. +foreign import ccall "crypto_onetimeauth_verify" + c_onetimeauth_verify :: Ptr CChar + -- ^ Constant authenticator buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Length of message buffer + -> Ptr CChar + -- ^ Constant key buffer + -> CInt + -- ^ Success if 0, failure if -1 diff --git a/src/Crypto/Saltine/Internal/Password.hs b/src/Crypto/Saltine/Internal/Password.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/Password.hs @@ -0,0 +1,567 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} + +-- | +-- Module : Crypto.Saltine.Internal.Password +-- Copyright : (c) Promethea Raschke 2018 +-- Max Amanshauser 2021 +-- License : MIT +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable + +module Crypto.Saltine.Internal.Password + ( c_pwhash + , c_pwhash_str + , c_pwhash_str_verify + , c_pwhash_str_needs_rehash + + , pwhash_alg_argon2i13 + , pwhash_alg_argon2id13 + , pwhash_alg_default + , algorithm + + -- Default algorithm constants + , pwhash_bytes_max + , pwhash_bytes_min + + , pwhash_memlimit_interactive + , pwhash_memlimit_moderate + , pwhash_memlimit_sensitive + , pwhash_memlimit_min + , pwhash_memlimit_max + + , pwhash_opslimit_interactive + , pwhash_opslimit_moderate + , pwhash_opslimit_sensitive + , pwhash_opslimit_min + , pwhash_opslimit_max + + , pwhash_passwd_min + , pwhash_passwd_max + , pwhash_saltbytes + , pwhash_strbytes + , pwhash_strprefix + + -- Argon2i algorithm constants + , pwhash_argon2i_bytes_max + , pwhash_argon2i_bytes_min + + , pwhash_argon2i_memlimit_interactive + , pwhash_argon2i_memlimit_moderate + , pwhash_argon2i_memlimit_sensitive + , pwhash_argon2i_memlimit_min + , pwhash_argon2i_memlimit_max + + , pwhash_argon2i_opslimit_interactive + , pwhash_argon2i_opslimit_moderate + , pwhash_argon2i_opslimit_sensitive + , pwhash_argon2i_opslimit_min + , pwhash_argon2i_opslimit_max + + , pwhash_argon2i_passwd_min + , pwhash_argon2i_passwd_max + , pwhash_argon2i_saltbytes + , pwhash_argon2i_strbytes + , pwhash_argon2i_strprefix + + -- Argon2id algorithm constants + , pwhash_argon2id_bytes_max + , pwhash_argon2id_bytes_min + + , pwhash_argon2id_memlimit_interactive + , pwhash_argon2id_memlimit_moderate + , pwhash_argon2id_memlimit_sensitive + , pwhash_argon2id_memlimit_min + , pwhash_argon2id_memlimit_max + + , pwhash_argon2id_opslimit_interactive + , pwhash_argon2id_opslimit_moderate + , pwhash_argon2id_opslimit_sensitive + , pwhash_argon2id_opslimit_min + , pwhash_argon2id_opslimit_max + + , pwhash_argon2id_passwd_min + , pwhash_argon2id_passwd_max + , pwhash_argon2id_saltbytes + , pwhash_argon2id_strbytes + , pwhash_argon2id_strprefix + + , Salt(..) + , PasswordHash(..) + , Opslimit(..) + , Memlimit(..) + , Policy(..) + , Algorithm(..) + ) where + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Data.Text (Text) +import GHC.Generics (Generic) +import Foreign.C +import Foreign.Ptr + +import qualified Data.ByteString as S +import qualified Data.Text.Encoding as DTE + + +-- | Salt for deriving keys from passwords +newtype Salt = Salt { unSalt :: ByteString } deriving (Ord, Data, Hashable, Typeable, Generic, NFData) +instance Eq Salt where + Salt a == Salt b = U.compare a b +instance Show Salt where + show k = "Password.Salt " <> bin2hex (encode k) + +instance IsEncoding Salt where + decode v = if S.length v == pwhash_saltbytes + then Just (Salt v) + else Nothing + {-# INLINE decode #-} + encode (Salt v) = v + {-# INLINE encode #-} + +-- | Verification string for stored passwords +-- This hash contains only printable characters, hence we can just derive Show. +newtype PasswordHash = PasswordHash { unPasswordHash :: Text } deriving (Ord, Data, Hashable, Typeable, Generic, Show, NFData) +-- Constant time Eq instance, just in case. +instance Eq PasswordHash where + PasswordHash a == PasswordHash b = U.compare (DTE.encodeUtf8 a) (DTE.encodeUtf8 b) + +-- | Wrapper type for the operations used by password hashing +newtype Opslimit = Opslimit { getOpslimit :: Int } deriving (Eq, Ord, Data, Hashable, Typeable, Generic, Show, NFData) + +-- | Wrapper type for the memory used by password hashing +newtype Memlimit = Memlimit { getMemlimit :: Int } deriving (Eq, Ord, Data, Hashable, Typeable, Generic, Show, NFData) + +-- | Wrapper for opslimit, memlimit and algorithm +data Policy = Policy + { opsPolicy :: Opslimit + , memPolicy :: Memlimit + , algPolicy :: Algorithm + } deriving (Eq, Ord, Data, Typeable, Generic, Show) +instance Hashable Policy + +-- | Algorithms known to Libsodium, as an enum datatype +data Algorithm + = DefaultAlgorithm + | Argon2i13 + | Argon2id13 + deriving (Eq, Enum, Ord, Show, Generic, Data, Typeable, Bounded) +instance Hashable Algorithm + +algorithm :: Algorithm -> CInt +algorithm DefaultAlgorithm = fromIntegral pwhash_alg_default +algorithm Argon2i13 = fromIntegral pwhash_alg_argon2i13 +algorithm Argon2id13 = fromIntegral pwhash_alg_argon2id13 + +-- | Lets libsodium pick a hashing algorithm +pwhash_alg_default :: Int +pwhash_alg_default = fromIntegral c_crypto_pwhash_alg_default +-- | version 1.3 of the Argon2i algorithm +pwhash_alg_argon2i13 :: Int +pwhash_alg_argon2i13 = fromIntegral c_crypto_pwhash_alg_argon2i13 +-- | version 1.3 of the Argon2id algorithm +pwhash_alg_argon2id13 :: Int +pwhash_alg_argon2id13 = fromIntegral c_crypto_pwhash_alg_argon2id13 + +-- | Constants for the default algorithm +-- | Minimum output length for key derivation (16 (128 bits)). +pwhash_bytes_min :: Int +pwhash_bytes_min = fromIntegral c_crypto_pwhash_bytes_min +-- | Maximum output length for key derivation. +pwhash_bytes_max :: Int +pwhash_bytes_max = fromIntegral c_crypto_pwhash_bytes_max + +-- | Minimum allowed memory limit for password hashing +pwhash_memlimit_min :: Int +pwhash_memlimit_min = fromIntegral c_crypto_pwhash_memlimit_min +-- | Maximum allowed memory limit for password hashing +pwhash_memlimit_max :: Int +pwhash_memlimit_max = fromIntegral c_crypto_pwhash_memlimit_max +-- | Constant for currently 64MB memory +pwhash_memlimit_interactive :: Int +pwhash_memlimit_interactive = fromIntegral c_crypto_pwhash_memlimit_interactive +-- | Constant for currently 256MB memory +pwhash_memlimit_moderate :: Int +pwhash_memlimit_moderate = fromIntegral c_crypto_pwhash_memlimit_moderate +-- | Constant for currently 1024MB memory +pwhash_memlimit_sensitive :: Int +pwhash_memlimit_sensitive = fromIntegral c_crypto_pwhash_memlimit_sensitive + +-- | Minimum allowed number of computations for password hashing +pwhash_opslimit_min :: Int +pwhash_opslimit_min = fromIntegral c_crypto_pwhash_opslimit_min +-- | Maximum allowed number of computations for password hashing +pwhash_opslimit_max :: Int +pwhash_opslimit_max = fromIntegral c_crypto_pwhash_opslimit_max + +-- | Constant for relatively fast hashing +pwhash_opslimit_interactive :: Int +pwhash_opslimit_interactive = fromIntegral c_crypto_pwhash_opslimit_interactive +-- | Constant for moderately fast hashing +pwhash_opslimit_moderate :: Int +pwhash_opslimit_moderate = fromIntegral c_crypto_pwhash_opslimit_moderate +-- | Constant for relatively slow hashing +pwhash_opslimit_sensitive :: Int +pwhash_opslimit_sensitive = fromIntegral c_crypto_pwhash_opslimit_sensitive + +-- | Minimum number of characters in password for key derivation +pwhash_passwd_min :: Int +pwhash_passwd_min = fromIntegral c_crypto_pwhash_passwd_min +-- | Maximum number of characters in password for key derivation +pwhash_passwd_max :: Int +pwhash_passwd_max = fromIntegral c_crypto_pwhash_passwd_max + +-- | Size of salt +pwhash_saltbytes :: Int +pwhash_saltbytes = fromIntegral c_crypto_pwhash_saltbytes +-- | (Maximum) size of password hashing output +pwhash_strbytes :: Int +pwhash_strbytes = fromIntegral c_crypto_pwhash_strbytes +-- string that hashes with this algorithm are prefixed with +pwhash_strprefix :: Int +pwhash_strprefix = fromIntegral c_crypto_pwhash_strprefix + + +-- | Constants for Argon2ID +-- | Minimum output length for key derivation (= 16 (128 bits)). +pwhash_argon2id_bytes_min :: Int +pwhash_argon2id_bytes_min = fromIntegral c_crypto_pwhash_argon2id_bytes_min +-- | Maximum output length for key derivation. +pwhash_argon2id_bytes_max :: Int +pwhash_argon2id_bytes_max = fromIntegral c_crypto_pwhash_argon2id_bytes_max + +-- | Minimum allowed memory limit for password hashing +pwhash_argon2id_memlimit_min :: Int +pwhash_argon2id_memlimit_min = fromIntegral c_crypto_pwhash_argon2id_memlimit_min +-- | Maximum allowed memory limit for password hashing +pwhash_argon2id_memlimit_max :: Int +pwhash_argon2id_memlimit_max = fromIntegral c_crypto_pwhash_argon2id_memlimit_max +-- | Constant for currently 64MB memory +pwhash_argon2id_memlimit_interactive :: Int +pwhash_argon2id_memlimit_interactive = fromIntegral c_crypto_pwhash_argon2id_memlimit_interactive +-- | Constant for currently 256MB memory +pwhash_argon2id_memlimit_moderate :: Int +pwhash_argon2id_memlimit_moderate = fromIntegral c_crypto_pwhash_argon2id_memlimit_moderate +-- | Constant for currently 1024MB memory +pwhash_argon2id_memlimit_sensitive :: Int +pwhash_argon2id_memlimit_sensitive = fromIntegral c_crypto_pwhash_argon2id_memlimit_sensitive + +-- | Minimum allowed number of computations for password hashing +pwhash_argon2id_opslimit_min :: Int +pwhash_argon2id_opslimit_min = fromIntegral c_crypto_pwhash_argon2id_opslimit_min +-- | Maximum allowed number of computations for password hashing +pwhash_argon2id_opslimit_max :: Int +pwhash_argon2id_opslimit_max = fromIntegral c_crypto_pwhash_argon2id_opslimit_max + +-- | Constant for relatively fast hashing +pwhash_argon2id_opslimit_interactive :: Int +pwhash_argon2id_opslimit_interactive = fromIntegral c_crypto_pwhash_argon2id_opslimit_interactive +-- | Constant for moderately fast hashing +pwhash_argon2id_opslimit_moderate :: Int +pwhash_argon2id_opslimit_moderate = fromIntegral c_crypto_pwhash_argon2id_opslimit_moderate +-- | Constant for relatively slow hashing +pwhash_argon2id_opslimit_sensitive :: Int +pwhash_argon2id_opslimit_sensitive = fromIntegral c_crypto_pwhash_argon2id_opslimit_sensitive + +-- | Minimum number of characters in password for key derivation +pwhash_argon2id_passwd_min :: Int +pwhash_argon2id_passwd_min = fromIntegral c_crypto_pwhash_argon2id_passwd_min +-- | Maximum number of characters in password for key derivation +pwhash_argon2id_passwd_max :: Int +pwhash_argon2id_passwd_max = fromIntegral c_crypto_pwhash_argon2id_passwd_max + +-- | Size of salt +pwhash_argon2id_saltbytes :: Int +pwhash_argon2id_saltbytes = fromIntegral c_crypto_pwhash_argon2id_saltbytes +-- | (Maximum) size of password hashing output +pwhash_argon2id_strbytes :: Int +pwhash_argon2id_strbytes = fromIntegral c_crypto_pwhash_argon2id_strbytes +-- string that hashes with this algorithm are prefixed with +pwhash_argon2id_strprefix :: Int +pwhash_argon2id_strprefix = fromIntegral c_crypto_pwhash_argon2id_strprefix + +-- | Constants for ARGON2I +-- | Minimum output length for key derivation (= 16 (128 bits)). +pwhash_argon2i_bytes_min :: Int +pwhash_argon2i_bytes_min = fromIntegral c_crypto_pwhash_argon2i_bytes_min +-- | Maximum output length for key derivation. +pwhash_argon2i_bytes_max :: Int +pwhash_argon2i_bytes_max = fromIntegral c_crypto_pwhash_argon2i_bytes_max + +-- | Minimum allowed memory limit for password hashing +pwhash_argon2i_memlimit_min :: Int +pwhash_argon2i_memlimit_min = fromIntegral c_crypto_pwhash_argon2i_memlimit_min +-- | Maximum allowed memory limit for password hashing +pwhash_argon2i_memlimit_max :: Int +pwhash_argon2i_memlimit_max = fromIntegral c_crypto_pwhash_argon2i_memlimit_max +-- | Constant for currently 64MB memory +pwhash_argon2i_memlimit_interactive :: Int +pwhash_argon2i_memlimit_interactive = fromIntegral c_crypto_pwhash_argon2i_memlimit_interactive +-- | Constant for currently 256MB memory +pwhash_argon2i_memlimit_moderate :: Int +pwhash_argon2i_memlimit_moderate = fromIntegral c_crypto_pwhash_argon2i_memlimit_moderate +-- | Constant for currently 1024MB memory +pwhash_argon2i_memlimit_sensitive :: Int +pwhash_argon2i_memlimit_sensitive = fromIntegral c_crypto_pwhash_argon2i_memlimit_sensitive + +-- | Minimum allowed number of computations for password hashing +pwhash_argon2i_opslimit_min :: Int +pwhash_argon2i_opslimit_min = fromIntegral c_crypto_pwhash_argon2i_opslimit_min +-- | Maximum allowed number of computations for password hashing +pwhash_argon2i_opslimit_max :: Int +pwhash_argon2i_opslimit_max = fromIntegral c_crypto_pwhash_argon2i_opslimit_max + +-- | Constant for relatively fast hashing +pwhash_argon2i_opslimit_interactive :: Int +pwhash_argon2i_opslimit_interactive = fromIntegral c_crypto_pwhash_argon2i_opslimit_interactive +-- | Constant for moderately fast hashing +pwhash_argon2i_opslimit_moderate :: Int +pwhash_argon2i_opslimit_moderate = fromIntegral c_crypto_pwhash_argon2i_opslimit_moderate +-- | Constant for relatively slow hashing +pwhash_argon2i_opslimit_sensitive :: Int +pwhash_argon2i_opslimit_sensitive = fromIntegral c_crypto_pwhash_argon2i_opslimit_sensitive + +-- | Minimum number of characters in password for key derivation +pwhash_argon2i_passwd_min :: Int +pwhash_argon2i_passwd_min = fromIntegral c_crypto_pwhash_argon2i_passwd_min +-- | Maximum number of characters in password for key derivation +pwhash_argon2i_passwd_max :: Int +pwhash_argon2i_passwd_max = fromIntegral c_crypto_pwhash_argon2i_passwd_max + +-- | Size of salt +pwhash_argon2i_saltbytes :: Int +pwhash_argon2i_saltbytes = fromIntegral c_crypto_pwhash_argon2i_saltbytes +-- | (Maximum) size of password hashing output +pwhash_argon2i_strbytes :: Int +pwhash_argon2i_strbytes = fromIntegral c_crypto_pwhash_argon2i_strbytes +-- string that hashes with this algorithm are prefixed with +pwhash_argon2i_strprefix :: Int +pwhash_argon2i_strprefix = fromIntegral c_crypto_pwhash_argon2i_strprefix + + + +foreign import ccall "crypto_pwhash" + c_pwhash + :: Ptr CChar + -- ^ Derived key output buffer + -> CULLong + -- ^ Derived key length + -> Ptr CChar + -- ^ Password input buffer + -> CULLong + -- ^ Password length + -> Ptr CChar + -- ^ Salt input buffer + -> CULLong + -- ^ Operation limit + -> CSize + -- ^ Memory usage limit + -> CInt + -- ^ Algorithm + -> IO CInt + +foreign import ccall "crypto_pwhash_str" + c_pwhash_str + :: Ptr CChar + -- ^ Hashed password output buffer + -> Ptr CChar + -- ^ Password input buffer + -> CULLong + -- ^ Password length + -> CULLong + -- ^ Operation limit + -> CSize + -- ^ Memory usage limit + -> IO CInt + +foreign import ccall "crypto_pwhash_str_verify" + c_pwhash_str_verify + :: Ptr CChar + -- ^ Hashed password input buffer + -> Ptr CChar + -- ^ Password input buffer + -> CULLong + -- ^ Password length + -> IO CInt + +foreign import ccall "crypto_pwhash_str_needs_rehash" + c_pwhash_str_needs_rehash + :: Ptr CChar + -- ^ Hashed password input buffer + -> CULLong + -- ^ Operation limit + -> CSize + -- ^ Memory usage limit + -> IO CInt + +foreign import ccall "crypto_pwhash_alg_argon2id13" + c_crypto_pwhash_alg_argon2id13 :: CSize + +foreign import ccall "crypto_pwhash_alg_argon2i13" + c_crypto_pwhash_alg_argon2i13 :: CSize + +foreign import ccall "crypto_pwhash_alg_default" + c_crypto_pwhash_alg_default :: CSize + +-- Constants for the default algorithm +foreign import ccall "crypto_pwhash_bytes_min" + c_crypto_pwhash_bytes_min :: CSize + +foreign import ccall "crypto_pwhash_bytes_max" + c_crypto_pwhash_bytes_max :: CSize + +foreign import ccall "crypto_pwhash_memlimit_min" + c_crypto_pwhash_memlimit_min :: CSize + +foreign import ccall "crypto_pwhash_memlimit_max" + c_crypto_pwhash_memlimit_max :: CSize + +foreign import ccall "crypto_pwhash_memlimit_interactive" + c_crypto_pwhash_memlimit_interactive :: CSize + +foreign import ccall "crypto_pwhash_memlimit_moderate" + c_crypto_pwhash_memlimit_moderate :: CSize + +foreign import ccall "crypto_pwhash_memlimit_sensitive" + c_crypto_pwhash_memlimit_sensitive :: CSize + +foreign import ccall "crypto_pwhash_opslimit_min" + c_crypto_pwhash_opslimit_min :: CSize + +foreign import ccall "crypto_pwhash_opslimit_max" + c_crypto_pwhash_opslimit_max :: CSize + +foreign import ccall "crypto_pwhash_opslimit_interactive" + c_crypto_pwhash_opslimit_interactive :: CSize + +foreign import ccall "crypto_pwhash_opslimit_moderate" + c_crypto_pwhash_opslimit_moderate :: CSize + +foreign import ccall "crypto_pwhash_opslimit_sensitive" + c_crypto_pwhash_opslimit_sensitive :: CSize + +foreign import ccall "crypto_pwhash_passwd_min" + c_crypto_pwhash_passwd_min :: CSize + +foreign import ccall "crypto_pwhash_passwd_max" + c_crypto_pwhash_passwd_max :: CSize + +foreign import ccall "crypto_pwhash_saltbytes" + c_crypto_pwhash_saltbytes :: CSize + +foreign import ccall "crypto_pwhash_strbytes" + c_crypto_pwhash_strbytes :: CSize + +foreign import ccall "crypto_pwhash_strprefix" + c_crypto_pwhash_strprefix :: CSize + +-- Constants for ARGON2ID (currently default) +foreign import ccall "crypto_pwhash_argon2id_bytes_min" + c_crypto_pwhash_argon2id_bytes_min :: CSize + +foreign import ccall "crypto_pwhash_argon2id_bytes_max" + c_crypto_pwhash_argon2id_bytes_max :: CSize + +foreign import ccall "crypto_pwhash_argon2id_memlimit_min" + c_crypto_pwhash_argon2id_memlimit_min :: CSize + +foreign import ccall "crypto_pwhash_argon2id_memlimit_max" + c_crypto_pwhash_argon2id_memlimit_max :: CSize + +foreign import ccall "crypto_pwhash_argon2id_memlimit_interactive" + c_crypto_pwhash_argon2id_memlimit_interactive :: CSize + +foreign import ccall "crypto_pwhash_argon2id_memlimit_moderate" + c_crypto_pwhash_argon2id_memlimit_moderate :: CSize + +foreign import ccall "crypto_pwhash_argon2id_memlimit_sensitive" + c_crypto_pwhash_argon2id_memlimit_sensitive :: CSize + +foreign import ccall "crypto_pwhash_argon2id_opslimit_min" + c_crypto_pwhash_argon2id_opslimit_min :: CSize + +foreign import ccall "crypto_pwhash_argon2id_opslimit_max" + c_crypto_pwhash_argon2id_opslimit_max :: CSize + +foreign import ccall "crypto_pwhash_argon2id_opslimit_interactive" + c_crypto_pwhash_argon2id_opslimit_interactive :: CSize + +foreign import ccall "crypto_pwhash_argon2id_opslimit_moderate" + c_crypto_pwhash_argon2id_opslimit_moderate :: CSize + +foreign import ccall "crypto_pwhash_argon2id_opslimit_sensitive" + c_crypto_pwhash_argon2id_opslimit_sensitive :: CSize + +foreign import ccall "crypto_pwhash_argon2id_passwd_min" + c_crypto_pwhash_argon2id_passwd_min :: CSize + +foreign import ccall "crypto_pwhash_argon2id_passwd_max" + c_crypto_pwhash_argon2id_passwd_max :: CSize + +foreign import ccall "crypto_pwhash_argon2id_saltbytes" + c_crypto_pwhash_argon2id_saltbytes :: CSize + +foreign import ccall "crypto_pwhash_argon2id_strbytes" + c_crypto_pwhash_argon2id_strbytes :: CSize + +foreign import ccall "crypto_pwhash_argon2id_strprefix" + c_crypto_pwhash_argon2id_strprefix :: CSize + + +-- Constants for ARGON2I +foreign import ccall "crypto_pwhash_argon2i_bytes_min" + c_crypto_pwhash_argon2i_bytes_min :: CSize + +foreign import ccall "crypto_pwhash_argon2i_bytes_max" + c_crypto_pwhash_argon2i_bytes_max :: CSize + +foreign import ccall "crypto_pwhash_argon2i_memlimit_min" + c_crypto_pwhash_argon2i_memlimit_min :: CSize + +foreign import ccall "crypto_pwhash_argon2i_memlimit_max" + c_crypto_pwhash_argon2i_memlimit_max :: CSize + +foreign import ccall "crypto_pwhash_argon2i_memlimit_interactive" + c_crypto_pwhash_argon2i_memlimit_interactive :: CSize + +foreign import ccall "crypto_pwhash_argon2i_memlimit_moderate" + c_crypto_pwhash_argon2i_memlimit_moderate :: CSize + +foreign import ccall "crypto_pwhash_argon2i_memlimit_sensitive" + c_crypto_pwhash_argon2i_memlimit_sensitive :: CSize + +foreign import ccall "crypto_pwhash_argon2i_opslimit_min" + c_crypto_pwhash_argon2i_opslimit_min :: CSize + +foreign import ccall "crypto_pwhash_argon2i_opslimit_max" + c_crypto_pwhash_argon2i_opslimit_max :: CSize + +foreign import ccall "crypto_pwhash_argon2i_opslimit_interactive" + c_crypto_pwhash_argon2i_opslimit_interactive :: CSize + +foreign import ccall "crypto_pwhash_argon2i_opslimit_moderate" + c_crypto_pwhash_argon2i_opslimit_moderate :: CSize + +foreign import ccall "crypto_pwhash_argon2i_opslimit_sensitive" + c_crypto_pwhash_argon2i_opslimit_sensitive :: CSize + +foreign import ccall "crypto_pwhash_argon2i_passwd_min" + c_crypto_pwhash_argon2i_passwd_min :: CSize + +foreign import ccall "crypto_pwhash_argon2i_passwd_max" + c_crypto_pwhash_argon2i_passwd_max :: CSize + +foreign import ccall "crypto_pwhash_argon2i_saltbytes" + c_crypto_pwhash_argon2i_saltbytes :: CSize + +foreign import ccall "crypto_pwhash_argon2i_strbytes" + c_crypto_pwhash_argon2i_strbytes :: CSize + +foreign import ccall "crypto_pwhash_argon2i_strprefix" + c_crypto_pwhash_argon2i_strprefix :: CSize diff --git a/src/Crypto/Saltine/Internal/ScalarMult.hs b/src/Crypto/Saltine/Internal/ScalarMult.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/ScalarMult.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.ScalarMult +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.ScalarMult ( + scalarmult_bytes + , scalarmult_scalarbytes + , c_scalarmult + , c_scalarmult_base + , GroupElement(..) + , Scalar(..) +) where + +import Control.DeepSeq +import Crypto.Saltine.Class +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + + +-- | A group element. +newtype GroupElement = GE { unGE :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show GroupElement where + show = bin2hex . encode + +instance IsEncoding GroupElement where + decode v = if S.length v == scalarmult_bytes + then Just (GE v) + else Nothing + {-# INLINE decode #-} + encode (GE v) = v + {-# INLINE encode #-} + +-- | A scalar integer. +newtype Scalar = Sc { unSc :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Scalar where + show = bin2hex . encode + +instance IsEncoding Scalar where + decode v = if S.length v == scalarmult_scalarbytes + then Just (Sc v) + else Nothing + {-# INLINE decode #-} + encode (Sc v) = v + {-# INLINE encode #-} + + +scalarmult_bytes, scalarmult_scalarbytes :: Int + +-- ScalarMult +-- | Size of a group element string representation for +-- @crypto_scalarmult@. +scalarmult_bytes = fromIntegral c_crypto_scalarmult_bytes +-- | Size of a integer string representation for @crypto_scalarmult@. +scalarmult_scalarbytes = fromIntegral c_crypto_scalarmult_scalarbytes + +-- src/libsodium/crypto_scalarmult/crypto_scalarmult.c +foreign import ccall "crypto_scalarmult_bytes" + c_crypto_scalarmult_bytes :: CSize +foreign import ccall "crypto_scalarmult_scalarbytes" + c_crypto_scalarmult_scalarbytes :: CSize + +foreign import ccall "crypto_scalarmult" + c_scalarmult :: Ptr CChar + -- ^ Output group element buffer + -> Ptr CChar + -- ^ Input integer buffer + -> Ptr CChar + -- ^ Input group element buffer + -> IO CInt + -- ^ Always 0 + +foreign import ccall "crypto_scalarmult_base" + c_scalarmult_base :: Ptr CChar + -- ^ Output group element buffer + -> Ptr CChar + -- ^ Input integer buffer + -> IO CInt + -- ^ Always 0 diff --git a/src/Crypto/Saltine/Internal/SecretBox.hs b/src/Crypto/Saltine/Internal/SecretBox.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/SecretBox.hs @@ -0,0 +1,179 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.SecretBox +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.SecretBox ( + secretbox_keybytes, + secretbox_noncebytes, + secretbox_macbytes, + secretbox_zerobytes, + secretbox_boxzerobytes, + c_secretbox, + c_secretbox_detached, + c_secretbox_open, + c_secretbox_open_detached, + Key(..), + Nonce(..), + Authenticator(..) +) where + +import Control.DeepSeq (NFData) +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + +secretbox_keybytes, secretbox_noncebytes, secretbox_macbytes, secretbox_zerobytes, secretbox_boxzerobytes :: Int + +-- | An opaque 'secretbox' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "SecretBox.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == secretbox_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'secretbox' nonce. +newtype Nonce = Nonce { unNonce :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Nonce where + show k = "SecretBox.Nonce " <> bin2hex (encode k) + +instance IsEncoding Nonce where + decode v = if S.length v == secretbox_noncebytes + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +instance IsNonce Nonce where + zero = Nonce (S.replicate secretbox_noncebytes 0) + nudge (Nonce n) = Nonce (nudgeBS n) + + +-- | An Authenticator for a Message +newtype Authenticator = Au { unAu :: ByteString } deriving (Eq, Ord, Data, Typeable, Hashable, Generic, NFData) +instance Show Authenticator where + show k = "Sign.Authenticator " <> bin2hex (encode k) + +instance IsEncoding Authenticator where + decode v = if S.length v == secretbox_macbytes + then Just (Au v) + else Nothing + {-# INLINE decode #-} + encode (Au v) = v + {-# INLINE encode #-} + + +-- | Size of a @crypto_secretbox@ secret key +secretbox_keybytes = fromIntegral c_crypto_secretbox_keybytes +-- | Size of a @crypto_secretbox@ nonce +secretbox_noncebytes = fromIntegral c_crypto_secretbox_noncebytes +-- | Size of a @crypto_secretbox@ mac +secretbox_macbytes = fromIntegral c_crypto_secretbox_macbytes +-- | Size of 0-padding prepended to messages before using +-- @crypto_secretbox@ or after using @crypto_secretbox_open@ +secretbox_zerobytes = fromIntegral c_crypto_secretbox_zerobytes +-- | Size of 0-padding prepended to ciphertext before using +-- @crypto_secretbox_open@ or after using @crypto_secretbox@ +secretbox_boxzerobytes = fromIntegral c_crypto_secretbox_boxzerobytes + +-- src/libsodium/crypto_secretbox/crypto_secretbox.c +foreign import ccall "crypto_secretbox_keybytes" + 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" + c_crypto_secretbox_boxzerobytes :: CSize + +-- | The secretbox C API uses 0-padded C strings. Always returns 0. +foreign import ccall "crypto_secretbox" + c_secretbox + :: 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 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" + c_secretbox_open + :: Ptr CChar + -- ^ Message 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 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 + -- ^ Constant key buffer + -> IO CInt diff --git a/src/Crypto/Saltine/Internal/Sign.hs b/src/Crypto/Saltine/Internal/Sign.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/Sign.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.Sign +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.Sign ( + sign_bytes + , sign_publickeybytes + , sign_secretkeybytes + , c_sign_keypair + , c_sign + , c_sign_open + , c_sign_detached + , c_sign_verify_detached + , c_sign_ed25519_pk_to_curve25519 + , c_sign_ed25519_sk_to_curve25519 + , SecretKey(..) + , PublicKey(..) + , Keypair(..) + , Signature(..) +) where + +import Control.DeepSeq (NFData) +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + + +-- | An opaque 'box' cryptographic secret key. +newtype SecretKey = SK { unSK :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq SecretKey where + SK a == SK b = U.compare a b +instance Show SecretKey where + show k = "Sign.SecretKey {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding SecretKey where + decode v = if S.length v == sign_secretkeybytes + then Just (SK v) + else Nothing + {-# INLINE decode #-} + encode (SK v) = v + {-# INLINE encode #-} + +-- | An opaque 'box' cryptographic public key. +newtype PublicKey = PK { unPK :: ByteString } deriving (Ord, Data, Typeable, Hashable, Generic, NFData) +instance Eq PublicKey where + PK a == PK b = U.compare a b +instance Show PublicKey where + show k = "Sign.PublicKey {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding PublicKey where + decode v = if S.length v == sign_publickeybytes + then Just (PK v) + else Nothing + {-# INLINE decode #-} + encode (PK v) = v + {-# INLINE encode #-} + +-- | A convenience type for keypairs +data Keypair = Keypair { + secretKey :: SecretKey + , publicKey :: PublicKey +} deriving (Ord, Data, Typeable, Generic) + +instance Eq Keypair where + kp1 == kp2 = U.compare (encode $ secretKey kp1) (encode $ secretKey kp2) + !&&! U.compare (encode $ publicKey kp1) (encode $ publicKey kp2) + +instance Show Keypair where + show k = "Sign.Keypair {secretKey = " <> show (secretKey k) <> ", publicKey = " <> show (publicKey k) <> "}" + +instance Hashable Keypair +instance NFData Keypair + + +-- | A signature for a Message +newtype Signature = Signature { unSignature :: ByteString } deriving (Ord, Data, Typeable, Hashable, Generic, NFData) +instance Eq Signature where + Signature a == Signature b = U.compare a b +instance Show Signature where + show k = "Sign.Signature " <> bin2hex (encode k) + +-- | Actual signatures may be shorter, but not when generated with saltine. +instance IsEncoding Signature where + decode v = if S.length v == sign_bytes + then Just (Signature v) + else Nothing + {-# INLINE decode #-} + encode (Signature s) = s + {-# INLINE encode #-} + +sign_bytes, sign_publickeybytes, sign_secretkeybytes :: Int + +-- Signatures +-- | The maximum size of a signature prepended to a message to form a +-- signed message. +sign_bytes = fromIntegral c_crypto_sign_bytes +-- | The size of a public key for signing verification +sign_publickeybytes = fromIntegral c_crypto_sign_publickeybytes +-- | The size of a secret key for signing +sign_secretkeybytes = fromIntegral c_crypto_sign_secretkeybytes + +-- src/libsodium/crypto_sign/crypto_sign.c +foreign import ccall "crypto_sign_bytes" + c_crypto_sign_bytes :: CSize +foreign import ccall "crypto_sign_publickeybytes" + c_crypto_sign_publickeybytes :: CSize +foreign import ccall "crypto_sign_secretkeybytes" + c_crypto_sign_secretkeybytes :: CSize + + +foreign import ccall "crypto_sign_keypair" + c_sign_keypair :: Ptr CChar + -- ^ Public key output buffer + -> Ptr CChar + -- ^ Secret key output buffer + -> IO CInt + -- ^ Always 0 + +foreign import ccall "crypto_sign" + c_sign :: Ptr CChar + -- ^ Signed message output buffer + -> Ptr CULLong + -- ^ Length of signed message + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Length of message input buffer + -> Ptr CChar + -- ^ Constant secret key buffer + -> IO CInt + -- ^ Always 0 + +foreign import ccall "crypto_sign_open" + c_sign_open :: Ptr CChar + -- ^ Message output buffer + -> Ptr CULLong + -- ^ Length of message + -> Ptr CChar + -- ^ Constant signed message buffer + -> CULLong + -- ^ Length of signed message buffer + -> Ptr CChar + -- ^ Public key buffer + -> IO CInt + -- ^ 0 if signature is verifiable, -1 otherwise + +foreign import ccall "crypto_sign_detached" + c_sign_detached :: Ptr CChar + -- ^ Signature output buffer + -> Ptr CULLong + -- ^ Length of the signature + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Length of message buffer + -> Ptr CChar + -- ^ Constant secret key buffer + -> IO CInt +foreign import ccall "crypto_sign_verify_detached" + c_sign_verify_detached :: Ptr CChar + -- ^ Signature buffer + -> Ptr CChar + -- ^ Constant signed message buffer + -> CULLong + -- ^ Length of signed message buffer + -> Ptr CChar + -- ^ Public key buffer + -> IO CInt + +foreign import ccall "crypto_sign_ed25519_pk_to_curve25519" + c_sign_ed25519_pk_to_curve25519 :: Ptr CChar + -- ^ X25519 public key output buffer + -> Ptr CChar + -- ^ Ed25519 public key buffer + -> IO CInt + +foreign import ccall "crypto_sign_ed25519_sk_to_curve25519" + c_sign_ed25519_sk_to_curve25519 :: Ptr CChar + -- ^ X25519 secret key output buffer + -> Ptr CChar + -- ^ Ed25519 secret key buffer + -> IO CInt diff --git a/src/Crypto/Saltine/Internal/Stream.hs b/src/Crypto/Saltine/Internal/Stream.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Saltine/Internal/Stream.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric, ForeignFunctionInterface #-} +-- | +-- Module : Crypto.Saltine.Internal.Stream +-- Copyright : (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.Stream ( + stream_keybytes + , stream_noncebytes + , c_stream + , c_stream_xor + , Key(..) + , Nonce(..) +) where + +import Control.DeepSeq (NFData) +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Hash (shorthash) +import Crypto.Saltine.Internal.Hash (nullShKey) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.Monoid +import Foreign.C +import Foreign.Ptr +import GHC.Generics (Generic) + +import qualified Data.ByteString as S + +-- | An opaque 'stream' cryptographic key. +newtype Key = Key { unKey :: ByteString } deriving (Ord, Hashable, Data, Typeable, Generic, NFData) +instance Eq Key where + Key a == Key b = U.compare a b +instance Show Key where + show k = "Stream.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "\"}" + +instance IsEncoding Key where + decode v = if S.length v == stream_keybytes + then Just (Key v) + else Nothing + {-# INLINE decode #-} + encode (Key v) = v + {-# INLINE encode #-} + +-- | An opaque 'stream' nonce. +newtype Nonce = Nonce { unNonce :: ByteString } deriving (Eq, Ord, Hashable, Data, Typeable, Generic, NFData) +instance Show Nonce where + show k = "Stream.Nonce " <> bin2hex (encode k) + +instance IsNonce Nonce where + zero = Nonce (S.replicate stream_noncebytes 0) + nudge (Nonce n) = Nonce (nudgeBS n) + +instance IsEncoding Nonce where + decode v = if S.length v == stream_noncebytes + then Just (Nonce v) + else Nothing + {-# INLINE decode #-} + encode (Nonce v) = v + {-# INLINE encode #-} + +stream_keybytes, stream_noncebytes :: Int + +-- Streams +-- | The size of a key for the cryptographic stream generation +stream_keybytes = fromIntegral c_crypto_stream_keybytes +-- | The size of a nonce for the cryptographic stream generation +stream_noncebytes = fromIntegral c_crypto_stream_noncebytes + +-- src/libsodium/crypto_stream/crypto_stream.c +-- src/libsodium/include/sodium/crypto_stream.h +foreign import ccall "crypto_stream_keybytes" + c_crypto_stream_keybytes :: CSize +foreign import ccall "crypto_stream_noncebytes" + c_crypto_stream_noncebytes :: CSize + + +foreign import ccall "crypto_stream" + c_stream :: Ptr CChar + -- ^ Stream output buffer + -> CULLong + -- ^ Length of stream to generate + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + -- ^ Always 0 + +foreign import ccall "crypto_stream_xor" + c_stream_xor :: Ptr CChar + -- ^ Ciphertext output buffer + -> Ptr CChar + -- ^ Constant message buffer + -> CULLong + -- ^ Length of message buffer + -> Ptr CChar + -- ^ Constant nonce buffer + -> Ptr CChar + -- ^ Constant key buffer + -> IO CInt + -- ^ Always 0 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 @@ -1,16 +1,29 @@ -module Crypto.Saltine.Internal.Util where +{-# LANGUAGE BangPatterns #-} -import Foreign.C -import Foreign.Marshal.Alloc (mallocBytes) -import Foreign.Ptr -import System.IO.Unsafe +module Crypto.Saltine.Internal.Util ( + module Crypto.Saltine.Internal.Util + , withCString + , allocaBytes +) +where -import Control.Applicative -import qualified Data.ByteString as S -import Data.ByteString (ByteString) -import Data.ByteString.Unsafe -import Data.Monoid +import Data.ByteString (ByteString) +import Data.ByteString.Unsafe +import Data.Monoid +import Foreign.C +import Foreign.Marshal.Alloc (mallocBytes, allocaBytes) +import Foreign.Ptr +import GHC.Word (Word8) +import System.IO.Unsafe +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 + +-- | Returns @Nothing@ if the subtraction would result in an +-- underflow or a negative number. +safeSubtract :: (Ord a, Num a) => a -> a -> Maybe a +x `safeSubtract` y = if y > x then Nothing else Just (x - y) + -- | @snd . cycleSucc@ computes the 'succ' of a 'Bounded', 'Eq' 'Enum' -- with wraparound. The @fst . cycleSuc@ is whether the wraparound -- occurred (i.e. @fst . cycleSucc == (== maxBound)@). @@ -58,6 +71,12 @@ where go 0 = True go _ = False +withCStrings :: [String] -> ([CString] -> IO a) -> IO a +withCStrings = foldr (\v kk -> \k -> (withCString v) (\a -> kk (\as -> k (a:as)))) ($ []) + +withCStringLens :: [String] -> ([CStringLen] -> IO a) -> IO a +withCStringLens = foldr (\v kk -> \k -> (withCStringLen v) (\a -> kk (\as -> k (a:as)))) ($ []) + -- | Convenience function for accessing constant C strings constByteStrings :: [ByteString] -> ([CStringLen] -> IO b) -> IO b constByteStrings = @@ -72,6 +91,18 @@ out <- unsafeUseAsCString bs k return (out, bs) + +-- | Sometimes we have to deal with variable-length strings +buildUnsafeVariableByteString' :: Int -> (Ptr CChar -> IO b) -> IO (b, ByteString) +buildUnsafeVariableByteString' n k = do + ph <- mallocBytes n + out <- k ph + bs <- unsafePackMallocCString ph + return (out, bs) + +buildUnsafeVariableByteString :: Int -> (Ptr CChar -> IO b) -> (b, ByteString) +buildUnsafeVariableByteString n = unsafePerformIO . buildUnsafeVariableByteString' n + -- | Extremely unsafe function, use with utmost care! Builds a new -- ByteString using a ccall which is given access to the raw underlying -- pointer. Overwrites are UNCHECKED and 'unsafePerformIO' is used so @@ -91,3 +122,67 @@ foreign import ccall "randombytes_buf" c_randombytes_buf :: Ptr CChar -> CInt -> IO () + +-- | Constant time memory comparison +foreign import ccall unsafe "sodium_memcmp" + c_sodium_memcmp + :: Ptr CChar -- a + -> Ptr CChar -- b + -> CInt -- Length + -> IO CInt + +foreign import ccall unsafe "sodium_malloc" + c_sodium_malloc + :: CSize -> IO (Ptr a) + +foreign import ccall unsafe "sodium_free" + c_sodium_free + :: Ptr Word8 -> IO () + +-- | Not sure yet what to use this for +buildUnsafeScrubbedByteString' :: Int -> (Ptr CChar -> IO b) -> IO (b,ByteString) +buildUnsafeScrubbedByteString' n k = do + p <- c_sodium_malloc (fromIntegral n) + + bs <- unsafePackCStringFinalizer p n (c_sodium_free p) + out <- unsafeUseAsCString bs k + pure (out,bs) + +-- | Not sure yet what to use this for +buildUnsafeScrubbedByteString :: Int -> (Ptr CChar -> IO b) -> (b,ByteString) +buildUnsafeScrubbedByteString n = unsafePerformIO . buildUnsafeScrubbedByteString' n + +-- | Constant-time comparison +compare :: ByteString -> ByteString -> Bool +compare a b = + (S.length a == S.length b) && unsafePerformIO (constByteStrings [a, b] $ \ + [(bsa, _), (bsb,_)] -> + (== 0) <$> c_sodium_memcmp bsa bsb (fromIntegral $ S.length a)) + +-- | bin2hex conversion for showing various binary types +foreign import ccall unsafe "sodium_bin2hex" + c_sodium_bin2hex + :: Ptr CChar -- Target zone + -> CInt -- Max. length of target string (must be min. bin_len * 2 + 1) + -> Ptr CChar -- Source + -> CInt -- Source length + -> IO (Ptr CChar) + +bin2hex :: ByteString -> String +bin2hex bs = let tlen = S.length bs * 2 + 1 in + S8.unpack . S8.init . snd . buildUnsafeByteString tlen $ \t -> + constByteStrings [bs] $ \ + [(pbs, _)] -> + c_sodium_bin2hex t (fromIntegral tlen) pbs (fromIntegral $ S.length bs) + +uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) +uncurry3 f ~(a,b,c) = f a b c + +uncurry5 :: (a -> b -> c -> d -> e -> f) -> ((a, b, c, d, e) -> f) +uncurry5 f ~(a,b,c,d,e) = f a b c d e + +(!&&!) :: Bool -> Bool -> Bool +(!&&!) !a !b = a && b + +(!||!) :: Bool -> Bool -> Bool +(!||!) !a !b = a || b diff --git a/tests/AEAD/AES256GCMProperties.hs b/tests/AEAD/AES256GCMProperties.hs new file mode 100644 --- /dev/null +++ b/tests/AEAD/AES256GCMProperties.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module AEAD.AES256GCMProperties ( + testAEADAES + ) where + +import Util +import Crypto.Saltine.Core.AEAD.AES256GCM +import Crypto.Saltine.Class (decode) +import Crypto.Saltine.Internal.AEAD.AES256GCM as Bytes + +import qualified Data.ByteString as S +import Data.Maybe (fromJust) +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.aead_aes256gcm_npubbytes + pure $ fromJust (decode bs) + +instance Arbitrary Key where + arbitrary = + do bs <- S.pack <$> vector Bytes.aead_aes256gcm_keybytes + pure $ fromJust (decode bs) + +-- | 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 + +testAEADAES :: Test +testAEADAES = buildTest $ + + return $ testGroup "...Internal.AEAD.AES256GCM" $ if not aead_aes256gcm_available then [] else [ + 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/AEAD/ChaCha20Poly1305IETFProperties.hs b/tests/AEAD/ChaCha20Poly1305IETFProperties.hs new file mode 100644 --- /dev/null +++ b/tests/AEAD/ChaCha20Poly1305IETFProperties.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module AEAD.ChaCha20Poly1305IETFProperties ( + testAEADIETF + ) where + +import Util +import Crypto.Saltine.Core.AEAD.ChaCha20Poly1305IETF +import Crypto.Saltine.Class (decode) +import Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305IETF as Bytes + +import qualified Data.ByteString as S +import Data.Maybe (fromJust) +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.aead_chacha20poly1305_ietf_npubbytes + pure $ fromJust (decode bs) + +instance Arbitrary Key where + arbitrary = + do bs <- S.pack <$> vector Bytes.aead_chacha20poly1305_ietf_keybytes + pure $ fromJust (decode bs) + +-- | 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 + +testAEADIETF :: Test +testAEADIETF = buildTest $ do + + return $ testGroup "...Internal.AEAD.ChaCha20Poly1305IETF" [ + + 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/AEAD/ChaCha20Poly1305Properties.hs b/tests/AEAD/ChaCha20Poly1305Properties.hs new file mode 100644 --- /dev/null +++ b/tests/AEAD/ChaCha20Poly1305Properties.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module AEAD.ChaCha20Poly1305Properties ( + testAEADChaCha20 + ) where + +import Util +import Crypto.Saltine.Core.AEAD.ChaCha20Poly1305IETF +import Crypto.Saltine.Class (decode) +import Crypto.Saltine.Internal.AEAD.ChaCha20Poly1305IETF as Bytes + +import qualified Data.ByteString as S +import Data.Maybe (fromJust) +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.aead_chacha20poly1305_ietf_npubbytes + pure $ fromJust (decode bs) + +instance Arbitrary Key where + arbitrary = + do bs <- S.pack <$> vector Bytes.aead_chacha20poly1305_ietf_keybytes + pure $ fromJust (decode bs) + +-- | 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 + +testAEADChaCha20 :: Test +testAEADChaCha20 = buildTest $ do + + return $ testGroup "...Internal.AEAD.ChaCha20Poly1305" [ + + 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/AEAD/XChaCha20Poly1305Properties.hs b/tests/AEAD/XChaCha20Poly1305Properties.hs new file mode 100644 --- /dev/null +++ b/tests/AEAD/XChaCha20Poly1305Properties.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module AEAD.XChaCha20Poly1305Properties ( + testAEADXChaCha20 + ) where + +import Util +import Crypto.Saltine.Core.AEAD.XChaCha20Poly1305 +import Crypto.Saltine.Class (decode) +import Crypto.Saltine.Internal.AEAD.XChaCha20Poly1305 as Bytes + +import qualified Data.ByteString as S +import Data.Maybe (fromJust) +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.aead_xchacha20poly1305_ietf_npubbytes + pure $ fromJust (decode bs) + +instance Arbitrary Key where + arbitrary = + do bs <- S.pack <$> vector Bytes.aead_xchacha20poly1305_ietf_keybytes + pure $ fromJust (decode bs) + +-- | 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 + +testAEADXChaCha20 :: Test +testAEADXChaCha20 = buildTest $ do + + return $ testGroup "...Internal.AEAD.XChaCha20Poly1305" [ + + 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/AEADProperties.hs b/tests/AEADProperties.hs deleted file mode 100644 --- a/tests/AEADProperties.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# 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 @@ -5,49 +5,47 @@ testBox ) where -import Util -import Crypto.Saltine.Core.Box -import qualified Data.ByteString as S -import Data.Monoid - -import Test.Framework.Providers.QuickCheck2 -import Test.Framework -import Test.QuickCheck.Property -import Test.QuickCheck.Monadic +import Crypto.Saltine.Core.Box +import Data.Monoid +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck.Property +import Test.QuickCheck.Monadic +import Util -- | Ciphertext can be decrypted rightInverseProp :: Keypair -> Keypair -> Nonce -> Message -> Bool -rightInverseProp (sk1, pk1) (sk2, pk2) n (Message bs) = +rightInverseProp (Keypair sk1 pk1) (Keypair sk2 pk2) n (Message bs) = Just bs == boxOpen pk1 sk2 n (box pk2 sk1 n bs) -- | Cannot decrypt without the corrent secret key rightInverseFailureProp1 :: Keypair -> Keypair -> Nonce -> Message -> Perturb -> Bool -rightInverseFailureProp1 (sk1, pk1) (sk2, pk2) n (Message bs) p = +rightInverseFailureProp1 (Keypair sk1 pk1) (Keypair 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 -> Perturb -> Bool -rightInverseFailureProp2 (sk1, pk1) (sk2, pk2) n (Message bs) p = +rightInverseFailureProp2 (Keypair sk1 pk1) (Keypair 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 -> Perturb -> Bool -rightInverseFailureProp3 (sk1, pk1) (sk2, pk2) n (Message bs) p = +rightInverseFailureProp3 (Keypair sk1 pk1) (Keypair 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 :: Keypair -> Keypair -> Nonce -> Nonce -> Message -> Bool -cannotDecryptNonceProp (sk1, pk1) (sk2, pk2) n1 n2 (Message bs) = +cannotDecryptNonceProp (Keypair sk1 pk1) (Keypair sk2 pk2) n1 n2 (Message bs) = Nothing == boxOpen pk1 sk2 n2 (box pk2 sk1 n1 bs) -- | BeforeNM creates identical secret keys when called in an -- anti-symmetric fashion. beforeNMCreateSecretKeyProp :: Test.QuickCheck.Property.Property beforeNMCreateSecretKeyProp = monadicIO . (assert =<<) . run $ do - (sk1, pk1) <- newKeypair - (sk2, pk2) <- newKeypair + Keypair sk1 pk1 <- newKeypair + Keypair sk2 pk2 <- newKeypair let ck_1for2 = beforeNM sk1 pk2 ck_2for1 = beforeNM sk2 pk1 return (ck_1for2 == ck_2for1) @@ -66,8 +64,8 @@ testBox :: Test testBox = buildTest $ do - (sk1, pk1) <- newKeypair - (sk2, pk2) <- newKeypair + kp1@(Keypair sk1 pk1) <- newKeypair + kp2@(Keypair sk2 pk2) <- newKeypair let ck_1for2 = beforeNM sk1 pk2 ck_2for1 = beforeNM sk2 pk1 n1 <- newNonce @@ -78,7 +76,7 @@ testGroup "Can decrypt ciphertext using..." [ testProperty "... public key/secret key" - $ rightInverseProp (sk1, pk1) (sk2, pk2) n1 , + $ rightInverseProp kp1 kp2 n1 , testProperty "... combined key" $ rightInverseAfterNMProp ck_1for2 ck_2for1 n1 @@ -88,16 +86,16 @@ testGroup "Fail to verify ciphertext when..." [ testProperty "... not using proper secret key" - $ rightInverseFailureProp1 (sk1, pk1) (sk2, pk2) n1, + $ rightInverseFailureProp1 kp1 kp2 n1, testProperty "... not actually sent to you" - $ rightInverseFailureProp2 (sk1, pk1) (sk2, pk2) n1, + $ rightInverseFailureProp2 kp1 kp2 n1, testProperty "... ciphertext has been perturbed" - $ rightInverseFailureProp3 (sk1, pk1) (sk2, pk2) n1, + $ rightInverseFailureProp3 kp1 kp2 n1, testProperty "... using the wrong nonce" - $ cannotDecryptNonceProp (sk1, pk1) (sk2, pk2) n1 n2, + $ cannotDecryptNonceProp kp1 kp2 n1 n2, testProperty "... using the wrong combined key" $ rightInverseFailureAfterNMProp1 ck_1for2 ck_2for1 n1 diff --git a/tests/HashProperties.hs b/tests/HashProperties.hs new file mode 100644 --- /dev/null +++ b/tests/HashProperties.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HashProperties ( + testHash + ) where + +import Util +import Crypto.Saltine.Core.Hash + +import qualified Data.ByteString as S +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck + +testHash :: Test +testHash = buildTest $ do + shKey <- newShorthashKey + shKey2 <- newShorthashKey + ghKey <- newGenerichashKey 24 >>= maybe undefined return + ghKey2 <- newGenerichashKey 24 >>= maybe undefined return + let ghOutLen = maybe undefined id $ generichashOutLen 32 + + return $ testGroup "...Internal.Hash" [ + + testProperty "No two hashes are alike" + $ \(Message bs1, Message bs2) -> bs1 /= bs2 ==> hash bs1 /= hash bs2, + + testProperty "Hash of empty ByteString is correct" + $ \(Message bs) -> (bs == S.empty) ==> hash bs == (read hashEmptyBS :: S.ByteString), + + testProperty "SHA256 of empty ByteString is correct" + $ \(Message bs) -> (bs == S.empty) ==> sha256 bs == (read sha256EmptyBS :: S.ByteString), + + testProperty "No two shorthashes are alike" + $ \(Message bs1, Message bs2) -> bs1 /= bs2 ==> shorthash shKey bs1 /= shorthash shKey bs2, + + testProperty "Different keys produce different shorthashes" + $ \(Message bs) -> shorthash shKey bs /= shorthash shKey2 bs, + + testProperty "No two generic hashes are alike" + $ \(Message bs1, Message bs2) -> bs1 /= bs2 ==> generichash ghKey bs1 ghOutLen /= generichash ghKey bs2 ghOutLen, + + testProperty "No two SHA256 hashes are alike" + $ \(Message bs1, Message bs2) -> bs1 /= bs2 ==> sha256 bs1 /= sha256 bs2, + + testProperty "Different keys produce different generichashes" + $ \(Message bs) -> generichash ghKey bs ghOutLen /= generichash ghKey2 bs ghOutLen + + ] + + where + hashEmptyBS = "\"\207\131\225\&5~\239\184\189\241T(P\214m\128\a\214 \228\ENQ\vW\NAK\220\131\244\169!\211l\233\206G\208\209<]\133\242\176\255\131\CAN\210\135~\236/c\185\&1\189GAz\129\165\&82z\249'\218>\"" + sha256EmptyBS = "\"\227\176\196B\152\252\FS\DC4\154\251\244\200\153o\185$'\174A\228d\155\147L\164\149\153\ESCxR\184U\"" diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -3,14 +3,20 @@ module Main where import SecretBoxProperties (testSecretBox) -import AEADProperties (testAEAD) +import AEAD.ChaCha20Poly1305Properties (testAEADChaCha20) +import AEAD.ChaCha20Poly1305IETFProperties (testAEADIETF) +import AEAD.XChaCha20Poly1305Properties (testAEADXChaCha20) +import AEAD.AES256GCMProperties (testAEADAES) import BoxProperties (testBox) import SealedBoxProperties (testSealedBox) import StreamProperties (testStream) import AuthProperties (testAuth) import OneTimeAuthProperties (testOneTimeAuth) import SignProperties (testSign) +import HashProperties (testHash) import ScalarMultProperties (testScalarMult) +import PasswordProperties (testPassword) +import UtilProperties (testUtils) import Crypto.Saltine import Test.Framework @@ -27,13 +33,19 @@ main = do sodiumInit flip defaultMainWithOpts runOpts [ + testUtils, testBox, testSealedBox, testSecretBox, - testAEAD, + testAEADChaCha20, + testAEADIETF, + testAEADXChaCha20, + testAEADAES, testStream, testAuth, testOneTimeAuth, testSign, - testScalarMult + testHash, + testScalarMult, + testPassword ] diff --git a/tests/PasswordProperties.hs b/tests/PasswordProperties.hs new file mode 100644 --- /dev/null +++ b/tests/PasswordProperties.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} + +module PasswordProperties ( + testPassword +) where + +import Crypto.Saltine.Core.Password +import Crypto.Saltine.Internal.Util +import Data.Maybe (isJust, isNothing, fromJust) +import Data.Monoid +import Data.Text (Text) +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck + +import qualified Crypto.Saltine.Internal.Password as I +import qualified Data.Text as T + +instance Arbitrary Text where + arbitrary = T.pack <$> arbitrary + +instance Arbitrary Algorithm where + arbitrary = elements $ enumFromTo minBound maxBound + +-- | Sadly using the actual maximum limit is just way too slow +instance Arbitrary Memlimit where + arbitrary = I.Memlimit <$> chooseInt ( max I.pwhash_argon2i_memlimit_min I.pwhash_argon2id_memlimit_min + , max I.pwhash_argon2i_memlimit_min I.pwhash_argon2id_memlimit_min * 4 + ) + +instance Arbitrary Opslimit where + arbitrary = I.Opslimit <$> chooseInt ( max I.pwhash_argon2i_opslimit_min I.pwhash_argon2id_opslimit_min + , max I.pwhash_argon2i_opslimit_min I.pwhash_argon2id_opslimit_min * 4 + ) + +instance Arbitrary Policy where + arbitrary = applyArbitrary3 Policy + +rightInverseProp :: Text -> Policy -> IO Bool +rightInverseProp pw pol = do + h <- pwhashStr pw pol + pure $ pwhashStrVerify (fromJust h) pw + +rightInverseFailureProp1 :: Text -> Policy -> Text -> IO Bool +rightInverseFailureProp1 pw pol per = + let npw = T.reverse pw <> T.pack "0" <> per + in do + h <- pwhashStr pw pol + pure . not $ pwhashStrVerify (fromJust h) npw + +rightProp :: Text -> Policy -> IO Bool +rightProp pw pol = do + h <- pwhashStr pw pol + pure $ Just False == needsRehash (opsPolicy pol) (memPolicy pol) (fromJust h) + +rightFailureProp :: Text -> Opslimit -> Opslimit -> Memlimit -> Memlimit -> IO Bool +rightFailureProp pw ops1 ops2 mem1 mem2 = do + h <- pwhashStr pw (Policy ops1 mem1 defaultAlgorithm) + pure $ Just True == needsRehash ops2 mem2 (fromJust h) + || ops1 == ops2 + +rightFailureProp2 :: Text -> Opslimit -> Memlimit -> Bool +rightFailureProp2 invhash ops mem = + isNothing $ needsRehash ops mem (I.PasswordHash invhash) + +rightProp2 :: Salt -> Text -> Policy -> Gen Bool +rightProp2 salt pw pol = do + i <- chooseInt (I.pwhash_bytes_min, 1024) + + pure $ isJust $ pwhash pw i salt pol + + +testPassword :: Test +testPassword = buildTest $ do + salt <- newSalt + + return $ testGroup "... Password" [ + + testProperty "Can hash passwords and verify them..." + $ ioProperty . uncurry rightInverseProp, + + testProperty "Hashed passwords cannot be verified with the wrong password..." + $ ioProperty . uncurry3 rightInverseFailureProp1, + + testProperty "Hashed passwords do not need to be rehashed with the same policy..." + $ ioProperty . uncurry rightProp, + + testProperty "Hashed passwords do need to be rehashed with a different policy..." + $ ioProperty . uncurry5 rightFailureProp, + + testProperty "needsRehash detects invalid hashes..." + rightFailureProp2, + + testProperty "Deriving a key from a password..." + (rightProp2 salt) + ] diff --git a/tests/SealedBoxProperties.hs b/tests/SealedBoxProperties.hs --- a/tests/SealedBoxProperties.hs +++ b/tests/SealedBoxProperties.hs @@ -5,69 +5,67 @@ 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) +import Crypto.Saltine.Core.Box +import Data.Monoid +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck.Property (ioProperty) +import Util -- | Ciphertext can be decrypted rightInverseProp :: Keypair -> Message -> IO Bool -rightInverseProp (sk1, pk1) (Message bs) = do +rightInverseProp (Keypair 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 +rightInverseFailureProp1 (Keypair 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 +rightInverseFailureProp2 (Keypair 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 +rightInverseFailureProp3 (Keypair 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 +rightInverseFailureProp4 (Keypair 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 + kp <- newKeypair return $ testGroup "... SealedBox" [ testGroup "Can decrypt ciphertext using..." [ testProperty "... public key/secret key" - $ ioProperty . rightInverseProp (sk1, pk1) + $ ioProperty . rightInverseProp kp ], testGroup "Fail to verify ciphertext when..." [ testProperty "... not using proper secret key" - $ ioProperty . uncurry (rightInverseFailureProp1 (sk1, pk1)), + $ ioProperty . uncurry (rightInverseFailureProp1 kp), testProperty "... not using proper public key" - $ ioProperty . uncurry (rightInverseFailureProp2 (sk1, pk1)), + $ ioProperty . uncurry (rightInverseFailureProp2 kp), testProperty "... not actually sent to you" - $ ioProperty . uncurry (rightInverseFailureProp3 (sk1, pk1)), + $ ioProperty . uncurry (rightInverseFailureProp3 kp), testProperty "... ciphertext has been perturbed" - $ ioProperty . uncurry ( rightInverseFailureProp4 (sk1, pk1) ) + $ ioProperty . uncurry (rightInverseFailureProp4 kp) ] ] diff --git a/tests/SecretBoxProperties.hs b/tests/SecretBoxProperties.hs --- a/tests/SecretBoxProperties.hs +++ b/tests/SecretBoxProperties.hs @@ -8,9 +8,10 @@ import Util import Crypto.Saltine.Core.SecretBox import Crypto.Saltine.Class -import Crypto.Saltine.Internal.ByteSizes as Bytes +import Crypto.Saltine.Internal.SecretBox as Internal import qualified Data.ByteString as S +import Data.Maybe (fromJust) import Test.Framework.Providers.QuickCheck2 import Test.Framework import Test.QuickCheck (Property, (==>)) @@ -18,17 +19,13 @@ instance Arbitrary Nonce where arbitrary = - do bs <- S.pack <$> vector Bytes.secretBoxNonce - maybe (fail "impossible arbitrary failure.") pure (decode bs) + do bs <- S.pack <$> vector Internal.secretbox_noncebytes + pure $ fromJust (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 + do bs <- S.pack <$> vector Internal.secretbox_keybytes + pure $ fromJust (decode bs) -- | Ciphertext can be decrypted rightInverseProp :: Key -> Nonce -> Message -> Bool @@ -49,8 +46,9 @@ -- | Ciphertext cannot be decrypted if the tag is perturbed rightInverseTagFailureProp :: Key -> Nonce -> Message -> Message -> Property -rightInverseTagFailureProp k n (Message bs) (Message fakeTag) = +rightInverseTagFailureProp k n (Message bs) (Message fakeTagBs) = let (realTag, ct) = secretboxDetached k n bs + fakeTag = Internal.Au fakeTagBs in realTag /= fakeTag ==> Nothing == secretboxOpenDetached k n fakeTag ct -- | Ciphertext cannot be decrypted if the ciphertext is perturbed diff --git a/tests/SignProperties.hs b/tests/SignProperties.hs --- a/tests/SignProperties.hs +++ b/tests/SignProperties.hs @@ -5,17 +5,28 @@ ) where import Util -import Crypto.Saltine.Core.Sign +import Crypto.Saltine.Class +import Crypto.Saltine.Core.Sign +import Crypto.Saltine.Internal.Sign +import qualified Crypto.Saltine.Core.Box as Box +import Crypto.Saltine.Core.ScalarMult () +import Crypto.Saltine.Internal.ScalarMult import qualified Data.ByteString as S +import Data.Maybe (fromJust) import Test.Framework.Providers.QuickCheck2 import Test.Framework import Test.QuickCheck testSign :: Test testSign = buildTest $ do - (sk1, pk1) <- newKeypair - (_sk2, pk2) <- newKeypair + kp1 <- newKeypair + let sk1 = secretKey kp1 + let pk1 = publicKey kp1 + kp2 <- newKeypair + let sk2 = secretKey kp2 + let pk2 = publicKey kp2 + n <- Box.newNonce return $ testGroup "...Internal.Sign" [ @@ -34,6 +45,15 @@ testProperty "Rejects message with mismatched key w/ detached signature" $ \(Message bs) -> not (S.null bs) ==> - not (signVerifyDetached pk2 (sign sk1 bs) bs) + not (signVerifyDetached pk2 (signDetached sk1 bs) bs), + testProperty "Ed25515 -> Curve25519 conversion produces valid keypairs" + $ \(Message bs) -> + let p1 = fromJust . decode . unGE . fromJust $ signPublicKeyToScalarMult pk1 + s1 = fromJust . decode . unSc . fromJust $ signSecretKeyToScalarMult sk1 + + p2 = fromJust . decode . unGE . fromJust $ signPublicKeyToScalarMult pk2 + s2 = fromJust . decode . unSc . fromJust $ signSecretKeyToScalarMult sk2 + + in (Box.boxOpen p2 s1 n (Box.box p1 s2 n bs)) == Just bs ] diff --git a/tests/StreamProperties.hs b/tests/StreamProperties.hs --- a/tests/StreamProperties.hs +++ b/tests/StreamProperties.hs @@ -23,8 +23,8 @@ ==> S.length (stream k n len) == len, testProperty "xor munges input" - $ \(Message bs) -> not (S.null bs) - ==> xor k n bs /= bs, + $ \(ByteString32 bs) -> -- ByteString32 so we don't fail the test by pure chance, e.g. in case of 1-byte bytestrings + xor k n bs /= bs, testProperty "xor is involutive" $ \(Message bs) -> xor k n (xor k n bs) == bs diff --git a/tests/Util.hs b/tests/Util.hs --- a/tests/Util.hs +++ b/tests/Util.hs @@ -5,13 +5,12 @@ import Crypto.Saltine.Class -import Control.Applicative import Control.Monad (replicateM) import qualified Data.ByteString as S import Data.Monoid +import Data.Semigroup (Semigroup) import Data.Word (Word8) import Data.Bits (xor) -import Data.Semigroup (Semigroup) import Test.QuickCheck import GHC.Exts (IsList(..)) @@ -45,7 +44,7 @@ then pure (Perturb (1:bs)) else pure (Perturb bs) -newtype ByteString32 = ByteString32 S.ByteString deriving (Show) +newtype ByteString32 = ByteString32 S.ByteString deriving (Eq,Show) instance Arbitrary ByteString32 where arbitrary = ByteString32 . S.pack <$> replicateM 32 arbitrary diff --git a/tests/UtilProperties.hs b/tests/UtilProperties.hs new file mode 100644 --- /dev/null +++ b/tests/UtilProperties.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + +module UtilProperties ( + testUtils + ) where + +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck +import Util + +import qualified Crypto.Saltine.Internal.Util as U + +-- | Testing the comparison of keys +keyEquality :: ByteString32 -> Property +keyEquality k@(ByteString32 bs1) = k === k .&. U.compare bs1 bs1 + +keyInequality :: ByteString32 -> ByteString32 -> Property +keyInequality k1@(ByteString32 bs1) k2@(ByteString32 bs2) = + k1 /= k2 ==> not $ U.compare bs1 bs2 + + +testUtils :: Test +testUtils = buildTest $ do + return $ testGroup "...Utils" [ + testProperty "ByteString equality" keyEquality, + testProperty "ByteString inequality" keyInequality + ]