diff --git a/miscellaneous/saltine/.github/workflows/haskell.yml b/miscellaneous/saltine/.github/workflows/haskell.yml new file mode 100644 index 00000000..2e5e4f3f --- /dev/null +++ b/miscellaneous/saltine/.github/workflows/haskell.yml @@ -0,0 +1,53 @@ +name: Haskell CI + +on: [push, pull_request] + +jobs: + build: + if: "!contains(github.event.head_commit.message, 'skip ci') && !contains(github.event.head_commit.message, 'ci skip')" + runs-on: ubuntu-22.04 + + strategy: + matrix: + ghc-version: ['8.0.2','8.2.2','8.4.4','8.6.5','8.8.4','8.10.7','9.0.2', '9.2.6', '9.4.4'] + fail-fast: false + steps: + - uses: actions/checkout@v3 + + - name: Workaround runner image issue + if: ${{ runner.os == 'Linux' }} + # https://github.com/actions/runner-images/issues/7061 + run: sudo chown -R $USER /usr/local/.ghcup + + - uses: haskell/actions/setup@v2 + with: + ghc-version: ${{ matrix.ghc-version }} + cabal-version: '3.8' + + - name: Cache + uses: actions/cache@v2 + env: + cache-name: cache-cabal-ghc-${{ matrix.ghc-version }} + with: + path: ~/.cabal + key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }} + restore-keys: | + ${{ runner.os }}-build-${{ env.cache-name }}- + + - name: Install libsodium + run: | + curl -# -L https://github.com/jedisct1/libsodium/releases/download/$SODIUMVER-RELEASE/libsodium-$SODIUMVER.tar.gz | tar xzf - + (cd libsodium-$SODIUMVER && ./autogen.sh && ./configure && make check && sudo make install && sudo ldconfig) + env: + SODIUMVER: 1.0.18 + + - name: Install dependencies + run: | + cabal update + cabal build --only-dependencies --enable-tests --enable-benchmarks + - name: Build + run: cabal build --enable-tests --enable-benchmarks all + - name: Run tests + run: cabal test all + - name: Install + run: cabal install --lib diff --git a/miscellaneous/saltine/.gitignore b/miscellaneous/saltine/.gitignore new file mode 100644 index 00000000..e61fbb17 --- /dev/null +++ b/miscellaneous/saltine/.gitignore @@ -0,0 +1,2 @@ +.hsenv* +dist* \ No newline at end of file diff --git a/miscellaneous/saltine/CHANGELOG.md b/miscellaneous/saltine/CHANGELOG.md new file mode 100644 index 00000000..125a5d77 --- /dev/null +++ b/miscellaneous/saltine/CHANGELOG.md @@ -0,0 +1,44 @@ +# 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.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/miscellaneous/saltine/LICENSE b/miscellaneous/saltine/LICENSE new file mode 100644 index 00000000..8eb902de --- /dev/null +++ b/miscellaneous/saltine/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2013 Joseph Abrahamson + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. \ No newline at end of file diff --git a/miscellaneous/saltine/Makefile b/miscellaneous/saltine/Makefile new file mode 100644 index 00000000..2cdd2fac --- /dev/null +++ b/miscellaneous/saltine/Makefile @@ -0,0 +1,20 @@ + +deps: + cabal install --only-dependencies --enable-test -j4 + +configure: deps + cabal configure --enable-test + +build: configure + cabal build + +test: build + cabal test + +clean: + cabal clean + +all: test + + +.PHONY: deps configure build test all diff --git a/miscellaneous/saltine/README.md b/miscellaneous/saltine/README.md new file mode 100644 index 00000000..cb87b549 --- /dev/null +++ b/miscellaneous/saltine/README.md @@ -0,0 +1,69 @@ +# Saltine 0.2.1.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/miscellaneous/saltine/Setup.hs b/miscellaneous/saltine/Setup.hs new file mode 100755 index 00000000..a6a22c8e --- /dev/null +++ b/miscellaneous/saltine/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain \ No newline at end of file diff --git a/miscellaneous/saltine/bench/AES256GCMBench.hs b/miscellaneous/saltine/bench/AES256GCMBench.hs new file mode 100644 index 00000000..11f65d89 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/AuthBench.hs b/miscellaneous/saltine/bench/AuthBench.hs new file mode 100644 index 00000000..8550a382 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/BenchUtils.hs b/miscellaneous/saltine/bench/BenchUtils.hs new file mode 100644 index 00000000..cf6360db --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/BoxBench.hs b/miscellaneous/saltine/bench/BoxBench.hs new file mode 100644 index 00000000..27b61b85 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/ChaCha20Poly1305Bench.hs b/miscellaneous/saltine/bench/ChaCha20Poly1305Bench.hs new file mode 100644 index 00000000..a48eabfa --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/ChaCha20Poly1305IETFBench.hs b/miscellaneous/saltine/bench/ChaCha20Poly1305IETFBench.hs new file mode 100644 index 00000000..918e0e1e --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/ConstantTimeBench.hs b/miscellaneous/saltine/bench/ConstantTimeBench.hs new file mode 100644 index 00000000..d604f68e --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/HashBench.hs b/miscellaneous/saltine/bench/HashBench.hs new file mode 100644 index 00000000..3b7401d9 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/Main.hs b/miscellaneous/saltine/bench/Main.hs new file mode 100644 index 00000000..4dd9321b --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/OneTimeAuthBench.hs b/miscellaneous/saltine/bench/OneTimeAuthBench.hs new file mode 100644 index 00000000..0b04a000 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/PasswordBench.hs b/miscellaneous/saltine/bench/PasswordBench.hs new file mode 100644 index 00000000..e677bfeb --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/RandomBench.hs b/miscellaneous/saltine/bench/RandomBench.hs new file mode 100644 index 00000000..2bb16a2a --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/ScalarMultBench.hs b/miscellaneous/saltine/bench/ScalarMultBench.hs new file mode 100644 index 00000000..5faeb066 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/SecretBoxBench.hs b/miscellaneous/saltine/bench/SecretBoxBench.hs new file mode 100644 index 00000000..bef2652d --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/SignBench.hs b/miscellaneous/saltine/bench/SignBench.hs new file mode 100644 index 00000000..9f8d7963 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/StreamBench.hs b/miscellaneous/saltine/bench/StreamBench.hs new file mode 100644 index 00000000..c50ac0d6 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/bench/XChaCha20Poly1305Bench.hs b/miscellaneous/saltine/bench/XChaCha20Poly1305Bench.hs new file mode 100644 index 00000000..aa767187 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/saltine.cabal b/miscellaneous/saltine/saltine.cabal new file mode 100644 index 00000000..2e2a279e --- /dev/null +++ b/miscellaneous/saltine/saltine.cabal @@ -0,0 +1,159 @@ +cabal-version: 2.0 + +name: saltine +version: 0.2.1.0 +synopsis: Cryptography that's easy to digest (NaCl/libsodium bindings). +description: + + /NaCl/ (pronounced \"salt\") is a new easy-to-use high-speed software + library for network communication, encryption, decryption, + signatures, etc. NaCl's goal is to provide all of the core + operations needed to build higher-level cryptographic tools. + . + + . + /Sodium/ is a portable, cross-compilable, installable, packageable + crypto library based on NaCl, with a compatible API. + . + + . + /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 +maintainer: Max Amanshauser +bug-reports: http://github.com/tel/saltine/issues +copyright: Copyright (c) Joseph Abrahamson 2013 +category: Cryptography +build-type: Simple +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 + location: https://github.com/tel/saltine.git + +library + hs-source-dirs: src + exposed-modules: + Crypto.Saltine + 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 + Crypto.Saltine.Core.OneTimeAuth + Crypto.Saltine.Core.Sign + Crypto.Saltine.Core.Hash + Crypto.Saltine.Core.ScalarMult + Crypto.Saltine.Core.Password + Crypto.Saltine.Core.Utils + 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.18 + + cc-options: -Wall + ghc-options: -Wall -funbox-strict-fields + default-language: Haskell2010 + build-depends: + base >= 4.5 && < 5 + , bytestring >= 0.10.8 && < 0.12 + , deepseq ^>= 1.4 + , profunctors >= 5.3 && < 5.7 + , hashable + , text ^>= 1.2 || ^>= 2.0 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + AuthProperties + BoxProperties + HashProperties + OneTimeAuthProperties + PasswordProperties + ScalarMultProperties + SecretBoxProperties + SealedBoxProperties + SignProperties + StreamProperties + 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.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/miscellaneous/saltine/src/Crypto/Saltine.hs b/miscellaneous/saltine/src/Crypto/Saltine.hs new file mode 100644 index 00000000..30212479 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} + +module Crypto.Saltine ( + sodiumInit + ) where + +import Foreign.C + +-- | Runs Sodiums's initialization routine. This must be called before +-- using any other function. It is thread-safe since libsodium 1.0.11. +sodiumInit :: IO () +sodiumInit = do + err <- c_sodiumInit + case err of + 0 -> -- everything went well + return () + 1 -> -- already initialized, we're good + return () + _ -> -- some kind of failure + error "Crypto.Saltine.sodiumInit" + +foreign import ccall "sodium_init" c_sodiumInit :: IO CInt diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Class.hs b/miscellaneous/saltine/src/Crypto/Saltine/Class.hs new file mode 100644 index 00000000..a5f421d3 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Class.hs @@ -0,0 +1,55 @@ +-- {-# LANGUAGE FlexibleInstances #-} + +-- | +-- Module : Crypto.Saltine.Class +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Saltine type classes +module Crypto.Saltine.Class ( + IsEncoding (..), + IsNonce (..) + ) where + +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 +-- type @Prism' ByteString a@ compatible with "Control.Lens" and +-- is automatically deduced. +class IsEncoding a where + encode :: a -> ByteString + decode :: ByteString -> Maybe a + encoded :: (Choice p, Applicative f) + => p a (f a) -> p ByteString (f ByteString) + encoded = prism' encode decode + {-# INLINE encoded #-} + +-- | A generic class for interacting with nonces. +class IsNonce n where + zero :: n + -- ^ Some privileged nonce value. + nudge :: n -> n + -- ^ Some perturbation on nonces such that @n /= nudge n@ with high + -- probability. Since nonces are finite, repeats may happen in + -- particularly small cases, but no nonces in Saltine are so + -- small. This is not guaranteed to be difficult to predict---if a + -- nonce had an `Enum` instance `succ` would be a good + -- implementation excepting that `succ` is partial. + +-- Copied over from Control.Lens + +prism' :: (Applicative f, Choice p) => + (a1 -> a) -> (a -> Maybe a2) -> p a2 (f a1) -> p a (f a) +prism' bs sma = prism bs (\s -> maybe (Left s) Right (sma s)) +{-# INLINE prism' #-} + +prism :: (Applicative f, Choice p) => + (a2 -> a1) -> (a -> Either a1 a3) -> p a3 (f a2) -> p a (f a1) +prism bt seta = dimap seta (either pure (fmap bt)) . right' +{-# INLINE prism #-} diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD.hs new file mode 100644 index 00000000..d258de5e --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD.hs @@ -0,0 +1,47 @@ +-- | +-- Module : Crypto.Saltine.Core.AEAD +-- 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" +-- +-- The 'aead' function encrypts and authenticates a message +-- 'ByteString' and additional authenticated data 'ByteString' +-- using a secret key and a nonce. The 'aeadOpen' +-- function verifies and decrypts a ciphertext 'ByteString' using a +-- secret key and a nonce. If the ciphertext fails validation, +-- 'aeadOpen' returns 'Nothing'. +-- +-- The "Crypto.Saltine.Core.AEAD" module is designed to meet +-- the standard notions of privacy and authenticity for a secret-key +-- authenticated-encryption scheme using nonces. For formal +-- definitions see, e.g., Bellare and Namprempre, "Authenticated +-- encryption: relations among notions and analysis of the generic +-- composition paradigm," Lecture Notes in Computer Science 1976 +-- (2000), 531–545, . +-- +-- Note that the length is not hidden. Note also that it is the +-- caller's responsibility to ensure the uniqueness of nonces—for +-- example, by using nonce 1 for the first message, nonce 2 for the +-- second message, etc. 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 ( + module X + ) where + +import Crypto.Saltine.Core.AEAD.XChaCha20Poly1305 as X diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/AES256GCM.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/AES256GCM.hs new file mode 100644 index 00000000..626246f9 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305.hs new file mode 100644 index 00000000..0de8a45e --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305IETF.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/ChaCha20Poly1305IETF.hs new file mode 100644 index 00000000..07f10f4d --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/XChaCha20Poly1305.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/AEAD/XChaCha20Poly1305.hs new file mode 100644 index 00000000..da055876 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Core/Auth.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/Auth.hs new file mode 100644 index 00000000..00dc0aaa --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/Auth.hs @@ -0,0 +1,84 @@ +-- | +-- Module : Crypto.Saltine.Core.Auth +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key message authentication: +-- "Crypto.Saltine.Core.Auth" +-- +-- The 'auth' function authenticates a message 'ByteString' using a +-- 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. +-- +-- The 'auth' function, viewed as a function of the message for a +-- uniform random key, is designed to meet the standard notion of +-- unforgeability. This means that an attacker cannot find +-- authenticators for any messages not authenticated by the sender, +-- even if the attacker has adaptively influenced the messages +-- authenticated by the sender. For a formal definition see, e.g., +-- Section 2.4 of Bellare, Kilian, and Rogaway, \"The security of the +-- cipher block chaining message authentication code,\" Journal of +-- Computer and System Sciences 61 (2000), 362–399; +-- . +-- +-- Saltine does not make any promises regarding \"strong\" +-- unforgeability; perhaps one valid authenticator can be converted +-- into another valid authenticator for the same message. NaCl also +-- does not make any promises regarding \"truncated unforgeability.\" +-- +-- "Crypto.Saltine.Core.Auth" is currently an implementation of +-- HMAC-SHA-512-256, i.e., the first 256 bits of +-- HMAC-SHA-512. HMAC-SHA-512-256 is conjectured to meet the standard +-- notion of unforgeability. +-- +-- This is version 2010.08.30 of the auth.html web page. +module Crypto.Saltine.Core.Auth ( + Key, Authenticator, + newKey, + auth, verify + ) where + +import Crypto.Saltine.Internal.Auth + ( c_auth + , c_auth_verify + , Key(..) + , Authenticator(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) + +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.auth_keybytes + +-- | Computes an keyed authenticator 'ByteString' from a message. It +-- is infeasible to forge these authenticators without the key, even +-- if an attacker observes many authenticators and messages and has +-- the ability to influence the messages sent. +auth :: Key + -> ByteString + -- ^ Message + -> Authenticator +auth (Key key) msg = + Au . snd . buildUnsafeByteString Bytes.auth_bytes $ \pa -> + constByteStrings [key, msg] $ \[(pk, _), (pm, mlen)] -> + c_auth pa pm (fromIntegral mlen) pk + +-- | Checks to see if an authenticator is a correct proof that a +-- message was signed by some key. +verify :: Key + -> Authenticator + -> ByteString + -- ^ Message + -> Bool + -- ^ Is this message authentic? +verify (Key key) (Au a) msg = + unsafeDidSucceed $ constByteStrings [key, msg, a] $ \[(pk, _), (pm, mlen), (pa, _)] -> + return $ c_auth_verify pa pm (fromIntegral mlen) pk diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/Box.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/Box.hs new file mode 100644 index 00000000..bf659f15 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/Box.hs @@ -0,0 +1,231 @@ +-- | +-- Module : Crypto.Saltine.Core.Box +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Public-key cryptography abstraction: +-- "Crypto.Saltine.Core.Box" +-- +-- This module consists of functions dealing with two public-key +-- cryptography concepts in libsodium. +-- +-- The first one is an authenticated encryption scheme. In this +-- scheme, the 'box' function encrypts and authenticates a message +-- 'ByteString' using the sender's secret key, the receiver's public +-- key, and a nonce. The 'boxOpen' function verifies and decrypts a +-- ciphertext 'ByteString' using the receiver's secret key, the +-- sender's public key, and a nonce. If the ciphertext fails +-- verification, 'boxOpen' returns 'Nothing'. +-- +-- The set of box functions is designed to meet the +-- standard notions of privacy and third-party unforgeability for a +-- public-key authenticated-encryption scheme using nonces. For formal +-- definitions see, e.g., Jee Hea An, "Authenticated encryption in the +-- public-key setting: security notions and analyses," +-- . +-- +-- Distinct messages between the same @{sender, receiver}@ set are +-- required to have distinct nonces. For example, the +-- lexicographically smaller public key can use nonce 1 for its first +-- message to the other key, nonce 3 for its second message, nonce 5 +-- for its third message, etc., while the lexicographically larger +-- public key uses nonce 2 for its first message to the other key, +-- nonce 4 for its second message, nonce 6 for its third message, +-- etc. Nonces are long enough that randomly generated nonces have +-- negligible risk of collision. +-- +-- There is no harm in having the same nonce for different messages if +-- the @{sender, receiver}@ sets are different. This is true even if +-- the sets overlap. For example, a sender can use the same nonce for +-- two different messages if the messages are sent to two different +-- public keys. +-- +-- The second concept is sealed boxes, which provide encryption and +-- preservation of integrity, but not authentication. Technically, +-- the sender of a message generates a keypair, uses the regular +-- box mechanism, attaches the public key to the message and then +-- immediately destroys the private key. This is useful, e.g. when +-- the receiver cannot know the sender's public key in advance and +-- hence cannot use the regular box functions, or when you want to +-- send messages anonymously. +-- +-- The "Crypto.Saltine.Core.Box" module is not meant to provide +-- non-repudiation. On the contrary: the crypto_box function +-- guarantees repudiability. A receiver can freely modify a boxed +-- message, and therefore cannot convince third parties that this +-- particular message came from the sender. The sender and receiver +-- are nevertheless protected against forgeries by other parties. In +-- the terminology of +-- , +-- crypto_box uses "public-key authenticators" rather than "public-key +-- signatures." +-- +-- Users who want public verifiability (or receiver-assisted public +-- verifiability) should instead use signatures (or +-- signcryption). Signatures are documented in the +-- "Crypto.Saltine.Core.Sign" module. +-- +-- "Crypto.Saltine.Core.Box" is @curve25519xsalsa20poly1305@, a +-- particular combination of Curve25519, Salsa20, and Poly1305 +-- specified in "Cryptography in NaCl" +-- (). This function is conjectured +-- to meet the standard notions of privacy and third-party +-- unforgeability. +-- +-- This is version 2010.08.30 of the box.html web page. +module Crypto.Saltine.Core.Box ( + SecretKey, PublicKey, Keypair(..), CombinedKey, Nonce, + newKeypair, beforeNM, newNonce, + box, boxOpen, + boxAfterNM, boxOpenAfterNM, + boxSeal, boxSealOpen + ) where + +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) + +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.box_publickeybytes $ \pkbuf -> + buildUnsafeByteString' Bytes.box_secretkeybytes $ \skbuf -> + c_box_keypair pkbuf skbuf + return $ Keypair (SK sk) (PK pk) + +-- | Randomly generates a nonce for usage with 'box' and 'boxOpen'. +newNonce :: IO Nonce +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.box_beforenmbytes $ \ckbuf -> + constByteStrings [pk, sk] $ \[(ppk, _), (psk, _)] -> + c_box_beforenm ckbuf ppk psk + +-- | Encrypts a message for sending to the owner of the public +-- key. They must have your public key in order to decrypt the +-- message. It is infeasible for an attacker to decrypt the message so +-- long as the 'Nonce' is not repeated. +box :: PublicKey + -> SecretKey + -> Nonce + -> ByteString + -- ^ Message + -> ByteString + -- ^ Ciphertext (incl. authentication tag) +box (PK pk) (SK sk) (Nonce nonce) msg = + snd . buildUnsafeByteString bufSize $ \pc -> + constByteStrings [pk, sk, msg, nonce] $ \ + [(ppk, _), (psk, _), (pm, _), (pn, _)] -> + c_box_easy pc pm (fromIntegral msgLen) pn ppk psk + where + bufSize = S.length msg + Bytes.box_macbytes + msgLen = S.length msg + +-- | Decrypts a message sent from the owner of the public key. They +-- must have encrypted it using your public key. Returns 'Nothing' if +-- the keys and message do not match. +boxOpen :: PublicKey -> SecretKey -> Nonce + -> ByteString + -- ^ Ciphertext (incl. authentication tag) + -> Maybe ByteString + -- ^ Message +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 + hush . handleErrno err $ vec + + +-- | 'box' using a 'CombinedKey' and thus faster. +boxAfterNM :: CombinedKey + -> Nonce + -> ByteString + -- ^ Message + -> ByteString + -- ^ Ciphertext (incl. authentication tag) +boxAfterNM (CK ck) (Nonce nonce) msg = + snd . buildUnsafeByteString bufSize $ \pc -> + constByteStrings [ck, msg, nonce] $ \ + [(pck, _), (pm, _), (pn, _)] -> + c_box_easy_afternm pc pm (fromIntegral msgLen) pn pck + where + bufSize = S.length msg + Bytes.box_macbytes + msgLen = S.length msg + +-- | 'boxOpen' using a 'CombinedKey' and is thus faster. +boxOpenAfterNM :: CombinedKey + -> Nonce + -> ByteString + -- ^ Ciphertext (incl. authentication tag) + -> Maybe ByteString + -- ^ Message +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 + 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.box_sealbytes + msgLen = S.length msg + +-- | Decrypts a sealed box message. The message must have been +-- encrypted using the receiver's public key. +-- Returns 'Nothing' if keys and message do not match or integrity +-- is violated. +boxSealOpen :: PublicKey + -> SecretKey + -> ByteString + -- ^ Ciphertext + -> Maybe ByteString + -- ^ Message +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 + hush . handleErrno err $ vec diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/Hash.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/Hash.hs new file mode 100644 index 00000000..1bac2973 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/Hash.hs @@ -0,0 +1,103 @@ + -- | +-- Module : Crypto.Saltine.Core.Hash +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Hashing: "Crypto.Saltine.Core.Hash" +-- +-- The 'hash' function hashes a message 'ByteString' and returns a +-- hash. Hashes are always of length 'Bytes.hash'. The 'shorthash' +-- function hashes a message 'ByteString' with respect to a secret key +-- and returns a very short hash. Short hashes are always of length +-- 'Bytes.shorthash'. +-- +-- The 'hash' function is designed to be usable as a strong component +-- of DSA, RSA-PSS, key derivation, hash-based message-authentication +-- codes, hash-based ciphers, and various other common +-- applications. "Strong" means that the security of these +-- applications, when instantiated with 'hash', is the same as the +-- security of the applications against generic attacks. In +-- particular, the 'hash' function is designed to make finding +-- collisions difficult. +-- +-- 'hash' is currently an implementation of SHA-512. 'shorthash' is +-- currently an implementation of SipHash-2-4 +-- (). +-- +-- There has been considerable degradation of public confidence in the +-- security conjectures for many hash functions, including +-- SHA-512. However, for the moment, there do not appear to be +-- 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 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 ( + ShorthashKey, + hash, + shorthash, newShorthashKey, + GenerichashKey, + newGenerichashKey, + GenerichashOutLen, + generichashOutLen, generichash + ) where + +import Crypto.Saltine.Internal.Hash + ( c_hash + , c_generichash + , shorthash + , ShorthashKey(..) + , GenerichashKey(..) + , GenerichashOutLen(..) + ) +import Crypto.Saltine.Internal.Util as U +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 +-- attack. +hash :: ByteString + -- ^ Message + -> ByteString + -- ^ Hash +hash m = snd . buildUnsafeByteString Bytes.hash_bytes $ \ph -> + constByteStrings [m] $ \[(pm, _)] -> c_hash ph pm (fromIntegral $ S.length m) + +-- | Randomly generates a new key for 'shorthash'. +newShorthashKey :: IO ShorthashKey +newShorthashKey = ShK <$> randomByteString Bytes.shorthash_keybytes + +-- | 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 + +-- | 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 + +-- | 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) diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/OneTimeAuth.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/OneTimeAuth.hs new file mode 100644 index 00000000..ff6145a1 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/OneTimeAuth.hs @@ -0,0 +1,80 @@ +-- | +-- Module : Crypto.Saltine.Core.OneTimeAuth +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key single-message authentication: +-- "Crypto.Saltine.Core.OneTimeAuth" +-- +-- The 'auth' function authenticates a message 'ByteString' using a +-- 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. +-- +-- The 'auth' function, viewed as a function of the message for a +-- uniform random key, is designed to meet the standard notion of +-- unforgeability after a single message. After the sender +-- authenticates one message, an attacker cannot find authenticators +-- for any other messages. +-- +-- The sender must not use 'auth' to authenticate more than one +-- message under the same key. Authenticators for two messages under +-- the same key should be expected to reveal enough information to +-- allow forgeries of authenticators on other messages. +-- +-- "Crypto.Saltine.Core.OneTimeAuth" is +-- @crypto_onetimeauth_poly1305@, an authenticator specified in +-- "Cryptography in NaCl" (), Section +-- 9. This authenticator is proven to meet the standard notion of +-- unforgeability after a single message. +-- +-- This is version 2010.08.30 of the onetimeauth.html web page. +module Crypto.Saltine.Core.OneTimeAuth ( + Key, Authenticator, + newKey, + auth, verify + ) where + +import Crypto.Saltine.Internal.OneTimeAuth + ( c_onetimeauth + , c_onetimeauth_verify + , Key(..) + , Authenticator(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) + +import qualified Crypto.Saltine.Internal.OneTimeAuth as Bytes +import qualified Data.ByteString as S + +-- | Creates a random key of the correct size for 'auth' and 'verify'. +newKey :: IO Key +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 +-- never used twice. +auth :: Key + -> ByteString + -- ^ Message + -> Authenticator +auth (Key key) msg = + Au . snd . buildUnsafeByteString Bytes.onetimeauth_bytes $ \pa -> + constByteStrings [key, msg] $ \[(pk, _), (pm, _)] -> + c_onetimeauth pa pm (fromIntegral $ S.length msg) pk + +-- | Verifies that an 'Authenticator' matches a given message and key. +verify :: Key + -> Authenticator + -> ByteString + -- ^ Message + -> Bool + -- ^ Is this message authentic? +verify (Key key) (Au a) msg = + unsafeDidSucceed $ constByteStrings [key, msg, a] $ \ + [(pk, _), (pm, _), (pa, _)] -> + return $ c_onetimeauth_verify pa pm (fromIntegral $ S.length msg) pk diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/Password.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/Password.hs new file mode 100644 index 00000000..f3a39fca --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Core/ScalarMult.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/ScalarMult.hs new file mode 100644 index 00000000..9380754b --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/ScalarMult.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric #-} + +-- | +-- Module : Crypto.Saltine.Core.ScalarMult +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Scalar multiplication: "Crypto.Saltine.Core.ScalarMult" +-- +-- The 'mult' function multiplies a group element by an integer of +-- length 'Bytes.multScalar'. It returns the resulting group element +-- of length 'Bytes.mult'. The 'multBase' function multiplies a +-- standard group element by an integer of length +-- 'Bytes.multScalar'. It returns the resulting group element of +-- length 'Bytes.mult'. +-- +-- The correspondence between strings and group elements depends on +-- the primitive implemented by 'mult'. The correspondence is not +-- necessarily injective in either direction, but it is compatible +-- with scalar multiplication in the group. The correspondence does +-- not necessarily include all group elements, but it does include all +-- strings; i.e., every string represents at least one group element. +-- +-- The correspondence between strings and integers also depends on the +-- primitive implemented by 'mult'. Every string represents at least +-- one integer. +-- +-- 'mult' is designed to be strong as a component of various +-- well-known \"hashed Diffie–Hellman\" applications. In particular, +-- it is designed to make the \"computational Diffie–Hellman\" problem +-- (CDH) difficult with respect to the standard base. 'mult' is also +-- designed to make CDH difficult with respect to other nontrivial +-- bases. In particular, if a represented group element has small +-- order, then it is annihilated by all represented scalars. This +-- feature allows protocols to avoid validating membership in the +-- subgroup generated by the standard base. +-- +-- NaCl does not make any promises regarding the \"decisional +-- Diffie–Hellman\" problem (DDH), the \"static Diffie–Hellman\" +-- problem (SDH), etc. Users are responsible for hashing group +-- elements. +-- +-- 'mult' is the function @crypto_scalarmult_curve25519@ specified in +-- \"Cryptography in NaCl\", Sections 2, 3, and 4 +-- (). This function is conjectured +-- to be strong. For background see Bernstein, \"Curve25519: new +-- Diffie-Hellman speed records,\" Lecture Notes in Computer Science +-- 3958 (2006), 207–228, . +-- +-- This is version 2010.08.30 of the scalarmult.html web page. +module Crypto.Saltine.Core.ScalarMult ( + Scalar, GroupElement, + mult, multBase + ) where + +import Crypto.Saltine.Internal.Util +import Crypto.Saltine.Internal.ScalarMult + ( c_scalarmult + , c_scalarmult_base + , GroupElement(..) + , Scalar(..) + ) + +import qualified Crypto.Saltine.Internal.ScalarMult as Bytes + + +mult :: Scalar -> GroupElement -> GroupElement +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.scalarmult_bytes $ \pq -> + constByteStrings [n] $ \[(pn, _)] -> + c_scalarmult_base pq pn diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/SecretBox.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/SecretBox.hs new file mode 100644 index 00000000..1d80ef17 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/SecretBox.hs @@ -0,0 +1,146 @@ +-- | +-- Module : Crypto.Saltine.Core.SecretBox +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key authenticated encryption: +-- "Crypto.Saltine.Core.SecretBox" +-- +-- The 'secretbox' function encrypts and authenticates a message +-- 'ByteString' using a secret key and a nonce. The 'secretboxOpen' +-- function verifies and decrypts a ciphertext 'ByteString' using a +-- secret key and a nonce. If the ciphertext fails validation, +-- 'secretboxOpen' returns 'Nothing'. +-- +-- The "Crypto.Saltine.Core.SecretBox" module is designed to meet +-- the standard notions of privacy and authenticity for a secret-key +-- authenticated-encryption scheme using nonces. For formal +-- definitions see, e.g., Bellare and Namprempre, "Authenticated +-- encryption: relations among notions and analysis of the generic +-- composition paradigm," Lecture Notes in Computer Science 1976 +-- (2000), 531–545, . +-- +-- Note that the length is not hidden. Note also that it is the +-- caller's responsibility to ensure the uniqueness of nonces—for +-- example, by using nonce 1 for the first message, nonce 2 for the +-- second message, etc. Nonces are long enough that randomly generated +-- nonces have negligible risk of collision. +-- +-- "Crypto.Saltine.Core.SecretBox" is +-- @crypto_secretbox_xsalsa20poly1305@, a particular combination of +-- Salsa20 and Poly1305 specified in \"Cryptography in NaCl\" +-- (). This function is conjectured +-- to meet the standard notions of privacy and authenticity. +-- +-- This is version 2010.08.30 of the secretbox.html web page. +module Crypto.Saltine.Core.SecretBox ( + Key, Nonce, Authenticator, + secretbox, secretboxOpen, + secretboxDetached, secretboxOpenDetached, + newKey, newNonce + ) where + +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 qualified Crypto.Saltine.Internal.SecretBox as Bytes +import qualified Data.ByteString as S + +-- | Creates a random key of the correct size for 'secretbox'. +newKey :: IO Key +newKey = Key <$> randomByteString Bytes.secretbox_keybytes + +-- | Creates a random nonce of the correct size for 'secretbox'. +newNonce :: IO Nonce +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 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.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 + -> (Authenticator,ByteString) + -- ^ (Authentication Tag, Ciphertext) +secretboxDetached (Key key) (Nonce nonce) msg = + buildUnsafeByteString ctLen $ \pc -> + 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.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 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.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 + -> 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] $ \ + [(pk, _), (pc, _), (pt, _), (pn, _)] -> + c_secretbox_open_detached pm pc pt (fromIntegral len) pn pk + in hush . handleErrno err $ vec + where len = S.length cipher diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/Sign.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/Sign.hs new file mode 100644 index 00000000..40d3ed9c --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/Sign.hs @@ -0,0 +1,131 @@ + +-- | +-- Module : Crypto.Saltine.Core.Sign +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Signatures: "Crypto.Saltine.Core.Sign" +-- +-- The 'newKeypair' function randomly generates a secret key and a +-- corresponding public key. The 'sign' function signs a message +-- 'ByteString' using the signer's secret key and returns the +-- resulting signed message. The 'signOpen' function verifies the +-- signature in a signed message using the signer's public key then +-- returns the message without its signature. +-- +-- "Crypto.Saltine.Core.Sign" is an EdDSA signature using +-- elliptic-curve Curve25519 (see: ). See +-- also, \"Daniel J. Bernstein, Niels Duif, Tanja Lange, Peter +-- Schwabe, Bo-Yin Yang. High-speed high-security signatures. Journal +-- of Cryptographic Engineering 2 (2012), 77–89.\" +-- . +-- +-- This is current information as of 2013 June 6. + +module Crypto.Saltine.Core.Sign ( + SecretKey, PublicKey, Keypair(..), Signature, + newKeypair, + sign, signOpen, + signDetached, signVerifyDetached + ) where + +import Crypto.Saltine.Internal.Sign + ( c_sign_keypair + , c_sign + , c_sign_open + , c_sign_detached + , c_sign_verify_detached + , 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 + +import qualified Crypto.Saltine.Internal.Sign as Bytes +import qualified Data.ByteString as S + +-- | Creates a random key of the correct size for 'sign' and +-- 'signOpen' of form @(secretKey, publicKey)@. +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.sign_publickeybytes $ \pkbuf -> + buildUnsafeByteString' Bytes.sign_secretkeybytes $ \skbuf -> + c_sign_keypair pkbuf skbuf + return $ Keypair (SK sk) (PK pk) + +-- | Augments a message with a signature forming a \"signed +-- message\". +sign :: SecretKey + -> ByteString + -- ^ Message + -> ByteString + -- ^ Signed message +sign (SK k) m = unsafePerformIO $ + alloca $ \psmlen -> do + (_err, sm) <- buildUnsafeByteString' (len + Bytes.sign_bytes) $ \psmbuf -> + constByteStrings [k, m] $ \[(pk, _), (pm, _)] -> + c_sign psmbuf psmlen pm (fromIntegral len) pk + smlen <- peek psmlen + return $ S.take (fromIntegral smlen) sm + where len = S.length m + +-- | Checks a \"signed message\" returning 'Just' the original message +-- iff the signature was generated using the 'SecretKey' corresponding +-- to the given 'PublicKey'. Returns 'Nothing' otherwise. +signOpen :: PublicKey + -> ByteString + -- ^ Signed message + -> Maybe ByteString + -- ^ Maybe the restored message +signOpen (PK k) sm = unsafePerformIO $ + alloca $ \pmlen -> do + (err, m) <- buildUnsafeByteString' smlen $ \pmbuf -> + constByteStrings [k, sm] $ \[(pk, _), (psm, _)] -> + c_sign_open pmbuf pmlen psm (fromIntegral smlen) pk + mlen <- peek pmlen + case err of + 0 -> return $ Just $ S.take (fromIntegral mlen) m + _ -> return Nothing + where smlen = S.length sm + +-- | Returns just the signature for a message using a SecretKey. +signDetached :: SecretKey + -> ByteString + -- ^ Message + -> Signature + -- ^ Signature +signDetached (SK k) m = unsafePerformIO $ + alloca $ \psmlen -> do + (_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 $ 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 + -> Signature + -- ^ Signature + -> ByteString + -- ^ Message (not signed) + -> Bool +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 + + diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/Stream.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/Stream.hs new file mode 100644 index 00000000..78b36ffb --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/Stream.hs @@ -0,0 +1,103 @@ +-- | +-- Module : Crypto.Saltine.Core.Stream +-- Copyright : (c) Joseph Abrahamson 2013 +-- License : MIT +-- +-- Maintainer : me@jspha.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Secret-key encryption: +-- "Crypto.Saltine.Core.Stream" +-- +-- The 'stream' function produces a sized stream 'ByteString' as a +-- function of a secret key and a nonce. The 'xor' function encrypts a +-- message 'ByteString' using a secret key and a nonce. The 'xor' +-- function guarantees that the ciphertext has the same length as the +-- plaintext, and is the @plaintext `xor` stream k n@. Consequently +-- 'xor' can also be used to decrypt. +-- +-- The 'stream' function, viewed as a function of the nonce for a +-- uniform random key, is designed to meet the standard notion of +-- unpredictability (\"PRF\"). For a formal definition see, e.g., +-- Section 2.3 of Bellare, Kilian, and Rogaway, \"The security of the +-- cipher block chaining message authentication code,\" Journal of +-- Computer and System Sciences 61 (2000), 362–399; +-- . This means that +-- an attacker cannot distinguish this function from a uniform random +-- function. Consequently, if a series of messages is encrypted by +-- 'xor' with /a different nonce for each message/, the ciphertexts +-- are indistinguishable from uniform random strings of the same +-- length. +-- +-- 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. +-- +-- Saltine does not make any promises regarding the resistance of +-- crypto_stream to \"related-key attacks.\" It is the caller's +-- responsibility to use proper key-derivation functions. +-- +-- "Crypto.Saltine.Core.Stream" is @crypto_stream_xsalsa20@, a +-- particular cipher specified in \"Cryptography in NaCl\" +-- (), Section 7. This cipher is +-- conjectured to meet the standard notion of unpredictability. +-- +-- This is version 2010.08.30 of the stream.html web page. + +module Crypto.Saltine.Core.Stream ( + Key, Nonce, + newKey, newNonce, + stream, xor + ) where + +import Crypto.Saltine.Internal.Stream ( c_stream + , c_stream_xor + , Key(..) + , Nonce(..) + ) +import Crypto.Saltine.Internal.Util as U +import Data.ByteString (ByteString) + +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.stream_keybytes + +-- | Creates a random nonce of the correct size for 'stream' and +-- 'xor'. +newNonce :: IO Nonce +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 +-- long as the 'Nonce' is not used more than once. +stream :: Key -> Nonce -> Int + -> ByteString + -- ^ Cryptographic stream +stream (Key key) (Nonce nonce) n = + snd . buildUnsafeByteString n $ \ps -> + constByteStrings [key, nonce] $ \[(pk, _), (pn, _)] -> + c_stream ps (fromIntegral n) pn pk + +-- | Computes the exclusive-or between a message and a cryptographic +-- random stream indexed by the 'Key' and the 'Nonce'. This renders +-- the output indistinguishable from random noise so long as the +-- 'Nonce' is not used more than once. /Note:/ while this can be used +-- for encryption and decryption, it is /possible for an attacker to/ +-- /manipulate the message in transit without detection/. USE AT YOUR +-- OWN RISK. +xor :: Key -> Nonce + -> ByteString + -- ^ Message + -> ByteString + -- ^ Ciphertext +xor (Key key) (Nonce nonce) msg = + snd . buildUnsafeByteString len $ \pc -> + constByteStrings [key, nonce, msg] $ \[(pk, _), (pn, _), (pm, _)] -> + c_stream_xor pc pm (fromIntegral len) pn pk + where len = S.length msg diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Core/Utils.hs b/miscellaneous/saltine/src/Crypto/Saltine/Core/Utils.hs new file mode 100644 index 00000000..77d97aeb --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Core/Utils.hs @@ -0,0 +1,6 @@ +module Crypto.Saltine.Core.Utils + ( Crypto.Saltine.Internal.Util.randomByteString + , Crypto.Saltine.Internal.Util.bin2hex + ) where + +import qualified Crypto.Saltine.Internal.Util diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/AES256GCM.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/AES256GCM.hs new file mode 100644 index 00000000..199c0210 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305.hs new file mode 100644 index 00000000..57081864 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305IETF.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/ChaCha20Poly1305IETF.hs new file mode 100644 index 00000000..4e7b91a2 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/XChaCha20Poly1305.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/AEAD/XChaCha20Poly1305.hs new file mode 100644 index 00000000..bf3b58bf --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/Auth.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Auth.hs new file mode 100644 index 00000000..06c94ac3 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/Box.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Box.hs new file mode 100644 index 00000000..8eb5c1df --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/ByteSizes.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/ByteSizes.hs new file mode 100644 index 00000000..62186f96 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Internal/ByteSizes.hs @@ -0,0 +1,193 @@ +-- | +-- Module : Crypto.Saltine.Internal.ByteSizes +-- Copyright : (c) Joseph Abrahamson 2013 +-- (c) Max Amanshauser 2021 +-- License : MIT +-- +-- Maintainer : max@lambdalifting.org +-- Stability : experimental +-- Portability : non-portable +-- +module Crypto.Saltine.Internal.ByteSizes ( + ) where + + +-- Others +-- ------ + +-- src/libsodium/crypto_auth/hmacsha256/auth_hmacsha256_api.c +-- foreign import ccall "crypto_auth_hmacsha256_bytes" +-- c_crypto_auth_hmacsha256_bytes :: CSize +-- foreign import ccall "crypto_auth_hmacsha256_keybytes" +-- c_crypto_auth_hmacsha256_keybytes :: CSize + +-- src/libsodium/crypto_auth/hmacsha512256/auth_hmacsha512256_api.c +-- foreign import ccall "crypto_auth_hmacsha512256_bytes" +-- c_crypto_auth_hmacsha512256_bytes :: CSize +-- foreign import ccall "crypto_auth_hmacsha512256_keybytes" +-- c_crypto_auth_hmacsha512256_keybytes :: CSize + +-- src/libsodium/crypto_box/curve25519xsalsa20poly1305/box_curve25519xsalsa20poly1305_api.c +-- foreign import ccall "crypto_box_curve25519xsalsa20poly1305_publickeybytes" +-- c_crypto_box_curve25519xsalsa20poly1305_publickeybytes :: CSize +-- foreign import ccall "crypto_box_curve25519xsalsa20poly1305_secretkeybytes" +-- c_crypto_box_curve25519xsalsa20poly1305_secretkeybytes :: CSize +-- foreign import ccall "crypto_box_curve25519xsalsa20poly1305_beforenmbytes" +-- c_crypto_box_curve25519xsalsa20poly1305_beforenmbytes :: CSize +-- foreign import ccall "crypto_box_curve25519xsalsa20poly1305_noncebytes" +-- c_crypto_box_curve25519xsalsa20poly1305_noncebytes :: CSize +-- foreign import ccall "crypto_box_curve25519xsalsa20poly1305_zerobytes" +-- c_crypto_box_curve25519xsalsa20poly1305_zerobytes :: CSize +-- foreign import ccall "crypto_box_curve25519xsalsa20poly1305_boxzerobytes" +-- c_crypto_box_curve25519xsalsa20poly1305_boxzerobytes :: CSize +-- foreign import ccall "crypto_box_curve25519xsalsa20poly1305_macbytes" +-- c_crypto_box_curve25519xsalsa20poly1305_macbytes :: CSize + +-- src/libsodium/crypto_core/hsalsa20/core_hsalsa20_api.c +-- foreign import ccall "crypto_core_hsalsa20_outputbytes" +-- c_crypto_core_hsalsa20_outputbytes :: CSize +-- foreign import ccall "crypto_core_hsalsa20_inputbytes" +-- c_crypto_core_hsalsa20_inputbytes :: CSize +-- foreign import ccall "crypto_core_hsalsa20_keybytes" +-- c_crypto_core_hsalsa20_keybytes :: CSize +-- foreign import ccall "crypto_core_hsalsa20_constbytes" +-- c_crypto_core_hsalsa20_constbytes :: CSize + +-- src/libsodium/crypto_core/salsa20/core_salsa20_api.c +-- foreign import ccall "crypto_core_salsa20_outputbytes" +-- c_crypto_core_salsa20_outputbytes :: CSize +-- foreign import ccall "crypto_core_salsa20_inputbytes" +-- c_crypto_core_salsa20_inputbytes :: CSize +-- foreign import ccall "crypto_core_salsa20_keybytes" +-- c_crypto_core_salsa20_keybytes :: CSize +-- foreign import ccall "crypto_core_salsa20_constbytes" +-- c_crypto_core_salsa20_constbytes :: CSize + +-- src/libsodium/crypto_core/salsa2012/core_salsa2012_api.c +-- foreign import ccall "crypto_core_salsa2012_outputbytes" +-- c_crypto_core_salsa2012_outputbytes :: CSize +-- foreign import ccall "crypto_core_salsa2012_inputbytes" +-- c_crypto_core_salsa2012_inputbytes :: CSize +-- foreign import ccall "crypto_core_salsa2012_keybytes" +-- c_crypto_core_salsa2012_keybytes :: CSize +-- foreign import ccall "crypto_core_salsa2012_constbytes" +-- c_crypto_core_salsa2012_constbytes :: CSize + +-- src/libsodium/crypto_core/salsa208/core_salsa208_api.c +-- foreign import ccall "crypto_core_salsa208_outputbytes" +-- c_crypto_core_salsa208_outputbytes :: CSize +-- foreign import ccall "crypto_core_salsa208_inputbytes" +-- c_crypto_core_salsa208_inputbytes :: CSize +-- foreign import ccall "crypto_core_salsa208_keybytes" +-- c_crypto_core_salsa208_keybytes :: CSize +-- foreign import ccall "crypto_core_salsa208_constbytes" +-- c_crypto_core_salsa208_constbytes :: CSize + +-- src/libsodium/crypto_generichash/blake2/generichash_blake2_api.c +-- foreign import ccall "crypto_generichash_blake2b_blockbytes" +-- c_crypto_generichash_blake2b_blockbytes :: CSize + +-- src/libsodium/crypto_generichash/crypto_generichash.c +-- foreign import ccall "crypto_generichash_bytes" +-- c_crypto_generichash_bytes :: CSize +-- foreign import ccall "crypto_generichash_keybytes" +-- c_crypto_generichash_keybytes :: CSize +-- foreign import ccall "crypto_generichash_blockbytes" +-- c_crypto_generichash_blockbytes :: CSize + +-- src/libsodium/crypto_hash/sha256/hash_sha256_api.c +-- foreign import ccall "crypto_hash_sha256_bytes" +-- c_crypto_hash_sha256_bytes :: CSize + +-- src/libsodium/crypto_hash/sha512/hash_sha512_api.c +-- foreign import ccall "crypto_hash_sha512_bytes" +-- c_crypto_hash_sha512_bytes :: CSize + +-- src/libsodium/crypto_hashblocks/sha256/hashblocks_sha256_api.c +-- foreign import ccall "crypto_hashblocks_sha256_statebytes" +-- c_crypto_hashblocks_sha256_statebytes :: CSize +-- foreign import ccall "crypto_hashblocks_sha256_blockbytes" +-- c_crypto_hashblocks_sha256_blockbytes :: CSize + +-- src/libsodium/crypto_hashblocks/sha512/hashblocks_sha512_api.c +-- foreign import ccall "crypto_hashblocks_sha512_statebytes" +-- c_crypto_hashblocks_sha512_statebytes :: CSize +-- foreign import ccall "crypto_hashblocks_sha512_blockbytes" +-- c_crypto_hashblocks_sha512_blockbytes :: CSize + +-- src/libsodium/crypto_onetimeauth/poly1305/onetimeauth_poly1305_api.c +-- foreign import ccall "crypto_onetimeauth_poly1305_bytes" +-- c_crypto_onetimeauth_poly1305_bytes :: CSize +-- foreign import ccall "crypto_onetimeauth_poly1305_keybytes" +-- c_crypto_onetimeauth_poly1305_keybytes :: CSize + +-- src/libsodium/crypto_secretbox/xsalsa20poly1305/secretbox_xsalsa20poly1305_api.c +-- foreign import ccall "crypto_secretbox_xsalsa20poly1305_keybytes" +-- c_crypto_secretbox_xsalsa20poly1305_keybytes :: CSize +-- foreign import ccall "crypto_secretbox_xsalsa20poly1305_noncebytes" +-- c_crypto_secretbox_xsalsa20poly1305_noncebytes :: CSize +-- foreign import ccall "crypto_secretbox_xsalsa20poly1305_zerobytes" +-- c_crypto_secretbox_xsalsa20poly1305_zerobytes :: CSize +-- foreign import ccall "crypto_secretbox_xsalsa20poly1305_boxzerobytes" +-- c_crypto_secretbox_xsalsa20poly1305_boxzerobytes :: CSize + +-- foreign import ccall "crypto_shorthash_siphash24_bytes" +-- c_crypto_shorthash_siphash24_bytes :: CSize + +-- src/libsodium/crypto_sign/ed25519/sign_ed25519_api.c +-- foreign import ccall "crypto_sign_ed25519_bytes" +-- c_crypto_sign_ed25519_bytes :: CSize +-- foreign import ccall "crypto_sign_ed25519_publickeybytes" +-- c_crypto_sign_ed25519_publickeybytes :: CSize +-- foreign import ccall "crypto_sign_ed25519_secretkeybytes" +-- c_crypto_sign_ed25519_secretkeybytes :: CSize + +-- src/libsodium/crypto_sign/edwards25519sha512batch/sign_edwards25519sha512batch_api.c +-- foreign import ccall "crypto_sign_edwards25519sha512batch_bytes" +-- c_crypto_sign_edwards25519sha512batch_bytes :: CSize +-- foreign import ccall "crypto_sign_edwards25519sha512batch_publickeybytes" +-- c_crypto_sign_edwards25519sha512batch_publickeybytes :: CSize +-- foreign import ccall "crypto_sign_edwards25519sha512batch_secretkeybytes" +-- c_crypto_sign_edwards25519sha512batch_secretkeybytes :: CSize + +-- src/libsodium/crypto_stream/aes128ctr/stream_aes128ctr_api.c +-- foreign import ccall "crypto_stream_aes128ctr_keybytes" +-- c_crypto_stream_aes128ctr_keybytes :: CSize +-- foreign import ccall "crypto_stream_aes128ctr_noncebytes" +-- c_crypto_stream_aes128ctr_noncebytes :: CSize +-- foreign import ccall "crypto_stream_aes128ctr_beforenmbytes" +-- c_crypto_stream_aes128ctr_beforenmbytes :: CSize + +-- src/libsodium/crypto_stream/aes256estream/stream_aes256estream_api.c +-- foreign import ccall "crypto_stream_aes256estream_keybytes" +-- c_crypto_stream_aes256estream_keybytes :: CSize +-- foreign import ccall "crypto_stream_aes256estream_noncebytes" +-- c_crypto_stream_aes256estream_noncebytes :: CSize +-- foreign import ccall "crypto_stream_aes256estream_beforenmbytes" +-- c_crypto_stream_aes256estream_beforenmbytes :: CSize + +-- src/libsodium/crypto_stream/salsa2012/stream_salsa2012_api.c +-- foreign import ccall "crypto_stream_salsa2012_keybytes" +-- c_crypto_stream_salsa2012_keybytes :: CSize +-- foreign import ccall "crypto_stream_salsa2012_noncebytes" +-- c_crypto_stream_salsa2012_noncebytes :: CSize + +-- src/libsodium/crypto_stream/salsa208/stream_salsa208_api.c +-- foreign import ccall "crypto_stream_salsa208_keybytes" +-- c_crypto_stream_salsa208_keybytes :: CSize +-- foreign import ccall "crypto_stream_salsa208_noncebytes" +-- c_crypto_stream_salsa208_noncebytes :: CSize + +-- src/libsodium/crypto_stream/xsalsa20/stream_xsalsa20_api.c +-- foreign import ccall "crypto_stream_xsalsa20_keybytes" +-- c_crypto_stream_xsalsa20_keybytes :: CSize +-- foreign import ccall "crypto_stream_xsalsa20_noncebytes" +-- c_crypto_stream_xsalsa20_noncebytes :: CSize + +-- src/libsodium/crypto_verify/16/verify_16_api.c +-- foreign import ccall "crypto_verify_16_bytes" +-- c_crypto_verify_16_bytes :: CSize + +-- src/libsodium/crypto_verify/32/verify_32_api.c +-- foreign import ccall "crypto_verify_32_bytes" +-- c_crypto_verify_32_bytes :: CSize diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Internal/Hash.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Hash.hs new file mode 100644 index 00000000..dd116a60 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Hash.hs @@ -0,0 +1,162 @@ +{-# 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 + , c_hash + , c_shorthash + , c_generichash + , 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 :: 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 + +-- 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 + + +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 diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Internal/OneTimeAuth.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/OneTimeAuth.hs new file mode 100644 index 00000000..c703adbe --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/Password.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Password.hs new file mode 100644 index 00000000..26c5e52b --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/ScalarMult.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/ScalarMult.hs new file mode 100644 index 00000000..03a084bf --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/SecretBox.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/SecretBox.hs new file mode 100644 index 00000000..a970eac4 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/Sign.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Sign.hs new file mode 100644 index 00000000..69d93b88 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Sign.hs @@ -0,0 +1,182 @@ +{-# 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 + , 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 diff --git a/miscellaneous/saltine/src/Crypto/Saltine/Internal/Stream.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Stream.hs new file mode 100644 index 00000000..e9676f50 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/src/Crypto/Saltine/Internal/Util.hs b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Util.hs new file mode 100644 index 00000000..5216d776 --- /dev/null +++ b/miscellaneous/saltine/src/Crypto/Saltine/Internal/Util.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE BangPatterns #-} + +module Crypto.Saltine.Internal.Util ( + module Crypto.Saltine.Internal.Util + , withCString + , allocaBytes +) +where + +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)@). +cycleSucc :: (Bounded a, Enum a, Eq a) => a -> (Bool, a) +cycleSucc a = (top, if top then minBound else succ a) + where top = a == maxBound + +-- | Treats a 'ByteString' as a little endian bitstring and increments +-- it. +nudgeBS :: ByteString -> ByteString +nudgeBS i = fst $ S.unfoldrN (S.length i) go (True, i) where + go (toSucc, bs) = do + (hd, tl) <- S.uncons bs + let (top, hd') = cycleSucc hd + + if toSucc + then return (hd', (top, tl)) + else return (hd, (top && toSucc, tl)) + +-- | Computes the orbit of a endomorphism... in a very brute force +-- manner. Exists just for the below property. +-- +-- prop> length . orbit nudgeBS . S.pack . replicate 0 == (256^) +orbit :: Eq a => (a -> a) -> a -> [a] +orbit f a0 = orbit' (f a0) where + orbit' a = if a == a0 then [a0] else a : orbit' (f a) + +-- | 0-pad a 'ByteString' +pad :: Int -> ByteString -> ByteString +pad n = mappend (S.replicate n 0) + +-- | Remove a 0-padding from a 'ByteString' +unpad :: Int -> ByteString -> ByteString +unpad = S.drop + +-- | Converts a C-convention errno to an Either +handleErrno :: CInt -> (a -> Either String a) +handleErrno err a = case err of + 0 -> Right a + -1 -> Left "failed" + n -> Left ("unexpected error code: " ++ show n) + +unsafeDidSucceed :: IO CInt -> Bool +unsafeDidSucceed = go . unsafePerformIO + 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 = + foldr (\v kk -> \k -> (unsafeUseAsCStringLen v) (\a -> kk (\as -> k (a:as)))) ($ []) + +-- | Slightly safer cousin to 'buildUnsafeByteString' that remains in the +-- 'IO' monad. +buildUnsafeByteString' :: Int -> (Ptr CChar -> IO b) -> IO (b, ByteString) +buildUnsafeByteString' n k = do + ph <- mallocBytes n + bs <- unsafePackMallocCStringLen (ph, fromIntegral n) + out <- unsafeUseAsCString bs k + return (out, bs) + + +-- | 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 +-- it's difficult to predict the timing of the 'ByteString' creation. +buildUnsafeByteString :: Int -> (Ptr CChar -> IO b) -> (b, ByteString) +buildUnsafeByteString n = unsafePerformIO . buildUnsafeByteString' n + +-- | Build a sized random 'ByteString' using Sodium's bindings to +-- @/dev/urandom@. +randomByteString :: Int -> IO ByteString +randomByteString n = + snd <$> buildUnsafeByteString' n (`c_randombytes_buf` fromIntegral n) + +-- | To prevent a dependency on package 'errors' +hush :: Either s a -> Maybe a +hush = either (const Nothing) Just + +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/miscellaneous/saltine/tests/AEAD/AES256GCMProperties.hs b/miscellaneous/saltine/tests/AEAD/AES256GCMProperties.hs new file mode 100644 index 00000000..1a9b4275 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/tests/AEAD/ChaCha20Poly1305IETFProperties.hs b/miscellaneous/saltine/tests/AEAD/ChaCha20Poly1305IETFProperties.hs new file mode 100644 index 00000000..a9416cb1 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/tests/AEAD/ChaCha20Poly1305Properties.hs b/miscellaneous/saltine/tests/AEAD/ChaCha20Poly1305Properties.hs new file mode 100644 index 00000000..3f6b3c9d --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/tests/AEAD/XChaCha20Poly1305Properties.hs b/miscellaneous/saltine/tests/AEAD/XChaCha20Poly1305Properties.hs new file mode 100644 index 00000000..4ae79149 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/tests/AuthProperties.hs b/miscellaneous/saltine/tests/AuthProperties.hs new file mode 100644 index 00000000..ffb9afa7 --- /dev/null +++ b/miscellaneous/saltine/tests/AuthProperties.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} + +module AuthProperties ( + testAuth + ) where + +import Util +import Crypto.Saltine.Core.Auth + +import Test.Framework.Providers.QuickCheck2 +import Test.Framework + +testAuth :: Test +testAuth = buildTest $ do + k <- newKey + return $ testGroup "...Internal.Auth" [ + + testProperty "Authenticates message" + $ \(Message bs) -> verify k (auth k bs) bs == True + + ] diff --git a/miscellaneous/saltine/tests/BoxProperties.hs b/miscellaneous/saltine/tests/BoxProperties.hs new file mode 100644 index 00000000..e53780f4 --- /dev/null +++ b/miscellaneous/saltine/tests/BoxProperties.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} + +module BoxProperties ( + testBox + ) where + +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 (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 (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 (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 (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 (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 + Keypair sk1 pk1 <- newKeypair + Keypair sk2 pk2 <- newKeypair + let ck_1for2 = beforeNM sk1 pk2 + ck_2for1 = beforeNM sk2 pk1 + return (ck_1for2 == ck_2for1) + +-- | Ciphertext can be decrypted using combined keys +rightInverseAfterNMProp + :: CombinedKey -> CombinedKey -> Nonce -> Message -> Bool +rightInverseAfterNMProp ck_1for2 ck_2for1 n (Message bs) = + Just bs == boxOpenAfterNM ck_2for1 n (boxAfterNM ck_1for2 n bs) + +-- | Perturbed ciphertext cannot be decrypted using combined keys +rightInverseFailureAfterNMProp1 + :: CombinedKey -> CombinedKey -> Nonce -> Message -> Perturb -> Bool +rightInverseFailureAfterNMProp1 ck_1for2 ck_2for1 n (Message bs) p = + Nothing == boxOpenAfterNM ck_2for1 n (perturb (boxAfterNM ck_1for2 n bs) p) + +testBox :: Test +testBox = buildTest $ do + kp1@(Keypair sk1 pk1) <- newKeypair + kp2@(Keypair sk2 pk2) <- newKeypair + let ck_1for2 = beforeNM sk1 pk2 + ck_2for1 = beforeNM sk2 pk1 + n1 <- newNonce + n2 <- newNonce + + return $ testGroup "...Internal.Box" [ + + testGroup "Can decrypt ciphertext using..." [ + + testProperty "... public key/secret key" + $ rightInverseProp kp1 kp2 n1 , + + testProperty "... combined key" + $ rightInverseAfterNMProp ck_1for2 ck_2for1 n1 + + ], + + testGroup "Fail to verify ciphertext when..." [ + + testProperty "... not using proper secret key" + $ rightInverseFailureProp1 kp1 kp2 n1, + + testProperty "... not actually sent to you" + $ rightInverseFailureProp2 kp1 kp2 n1, + + testProperty "... ciphertext has been perturbed" + $ rightInverseFailureProp3 kp1 kp2 n1, + + testProperty "... using the wrong nonce" + $ cannotDecryptNonceProp kp1 kp2 n1 n2, + + testProperty "... using the wrong combined key" + $ rightInverseFailureAfterNMProp1 ck_1for2 ck_2for1 n1 + + ], + + testGroup "(properties)" [ + + testProperty "beforeNM is anti-symmetric" beforeNMCreateSecretKeyProp + + ] + ] diff --git a/miscellaneous/saltine/tests/HashProperties.hs b/miscellaneous/saltine/tests/HashProperties.hs new file mode 100644 index 00000000..ef67bf36 --- /dev/null +++ b/miscellaneous/saltine/tests/HashProperties.hs @@ -0,0 +1,46 @@ +{-# 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 "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 "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>\"" diff --git a/miscellaneous/saltine/tests/Main.hs b/miscellaneous/saltine/tests/Main.hs new file mode 100644 index 00000000..88e31c9d --- /dev/null +++ b/miscellaneous/saltine/tests/Main.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import SecretBoxProperties (testSecretBox) +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 + +runOpts :: RunnerOptions +runOpts = mempty { ropt_color_mode = Just ColorAlways + , ropt_test_options = Just testOpts + } + +testOpts :: TestOptions +testOpts = mempty { topt_maximum_generated_tests = Just 20000 } + +main :: IO () +main = do + sodiumInit + flip defaultMainWithOpts runOpts [ + testUtils, + testBox, + testSealedBox, + testSecretBox, + testAEADChaCha20, + testAEADIETF, + testAEADXChaCha20, + testAEADAES, + testStream, + testAuth, + testOneTimeAuth, + testSign, + testHash, + testScalarMult, + testPassword + ] diff --git a/miscellaneous/saltine/tests/OneTimeAuthProperties.hs b/miscellaneous/saltine/tests/OneTimeAuthProperties.hs new file mode 100644 index 00000000..d0c75c69 --- /dev/null +++ b/miscellaneous/saltine/tests/OneTimeAuthProperties.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} + +module OneTimeAuthProperties ( + testOneTimeAuth + ) where + +import Util + +import Crypto.Saltine.Core.OneTimeAuth + +import Test.Framework.Providers.QuickCheck2 +import Test.Framework + +testOneTimeAuth :: Test +testOneTimeAuth = buildTest $ do + k <- newKey + return $ testGroup "...Internal.Auth (one-time)" [ + + testProperty "Authenticates message" + $ \(Message bs) -> verify k (auth k bs) bs == True + + ] diff --git a/miscellaneous/saltine/tests/PasswordProperties.hs b/miscellaneous/saltine/tests/PasswordProperties.hs new file mode 100644 index 00000000..8d1f1892 --- /dev/null +++ b/miscellaneous/saltine/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/miscellaneous/saltine/tests/ScalarMultProperties.hs b/miscellaneous/saltine/tests/ScalarMultProperties.hs new file mode 100644 index 00000000..dd697078 --- /dev/null +++ b/miscellaneous/saltine/tests/ScalarMultProperties.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ScalarMultProperties ( + testScalarMult + ) where + +import Util +import Crypto.Saltine.Class +import Crypto.Saltine.Core.ScalarMult + +import qualified Data.ByteString as S +import Data.Maybe (fromJust) +import Test.Framework.Providers.QuickCheck2 +import Test.Framework + +-- Test vectors extracted from "Cryptography in NaCl", +-- http://cr.yp.to/highspeed/naclcrypto-20090310.pdf +alicesk, bobsk :: Scalar +alicesk = fromJust . decode $ S.pack + [0x77,0x07,0x6d,0x0a,0x73,0x18,0xa5,0x7d + ,0x3c,0x16,0xc1,0x72,0x51,0xb2,0x66,0x45 + ,0xdf,0x4c,0x2f,0x87,0xeb,0xc0,0x99,0x2a + ,0xb1,0x77,0xfb,0xa5,0x1d,0xb9,0x2c,0x2a] +bobsk = fromJust . decode $ S.pack + [0x5d,0xab,0x08,0x7e,0x62,0x4a,0x8a,0x4b + ,0x79,0xe1,0x7f,0x8b,0x83,0x80,0x0e,0xe6 + ,0x6f,0x3b,0xb1,0x29,0x26,0x18,0xb6,0xfd + ,0x1c,0x2f,0x8b,0x27,0xff,0x88,0xe0,0xeb] + +alicepk, bobpk, sharedsk :: GroupElement +alicepk = fromJust . decode $ S.pack + [0x85,0x20,0xf0,0x09,0x89,0x30,0xa7,0x54 + ,0x74,0x8b,0x7d,0xdc,0xb4,0x3e,0xf7,0x5a + ,0x0d,0xbf,0x3a,0x0d,0x26,0x38,0x1a,0xf4 + ,0xeb,0xa4,0xa9,0x8e,0xaa,0x9b,0x4e,0x6a] +bobpk = fromJust . decode $ S.pack + [0xde,0x9e,0xdb,0x7d,0x7b,0x7d,0xc1,0xb4 + ,0xd3,0x5b,0x61,0xc2,0xec,0xe4,0x35,0x37 + ,0x3f,0x83,0x43,0xc8,0x5b,0x78,0x67,0x4d + ,0xad,0xfc,0x7e,0x14,0x6f,0x88,0x2b,0x4f] +sharedsk = fromJust . decode $ S.pack + [0x4a,0x5d,0x9d,0x5b,0xa4,0xce,0x2d,0xe1 + ,0x72,0x8e,0x3b,0xf4,0x80,0x35,0x0f,0x25 + ,0xe0,0x7e,0x21,0xc9,0x47,0xd1,0x9e,0x33 + ,0x76,0xf0,0x9b,0x3c,0x1e,0x16,0x17,0x42] + +testScalarMult :: Test +testScalarMult = buildTest $ + return $ testGroup "...Internal.ScalarMult" [ + + testProperty "mult a (multBase a) /= multBase a" + $ \(ByteString32 a') -> + let Just a = decode a' + in mult a (multBase a) /= multBase a, + + testProperty "mult a (multBase b) == mult b (multBase a)" + $ \(ByteString32 a') (ByteString32 b') -> + let Just a = decode a' + Just b = decode b' + in mult a (multBase b) == mult b (multBase a), + + testProperty "matches test vector for alice" + $ multBase alicesk == alicepk, + + testProperty "matches test vector for bob" + $ multBase bobsk == bobpk, + + testProperty "matches test vector for shared secret from alice's view" + $ mult alicesk bobpk == sharedsk, + + testProperty "matches test vector for shared secret from bob's view" + $ mult bobsk alicepk == sharedsk + + ] diff --git a/miscellaneous/saltine/tests/SealedBoxProperties.hs b/miscellaneous/saltine/tests/SealedBoxProperties.hs new file mode 100644 index 00000000..41a656dc --- /dev/null +++ b/miscellaneous/saltine/tests/SealedBoxProperties.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} + +module SealedBoxProperties ( + testSealedBox +) where + +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 (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 (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 (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 (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 (Keypair sk1 pk1) (Message bs) p = do + enc <- boxSeal pk1 bs + return (Nothing == boxSealOpen pk1 sk1 (perturb enc p)) + +testSealedBox :: Test +testSealedBox = buildTest $ do + + kp <- newKeypair + + return $ testGroup "... SealedBox" [ + + testGroup "Can decrypt ciphertext using..." [ + testProperty "... public key/secret key" + $ ioProperty . rightInverseProp kp + ], + + testGroup "Fail to verify ciphertext when..." [ + testProperty "... not using proper secret key" + $ ioProperty . uncurry (rightInverseFailureProp1 kp), + + testProperty "... not using proper public key" + $ ioProperty . uncurry (rightInverseFailureProp2 kp), + + testProperty "... not actually sent to you" + $ ioProperty . uncurry (rightInverseFailureProp3 kp), + + testProperty "... ciphertext has been perturbed" + $ ioProperty . uncurry (rightInverseFailureProp4 kp) + ] + ] diff --git a/miscellaneous/saltine/tests/SecretBoxProperties.hs b/miscellaneous/saltine/tests/SecretBoxProperties.hs new file mode 100644 index 00000000..cc9e3eb9 --- /dev/null +++ b/miscellaneous/saltine/tests/SecretBoxProperties.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module SecretBoxProperties ( + testSecretBox + ) where + +import Util +import Crypto.Saltine.Core.SecretBox +import Crypto.Saltine.Class +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, (==>)) +import Test.QuickCheck.Arbitrary + +instance Arbitrary Nonce where + arbitrary = + do bs <- S.pack <$> vector Internal.secretbox_noncebytes + pure $ fromJust (decode bs) + +instance Arbitrary Key where + arbitrary = + do bs <- S.pack <$> vector Internal.secretbox_keybytes + pure $ fromJust (decode bs) + +-- | Ciphertext can be decrypted +rightInverseProp :: Key -> Nonce -> Message -> Bool +rightInverseProp k n (Message bs) = + Just bs == secretboxOpen k n (secretbox k n bs) + +-- | Detached ciphertext/tag can be decrypted +rightInverseDetachedProp :: Key -> Nonce -> Message -> Bool +rightInverseDetachedProp k n (Message bs) = + Just bs == uncurry (secretboxOpenDetached k n) (secretboxDetached k n bs) + +-- | Ciphertext cannot be decrypted if the ciphertext is perturbed +rightInverseFailureProp :: Key -> Nonce -> Message -> Perturb -> Property +rightInverseFailureProp k n (Message bs) p = + let ct = secretbox k n bs + fakeCT = perturb ct p + in ct /= fakeCT ==> Nothing == secretboxOpen k n fakeCT + +-- | Ciphertext cannot be decrypted if the tag is perturbed +rightInverseTagFailureProp :: Key -> Nonce -> Message -> Message -> Property +rightInverseTagFailureProp k n (Message bs) (Message 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 +rightInverseFailureDetachedProp :: Key -> Nonce -> Message -> Perturb -> Property +rightInverseFailureDetachedProp k n (Message bs) p = + let (tag,ct) = secretboxDetached k n bs + fakeCT = perturb ct p + in fakeCT /= ct ==> Nothing == secretboxOpenDetached k n tag fakeCT + +-- | Ciphertext cannot be decrypted with a different key +cannotDecryptKeyProp :: Key -> Key -> Nonce -> Message -> Property +cannotDecryptKeyProp k1 k2 n (Message bs) = + k1 /= k2 ==> Nothing == secretboxOpen k2 n (secretbox k1 n bs) + +-- | Ciphertext cannot be decrypted with a different key +cannotDecryptKeyDetachedProp :: Key -> Key -> Nonce -> Message -> Property +cannotDecryptKeyDetachedProp k1 k2 n (Message bs) = + k1 /= k2 ==> Nothing == uncurry (secretboxOpenDetached k2 n) (secretboxDetached k1 n bs) + +-- | Ciphertext cannot be decrypted with a different nonce +cannotDecryptNonceProp :: Key -> Nonce -> Nonce -> Message -> Property +cannotDecryptNonceProp k n1 n2 (Message bs) = + n1 /= n2 ==> Nothing == secretboxOpen k n2 (secretbox k n1 bs) + +-- | Ciphertext cannot be decrypted with a different nonce +cannotDecryptNonceDetachedProp :: Key -> Nonce -> Nonce -> Message -> Property +cannotDecryptNonceDetachedProp k n1 n2 (Message bs) = + n1 /= n2 ==> Nothing == uncurry (secretboxOpenDetached k n2) (secretboxDetached k n1 bs) + +testSecretBox :: Test +testSecretBox = buildTest $ do + + return $ testGroup "...Internal.SecretBox" [ + + testProperty "Can decrypt ciphertext" + $ rightInverseProp, + + testProperty "Can decrypt ciphertext (detached)" + $ rightInverseDetachedProp, + + testGroup "Cannot decrypt ciphertext when..." [ + + testProperty "... ciphertext is perturbed" + $ rightInverseFailureProp, + + 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/miscellaneous/saltine/tests/SignProperties.hs b/miscellaneous/saltine/tests/SignProperties.hs new file mode 100644 index 00000000..56a72055 --- /dev/null +++ b/miscellaneous/saltine/tests/SignProperties.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} + +module SignProperties ( + testSign + ) where + +import Util +import Crypto.Saltine.Core.Sign +import Crypto.Saltine.Internal.Sign + +import qualified Data.ByteString as S +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck + +testSign :: Test +testSign = buildTest $ do + kp1 <- newKeypair + let sk1 = secretKey kp1 + let pk1 = publicKey kp1 + kp2 <- newKeypair + let pk2 = publicKey kp2 + + return $ testGroup "...Internal.Sign" [ + + testProperty "Verifies signed message" + $ \(Message bs) -> signOpen pk1 (sign sk1 bs) == Just bs, + + testProperty "Verifies signed message w/ detached signature" + $ \(Message bs) -> signVerifyDetached pk1 (signDetached sk1 bs) bs, + + testProperty "Signed message longer than message" + $ \(Message bs) -> S.length (sign sk1 bs) >= S.length bs, + + testProperty "Rejects message with mismatched key" + $ \(Message bs) -> not (S.null bs) ==> + signOpen pk2 (sign sk1 bs) == Nothing, + + testProperty "Rejects message with mismatched key w/ detached signature" + $ \(Message bs) -> not (S.null bs) ==> + not (signVerifyDetached pk2 (signDetached sk1 bs) bs) + + ] diff --git a/miscellaneous/saltine/tests/StreamProperties.hs b/miscellaneous/saltine/tests/StreamProperties.hs new file mode 100644 index 00000000..75ad4d67 --- /dev/null +++ b/miscellaneous/saltine/tests/StreamProperties.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} + +module StreamProperties ( + testStream + ) where + +import Util +import Crypto.Saltine.Core.Stream + +import qualified Data.ByteString as S +import Test.Framework.Providers.QuickCheck2 +import Test.Framework +import Test.QuickCheck + +testStream :: Test +testStream = buildTest $ do + k <- newKey + n <- newNonce + return $ testGroup "...Internal.Stream" [ + + testProperty "Stream is apropriately sized" + $ \len -> (len > 0 && len < 200) + ==> S.length (stream k n len) == len, + + testProperty "xor munges input" + $ \(Message bs) -> not (S.null bs) + ==> xor k n bs /= bs, + + testProperty "xor is involutive" + $ \(Message bs) -> xor k n (xor k n bs) == bs + + ] diff --git a/miscellaneous/saltine/tests/Util.hs b/miscellaneous/saltine/tests/Util.hs new file mode 100644 index 00000000..b729fa53 --- /dev/null +++ b/miscellaneous/saltine/tests/Util.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Util where + +import Crypto.Saltine.Class + +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 Test.QuickCheck +import GHC.Exts (IsList(..)) + +instance IsEncoding S.ByteString where + encode x = x + decode x = Just x + +perturb :: IsEncoding a => a -> Perturb -> a +perturb a (Perturb p) = + let bytes = encode a + len = S.length bytes + plen = length p + fullP = p <> replicate (len - plen) 0 + newBytes = S.pack $ zipWith xor fullP (S.unpack bytes) + in case decode newBytes of + Nothing -> error "Invalid use of perturb on picky encoding." + Just x -> x + +newtype Perturb = Perturb [Word8] + deriving (Show,Semigroup,Monoid) + +instance IsList Perturb where + type Item Perturb = Word8 + fromList = Perturb + toList (Perturb x) = x + +instance Arbitrary Perturb where + arbitrary = + do bs <- arbitrary + if all (==0) bs + then pure (Perturb (1:bs)) + else pure (Perturb bs) + +newtype ByteString32 = ByteString32 S.ByteString deriving (Eq,Show) + +instance Arbitrary ByteString32 where + arbitrary = ByteString32 . S.pack <$> replicateM 32 arbitrary + +newtype Message = Message S.ByteString deriving (Show) + +instance Arbitrary Message where + arbitrary = Message . S.pack <$> arbitrary diff --git a/miscellaneous/saltine/tests/UtilProperties.hs b/miscellaneous/saltine/tests/UtilProperties.hs new file mode 100644 index 00000000..01cad763 --- /dev/null +++ b/miscellaneous/saltine/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 + ]