diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,3 +7,9 @@ * `Sized` byte arrays * `Secretbox` * `Box` +* `Auth` +* `Sign` +* `Stream` +* `Hash` +* `Verify` +* `Scalarmult` diff --git a/NaCl.cabal b/NaCl.cabal --- a/NaCl.cabal +++ b/NaCl.cabal @@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack -- --- hash: 1a62f7dc222dc8ad85a2dec5e6789c2ea3adaa30dbbfcb5b89a40e1c62f4126a +-- hash: 96801ddcac1bde4bd9ab56c0f221a68ee0d9ccdfe421b3c1c2aeaa46a72b99ba name: NaCl -version: 0.0.3.1 +version: 0.0.4.0 synopsis: Easy-and-safe-to-use high-level Haskell bindings to NaCl description: This library uses under the hood, but only exposes the primitives that are part of the “classic” NaCl @@ -26,19 +26,28 @@ If you need them too (you probably do), you should use instead. . + = Public-key cryptography + . + * Authenticated encryption: "NaCl.Box" + * Scalar multiplication: "NaCl.Scalarmult" + * Public-key signatures: "NaCl.Sign" + . = Secret-key cryptography . - * Authenticated encryption: "Crypto.Secretbox" + * Authenticated encryption: "NaCl.Secretbox" + * Unauthenticated streaming encryption: "NaCl.Stream" + * Authentication: "NaCl.Auth" . - = Public-key cryptography + = Low-level functions . - * Authenticated encryption: "Crypto.Box" + * Hashing: "NaCl.Hash" + * String comparison: "NaCl.Verify" category: Cryptography homepage: https://github.com/serokell/haskell-crypto#readme bug-reports: https://github.com/serokell/haskell-crypto/issues author: Kirill Elagin -maintainer: Kirill Elagin -copyright: 2020 Serokell +maintainer: Serokell +copyright: 2021 Serokell license: MPL-2.0 license-file: LICENSES/MPL-2.0.txt build-type: Simple @@ -52,34 +61,76 @@ library exposed-modules: - Crypto.Box - Crypto.Box.Internal - Crypto.Secretbox - Crypto.Secretbox.Internal + NaCl.Auth + NaCl.Auth.Internal + NaCl.Box + NaCl.Box.Internal + NaCl.Hash + NaCl.Hash.Internal + NaCl.Scalarmult + NaCl.Secretbox + NaCl.Secretbox.Internal + NaCl.Sign + NaCl.Sign.Internal + NaCl.Stream + NaCl.Stream.Internal + NaCl.Verify other-modules: Paths_NaCl hs-source-dirs: lib - default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores OverloadedStrings PolyKinds ScopedTypeVariables TypeApplications + default-extensions: + DataKinds + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + KindSignatures + LambdaCase + MultiParamTypeClasses + NamedFieldPuns + NumericUnderscores + OverloadedStrings + PolyKinds + ScopedTypeVariables + TypeApplications ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends: base >=4.10 && <4.15 , bytestring >=0.9 && <0.11 , libsodium >=1.0.11 && <2 , memory >=0.14.15 && <0.16 - , safe-exceptions >=0.1 && <0.2 + , safe-exceptions ==0.1.* default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 main-is: Test.hs other-modules: - Test.Crypto.Box - Test.Crypto.Secretbox + Test.NaCl.Auth + Test.NaCl.Box + Test.NaCl.Hash + Test.NaCl.Scalarmult + Test.NaCl.Secretbox + Test.NaCl.Sign + Test.NaCl.Stream + Test.NaCl.Verify Paths_NaCl hs-source-dirs: test - default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns NumericUnderscores OverloadedStrings PolyKinds ScopedTypeVariables TypeApplications + default-extensions: + DataKinds + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + KindSignatures + LambdaCase + MultiParamTypeClasses + NamedFieldPuns + NumericUnderscores + OverloadedStrings + PolyKinds + ScopedTypeVariables + TypeApplications ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-tool-depends: tasty-discover:tasty-discover @@ -87,11 +138,12 @@ HUnit , NaCl , base >=4.10 && <4.15 + , base16 >=0.1.1 && <0.4 , bytestring >=0.9 && <0.11 , hedgehog , libsodium >=1.0.11 && <2 , memory >=0.14.15 && <0.16 - , safe-exceptions >=0.1 && <0.2 + , safe-exceptions ==0.1.* , tasty , tasty-hedgehog , tasty-hunit diff --git a/lib/Crypto/Box.hs b/lib/Crypto/Box.hs deleted file mode 100644 --- a/lib/Crypto/Box.hs +++ /dev/null @@ -1,108 +0,0 @@ --- SPDX-FileCopyrightText: 2020 Serokell --- --- SPDX-License-Identifier: MPL-2.0 - --- | Public-key authenticated encryption. --- --- It is best to import this module qualified: --- --- @ --- import qualified Crypto.Box as Box --- --- encrypted = Box.'create' pk sk nonce message --- decrypted = Box.'open' pk sk nonce encrypted --- @ --- --- This is @crypto_box_*@ from NaCl. -module Crypto.Box - ( PublicKey - , toPublicKey - , SecretKey - , toSecretKey - , keypair - - , Nonce - , toNonce - - , create - , open - ) where - -import Data.ByteArray (ByteArray, ByteArrayAccess) -import System.IO.Unsafe (unsafeDupablePerformIO) - -import Crypto.Box.Internal (Nonce, PublicKey, SecretKey, keypair, toNonce, toPublicKey, toSecretKey) - -import qualified Crypto.Box.Internal as I - - --- | Encrypt a message. --- --- @ --- encrypted = Box.create pk sk nonce message --- @ --- --- * @pk@ is the receiver’s public key, used for encryption. --- @sk@ is the sender’s public key, used for authentication. --- --- These are generated using 'keypair' and are supposed to be exchanged --- in advance. Both parties need to know their own secret key and the other’s --- public key. --- --- * @nonce@ is an extra noise that ensures that if you encrypt the same --- message with the same key multiple times, you will get different ciphertexts, --- which is required for --- . --- There are two standard ways of getting it: --- --- 1. /Use a counter/. In this case you keep a counter of encrypted messages, --- which means that the nonce will be new for each new message. --- --- 2. /Random/. You generate a random nonce every time you encrypt a message. --- Since the nonce is large enough, the chances of you using the same --- nonce twice are negligible. For useful helpers, see @Crypto.Random@, --- in . --- --- * @message@ is the data you are encrypting. --- --- This function adds authentication data, so if anyone modifies the cyphertext, --- @open@ will refuse to decrypt it. -create - :: ( ByteArrayAccess nonceBytes - , ByteArrayAccess ptBytes, ByteArray ctBytes - ) - => PublicKey -- ^ Receiver’s public key - -> SecretKey -- ^ Sender’s secret key - -> Nonce nonceBytes -- ^ Nonce - -> ptBytes -- ^ Plaintext message - -> ctBytes -create pk sk nonce msg = - -- This IO is safe, because it is pure. - unsafeDupablePerformIO $ I.create pk sk nonce msg - - --- | Decrypt a message. --- --- @ --- decrypted = Box.open sk pk nonce encrypted --- @ --- --- * @sk@ is the receiver’s secret key, used for description. --- * @pk@ is the sender’s public key, used for authentication. --- * @nonce@ is the same that was used for encryption. --- * @encrypted@ is the output of 'create'. --- --- This function will return @Nothing@ if the encrypted message was tampered --- with after it was encrypted. -open - :: ( ByteArrayAccess nonceBytes - , ByteArray ptBytes, ByteArrayAccess ctBytes - ) - => SecretKey -- ^ Receiver’s secret key - -> PublicKey -- ^ Sender’s public key - -> Nonce nonceBytes -- ^ Nonce - -> ctBytes -- ^ Encrypted message (cyphertext) - -> Maybe ptBytes -open sk pk nonce ct = - -- This IO is safe, because it is pure. - unsafeDupablePerformIO $ I.open sk pk nonce ct diff --git a/lib/Crypto/Box/Internal.hs b/lib/Crypto/Box/Internal.hs deleted file mode 100644 --- a/lib/Crypto/Box/Internal.hs +++ /dev/null @@ -1,139 +0,0 @@ --- SPDX-FileCopyrightText: 2020 Serokell --- --- SPDX-License-Identifier: MPL-2.0 - --- | Internals of @crypto_box@. -module Crypto.Box.Internal - ( SecretKey - , toSecretKey - , PublicKey - , toPublicKey - , keypair - - , Nonce - , toNonce - - , create - , open - ) where - -import Prelude hiding (length) - -import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, allocRet, length, withByteArray) -import Data.ByteArray.Sized (SizedByteArray, sizedByteArray) -import Data.ByteString (ByteString) -import Data.Functor (void) -import Data.Proxy (Proxy (Proxy)) - -import qualified Data.ByteArray.Sized as Sized (alloc, allocRet) -import qualified Libsodium as Na - - --- | Secret key that can be used for Box. -type SecretKey = SizedByteArray Na.CRYPTO_BOX_SECRETKEYBYTES ScrubbedBytes - --- | Convert bytes to a secret key. -toSecretKey :: ScrubbedBytes -> Maybe SecretKey -toSecretKey = sizedByteArray - --- | Public key that can be used for Box. -type PublicKey = SizedByteArray Na.CRYPTO_BOX_PUBLICKEYBYTES ByteString - --- | Convert bytes to a public key. -toPublicKey :: ByteString -> Maybe PublicKey -toPublicKey = sizedByteArray - --- | Generate a new 'SecretKey' together with its 'PublicKey'. --- --- Note: this function is not thread-safe (since the underlying --- C function is not thread-safe both in Sodium and in NaCl)! --- Either make sure there are no concurrent calls or see --- @Crypto.Init@ in --- --- to learn how to make this function thread-safe. -keypair :: IO (PublicKey, SecretKey) -keypair = do - (pk, sk) <- - Sized.allocRet Proxy $ \skPtr -> - Sized.alloc $ \pkPtr -> - -- always returns 0, so we don’t check it - void $ Na.crypto_box_keypair pkPtr skPtr - pure (pk, sk) - - --- | Nonce that can be used for Box. --- --- This type is parametrised by the actual data type that contains --- bytes. This can be, for example, a @ByteString@. -type Nonce a = SizedByteArray Na.CRYPTO_BOX_NONCEBYTES a - --- | Make a 'Nonce' from an arbitrary byte array. --- --- This function returns @Just@ if and only if the byte array has --- the right length to be used as a nonce with a Box. -toNonce :: ByteArrayAccess ba => ba -> Maybe (Nonce ba) -toNonce = sizedByteArray - - --- | Encrypt a message. -create - :: ( ByteArrayAccess nonce - , ByteArrayAccess pt, ByteArray ct - ) - => PublicKey -- ^ Receiver’s public key - -> SecretKey -- ^ Sender’s secret key - -> Nonce nonce -- ^ Nonce - -> pt -- ^ Plaintext message - -> IO ct -create pk sk nonce msg = do - (_ret, ct) <- - allocRet clen $ \ctPtr -> - withByteArray pk $ \pkPtr -> - withByteArray sk $ \skPtr -> - withByteArray nonce $ \noncePtr -> - withByteArray msg $ \msgPtr -> do - -- TODO: Maybe, reimplement this without _easy, to stay closer - -- to the original NaCl. - Na.crypto_box_easy ctPtr - msgPtr (fromIntegral $ length msg) - noncePtr - pkPtr skPtr - -- _ret can be only 0, so we don’t check it - -- TODO: Actually, it looks like this function can fail and return - -- a -1, even though this is not documented :/. - pure ct - where - clen :: Int - clen = fromIntegral Na.crypto_box_macbytes + length msg - - --- | Decrypt a message. -open - :: ( ByteArrayAccess nonce - , ByteArray pt, ByteArrayAccess ct - ) - => SecretKey -- ^ Receiver’s secret key - -> PublicKey -- ^ Sender’s public key - -> Nonce nonce -- ^ Nonce - -> ct -- ^ Cyphertext - -> IO (Maybe pt) -open sk pk nonce ct = do - (ret, msg) <- - allocRet mlen $ \msgPtr -> - withByteArray sk $ \skPtr -> - withByteArray pk $ \pkPtr -> - withByteArray nonce $ \noncePtr -> - withByteArray ct $ \ctPtr -> do - -- TODO: Maybe, reimplement this without _easy, to stay closer - -- to the original NaCl. - Na.crypto_box_open_easy msgPtr - ctPtr (fromIntegral $ length ct) - noncePtr - pkPtr skPtr - if ret == 0 then - pure $ Just msg - else - pure Nothing - where - mlen :: Int - mlen = length ct - fromIntegral Na.crypto_box_macbytes diff --git a/lib/Crypto/Secretbox.hs b/lib/Crypto/Secretbox.hs deleted file mode 100644 --- a/lib/Crypto/Secretbox.hs +++ /dev/null @@ -1,110 +0,0 @@ --- SPDX-FileCopyrightText: 2020 Serokell --- --- SPDX-License-Identifier: MPL-2.0 - --- | Symmetric authenticated encryption. --- --- It is best to import this module qualified: --- --- @ --- import qualified Crypto.Secretbox as Secretbox --- --- encrypted = Secretbox.'create' key nonce message --- decrypted = Secretbox.'open' key nonce encrypted --- @ --- --- This is @crypto_secretbox_*@ from NaCl. -module Crypto.Secretbox - ( Key - , toKey - - , Nonce - , toNonce - - , create - , open - ) where - -import Data.ByteArray (ByteArray, ByteArrayAccess) -import System.IO.Unsafe (unsafeDupablePerformIO) - -import Crypto.Secretbox.Internal (Key, Nonce, toKey, toNonce) - -import qualified Crypto.Secretbox.Internal as I - - --- | Encrypt a message. --- --- @ --- encrypted = Secretbox.create key nonce message --- @ --- --- * @key@ is the secret key used for encryption. There are two typical ways --- of creating it: --- --- 1. /Derive from a password/. If you want to protect a message with a password, --- you must use a --- --- to turn this password into an encryption key. --- --- 2. /Generate a random one/. This can be useful in certain situations when --- you want to have an intermediate key that you will encrypt and share --- later. --- --- The @Crypto.Key@ module in --- --- has functions to help in either case. --- --- * @nonce@ is an extra noise that ensures that if you encrypt the same --- message with the same key multiple times, you will get different ciphertexts, --- which is required for --- . --- There are two standard ways of getting it: --- --- 1. /Use a counter/. In this case you keep a counter of encrypted messages, --- which means that the nonce will be new for each new message. --- --- 2. /Random/. You generate a random nonce every time you encrypt a message. --- Since the nonce is large enough, the chances of you using the same --- nonce twice are negligible. For useful helpers, see @Crypto.Random@, --- in . --- --- * @message@ is the data you are encrypting. --- --- This function adds authentication data, so if anyone modifies the cyphertext, --- @open@ will refuse to decrypt it. -create - :: ( ByteArrayAccess keyBytes, ByteArrayAccess nonceBytes - , ByteArrayAccess ptBytes, ByteArray ctBytes - ) - => Key keyBytes -- ^ Secret key - -> Nonce nonceBytes -- ^ Nonce - -> ptBytes -- ^ Plaintext message - -> ctBytes -create key nonce msg = - -- This IO is safe, because it is pure. - unsafeDupablePerformIO $ I.create key nonce msg - - --- | Decrypt a message. --- --- @ --- decrypted = Secretbox.open key nonce encrypted --- @ --- --- * @key@ and @nonce@ are the same that were used for encryption. --- * @encrypted@ is the output of 'create'. --- --- This function will return @Nothing@ if the encrypted message was tampered --- with after it was encrypted. -open - :: ( ByteArrayAccess keyBytes, ByteArrayAccess nonceBytes - , ByteArray ptBytes, ByteArrayAccess ctBytes - ) - => Key keyBytes -- ^ Secret key - -> Nonce nonceBytes -- ^ Nonce - -> ctBytes -- ^ Encrypted message (cyphertext) - -> Maybe ptBytes -open key nonce ct = - -- This IO is safe, because it is pure. - unsafeDupablePerformIO $ I.open key nonce ct diff --git a/lib/Crypto/Secretbox/Internal.hs b/lib/Crypto/Secretbox/Internal.hs deleted file mode 100644 --- a/lib/Crypto/Secretbox/Internal.hs +++ /dev/null @@ -1,110 +0,0 @@ --- SPDX-FileCopyrightText: 2020 Serokell --- --- SPDX-License-Identifier: MPL-2.0 - --- | Internals of @crypto_secretbox@. -module Crypto.Secretbox.Internal - ( Key - , toKey - - , Nonce - , toNonce - - , create - , open - ) where - -import Prelude hiding (length) - -import Data.ByteArray (ByteArray, ByteArrayAccess, allocRet, length, withByteArray) - -import qualified Libsodium as Na - -import Data.ByteArray.Sized (SizedByteArray, sizedByteArray) - - --- | Encryption key that can be used for Secretbox. --- --- This type is parametrised by the actual data type that contains --- bytes. This can be, for example, a @ByteString@, but, since this --- is a secret key, it is better to use @ScrubbedBytes@. -type Key a = SizedByteArray Na.CRYPTO_SECRETBOX_KEYBYTES a - --- | Make a 'Key' from an arbitrary byte array. --- --- This function returns @Just@ if and only if the byte array has --- the right length to be used as a key with a Secretbox. -toKey :: ByteArrayAccess ba => ba -> Maybe (Key ba) -toKey = sizedByteArray - - --- | Nonce that can be used for Secretbox. --- --- This type is parametrised by the actual data type that contains --- bytes. This can be, for example, a @ByteString@. -type Nonce a = SizedByteArray Na.CRYPTO_SECRETBOX_NONCEBYTES a - --- | Make a 'Nonce' from an arbitrary byte array. --- --- This function returns @Just@ if and only if the byte array has --- the right length to be used as a nonce with a Secretbox. -toNonce :: ByteArrayAccess ba => ba -> Maybe (Nonce ba) -toNonce = sizedByteArray - - --- | Encrypt a message. -create - :: ( ByteArrayAccess key, ByteArrayAccess nonce - , ByteArrayAccess pt, ByteArray ct - ) - => Key key -- ^ Secret key - -> Nonce nonce -- ^ Nonce - -> pt -- ^ Plaintext message - -> IO ct -create key nonce msg = do - (_ret, ct) <- - allocRet clen $ \ctPtr -> - withByteArray key $ \keyPtr -> - withByteArray nonce $ \noncePtr -> - withByteArray msg $ \msgPtr -> do - -- TODO: Maybe, reimplement this without _easy, to stay closer - -- to the original NaCl. - Na.crypto_secretbox_easy ctPtr - msgPtr (fromIntegral $ length msg) - noncePtr - keyPtr - -- _ret can be only 0, so we don’t check it - pure ct - where - clen :: Int - clen = fromIntegral Na.crypto_secretbox_macbytes + length msg - - --- | Decrypt a message. -open - :: ( ByteArrayAccess key, ByteArrayAccess nonce - , ByteArray pt, ByteArrayAccess ct - ) - => Key key -- ^ Secret key - -> Nonce nonce -- ^ Nonce - -> ct -- ^ Cyphertext - -> IO (Maybe pt) -open key nonce ct = do - (ret, msg) <- - allocRet mlen $ \msgPtr -> - withByteArray key $ \keyPtr -> - withByteArray nonce $ \noncePtr -> - withByteArray ct $ \ctPtr -> do - -- TODO: Maybe, reimplement this without _easy, to stay closer - -- to the original NaCl. - Na.crypto_secretbox_open_easy msgPtr - ctPtr (fromIntegral $ length ct) - noncePtr - keyPtr - if ret == 0 then - pure $ Just msg - else - pure Nothing - where - mlen :: Int - mlen = length ct - fromIntegral Na.crypto_secretbox_macbytes diff --git a/lib/NaCl/Auth.hs b/lib/NaCl/Auth.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Auth.hs @@ -0,0 +1,86 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Symmetric message authentication. +-- +-- It is best to import this module qualified: +-- +-- @ +-- import qualified NaCl.Auth as Auth +-- +-- authenticator = Auth.'create' key message +-- if Secretbox.'verify' key message authenticator +-- then {- Ok! -} +-- else {- Fail! -} +-- @ +-- +-- This is @crypto_auth_*@ from NaCl. +module NaCl.Auth + ( Key + , toKey + + , Authenticator + , toAuthenticator + + , create + , verify + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import System.IO.Unsafe (unsafePerformIO) + +import NaCl.Auth.Internal (Key, Authenticator, toAuthenticator, toKey) + +import qualified NaCl.Auth.Internal as I + + +-- | Create an authenticator for a message. +-- +-- @ +-- authenticator = Auth.create key message +-- @ +-- +-- * @key@ is the secret key used for authentication. +-- See "NaCl.Secretbox" for how to crete it, as the idea is the same. +-- +-- * @message@ is the data you are authenticating. +-- +-- This function produces authentication data, so if anyone modifies the message, +-- @verify@ will return @False@. +create + :: ( ByteArray authBytes + , ByteArrayAccess keyBytes + , ByteArrayAccess msg + ) + => Key keyBytes -- ^ Secret key. + -> msg -- ^ Message to authenticate. + -> Authenticator authBytes +create key msg = do + -- This IO is safe, because it is pure. + unsafePerformIO $ I.create key msg + + +-- | Verify an authenticator for a message. +-- +-- @ +-- isValid = Auth.verify key message authenticator +-- @ +-- +-- * @key@ and @message@ are the same as when creating the authenticator. +-- * @authenticator@ is the output of 'create'. +-- +-- This function will return @False@ if the message is not exactly the same +-- as it was when the authenticator was created. +verify + :: ( ByteArrayAccess authBytes + , ByteArrayAccess msg + , ByteArrayAccess keyBytes + ) + => Key keyBytes -- ^ Secret key. + -> msg -- ^ Authenticated message. + -> Authenticator authBytes -- ^ Authenticator tag. + -> Bool +verify key msg auth = do + -- This IO is safe, because it is pure. + unsafePerformIO $ I.verify key msg auth diff --git a/lib/NaCl/Auth/Internal.hs b/lib/NaCl/Auth/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Auth/Internal.hs @@ -0,0 +1,91 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Internals of @crypto_auth@. +module NaCl.Auth.Internal + ( Key + , toKey + + , Authenticator + , toAuthenticator + + , create + , verify + ) where + +import Prelude hiding (length) + +import Data.ByteArray (ByteArray, ByteArrayAccess, length, withByteArray) +import Data.ByteArray.Sized (SizedByteArray, allocRet, sizedByteArray) +import Data.Proxy (Proxy (Proxy)) + +import qualified Libsodium as Na + + +-- | Secret key that can be used for Sea authentication. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@, but, since this +-- is a secret key, it is better to use @ScrubbedBytes@. +type Key a = SizedByteArray Na.CRYPTO_AUTH_KEYBYTES a + +-- | Make a 'Key' from an arbitrary byte array. +-- +-- This function returns @Just@ if and only if the byte array has +-- the right length to be used as a key for authentication. +toKey :: ByteArrayAccess ba => ba -> Maybe (Key ba) +toKey = sizedByteArray + + +-- | A tag that confirms the authenticity of somde data. +type Authenticator a = SizedByteArray Na.CRYPTO_AUTH_BYTES a + +-- | Convert raw bytes into an 'Authenticator'. +-- +-- This function returns @Just@ if and only if the byte array has +-- the right length to be used as an authenticator. +toAuthenticator :: ByteArrayAccess ba => ba -> Maybe (Authenticator ba) +toAuthenticator = sizedByteArray + + +-- | Create an authenticator. +create + :: ( ByteArrayAccess keyBytes + , ByteArrayAccess msg + , ByteArray authBytes + ) + => Key keyBytes -- ^ Secret key. + -> msg -- ^ Message to authenticate. + -> IO (Authenticator authBytes) +create key msg = do + (_ret, auth) <- + allocRet (Proxy @Na.CRYPTO_AUTH_BYTES) $ \authPtr -> + withByteArray key $ \keyPtr -> + withByteArray msg $ \msgPtr -> do + Na.crypto_auth authPtr + msgPtr (fromIntegral $ length msg) + keyPtr + -- _ret can be only 0, so we don’t check it + pure auth + + +-- | Verify an authenticator. +verify + :: ( ByteArrayAccess keyBytes + , ByteArrayAccess msg + , ByteArrayAccess authBytes + ) + => Key keyBytes -- ^ Secret key. + -> msg -- ^ Authenticated message. + -> Authenticator authBytes -- ^ Authenticator tag. + -> IO Bool +verify key msg auth = do + ret <- + withByteArray key $ \keyPtr -> + withByteArray msg $ \msgPtr -> + withByteArray auth $ \authPtr -> + Na.crypto_auth_verify authPtr + msgPtr (fromIntegral $ length msg) + keyPtr + pure $ ret == 0 diff --git a/lib/NaCl/Box.hs b/lib/NaCl/Box.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Box.hs @@ -0,0 +1,115 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Public-key authenticated encryption. +-- +-- It is best to import this module qualified: +-- +-- @ +-- import qualified NaCl.Box as Box +-- +-- encrypted = Box.'create' pk sk nonce message +-- decrypted = Box.'open' pk sk nonce encrypted +-- @ +-- +-- This is @crypto_box_*@ from NaCl. +module NaCl.Box + ( PublicKey + , toPublicKey + , SecretKey + , toSecretKey + , keypair + + , Nonce + , toNonce + + , create + , open + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import System.IO.Unsafe (unsafePerformIO) + +import NaCl.Box.Internal (Nonce, PublicKey, SecretKey, keypair, toNonce, toPublicKey, toSecretKey) + +import qualified NaCl.Box.Internal as I + + +-- | Encrypt a message. +-- +-- @ +-- encrypted = Box.create pk sk nonce message +-- @ +-- +-- * @pk@ is the receiver’s public key, used for encryption. +-- @sk@ is the sender’s secret key, used for authentication. +-- +-- These are generated using 'keypair' and are supposed to be exchanged +-- in advance. Both parties need to know their own secret key and the other’s +-- public key. +-- +-- * @nonce@ is an extra noise that ensures that if you encrypt the same +-- message with the same key multiple times, you will get different ciphertexts, +-- which is required for +-- . +-- There are two standard ways of getting it: +-- +-- 1. /Use a counter/. In this case you keep a counter of encrypted messages, +-- which means that the nonce will be new for each new message. +-- +-- 2. /Random/. You generate a random nonce every time you encrypt a message. +-- Since the nonce is large enough, the chances of you using the same +-- nonce twice are negligible. For useful helpers, see @Crypto.Random@, +-- in . +-- +-- In either case, you need to be able to provide the same nonce when decrypting, +-- so you should be able to recover it by computation (e.g. in the case of +-- a counter) or you should store it alongside the encrypted data. The nonce +-- is not secret, so it is perfectly ok to store it in plaintext. +-- +-- * @message@ is the data you are encrypting. +-- +-- This function adds authentication data, so if anyone modifies the cyphertext, +-- 'open' will refuse to decrypt it. +create + :: ( ByteArrayAccess pkBytes, ByteArrayAccess skBytes + , ByteArrayAccess nonceBytes + , ByteArrayAccess ptBytes, ByteArray ctBytes + ) + => PublicKey pkBytes -- ^ Receiver’s public key + -> SecretKey skBytes -- ^ Sender’s secret key + -> Nonce nonceBytes -- ^ Nonce + -> ptBytes -- ^ Plaintext message + -> ctBytes +create pk sk nonce msg = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.create pk sk nonce msg + + +-- | Decrypt a message. +-- +-- @ +-- decrypted = Box.open sk pk nonce encrypted +-- @ +-- +-- * @sk@ is the receiver’s secret key, used for description. +-- * @pk@ is the sender’s public key, used for authentication. +-- * @nonce@ is the same that was used for encryption. +-- * @encrypted@ is the output of 'create'. +-- +-- This function will return @Nothing@ if the encrypted message was tampered +-- with after it was encrypted. +open + :: ( ByteArrayAccess skBytes, ByteArrayAccess pkBytes + , ByteArrayAccess nonceBytes + , ByteArray ptBytes, ByteArrayAccess ctBytes + ) + => SecretKey skBytes -- ^ Receiver’s secret key + -> PublicKey pkBytes -- ^ Sender’s public key + -> Nonce nonceBytes -- ^ Nonce + -> ctBytes -- ^ Encrypted message (cyphertext) + -> Maybe ptBytes +open sk pk nonce ct = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.open sk pk nonce ct diff --git a/lib/NaCl/Box/Internal.hs b/lib/NaCl/Box/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Box/Internal.hs @@ -0,0 +1,148 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Internals of @crypto_box@. +module NaCl.Box.Internal + ( SecretKey + , toSecretKey + , PublicKey + , toPublicKey + , keypair + + , Nonce + , toNonce + + , create + , open + ) where + +import Prelude hiding (length) + +import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, allocRet, length, withByteArray) +import Data.ByteArray.Sized (SizedByteArray, sizedByteArray) +import Data.ByteString (ByteString) +import Data.Functor (void) +import Data.Proxy (Proxy (Proxy)) + +import qualified Data.ByteArray.Sized as Sized (alloc, allocRet) +import qualified Libsodium as Na + + +-- | Secret key that can be used for Box. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@, but, since this +-- is a secret key, it is better to use @ScrubbedBytes@. +type SecretKey a = SizedByteArray Na.CRYPTO_BOX_SECRETKEYBYTES a + +-- | Convert bytes to a secret key. +toSecretKey :: ByteArrayAccess bytes => bytes -> Maybe (SecretKey bytes) +toSecretKey = sizedByteArray + +-- | Public key that can be used for Box. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +type PublicKey a = SizedByteArray Na.CRYPTO_BOX_PUBLICKEYBYTES a + +-- | Convert bytes to a public key. +toPublicKey :: ByteArrayAccess bytes => bytes -> Maybe (PublicKey bytes) +toPublicKey = sizedByteArray + +-- | Generate a new 'SecretKey' together with its 'PublicKey'. +-- +-- Note: this function is not thread-safe (since the underlying +-- C function is not thread-safe both in Sodium and in NaCl)! +-- Either make sure there are no concurrent calls or see +-- @Crypto.Init@ in +-- +-- to learn how to make this function thread-safe. +keypair :: IO (PublicKey ByteString, SecretKey ScrubbedBytes) +keypair = do + (pk, sk) <- + Sized.allocRet Proxy $ \skPtr -> + Sized.alloc $ \pkPtr -> + -- always returns 0, so we don’t check it + void $ Na.crypto_box_keypair pkPtr skPtr + pure (pk, sk) + + +-- | Nonce that can be used for Box. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +type Nonce a = SizedByteArray Na.CRYPTO_BOX_NONCEBYTES a + +-- | Make a 'Nonce' from an arbitrary byte array. +-- +-- This function returns @Just@ if and only if the byte array has +-- the right length to be used as a nonce with a Box. +toNonce :: ByteArrayAccess ba => ba -> Maybe (Nonce ba) +toNonce = sizedByteArray + + +-- | Encrypt a message. +create + :: ( ByteArrayAccess pkBytes, ByteArrayAccess skBytes + , ByteArrayAccess nonce + , ByteArrayAccess pt, ByteArray ct + ) + => PublicKey pkBytes -- ^ Receiver’s public key + -> SecretKey skBytes -- ^ Sender’s secret key + -> Nonce nonce -- ^ Nonce + -> pt -- ^ Plaintext message + -> IO ct +create pk sk nonce msg = do + (_ret, ct) <- + allocRet clen $ \ctPtr -> + withByteArray pk $ \pkPtr -> + withByteArray sk $ \skPtr -> + withByteArray nonce $ \noncePtr -> + withByteArray msg $ \msgPtr -> do + -- TODO: Maybe, reimplement this without _easy, to stay closer + -- to the original NaCl. + Na.crypto_box_easy ctPtr + msgPtr (fromIntegral $ length msg) + noncePtr + pkPtr skPtr + -- _ret can be only 0, so we don’t check it + -- TODO: Actually, it looks like this function can fail and return + -- a -1, even though this is not documented :/. + pure ct + where + clen :: Int + clen = fromIntegral Na.crypto_box_macbytes + length msg + + +-- | Decrypt a message. +open + :: ( ByteArrayAccess skBytes, ByteArrayAccess pkBytes + , ByteArrayAccess nonce + , ByteArray pt, ByteArrayAccess ct + ) + => SecretKey skBytes -- ^ Receiver’s secret key + -> PublicKey pkBytes -- ^ Sender’s public key + -> Nonce nonce -- ^ Nonce + -> ct -- ^ Cyphertext + -> IO (Maybe pt) +open sk pk nonce ct = do + (ret, msg) <- + allocRet mlen $ \msgPtr -> + withByteArray sk $ \skPtr -> + withByteArray pk $ \pkPtr -> + withByteArray nonce $ \noncePtr -> + withByteArray ct $ \ctPtr -> do + -- TODO: Maybe, reimplement this without _easy, to stay closer + -- to the original NaCl. + Na.crypto_box_open_easy msgPtr + ctPtr (fromIntegral $ length ct) + noncePtr + pkPtr skPtr + if ret == 0 then + pure $ Just msg + else + pure Nothing + where + mlen :: Int + mlen = length ct - fromIntegral Na.crypto_box_macbytes diff --git a/lib/NaCl/Hash.hs b/lib/NaCl/Hash.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Hash.hs @@ -0,0 +1,65 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Hashing. +-- +-- It is best to import this module qualified: +-- +-- @ +-- import qualified NaCl.Hash as Hash +-- +-- hash_sha256 = Hash.'sha256' message +-- hash_sha512 = Hash.'sha512' signed +-- @ +-- +-- This is @crypto_hash_*@ from NaCl. +module NaCl.Hash + ( HashSha256 + , sha256 + + , HashSha512 + , sha512 + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import System.IO.Unsafe (unsafePerformIO) + +import NaCl.Hash.Internal (HashSha256, HashSha512) + +import qualified NaCl.Hash.Internal as I + + +-- | Hash a message using SHA-256. +-- +-- @ +-- hash = Hash.'sha256' message +-- @ +-- +-- * @message@ is the data you are hashing. +sha256 + :: ( ByteArrayAccess pt + , ByteArray hashBytes + ) + => pt -- ^ Message to hash + -> HashSha256 hashBytes +sha256 msg = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.sha256 msg + +-- | Hash a message using SHA-512. +-- +-- @ +-- hash = Hash.'sha512' message +-- @ +-- +-- * @message@ is the data you are hashing. +sha512 + :: ( ByteArrayAccess pt + , ByteArray hashBytes + ) + => pt -- ^ Message to hash + -> HashSha512 hashBytes +sha512 msg = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.sha512 msg diff --git a/lib/NaCl/Hash/Internal.hs b/lib/NaCl/Hash/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Hash/Internal.hs @@ -0,0 +1,66 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Internals of @crypto_hash@. +module NaCl.Hash.Internal + ( HashSha256 + , sha256 + + , HashSha512 + , sha512 + ) where + +import Prelude hiding (length) + +import Data.ByteArray (ByteArray, ByteArrayAccess, length, withByteArray) +import Data.ByteArray.Sized (SizedByteArray, allocRet) +import Data.Proxy (Proxy (Proxy)) + +import qualified Libsodium as Na + + +-- | Hash returned by 'sha256'. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +type HashSha256 a = SizedByteArray Na.CRYPTO_HASH_SHA256_BYTES a + +-- | Hash a message using SHA-256. +sha256 + :: ( ByteArrayAccess pt + , ByteArray hashBytes + ) + => pt -- ^ Message to hash + -> IO (HashSha256 hashBytes) +sha256 msg = do + (_ret, ct) <- + allocRet (Proxy :: Proxy Na.CRYPTO_HASH_SHA256_BYTES) $ \hashPtr -> + withByteArray msg $ \msgPtr -> do + Na.crypto_hash_sha256 hashPtr + msgPtr (fromIntegral $ length msg) + -- _ret can be only 0, so we don’t check it + pure ct + + +-- | Hash returned by 'sha512'. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +type HashSha512 a = SizedByteArray Na.CRYPTO_HASH_SHA512_BYTES a + +-- | Hash a message using SHA-512. +sha512 + :: ( ByteArrayAccess pt + , ByteArray hashBytes + ) + => pt -- ^ Message to hash + -> IO (HashSha512 hashBytes) +sha512 msg = do + (_ret, ct) <- + allocRet (Proxy :: Proxy Na.CRYPTO_HASH_SHA512_BYTES) $ \hashPtr -> + withByteArray msg $ \msgPtr -> do + Na.crypto_hash_sha512 hashPtr + msgPtr (fromIntegral $ length msg) + -- _ret can be only 0, so we don’t check it + pure ct diff --git a/lib/NaCl/Scalarmult.hs b/lib/NaCl/Scalarmult.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Scalarmult.hs @@ -0,0 +1,102 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Scalar multiplication in a group. +-- +-- This is @crypto_scalarmult_*@ from NaCl. +-- +-- Note that this primitive is designed to only make the /Computational Diffie–Hellman/ +-- problem hard. It makes no promises about other assumptions, therefore it is +-- the user’s responsibility to hash the output if required for the security +-- of the specific application. +module NaCl.Scalarmult + ( Point (..) + , toPoint + , Scalar (..) + , toScalar + + , mult + , multBase + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess, withByteArray) +import Data.ByteArray.Sized (ByteArrayN, SizedByteArray, allocRet, sizedByteArray) +import Data.Proxy (Proxy (Proxy)) +import System.IO.Unsafe (unsafePerformIO) + +import qualified Libsodium as Na + + +-- | Point in the group. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +newtype Point a = Point (SizedByteArray Na.CRYPTO_SCALARMULT_BYTES a) + deriving + ( ByteArrayAccess, ByteArrayN Na.CRYPTO_SCALARMULT_BYTES + , Eq, Ord, Show + ) + +-- | Convert bytes to a group point. +toPoint :: ByteArrayAccess bytes => bytes -> Maybe (Point bytes) +toPoint = fmap Point . sizedByteArray + +-- | Scalar that can be used for group multiplication. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +newtype Scalar a = Scalar (SizedByteArray Na.CRYPTO_SCALARMULT_SCALARBYTES a) + deriving + ( ByteArrayAccess, ByteArrayN Na.CRYPTO_SCALARMULT_SCALARBYTES + , Eq, Ord, Show + ) + +-- | Convert bytes to a scalar. +toScalar :: ByteArrayAccess bytes => bytes -> Maybe (Scalar bytes) +toScalar = fmap Scalar . sizedByteArray + +-- | Multiply a group point by an integer. +-- +-- Note that this function is slightly different from the corresponding function +-- in NaCl. Namely, unlike @crypto_scalarmult@ in NaCl, this one will return +-- @Nothing@ if: +-- +-- * either the group point has a small order (1, 2, 4, or 8) +-- * or the result of the multiplication is the identity point. +-- +-- This is how it is implemented in libsodium. +mult + :: forall outBytes pointBytes scalarBytes. + ( ByteArrayAccess pointBytes + , ByteArrayAccess scalarBytes + , ByteArray outBytes + ) + => Point pointBytes -- ^ Group point. + -> Scalar scalarBytes -- ^ Scalar. + -> Maybe (Point outBytes) +mult point scalar = unsafePerformIO $ do + (ret, out) <- + allocRet (Proxy @Na.CRYPTO_SCALARMULT_BYTES) $ \outPtr -> + withByteArray point $ \pointPtr -> + withByteArray scalar $ \scalarPtr -> + Na.crypto_scalarmult outPtr scalarPtr pointPtr + if ret == 0 + then pure $ Just out + else pure Nothing + +-- | Multiply the standard group point by an integer. +multBase + :: forall outBytes scalarBytes. + ( ByteArrayAccess scalarBytes + , ByteArray outBytes + ) + => Scalar scalarBytes -- ^ Scalar. + -> Point outBytes +multBase scalar = unsafePerformIO $ do + (_ret, out) <- + allocRet (Proxy @Na.CRYPTO_SCALARMULT_BYTES) $ \outPtr -> + withByteArray scalar $ \scalarPtr -> + Na.crypto_scalarmult_base outPtr scalarPtr + -- _ret can be only 0, so we don’t check it + pure out diff --git a/lib/NaCl/Secretbox.hs b/lib/NaCl/Secretbox.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Secretbox.hs @@ -0,0 +1,112 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Symmetric authenticated encryption. +-- +-- It is best to import this module qualified: +-- +-- @ +-- import qualified NaCl.Secretbox as Secretbox +-- +-- encrypted = Secretbox.'create' key nonce message +-- decrypted = Secretbox.'open' key nonce encrypted +-- @ +-- +-- This is @crypto_secretbox_*@ from NaCl. +module NaCl.Secretbox + ( Key + , toKey + + , Nonce + , toNonce + + , create + , open + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import System.IO.Unsafe (unsafePerformIO) + +import NaCl.Secretbox.Internal (Key, Nonce, toKey, toNonce) + +import qualified NaCl.Secretbox.Internal as I + + +-- | Encrypt a message. +-- +-- @ +-- encrypted = Secretbox.create key nonce message +-- @ +-- +-- * @key@ is the secret key used for encryption. There are two typical ways +-- of creating it: +-- +-- 1. /Derive from a password/. If you want to protect a message with a password, +-- you must use a +-- +-- to turn this password into an encryption key. +-- +-- 2. /Generate a random one/. This can be useful in certain situations when +-- you want to have an intermediate key that you will encrypt and share +-- later. +-- +-- The @Crypto.Key@ module in +-- +-- has functions to help in either case. +-- +-- * @nonce@ is an extra noise that is required for security. +-- There are two standard ways of getting it: +-- +-- 1. /Use a counter/. In this case you keep a counter of encrypted messages, +-- which means that the nonce will be new for each new message. +-- +-- 2. /Random/. You generate a random nonce every time you encrypt a message. +-- Since the nonce is large enough, the chances of you using the same +-- nonce twice are negligible. For useful helpers, see @Crypto.Random@, +-- in . +-- +-- In either case, you need to be able to provide the same nonce when decrypting, +-- so you should be able to recover it by computation (e.g. in the case of +-- a counter) or you should store it alongside the encrypted data. The nonce +-- is not secret, so it is perfectly ok to store it in plaintext. +-- +-- * @message@ is the data you are encrypting. +-- +-- This function adds authentication data, so if anyone modifies the cyphertext, +-- 'open' will refuse to decrypt it. +create + :: ( ByteArrayAccess keyBytes, ByteArrayAccess nonceBytes + , ByteArrayAccess ptBytes, ByteArray ctBytes + ) + => Key keyBytes -- ^ Secret key + -> Nonce nonceBytes -- ^ Nonce + -> ptBytes -- ^ Plaintext message + -> ctBytes +create key nonce msg = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.create key nonce msg + + +-- | Decrypt a message. +-- +-- @ +-- decrypted = Secretbox.open key nonce encrypted +-- @ +-- +-- * @key@ and @nonce@ are the same that were used for encryption. +-- * @encrypted@ is the output of 'create'. +-- +-- This function will return @Nothing@ if the encrypted message was tampered +-- with after it was encrypted. +open + :: ( ByteArrayAccess keyBytes, ByteArrayAccess nonceBytes + , ByteArray ptBytes, ByteArrayAccess ctBytes + ) + => Key keyBytes -- ^ Secret key + -> Nonce nonceBytes -- ^ Nonce + -> ctBytes -- ^ Encrypted message (cyphertext) + -> Maybe ptBytes +open key nonce ct = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.open key nonce ct diff --git a/lib/NaCl/Secretbox/Internal.hs b/lib/NaCl/Secretbox/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Secretbox/Internal.hs @@ -0,0 +1,109 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Internals of @crypto_secretbox@. +module NaCl.Secretbox.Internal + ( Key + , toKey + + , Nonce + , toNonce + + , create + , open + ) where + +import Prelude hiding (length) + +import Data.ByteArray (ByteArray, ByteArrayAccess, allocRet, length, withByteArray) +import Data.ByteArray.Sized (SizedByteArray, sizedByteArray) + +import qualified Libsodium as Na + + +-- | Encryption key that can be used for Secretbox. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@, but, since this +-- is a secret key, it is better to use @ScrubbedBytes@. +type Key a = SizedByteArray Na.CRYPTO_SECRETBOX_KEYBYTES a + +-- | Make a 'Key' from an arbitrary byte array. +-- +-- This function returns @Just@ if and only if the byte array has +-- the right length to be used as a key with a Secretbox. +toKey :: ByteArrayAccess ba => ba -> Maybe (Key ba) +toKey = sizedByteArray + + +-- | Nonce that can be used for Secretbox. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +type Nonce a = SizedByteArray Na.CRYPTO_SECRETBOX_NONCEBYTES a + +-- | Make a 'Nonce' from an arbitrary byte array. +-- +-- This function returns @Just@ if and only if the byte array has +-- the right length to be used as a nonce with a Secretbox. +toNonce :: ByteArrayAccess ba => ba -> Maybe (Nonce ba) +toNonce = sizedByteArray + + +-- | Encrypt a message. +create + :: ( ByteArrayAccess key, ByteArrayAccess nonce + , ByteArrayAccess pt, ByteArray ct + ) + => Key key -- ^ Secret key + -> Nonce nonce -- ^ Nonce + -> pt -- ^ Plaintext message + -> IO ct +create key nonce msg = do + (_ret, ct) <- + allocRet clen $ \ctPtr -> + withByteArray key $ \keyPtr -> + withByteArray nonce $ \noncePtr -> + withByteArray msg $ \msgPtr -> do + -- TODO: Maybe, reimplement this without _easy, to stay closer + -- to the original NaCl. + Na.crypto_secretbox_easy ctPtr + msgPtr (fromIntegral $ length msg) + noncePtr + keyPtr + -- _ret can be only 0, so we don’t check it + pure ct + where + clen :: Int + clen = fromIntegral Na.crypto_secretbox_macbytes + length msg + + +-- | Decrypt a message. +open + :: ( ByteArrayAccess key, ByteArrayAccess nonce + , ByteArray pt, ByteArrayAccess ct + ) + => Key key -- ^ Secret key + -> Nonce nonce -- ^ Nonce + -> ct -- ^ Cyphertext + -> IO (Maybe pt) +open key nonce ct = do + (ret, msg) <- + allocRet mlen $ \msgPtr -> + withByteArray key $ \keyPtr -> + withByteArray nonce $ \noncePtr -> + withByteArray ct $ \ctPtr -> do + -- TODO: Maybe, reimplement this without _easy, to stay closer + -- to the original NaCl. + Na.crypto_secretbox_open_easy msgPtr + ctPtr (fromIntegral $ length ct) + noncePtr + keyPtr + if ret == 0 then + pure $ Just msg + else + pure Nothing + where + mlen :: Int + mlen = length ct - fromIntegral Na.crypto_secretbox_macbytes diff --git a/lib/NaCl/Sign.hs b/lib/NaCl/Sign.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Sign.hs @@ -0,0 +1,83 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Public-key signatures. +-- +-- It is best to import this module qualified: +-- +-- @ +-- import qualified NaCl.Sign as Sign +-- +-- signed = Sign.'create' sk message +-- verified = Sign.'open' pk signed +-- @ +-- +-- This is @crypto_sign_*@ from NaCl. +module NaCl.Sign + ( PublicKey + , toPublicKey + , SecretKey + , toSecretKey + , keypair + + , create + , open + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import System.IO.Unsafe (unsafePerformIO) + +import NaCl.Sign.Internal (PublicKey, SecretKey, keypair, toPublicKey, toSecretKey) + +import qualified NaCl.Sign.Internal as I + + +-- | Sign a message. +-- +-- @ +-- signed = Sign.create sk message +-- @ +-- +-- * @sk@ is the signer’s secret key, used for authentication. +-- +-- This is generated using 'keypair' and the public part of the key +-- needs to be given to the verifying party in advance. +-- +-- * @message@ is the data you are signing. +-- +-- This function will copy the message to a new location +-- and add a signature, so that 'open' will refuce to verify it. +create + :: ( ByteArrayAccess skBytes + , ByteArrayAccess ptBytes, ByteArray ctBytes + ) + => SecretKey skBytes -- ^ Signer’s secret key + -> ptBytes -- ^ Message to sign + -> ctBytes +create sk msg = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.create sk msg + + +-- | Verify a signature. +-- +-- @ +-- verified = Sign.open pk signed +-- @ +-- +-- * @pk@ is the signer’s public key. +-- * @signed@ is the output of 'create'. +-- +-- This function will return @Nothing@ if the signature on the message +-- is invalid. +open + :: ( ByteArrayAccess pkBytes + , ByteArray ptBytes, ByteArrayAccess ctBytes + ) + => PublicKey pkBytes -- ^ Signer’s public key + -> ctBytes -- ^ Signed message + -> Maybe ptBytes +open pk ct = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.open pk ct diff --git a/lib/NaCl/Sign/Internal.hs b/lib/NaCl/Sign/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Sign/Internal.hs @@ -0,0 +1,116 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Internals of @crypto_sign@. +module NaCl.Sign.Internal + ( SecretKey + , toSecretKey + , PublicKey + , toPublicKey + , keypair + + , create + , open + ) where + +import Prelude hiding (length) + +import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, allocRet, length, withByteArray) +import Data.ByteArray.Sized (SizedByteArray, sizedByteArray) +import Data.ByteString (ByteString) +import Data.Functor (void) +import Data.Proxy (Proxy (Proxy)) +import Foreign.Ptr (nullPtr) + +import qualified Data.ByteArray.Sized as Sized (alloc, allocRet) +import qualified Libsodium as Na + + +-- | Secret key that can be used for creating a signature. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@, but, since this +-- is a secret key, it is better to use @ScrubbedBytes@. +type SecretKey a = SizedByteArray Na.CRYPTO_SIGN_SECRETKEYBYTES a + +-- | Convert bytes to a secret key. +toSecretKey :: ByteArrayAccess bytes => bytes -> Maybe (SecretKey bytes) +toSecretKey = sizedByteArray + +-- | Public key that can be used for verifyiing a signature. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +type PublicKey a = SizedByteArray Na.CRYPTO_SIGN_PUBLICKEYBYTES a + +-- | Convert bytes to a public key. +toPublicKey :: ByteArrayAccess bytes => bytes -> Maybe (PublicKey bytes) +toPublicKey = sizedByteArray + +-- | Generate a new 'SecretKey' together with its 'PublicKey'. +-- +-- Note: this function is not thread-safe (since the underlying +-- C function is not thread-safe both in Sodium and in NaCl)! +-- Either make sure there are no concurrent calls or see +-- @Crypto.Init@ in +-- +-- to learn how to make this function thread-safe. +keypair :: IO (PublicKey ByteString, SecretKey ScrubbedBytes) +keypair = do + (pk, sk) <- + Sized.allocRet Proxy $ \skPtr -> + Sized.alloc $ \pkPtr -> + -- always returns 0, so we don’t check it + void $ Na.crypto_sign_keypair pkPtr skPtr + pure (pk, sk) + + +-- | Sign a message. +create + :: ( ByteArrayAccess skBytes + , ByteArrayAccess pt, ByteArray ct + ) + => SecretKey skBytes -- ^ Signer’s secret key + -> pt -- ^ Message to sign + -> IO ct +create sk msg = do + (_ret, ct) <- + allocRet clen $ \ctPtr -> + withByteArray sk $ \skPtr -> + withByteArray msg $ \msgPtr -> do + Na.crypto_sign ctPtr nullPtr + msgPtr (fromIntegral $ length msg) + skPtr + -- _ret can be only 0, so we don’t check it + -- TODO: Actually, it looks like this function can fail and return + -- a -1, even though this is not documented :/. + pure ct + where + clen :: Int + clen = fromIntegral Na.crypto_sign_bytes + length msg + + +-- | Verify the signature of a signed message. +open + :: ( ByteArrayAccess pkBytes + , ByteArray pt, ByteArrayAccess ct + ) + => PublicKey pkBytes -- ^ Signer’s public key + -> ct -- ^ Signed message + -> IO (Maybe pt) +open pk ct = do + (ret, msg) <- + allocRet mlen $ \msgPtr -> + withByteArray pk $ \pkPtr -> + withByteArray ct $ \ctPtr -> do + Na.crypto_sign_open msgPtr nullPtr + ctPtr (fromIntegral $ length ct) + pkPtr + if ret == 0 then + pure $ Just msg + else + pure Nothing + where + mlen :: Int + mlen = length ct - fromIntegral Na.crypto_sign_bytes diff --git a/lib/NaCl/Stream.hs b/lib/NaCl/Stream.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Stream.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- ! This module intentionally does not contain extensive documentation +-- ! as a measure for discouraging its use. + +-- | Unauthenticated streaming encryption. +-- +-- __Note:__ Unauthenticated encryption is __insecure__ in general. +-- Only use the functions from this modules if you know exactly what you are doing. +-- We only provide this module for compatibility with NaCl. +-- @ +-- +-- This is @crypto_box_*@ from NaCl. +module NaCl.Stream + ( Key + , toKey + + , Nonce + , toNonce + + , MaxStreamSize + , generate + + , xor + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import Data.ByteArray.Sized (ByteArrayN) +import GHC.TypeLits (type (<=)) +import System.IO.Unsafe (unsafePerformIO) + +import NaCl.Stream.Internal (Nonce, Key, MaxStreamSize, toNonce, toKey) + +import qualified NaCl.Stream.Internal as I + + +-- | Generate a stream of pseudo-random bytes. +generate + :: forall n key nonce ct. + ( ByteArrayAccess key, ByteArrayAccess nonce + , ByteArrayN n ct + , n <= MaxStreamSize + ) + => Key key -- ^ Secret key + -> Nonce nonce -- ^ Nonce + -> ct +generate key nonce = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.generate key nonce + + +-- | Encrypt/decrypt a message. +xor + :: ( ByteArrayAccess key, ByteArrayAccess nonce + , ByteArrayAccess pt, ByteArray ct + ) + => Key key -- ^ Secret key + -> Nonce nonce -- ^ Nonce + -> pt -- ^ Input (plain/cipher) text + -> ct +xor key nonce msg = + -- This IO is safe, because it is pure. + unsafePerformIO $ I.xor key nonce msg diff --git a/lib/NaCl/Stream/Internal.hs b/lib/NaCl/Stream/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Stream/Internal.hs @@ -0,0 +1,112 @@ +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +-- | Internals of @crypto_stream@. +module NaCl.Stream.Internal + ( Key + , toKey + + , Nonce + , toNonce + + , MaxStreamSize + , generate + + , xor + ) where + +import Prelude hiding (length) + +import Data.ByteArray (ByteArray, ByteArrayAccess, allocRet, length, withByteArray) +import Data.ByteArray.Sized (ByteArrayN, SizedByteArray, sizedByteArray) +import Data.Proxy (Proxy (Proxy)) +import GHC.TypeLits (type (<=), natVal) + +import qualified Data.ByteArray.Sized as Sized (allocRet) +import qualified Libsodium as Na + + +-- | Encryption key that can be used for Stream. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@, but, since this +-- is a secret key, it is better to use @ScrubbedBytes@. +type Key a = SizedByteArray Na.CRYPTO_STREAM_KEYBYTES a + +-- | Make a 'Key' from an arbitrary byte array. +-- +-- This function returns @Just@ if and only if the byte array has +-- the right length to be used as a key with a Stream. +toKey :: ByteArrayAccess ba => ba -> Maybe (Key ba) +toKey = sizedByteArray + + +-- | Nonce that can be used for Stream. +-- +-- This type is parametrised by the actual data type that contains +-- bytes. This can be, for example, a @ByteString@. +type Nonce a = SizedByteArray Na.CRYPTO_STREAM_NONCEBYTES a + +-- | Make a 'Nonce' from an arbitrary byte array. +-- +-- This function returns @Just@ if and only if the byte array has +-- the right length to be used as a nonce with a Stream. +toNonce :: ByteArrayAccess ba => ba -> Maybe (Nonce ba) +toNonce = sizedByteArray + + +-- | The maximum size of the stream produced by 'generate'. +type MaxStreamSize = 18446744073709551615 -- = 2^64 - 1 (internal 64-bit counter) + +-- | Generate a stream of pseudo-random bytes. +generate + :: forall key nonce n ct. + ( ByteArrayAccess key, ByteArrayAccess nonce + , ByteArrayN n ct + , n <= MaxStreamSize + ) + => Key key -- ^ Secret key + -> Nonce nonce -- ^ Nonce + -> IO ct +generate key nonce = do + (_ret, ct) <- + Sized.allocRet (Proxy :: Proxy n) $ \ctPtr -> + withByteArray key $ \keyPtr -> + withByteArray nonce $ \noncePtr -> + Na.crypto_stream ctPtr + (fromIntegral $ natVal (Proxy :: Proxy n)) + noncePtr + keyPtr + -- _ret can be only 0, so we don’t check it + pure ct + + +-- | Encrypt/decrypt a message. +xor + :: ( ByteArrayAccess key, ByteArrayAccess nonce + , ByteArrayAccess pt, ByteArray ct + ) + => Key key -- ^ Secret key + -> Nonce nonce -- ^ Nonce + -> pt -- ^ Input (plain/cipher) text + -> IO ct +xor key nonce msg = do + (_ret, ct) <- + allocRet clen $ \ctPtr -> + withByteArray key $ \keyPtr -> + withByteArray nonce $ \noncePtr -> + withByteArray msg $ \msgPtr -> do + Na.crypto_stream_xor ctPtr + msgPtr (fromIntegral $ length msg) + noncePtr + keyPtr + -- _ret can be only 0, so we don’t check it + pure ct + where + clen :: Int + clen = length msg diff --git a/lib/NaCl/Verify.hs b/lib/NaCl/Verify.hs new file mode 100644 --- /dev/null +++ b/lib/NaCl/Verify.hs @@ -0,0 +1,69 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# LANGUAGE TypeFamilies #-} + +-- | String comparison. +-- +-- This is @crypto_verify_*@ from NaCl. +-- +-- Unlike NaCl, which provides multiple functions, this module exports only +-- one function – 'eq'. The function will automatically pick the correct +-- implementation based on type-level sizes of its inputs. +module NaCl.Verify + ( eq + , NaClComparable + ) where + +import Data.ByteArray (ByteArrayAccess, withByteArray) +import Data.ByteArray.Sized (SizedByteArray) +import Data.Proxy (Proxy (Proxy)) +import Foreign.C.Types (CInt, CUChar) +import Foreign.Ptr (Ptr) +import GHC.TypeLits (KnownNat, Nat) +import System.IO.Unsafe (unsafeDupablePerformIO) + +import qualified Libsodium as Na + + +-- | Class of bytestring lengths that can be verified by NaCl. +-- +-- This is a private class, we do not export it so that it is closed. +-- External users can use the @NaClComparable@ constraint on their functions, +-- but they can’t add instances. +class KnownNat n => CryptoVerify (n :: Nat) where + crypto_verify_n :: Proxy n -> Ptr CUChar -> Ptr CUChar -> IO CInt + +-- | Class of bytestring lengths that can be compared in constant-time +-- by NaCl. +class CryptoVerify n => NaClComparable n where + +instance CryptoVerify 16 where + crypto_verify_n _proxy = Na.crypto_verify_16 +instance NaClComparable 16 where + +instance CryptoVerify 32 where + crypto_verify_n _proxy = Na.crypto_verify_32 +instance NaClComparable 32 where + + +-- | Constant-time comparison of sequences of bytes. +-- +-- Unlike regular comparison, this function will always read both +-- sequences until the end rather than exit as soon as it finds +-- differing bytes. This makes it suitable for comparing secret data. +-- +-- It only works with inputs of size 16 or 32. +eq + :: forall n xBytes yBytes. + ( NaClComparable n + , ByteArrayAccess xBytes, ByteArrayAccess yBytes + ) + => SizedByteArray n xBytes -> SizedByteArray n yBytes -> Bool +eq x y = unsafeDupablePerformIO $ do + ret <- + withByteArray x $ \xPtr -> + withByteArray y $ \yPtr -> + crypto_verify_n (Proxy :: Proxy n) xPtr yPtr + pure $ ret == 0 diff --git a/test/Test/Crypto/Box.hs b/test/Test/Crypto/Box.hs deleted file mode 100644 --- a/test/Test/Crypto/Box.hs +++ /dev/null @@ -1,113 +0,0 @@ --- SPDX-FileCopyrightText: 2020 Serokell --- --- SPDX-License-Identifier: MPL-2.0 - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Test.Crypto.Box where - -import Hedgehog (Property, forAll, property, tripping) -import Hedgehog.Internal.Property (forAllT) -import Test.HUnit ((@?=), Assertion) - -import Data.ByteArray (ScrubbedBytes, convert) -import Data.ByteString (ByteString) -import Control.Monad.IO.Class (liftIO) - -import qualified Data.ByteString as BS -import qualified Libsodium as Na - -import qualified Hedgehog.Gen as G -import qualified Hedgehog.Range as R - -import qualified Crypto.Box as Box - - -nonceSize :: R.Range Int -nonceSize = R.singleton $ fromIntegral Na.crypto_box_noncebytes - - -hprop_encode_decode :: Property -hprop_encode_decode = property $ do - (pkS, skS) <- forAllT $ liftIO $ Box.keypair - (pkR, skR) <- forAllT $ liftIO $ Box.keypair - nonceBytes <- forAll $ G.bytes nonceSize - let Just nonce = Box.toNonce nonceBytes - msg <- forAll $ G.bytes (R.linear 0 1_000) - tripping msg (encodeBs pkR skS nonce) (decodeBs skR pkS nonce) - where - -- We need to specify the type of the cyphertext as it is polymorphic - encodeBs pkR skS nonce msg = Box.create pkR skS nonce msg :: ByteString - decodeBs skR pkS nonce ct = Box.open skR pkS nonce ct :: Maybe ByteString - - --- Test vector from --- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/box.c - -exampleSk :: ScrubbedBytes -exampleSk = convert $ BS.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 - ] - -examplePk :: ByteString -examplePk = BS.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 - ] - -exampleNonce :: ByteString -exampleNonce = BS.pack $ - [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 - , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 - , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 - , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 - ] - -exampleMsg :: ByteString -exampleMsg = BS.pack $ - [ 0xbe, 0x07, 0x5f, 0xc5 - , 0x3c, 0x81, 0xf2, 0xd5, 0xcf, 0x14, 0x13, 0x16, 0xeb, 0xeb, 0x0c, 0x7b - , 0x52, 0x28, 0xc5, 0x2a, 0x4c, 0x62, 0xcb, 0xd4, 0x4b, 0x66, 0x84, 0x9b - , 0x64, 0x24, 0x4f, 0xfc, 0xe5, 0xec, 0xba, 0xaf, 0x33, 0xbd, 0x75, 0x1a - , 0x1a, 0xc7, 0x28, 0xd4, 0x5e, 0x6c, 0x61, 0x29, 0x6c, 0xdc, 0x3c, 0x01 - , 0x23, 0x35, 0x61, 0xf4, 0x1d, 0xb6, 0x6c, 0xce, 0x31, 0x4a, 0xdb, 0x31 - , 0x0e, 0x3b, 0xe8, 0x25, 0x0c, 0x46, 0xf0, 0x6d, 0xce, 0xea, 0x3a, 0x7f - , 0xa1, 0x34, 0x80, 0x57, 0xe2, 0xf6, 0x55, 0x6a, 0xd6, 0xb1, 0x31, 0x8a - , 0x02, 0x4a, 0x83, 0x8f, 0x21, 0xaf, 0x1f, 0xde, 0x04, 0x89, 0x77, 0xeb - , 0x48, 0xf5, 0x9f, 0xfd, 0x49, 0x24, 0xca, 0x1c, 0x60, 0x90, 0x2e, 0x52 - , 0xf0, 0xa0, 0x89, 0xbc, 0x76, 0x89, 0x70, 0x40, 0xe0, 0x82, 0xf9, 0x37 - , 0x76, 0x38, 0x48, 0x64, 0x5e, 0x07, 0x05 - ] - -exampleCt :: ByteString -exampleCt = BS.pack $ - [ 0xf3, 0xff, 0xc7, 0x70, 0x3f, 0x94, 0x00, 0xe5 - , 0x2a, 0x7d, 0xfb, 0x4b, 0x3d, 0x33, 0x05, 0xd9 - , 0x8e, 0x99, 0x3b, 0x9f, 0x48, 0x68, 0x12, 0x73 - , 0xc2, 0x96, 0x50, 0xba, 0x32, 0xfc, 0x76, 0xce - , 0x48, 0x33, 0x2e, 0xa7, 0x16, 0x4d, 0x96, 0xa4 - , 0x47, 0x6f, 0xb8, 0xc5, 0x31, 0xa1, 0x18, 0x6a - , 0xc0, 0xdf, 0xc1, 0x7c, 0x98, 0xdc, 0xe8, 0x7b - , 0x4d, 0xa7, 0xf0, 0x11, 0xec, 0x48, 0xc9, 0x72 - , 0x71, 0xd2, 0xc2, 0x0f, 0x9b, 0x92, 0x8f, 0xe2 - , 0x27, 0x0d, 0x6f, 0xb8, 0x63, 0xd5, 0x17, 0x38 - , 0xb4, 0x8e, 0xee, 0xe3, 0x14, 0xa7, 0xcc, 0x8a - , 0xb9, 0x32, 0x16, 0x45, 0x48, 0xe5, 0x26, 0xae - , 0x90, 0x22, 0x43, 0x68, 0x51, 0x7a, 0xcf, 0xea - , 0xbd, 0x6b, 0xb3, 0x73, 0x2b, 0xc0, 0xe9, 0xda - , 0x99, 0x83, 0x2b, 0x61, 0xca, 0x01, 0xb6, 0xde - , 0x56, 0x24, 0x4a, 0x9e, 0x88, 0xd5, 0xf9, 0xb3 - , 0x79, 0x73, 0xf6, 0x22, 0xa4, 0x3d, 0x14, 0xa6 - , 0x59, 0x9b, 0x1f, 0x65, 0x4c, 0xb4, 0x5a, 0x74 - , 0xe3, 0x55, 0xa5 - ] - -unit_example_create :: Assertion -unit_example_create = do - let Just sk = Box.toSecretKey exampleSk - let Just pk = Box.toPublicKey examplePk - let Just nonce = Box.toNonce exampleNonce - Box.create pk sk nonce exampleMsg @?= exampleCt diff --git a/test/Test/Crypto/Secretbox.hs b/test/Test/Crypto/Secretbox.hs deleted file mode 100644 --- a/test/Test/Crypto/Secretbox.hs +++ /dev/null @@ -1,113 +0,0 @@ --- SPDX-FileCopyrightText: 2020 Serokell --- --- SPDX-License-Identifier: MPL-2.0 - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Test.Crypto.Secretbox where - -import Hedgehog (Property, forAll, property, tripping) -import Test.HUnit ((@?=), Assertion) - -import Data.ByteString (ByteString) - -import qualified Data.ByteString as BS -import qualified Libsodium as Na - -import qualified Hedgehog.Gen as G -import qualified Hedgehog.Range as R - -import qualified Crypto.Secretbox as Secretbox - - -keySize :: R.Range Int -keySize = R.singleton $ fromIntegral Na.crypto_secretbox_keybytes - -nonceSize :: R.Range Int -nonceSize = R.singleton $ fromIntegral Na.crypto_secretbox_noncebytes - - -hprop_encode_decode :: Property -hprop_encode_decode = property $ do - keyBytes <- forAll $ G.bytes keySize - let Just key = Secretbox.toKey keyBytes - nonceBytes <- forAll $ G.bytes nonceSize - let Just nonce = Secretbox.toNonce nonceBytes - msg <- forAll $ G.bytes (R.linear 0 1_000) - tripping msg (encodeBs key nonce) (decodeBs key nonce) - where - -- We need to specify the type of the cyphertext as it is polymorphic - encodeBs key nonce msg = Secretbox.create key nonce msg :: ByteString - decodeBs key nonce ct = Secretbox.open key nonce ct :: Maybe ByteString - - --- Test vector from --- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/secretbox.c - -exampleKey :: ByteString -exampleKey = BS.pack $ - [ 0x1b, 0x27, 0x55, 0x64, 0x73, 0xe9, 0x85 - , 0xd4, 0x62, 0xcd, 0x51, 0x19, 0x7a, 0x9a - , 0x46, 0xc7, 0x60, 0x09, 0x54, 0x9e, 0xac - , 0x64, 0x74, 0xf2, 0x06, 0xc4, 0xee, 0x08 - , 0x44, 0xf6, 0x83, 0x89 - ] - -exampleNonce :: ByteString -exampleNonce = BS.pack $ - [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 - , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 - , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 - , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 - ] - -exampleMsg :: ByteString -exampleMsg = BS.pack $ - [ 0xbe, 0x07, 0x5f, 0xc5 - , 0x3c, 0x81, 0xf2, 0xd5, 0xcf, 0x14, 0x13, 0x16, 0xeb, 0xeb, 0x0c, 0x7b - , 0x52, 0x28, 0xc5, 0x2a, 0x4c, 0x62, 0xcb, 0xd4, 0x4b, 0x66, 0x84, 0x9b - , 0x64, 0x24, 0x4f, 0xfc, 0xe5, 0xec, 0xba, 0xaf, 0x33, 0xbd, 0x75, 0x1a - , 0x1a, 0xc7, 0x28, 0xd4, 0x5e, 0x6c, 0x61, 0x29, 0x6c, 0xdc, 0x3c, 0x01 - , 0x23, 0x35, 0x61, 0xf4, 0x1d, 0xb6, 0x6c, 0xce, 0x31, 0x4a, 0xdb, 0x31 - , 0x0e, 0x3b, 0xe8, 0x25, 0x0c, 0x46, 0xf0, 0x6d, 0xce, 0xea, 0x3a, 0x7f - , 0xa1, 0x34, 0x80, 0x57, 0xe2, 0xf6, 0x55, 0x6a, 0xd6, 0xb1, 0x31, 0x8a - , 0x02, 0x4a, 0x83, 0x8f, 0x21, 0xaf, 0x1f, 0xde, 0x04, 0x89, 0x77, 0xeb - , 0x48, 0xf5, 0x9f, 0xfd, 0x49, 0x24, 0xca, 0x1c, 0x60, 0x90, 0x2e, 0x52 - , 0xf0, 0xa0, 0x89, 0xbc, 0x76, 0x89, 0x70, 0x40, 0xe0, 0x82, 0xf9, 0x37 - , 0x76, 0x38, 0x48, 0x64, 0x5e, 0x07, 0x05 - ] - -exampleCt :: ByteString -exampleCt = BS.pack $ - [ 0xf3, 0xff, 0xc7, 0x70, 0x3f, 0x94, 0x00, 0xe5 - , 0x2a, 0x7d, 0xfb, 0x4b, 0x3d, 0x33, 0x05, 0xd9 - , 0x8e, 0x99, 0x3b, 0x9f, 0x48, 0x68, 0x12, 0x73 - , 0xc2, 0x96, 0x50, 0xba, 0x32, 0xfc, 0x76, 0xce - , 0x48, 0x33, 0x2e, 0xa7, 0x16, 0x4d, 0x96, 0xa4 - , 0x47, 0x6f, 0xb8, 0xc5, 0x31, 0xa1, 0x18, 0x6a - , 0xc0, 0xdf, 0xc1, 0x7c, 0x98, 0xdc, 0xe8, 0x7b - , 0x4d, 0xa7, 0xf0, 0x11, 0xec, 0x48, 0xc9, 0x72 - , 0x71, 0xd2, 0xc2, 0x0f, 0x9b, 0x92, 0x8f, 0xe2 - , 0x27, 0x0d, 0x6f, 0xb8, 0x63, 0xd5, 0x17, 0x38 - , 0xb4, 0x8e, 0xee, 0xe3, 0x14, 0xa7, 0xcc, 0x8a - , 0xb9, 0x32, 0x16, 0x45, 0x48, 0xe5, 0x26, 0xae - , 0x90, 0x22, 0x43, 0x68, 0x51, 0x7a, 0xcf, 0xea - , 0xbd, 0x6b, 0xb3, 0x73, 0x2b, 0xc0, 0xe9, 0xda - , 0x99, 0x83, 0x2b, 0x61, 0xca, 0x01, 0xb6, 0xde - , 0x56, 0x24, 0x4a, 0x9e, 0x88, 0xd5, 0xf9, 0xb3 - , 0x79, 0x73, 0xf6, 0x22, 0xa4, 0x3d, 0x14, 0xa6 - , 0x59, 0x9b, 0x1f, 0x65, 0x4c, 0xb4, 0x5a, 0x74 - , 0xe3, 0x55, 0xa5 - ] - -unit_example_create :: Assertion -unit_example_create = do - let Just key = Secretbox.toKey exampleKey - let Just nonce = Secretbox.toNonce exampleNonce - Secretbox.create key nonce exampleMsg @?= exampleCt - -unit_example_open :: Assertion -unit_example_open = do - let Just key = Secretbox.toKey exampleKey - let Just nonce = Secretbox.toNonce exampleNonce - Secretbox.open key nonce exampleCt @?= Just exampleMsg diff --git a/test/Test/NaCl/Auth.hs b/test/Test/NaCl/Auth.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Auth.hs @@ -0,0 +1,63 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Auth where + +import Hedgehog (Property, assert, forAll, property) +import Test.HUnit ((@?), (@?=), Assertion) + +import Data.ByteArray.Sized (unSizedByteArray) +import Data.ByteString (ByteString) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 +import qualified Libsodium as Na + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +import qualified NaCl.Auth as Auth + + +keySize :: R.Range Int +keySize = R.singleton $ fromIntegral Na.crypto_auth_keybytes + + +hprop_verify_of_create :: Property +hprop_verify_of_create = property $ do + keyBytes <- forAll $ G.bytes keySize + let Just key = Auth.toKey keyBytes + msg <- forAll $ G.bytes (R.linear 0 1_000) + assert $ Auth.verify key msg (Auth.create @ByteString key msg) + + +-- Test vector from +-- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/auth.c + +exampleKey :: ByteString +exampleKey = C8.pack $ "Jefe" ++ replicate (32 - 4) '\NUL' + +exampleMsg :: ByteString +exampleMsg = C8.pack "what do ya want for nothing?" + +exampleAuth :: ByteString +exampleAuth = BS.pack $ + [ 0x16,0x4b,0x7a,0x7b,0xfc,0xf8,0x19,0xe2 + , 0xe3,0x95,0xfb,0xe7,0x3b,0x56,0xe0,0xa3 + , 0x87,0xbd,0x64,0x22,0x2e,0x83,0x1f,0xd6 + , 0x10,0x27,0x0c,0xd7,0xea,0x25,0x05,0x54 + ] + +unit_example_create :: Assertion +unit_example_create = do + let Just key = Auth.toKey exampleKey + unSizedByteArray (Auth.create key exampleMsg) @?= exampleAuth + +unit_example_verify :: Assertion +unit_example_verify = do + let Just key = Auth.toKey exampleKey + let Just auth = Auth.toAuthenticator exampleAuth + Auth.verify key exampleMsg auth @? "Verify ok" diff --git a/test/Test/NaCl/Box.hs b/test/Test/NaCl/Box.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Box.hs @@ -0,0 +1,113 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Box where + +import Hedgehog (Property, forAll, property, tripping) +import Hedgehog.Internal.Property (forAllT) +import Test.HUnit ((@?=), Assertion) + +import Data.ByteArray (ScrubbedBytes, convert) +import Data.ByteString (ByteString) +import Control.Monad.IO.Class (liftIO) + +import qualified Data.ByteString as BS +import qualified Libsodium as Na + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +import qualified NaCl.Box as Box + + +nonceSize :: R.Range Int +nonceSize = R.singleton $ fromIntegral Na.crypto_box_noncebytes + + +hprop_encode_decode :: Property +hprop_encode_decode = property $ do + (pkS, skS) <- forAllT $ liftIO $ Box.keypair + (pkR, skR) <- forAllT $ liftIO $ Box.keypair + nonceBytes <- forAll $ G.bytes nonceSize + let Just nonce = Box.toNonce nonceBytes + msg <- forAll $ G.bytes (R.linear 0 1_000) + tripping msg (encodeBs pkR skS nonce) (decodeBs skR pkS nonce) + where + -- We need to specify the type of the cyphertext as it is polymorphic + encodeBs pkR skS nonce msg = Box.create pkR skS nonce msg :: ByteString + decodeBs skR pkS nonce ct = Box.open skR pkS nonce ct :: Maybe ByteString + + +-- Test vector from +-- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/box.c + +exampleSk :: ScrubbedBytes +exampleSk = convert $ BS.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 + ] + +examplePk :: ByteString +examplePk = BS.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 + ] + +exampleNonce :: ByteString +exampleNonce = BS.pack $ + [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 + , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 + , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 + , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 + ] + +exampleMsg :: ByteString +exampleMsg = BS.pack $ + [ 0xbe, 0x07, 0x5f, 0xc5 + , 0x3c, 0x81, 0xf2, 0xd5, 0xcf, 0x14, 0x13, 0x16, 0xeb, 0xeb, 0x0c, 0x7b + , 0x52, 0x28, 0xc5, 0x2a, 0x4c, 0x62, 0xcb, 0xd4, 0x4b, 0x66, 0x84, 0x9b + , 0x64, 0x24, 0x4f, 0xfc, 0xe5, 0xec, 0xba, 0xaf, 0x33, 0xbd, 0x75, 0x1a + , 0x1a, 0xc7, 0x28, 0xd4, 0x5e, 0x6c, 0x61, 0x29, 0x6c, 0xdc, 0x3c, 0x01 + , 0x23, 0x35, 0x61, 0xf4, 0x1d, 0xb6, 0x6c, 0xce, 0x31, 0x4a, 0xdb, 0x31 + , 0x0e, 0x3b, 0xe8, 0x25, 0x0c, 0x46, 0xf0, 0x6d, 0xce, 0xea, 0x3a, 0x7f + , 0xa1, 0x34, 0x80, 0x57, 0xe2, 0xf6, 0x55, 0x6a, 0xd6, 0xb1, 0x31, 0x8a + , 0x02, 0x4a, 0x83, 0x8f, 0x21, 0xaf, 0x1f, 0xde, 0x04, 0x89, 0x77, 0xeb + , 0x48, 0xf5, 0x9f, 0xfd, 0x49, 0x24, 0xca, 0x1c, 0x60, 0x90, 0x2e, 0x52 + , 0xf0, 0xa0, 0x89, 0xbc, 0x76, 0x89, 0x70, 0x40, 0xe0, 0x82, 0xf9, 0x37 + , 0x76, 0x38, 0x48, 0x64, 0x5e, 0x07, 0x05 + ] + +exampleCt :: ByteString +exampleCt = BS.pack $ + [ 0xf3, 0xff, 0xc7, 0x70, 0x3f, 0x94, 0x00, 0xe5 + , 0x2a, 0x7d, 0xfb, 0x4b, 0x3d, 0x33, 0x05, 0xd9 + , 0x8e, 0x99, 0x3b, 0x9f, 0x48, 0x68, 0x12, 0x73 + , 0xc2, 0x96, 0x50, 0xba, 0x32, 0xfc, 0x76, 0xce + , 0x48, 0x33, 0x2e, 0xa7, 0x16, 0x4d, 0x96, 0xa4 + , 0x47, 0x6f, 0xb8, 0xc5, 0x31, 0xa1, 0x18, 0x6a + , 0xc0, 0xdf, 0xc1, 0x7c, 0x98, 0xdc, 0xe8, 0x7b + , 0x4d, 0xa7, 0xf0, 0x11, 0xec, 0x48, 0xc9, 0x72 + , 0x71, 0xd2, 0xc2, 0x0f, 0x9b, 0x92, 0x8f, 0xe2 + , 0x27, 0x0d, 0x6f, 0xb8, 0x63, 0xd5, 0x17, 0x38 + , 0xb4, 0x8e, 0xee, 0xe3, 0x14, 0xa7, 0xcc, 0x8a + , 0xb9, 0x32, 0x16, 0x45, 0x48, 0xe5, 0x26, 0xae + , 0x90, 0x22, 0x43, 0x68, 0x51, 0x7a, 0xcf, 0xea + , 0xbd, 0x6b, 0xb3, 0x73, 0x2b, 0xc0, 0xe9, 0xda + , 0x99, 0x83, 0x2b, 0x61, 0xca, 0x01, 0xb6, 0xde + , 0x56, 0x24, 0x4a, 0x9e, 0x88, 0xd5, 0xf9, 0xb3 + , 0x79, 0x73, 0xf6, 0x22, 0xa4, 0x3d, 0x14, 0xa6 + , 0x59, 0x9b, 0x1f, 0x65, 0x4c, 0xb4, 0x5a, 0x74 + , 0xe3, 0x55, 0xa5 + ] + +unit_example_create :: Assertion +unit_example_create = do + let Just sk = Box.toSecretKey exampleSk + let Just pk = Box.toPublicKey examplePk + let Just nonce = Box.toNonce exampleNonce + Box.create pk sk nonce exampleMsg @?= exampleCt diff --git a/test/Test/NaCl/Hash.hs b/test/Test/NaCl/Hash.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Hash.hs @@ -0,0 +1,60 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Hash where + +import Test.HUnit ((@?=), Assertion) + +import Data.ByteArray.Sized (sizedByteArray) +import Data.ByteString (ByteString) +import Data.ByteString.Base16 (decodeBase16) +import Data.Either (fromRight) + +import qualified NaCl.Hash as Hash + + +-- Test vectors from +-- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/hash.c + +unit_sha512_test1 :: Assertion +unit_sha512_test1 = do + let + msg = "testing\n" :: ByteString + Just hash = sizedByteArray . fromRight (error "impossible") . decodeBase16 $ + "24f950aac7b9ea9b3cb728228a0c82b67c39e96b4b344798870d5daee93e3ae5931baae8c7cacfea4b629452c38026a81d138bc7aad1af3ef7bfd5ec646d6c28" + Hash.sha512 msg @?= hash + +unit_sha512_test2 :: Assertion +unit_sha512_test2 = do + let + msg = mconcat @ByteString + [ "The Conscience of a Hacker is a small essay written January 8, 1986 by a " + , "computer security hacker who went by the handle of The Mentor, who " + , "belonged to the 2nd generation of Legion of Doom." + ] + Just hash = sizedByteArray . fromRight (error "impossible") . decodeBase16 $ + "a77abe1ccf8f5497e228fbc0acd73a521ededb21b89726684a6ebbc3baa32361aca5a244daa84f24bf19c68baf78e6907625a659b15479eb7bd426fc62aafa73" + Hash.sha512 msg @?= hash + +unit_sha256_test1 :: Assertion +unit_sha256_test1 = do + let + msg = "testing\n" :: ByteString + Just hash = sizedByteArray . fromRight (error "impossible") . decodeBase16 $ + "12a61f4e173fb3a11c05d6471f74728f76231b4a5fcd9667cef3af87a3ae4dc2" + Hash.sha256 msg @?= hash + +unit_sha256_test2 :: Assertion +unit_sha256_test2 = do + let + msg = mconcat @ByteString + [ "The Conscience of a Hacker is a small essay written January 8, 1986 by a " + , "computer security hacker who went by the handle of The Mentor, who " + , "belonged to the 2nd generation of Legion of Doom." + ] + Just hash = sizedByteArray . fromRight (error "impossible") . decodeBase16 $ + "71cc8123fef8c236e451d3c3ddf1adae9aa6cd9521e7041769d737024900a03a" + Hash.sha256 msg @?= hash diff --git a/test/Test/NaCl/Scalarmult.hs b/test/Test/NaCl/Scalarmult.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Scalarmult.hs @@ -0,0 +1,97 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Scalarmult where + +import Hedgehog ((===), Property, discard, failure, forAll, property, success) +import Test.HUnit ((@?=), Assertion) + +import Data.ByteString (ByteString) +import Data.ByteString.Base16 (decodeBase16) +import Data.Either (fromRight) + +import qualified Data.ByteString as BS + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +import NaCl.Scalarmult (Scalar, Point, mult, multBase, toScalar, toPoint) + + +pointSize :: R.Range Int +pointSize = R.singleton 32 + +scalarSize :: R.Range Int +scalarSize = R.singleton 32 + + +-- Test vectors from +-- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/scalarmult.c + +aliceSk :: Scalar ByteString +Just aliceSk = toScalar . BS.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 + ] +alicePk :: Point ByteString +alicePk = multBase aliceSk + + +bobSk :: Scalar ByteString +Just bobSk = toScalar . BS.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 + ] +bobPk :: Point ByteString +bobPk = multBase bobSk + +smallOrderP :: Point ByteString +Just smallOrderP = toPoint . BS.pack $ + [ 0xe0, 0xeb, 0x7a, 0x7c, 0x3b, 0x41, 0xb8, 0xae, 0x16, 0x56, 0xe3, + 0xfa, 0xf1, 0x9f, 0xc4, 0x6a, 0xda, 0x09, 0x8d, 0xeb, 0x9c, 0x32, + 0xb1, 0xfd, 0x86, 0x62, 0x05, 0x16, 0x5f, 0x49, 0xb8, 0x00 + ] + + +unit_alice_pk :: Assertion +unit_alice_pk = do + let Just expected = toPoint . fromRight (error "impossible") . decodeBase16 $ "8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a" + alicePk @?= expected + +unit_bob_pk :: Assertion +unit_bob_pk = do + let Just expected = toPoint . fromRight (error "impossible") . decodeBase16 $ "de9edb7d7b7dc1b4d35b61c2ece435373f8343c85b78674dadfc7e146f882b4f" + bobPk @?= expected + +unit_shared_example :: Assertion +unit_shared_example = do + let Just aliceShared = bobPk `mult` aliceSk + let Just bobShared = alicePk `mult` bobSk + let Just expected = toPoint . fromRight (error "impossible") . decodeBase16 $ "4a5d9d5ba4ce2de1728e3bf480350f25e07e21c947d19e3376f09b3c1e161742" + aliceShared @?= expected + bobShared @?= expected + +hprop_small_order :: Property +hprop_small_order = property $ do + Just sk <- forAll $ toScalar <$> G.bytes scalarSize + case mult @ByteString smallOrderP sk of + Nothing -> success + Just _ -> failure + +hprop_shared :: Property +hprop_shared = property $ do + Just sk1 <- forAll $ toScalar <$> G.bytes scalarSize + let pk1 = multBase @ByteString sk1 + Just sk2 <- forAll $ toScalar <$> G.bytes scalarSize + let pk2 = multBase @ByteString sk2 + + let mshared1 = mult @ByteString pk2 sk1 + let mshared2 = mult @ByteString pk1 sk2 + case (mshared1, mshared2) of + (Just shared1, Just shared2) -> shared1 === shared2 + _ -> discard diff --git a/test/Test/NaCl/Secretbox.hs b/test/Test/NaCl/Secretbox.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Secretbox.hs @@ -0,0 +1,113 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Secretbox where + +import Hedgehog (Property, forAll, property, tripping) +import Test.HUnit ((@?=), Assertion) + +import Data.ByteString (ByteString) + +import qualified Data.ByteString as BS +import qualified Libsodium as Na + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +import qualified NaCl.Secretbox as Secretbox + + +keySize :: R.Range Int +keySize = R.singleton $ fromIntegral Na.crypto_secretbox_keybytes + +nonceSize :: R.Range Int +nonceSize = R.singleton $ fromIntegral Na.crypto_secretbox_noncebytes + + +hprop_encode_decode :: Property +hprop_encode_decode = property $ do + keyBytes <- forAll $ G.bytes keySize + let Just key = Secretbox.toKey keyBytes + nonceBytes <- forAll $ G.bytes nonceSize + let Just nonce = Secretbox.toNonce nonceBytes + msg <- forAll $ G.bytes (R.linear 0 1_000) + tripping msg (encodeBs key nonce) (decodeBs key nonce) + where + -- We need to specify the type of the cyphertext as it is polymorphic + encodeBs key nonce msg = Secretbox.create key nonce msg :: ByteString + decodeBs key nonce ct = Secretbox.open key nonce ct :: Maybe ByteString + + +-- Test vector from +-- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/secretbox.c + +exampleKey :: ByteString +exampleKey = BS.pack $ + [ 0x1b, 0x27, 0x55, 0x64, 0x73, 0xe9, 0x85 + , 0xd4, 0x62, 0xcd, 0x51, 0x19, 0x7a, 0x9a + , 0x46, 0xc7, 0x60, 0x09, 0x54, 0x9e, 0xac + , 0x64, 0x74, 0xf2, 0x06, 0xc4, 0xee, 0x08 + , 0x44, 0xf6, 0x83, 0x89 + ] + +exampleNonce :: ByteString +exampleNonce = BS.pack $ + [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 + , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 + , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 + , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 + ] + +exampleMsg :: ByteString +exampleMsg = BS.pack $ + [ 0xbe, 0x07, 0x5f, 0xc5 + , 0x3c, 0x81, 0xf2, 0xd5, 0xcf, 0x14, 0x13, 0x16, 0xeb, 0xeb, 0x0c, 0x7b + , 0x52, 0x28, 0xc5, 0x2a, 0x4c, 0x62, 0xcb, 0xd4, 0x4b, 0x66, 0x84, 0x9b + , 0x64, 0x24, 0x4f, 0xfc, 0xe5, 0xec, 0xba, 0xaf, 0x33, 0xbd, 0x75, 0x1a + , 0x1a, 0xc7, 0x28, 0xd4, 0x5e, 0x6c, 0x61, 0x29, 0x6c, 0xdc, 0x3c, 0x01 + , 0x23, 0x35, 0x61, 0xf4, 0x1d, 0xb6, 0x6c, 0xce, 0x31, 0x4a, 0xdb, 0x31 + , 0x0e, 0x3b, 0xe8, 0x25, 0x0c, 0x46, 0xf0, 0x6d, 0xce, 0xea, 0x3a, 0x7f + , 0xa1, 0x34, 0x80, 0x57, 0xe2, 0xf6, 0x55, 0x6a, 0xd6, 0xb1, 0x31, 0x8a + , 0x02, 0x4a, 0x83, 0x8f, 0x21, 0xaf, 0x1f, 0xde, 0x04, 0x89, 0x77, 0xeb + , 0x48, 0xf5, 0x9f, 0xfd, 0x49, 0x24, 0xca, 0x1c, 0x60, 0x90, 0x2e, 0x52 + , 0xf0, 0xa0, 0x89, 0xbc, 0x76, 0x89, 0x70, 0x40, 0xe0, 0x82, 0xf9, 0x37 + , 0x76, 0x38, 0x48, 0x64, 0x5e, 0x07, 0x05 + ] + +exampleCt :: ByteString +exampleCt = BS.pack $ + [ 0xf3, 0xff, 0xc7, 0x70, 0x3f, 0x94, 0x00, 0xe5 + , 0x2a, 0x7d, 0xfb, 0x4b, 0x3d, 0x33, 0x05, 0xd9 + , 0x8e, 0x99, 0x3b, 0x9f, 0x48, 0x68, 0x12, 0x73 + , 0xc2, 0x96, 0x50, 0xba, 0x32, 0xfc, 0x76, 0xce + , 0x48, 0x33, 0x2e, 0xa7, 0x16, 0x4d, 0x96, 0xa4 + , 0x47, 0x6f, 0xb8, 0xc5, 0x31, 0xa1, 0x18, 0x6a + , 0xc0, 0xdf, 0xc1, 0x7c, 0x98, 0xdc, 0xe8, 0x7b + , 0x4d, 0xa7, 0xf0, 0x11, 0xec, 0x48, 0xc9, 0x72 + , 0x71, 0xd2, 0xc2, 0x0f, 0x9b, 0x92, 0x8f, 0xe2 + , 0x27, 0x0d, 0x6f, 0xb8, 0x63, 0xd5, 0x17, 0x38 + , 0xb4, 0x8e, 0xee, 0xe3, 0x14, 0xa7, 0xcc, 0x8a + , 0xb9, 0x32, 0x16, 0x45, 0x48, 0xe5, 0x26, 0xae + , 0x90, 0x22, 0x43, 0x68, 0x51, 0x7a, 0xcf, 0xea + , 0xbd, 0x6b, 0xb3, 0x73, 0x2b, 0xc0, 0xe9, 0xda + , 0x99, 0x83, 0x2b, 0x61, 0xca, 0x01, 0xb6, 0xde + , 0x56, 0x24, 0x4a, 0x9e, 0x88, 0xd5, 0xf9, 0xb3 + , 0x79, 0x73, 0xf6, 0x22, 0xa4, 0x3d, 0x14, 0xa6 + , 0x59, 0x9b, 0x1f, 0x65, 0x4c, 0xb4, 0x5a, 0x74 + , 0xe3, 0x55, 0xa5 + ] + +unit_example_create :: Assertion +unit_example_create = do + let Just key = Secretbox.toKey exampleKey + let Just nonce = Secretbox.toNonce exampleNonce + Secretbox.create key nonce exampleMsg @?= exampleCt + +unit_example_open :: Assertion +unit_example_open = do + let Just key = Secretbox.toKey exampleKey + let Just nonce = Secretbox.toNonce exampleNonce + Secretbox.open key nonce exampleCt @?= Just exampleMsg diff --git a/test/Test/NaCl/Sign.hs b/test/Test/NaCl/Sign.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Sign.hs @@ -0,0 +1,199 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Sign where + +import Hedgehog (Property, forAll, property, tripping) +import Hedgehog.Internal.Property (forAllT) +import Test.HUnit ((@?=), Assertion) + +import Data.ByteString (ByteString) +import Data.ByteString.Base16 (decodeBase16) +import Data.Either (fromRight) +import Control.Monad.IO.Class (liftIO) + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +import qualified NaCl.Sign as Sign + + +hprop_encode_decode :: Property +hprop_encode_decode = property $ do + (pk, sk) <- forAllT $ liftIO $ Sign.keypair + msg <- forAll $ G.bytes (R.linear 0 1_000) + tripping msg (encodeBs sk) (decodeBs pk) + where + -- We need to specify the type of the signed msg as it is polymorphic + encodeBs sk msg = Sign.create sk msg :: ByteString + decodeBs pk ct = Sign.open pk ct :: Maybe ByteString + + +-- Test vectors from RFC8032. +-- +-- Libsodium sk is 64 bytes and consists of 32 bytes of sk +-- followed by 32 bytes of pk. + +unit_rfc8032_test1 :: Assertion +unit_rfc8032_test1 = do + let + Just sk = Sign.toSecretKey $ fromRight (error "impossible") . decodeBase16 $ mconcat + [ "9d61b19deffd5a60ba844af492ec2cc4" + , "4449c5697b326919703bac031cae7f60" + , "d75a980182b10ab7d54bfed3c964073a" + , "0ee172f3daa62325af021a68f707511a" + ] + msg = "" + sig = fromRight (error "impossible") . decodeBase16 $ mconcat + [ "e5564300c360ac729086e2cc806e828a" + , "84877f1eb8e5d974d873e06522490155" + , "5fb8821590a33bacc61e39701cf9b46b" + , "d25bf5f0595bbe24655141438e7a100b" + ] + Sign.create sk msg @?= sig <> msg + +unit_rfc8032_test2 :: Assertion +unit_rfc8032_test2 = do + let + Just sk = Sign.toSecretKey $ fromRight (error "impossible") . decodeBase16 $ mconcat + [ "4ccd089b28ff96da9db6c346ec114e0f" + , "5b8a319f35aba624da8cf6ed4fb8a6fb" + , "3d4017c3e843895a92b70aa74d1b7ebc" + , "9c982ccf2ec4968cc0cd55f12af4660c" + ] + msg = fromRight (error "impossible") . decodeBase16 $ "72" + sig = fromRight (error "impossible") . decodeBase16 $ mconcat + [ "92a009a9f0d4cab8720e820b5f642540" + , "a2b27b5416503f8fb3762223ebdb69da" + , "085ac1e43e15996e458f3613d0f11d8c" + , "387b2eaeb4302aeeb00d291612bb0c00" + ] + Sign.create sk msg @?= sig <> msg + +unit_rfc8032_test3 :: Assertion +unit_rfc8032_test3 = do + let + Just sk = Sign.toSecretKey $ fromRight (error "impossible") . decodeBase16 $ mconcat + [ "c5aa8df43f9f837bedb7442f31dcb7b1" + , "66d38535076f094b85ce3a2e0b4458f7" + , "fc51cd8e6218a1a38da47ed00230f058" + , "0816ed13ba3303ac5deb911548908025" + ] + msg = fromRight (error "impossible") . decodeBase16 $ "af82" + sig = fromRight (error "impossible") . decodeBase16 $ mconcat + [ "6291d657deec24024827e69c3abe01a3" + , "0ce548a284743a445e3680d7db5ac3ac" + , "18ff9b538d16f290ae67f760984dc659" + , "4a7c15e9716ed28dc027beceea1ec40a" + ] + Sign.create sk msg @?= sig <> msg + +unit_rfc8032_test1024 :: Assertion +unit_rfc8032_test1024 = do + let + Just sk = Sign.toSecretKey $ fromRight (error "impossible") . decodeBase16 $ mconcat + [ "f5e5767cf153319517630f226876b86c" + , "8160cc583bc013744c6bf255f5cc0ee5" + , "278117fc144c72340f67d0f2316e8386" + , "ceffbf2b2428c9c51fef7c597f1d426e" + ] + msg = fromRight (error "impossible") . decodeBase16 $ mconcat + [ "08b8b2b733424243760fe426a4b54908" + , "632110a66c2f6591eabd3345e3e4eb98" + , "fa6e264bf09efe12ee50f8f54e9f77b1" + , "e355f6c50544e23fb1433ddf73be84d8" + , "79de7c0046dc4996d9e773f4bc9efe57" + , "38829adb26c81b37c93a1b270b20329d" + , "658675fc6ea534e0810a4432826bf58c" + , "941efb65d57a338bbd2e26640f89ffbc" + , "1a858efcb8550ee3a5e1998bd177e93a" + , "7363c344fe6b199ee5d02e82d522c4fe" + , "ba15452f80288a821a579116ec6dad2b" + , "3b310da903401aa62100ab5d1a36553e" + , "06203b33890cc9b832f79ef80560ccb9" + , "a39ce767967ed628c6ad573cb116dbef" + , "efd75499da96bd68a8a97b928a8bbc10" + , "3b6621fcde2beca1231d206be6cd9ec7" + , "aff6f6c94fcd7204ed3455c68c83f4a4" + , "1da4af2b74ef5c53f1d8ac70bdcb7ed1" + , "85ce81bd84359d44254d95629e9855a9" + , "4a7c1958d1f8ada5d0532ed8a5aa3fb2" + , "d17ba70eb6248e594e1a2297acbbb39d" + , "502f1a8c6eb6f1ce22b3de1a1f40cc24" + , "554119a831a9aad6079cad88425de6bd" + , "e1a9187ebb6092cf67bf2b13fd65f270" + , "88d78b7e883c8759d2c4f5c65adb7553" + , "878ad575f9fad878e80a0c9ba63bcbcc" + , "2732e69485bbc9c90bfbd62481d9089b" + , "eccf80cfe2df16a2cf65bd92dd597b07" + , "07e0917af48bbb75fed413d238f5555a" + , "7a569d80c3414a8d0859dc65a46128ba" + , "b27af87a71314f318c782b23ebfe808b" + , "82b0ce26401d2e22f04d83d1255dc51a" + , "ddd3b75a2b1ae0784504df543af8969b" + , "e3ea7082ff7fc9888c144da2af58429e" + , "c96031dbcad3dad9af0dcbaaaf268cb8" + , "fcffead94f3c7ca495e056a9b47acdb7" + , "51fb73e666c6c655ade8297297d07ad1" + , "ba5e43f1bca32301651339e22904cc8c" + , "42f58c30c04aafdb038dda0847dd988d" + , "cda6f3bfd15c4b4c4525004aa06eeff8" + , "ca61783aacec57fb3d1f92b0fe2fd1a8" + , "5f6724517b65e614ad6808d6f6ee34df" + , "f7310fdc82aebfd904b01e1dc54b2927" + , "094b2db68d6f903b68401adebf5a7e08" + , "d78ff4ef5d63653a65040cf9bfd4aca7" + , "984a74d37145986780fc0b16ac451649" + , "de6188a7dbdf191f64b5fc5e2ab47b57" + , "f7f7276cd419c17a3ca8e1b939ae49e4" + , "88acba6b965610b5480109c8b17b80e1" + , "b7b750dfc7598d5d5011fd2dcc5600a3" + , "2ef5b52a1ecc820e308aa342721aac09" + , "43bf6686b64b2579376504ccc493d97e" + , "6aed3fb0f9cd71a43dd497f01f17c0e2" + , "cb3797aa2a2f256656168e6c496afc5f" + , "b93246f6b1116398a346f1a641f3b041" + , "e989f7914f90cc2c7fff357876e506b5" + , "0d334ba77c225bc307ba537152f3f161" + , "0e4eafe595f6d9d90d11faa933a15ef1" + , "369546868a7f3a45a96768d40fd9d034" + , "12c091c6315cf4fde7cb68606937380d" + , "b2eaaa707b4c4185c32eddcdd306705e" + , "4dc1ffc872eeee475a64dfac86aba41c" + , "0618983f8741c5ef68d3a101e8a3b8ca" + , "c60c905c15fc910840b94c00a0b9d0" + ] + sig = fromRight (error "impossible") . decodeBase16 $ mconcat + [ "0aab4c900501b3e24d7cdf4663326a3a" + , "87df5e4843b2cbdb67cbf6e460fec350" + , "aa5371b1508f9f4528ecea23c436d94b" + , "5e8fcd4f681e30a6ac00a9704a188a03" + ] + Sign.create sk msg @?= sig <> msg + + +unit_rfc8032_test_sha_abc :: Assertion +unit_rfc8032_test_sha_abc = do + let + Just sk = Sign.toSecretKey $ fromRight (error "impossible") . decodeBase16 $ mconcat + [ "833fe62409237b9d62ec77587520911e" + , "9a759cec1d19755b7da901b96dca3d42" + , "ec172b93ad5e563bf4932c70e1245034" + , "c35467ef2efd4d64ebf819683467e2bf" + ] + msg = fromRight (error "impossible") . decodeBase16 $ mconcat + [ "ddaf35a193617abacc417349ae204131" + , "12e6fa4e89a97ea20a9eeee64b55d39a" + , "2192992a274fc1a836ba3c23a3feebbd" + , "454d4423643ce80e2a9ac94fa54ca49f" + ] + sig = fromRight (error "impossible") . decodeBase16 $ mconcat + [ "dc2a4459e7369633a52b1bf277839a00" + , "201009a3efbf3ecb69bea2186c26b589" + , "09351fc9ac90b3ecfdfbc7c66431e030" + , "3dca179c138ac17ad9bef1177331a704" + ] + Sign.create sk msg @?= sig <> msg diff --git a/test/Test/NaCl/Stream.hs b/test/Test/NaCl/Stream.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Stream.hs @@ -0,0 +1,78 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Stream where + +import Hedgehog (Property, forAll, property, tripping) +import Test.HUnit ((@?=), Assertion) + +import Data.ByteArray.Sized (unSizedByteArray) +import Data.ByteString (ByteString) +import Data.ByteString.Base16 (decodeBase16) +import Data.Either (fromRight) + +import qualified Data.ByteString as BS +import qualified Libsodium as Na + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +import NaCl.Hash (sha256) + +import qualified NaCl.Stream as Stream + + +keySize :: R.Range Int +keySize = R.singleton $ fromIntegral Na.crypto_stream_keybytes + +nonceSize :: R.Range Int +nonceSize = R.singleton $ fromIntegral Na.crypto_stream_noncebytes + + +hprop_xor_twice :: Property +hprop_xor_twice = property $ do + keyBytes <- forAll $ G.bytes keySize + let Just key = Stream.toKey keyBytes + nonceBytes <- forAll $ G.bytes nonceSize + let Just nonce = Stream.toNonce nonceBytes + msg <- forAll $ G.bytes (R.linear 0 1_000) + tripping msg (encodeBs key nonce) (decodeBs key nonce) + where + -- We need to specify the type of the cyphertext as it is polymorphic + encodeBs key nonce msg = Stream.xor key nonce msg :: ByteString + decodeBs key nonce ct = Just $ Stream.xor key nonce ct :: Maybe ByteString + + +-- Test vector from +-- https://github.com/jedisct1/libsodium/blob/f911b56650b680ecfc5d32b11b090849fc2b5f92/test/default/stream.c + +exampleKey :: ByteString +exampleKey = BS.pack $ + [ 0x1b, 0x27, 0x55, 0x64, 0x73, 0xe9, 0x85 + , 0xd4, 0x62, 0xcd, 0x51, 0x19, 0x7a, 0x9a + , 0x46, 0xc7, 0x60, 0x09, 0x54, 0x9e, 0xac + , 0x64, 0x74, 0xf2, 0x06, 0xc4, 0xee, 0x08 + , 0x44, 0xf6, 0x83, 0x89 + ] + +exampleNonce :: ByteString +exampleNonce = BS.pack $ + [ 0x69, 0x69, 0x6e, 0xe9, 0x55, 0xb6 + , 0x2b, 0x73, 0xcd, 0x62, 0xbd, 0xa8 + , 0x75, 0xfc, 0x73, 0xd6, 0x82, 0x19 + , 0xe0, 0x03, 0x6b, 0x7a, 0x0b, 0x37 + ] + +exampleStreamSha256 :: ByteString +exampleStreamSha256 = fromRight (error "impossible") . decodeBase16 $ + "662b9d0e3463029156069b12f918691a98f7dfb2ca0393c96bbfc6b1fbd630a2" + +unit_example_generate :: Assertion +unit_example_generate = do + let Just key = Stream.toKey exampleKey + let Just nonce = Stream.toNonce exampleNonce + let stream = unSizedByteArray $ Stream.generate @4194304 key nonce :: ByteString + unSizedByteArray (sha256 stream) @?= exampleStreamSha256 diff --git a/test/Test/NaCl/Verify.hs b/test/Test/NaCl/Verify.hs new file mode 100644 --- /dev/null +++ b/test/Test/NaCl/Verify.hs @@ -0,0 +1,53 @@ +-- SPDX-FileCopyrightText: 2020 Serokell +-- +-- SPDX-License-Identifier: MPL-2.0 + +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.NaCl.Verify where + +import Hedgehog (assert, forAll, property) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testProperty) + +import Data.ByteArray.Sized (sizedByteArray) +import Data.Proxy (Proxy (Proxy)) +import GHC.TypeLits (natVal) + +import qualified Hedgehog.Gen as G +import qualified Hedgehog.Range as R + +import NaCl.Verify (eq, NaClComparable) + + +crypto_verify_test :: forall n. NaClComparable n => TestTree +crypto_verify_test = + testGroup ("crypto_verify_" <> show n) $ + [ testProperty "self random" $ property $ do + xBytes <- forAll $ G.bytes (R.singleton n) + let Just x = sizedByteArray @n xBytes + assert $ x `eq` x + , testProperty "two random" $ property $ do + xBytes <- forAll $ G.bytes (R.singleton n) + let Just x = sizedByteArray @n xBytes + yBytes <- forAll $ G.bytes (R.singleton n) + let Just y = sizedByteArray @n yBytes + assert $ (x `eq` y) == (x == y) + , testProperty "checks last" $ property $ do + prefix <- forAll $ G.bytes (R.singleton $ n - 1) + xLast <- forAll $ G.bytes (R.singleton 1) + let Just x = sizedByteArray @n (prefix <> xLast) + yLast <- forAll $ G.bytes (R.singleton 1) + let Just y = sizedByteArray @n (prefix <> yLast) + assert $ (x `eq` y) == (xLast == yLast) + ] + where + n = fromIntegral $ natVal (Proxy @n) + + +test_16 :: TestTree +test_16 = crypto_verify_test @16 + +test_32 :: TestTree +test_32 = crypto_verify_test @32