diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,102 @@ # Changelog +## 0.1.0.0 -- 2025-12-30 + +* BREAKING: remove experimental FFI code related to `x509`. See PR + [#49](https://github.com/haskell-cryptography/botan/pull/49). This code might + be restored in some form in the future, but as of now it does not compile any + more, so it is removed. The modules that are removed are: + - `Botan.Low.X509.CA` + - `Botan.Low.X509.CRL` + - `Botan.Low.X509.CSR` + - `Botan.Low.X509.DN` + - `Botan.Low.X509.Extensions` + - `Botan.Low.X509.Options` + - `Botan.Low.X509.Path` + - `Botan.Low.X509.Store` +* BREAKING: remove the `XFFI` cabal flag. See PR + [#49](https://github.com/haskell-cryptography/botan/pull/49). It has no effect + now that the experimental `x509` code is moved. +* PATCH: enable `-Wall` in addition to a number of other GHC warnings. See PR + [#52](https://github.com/haskell-cryptography/botan/pull/52). +* PATCH: use `GHC2021` as the default language. See PR + [#52](https://github.com/haskell-cryptography/botan/pull/52). +* PATCH: update documentation in the `Botan.Low.Error` module. See PR + [#62](https://github.com/haskell-cryptography/botan/pull/62). +* PATCH: update documentation in the `Botan.Low.Utility` module. See PR + [#62](https://github.com/haskell-cryptography/botan/pull/62). +* PATCH: update documentation in the `Botan.Low.Version` module. See PR + [#62](https://github.com/haskell-cryptography/botan/pull/62). +* PATCH: update documentation in the `Botan.Low.View` module. See PR + [#62](https://github.com/haskell-cryptography/botan/pull/62). +* BREAKING: `Botan.Low.PwdHash.pbkdf2` now takes a `HashName` instead of a + `MacName`. See PR + [#63](https://github.com/haskell-cryptography/botan/pull/63). +* PATCH: update documentation in the `Botan.Low.PwdHash` module. See PR + [#63](https://github.com/haskell-cryptography/botan/pull/63). +* PATCH: introduce a work-around for a bug found in + `Botan.Low.SRP6.srp6ServerSessionStep1`, which would always throw an + exception. See PR + [#65](https://github.com/haskell-cryptography/botan/pull/65). +* BREAKING: add a `DLGroupName` function argument to + `Botan.Low.SRP6.srp6ServerSessionStep2`. See PR + [#65](https://github.com/haskell-cryptography/botan/pull/65). +* PATCH: update documentation in the `Botan.Low.SRP6` module. See PR + [#65](https://github.com/haskell-cryptography/botan/pull/65). +* PATCH: update documentation in the `Botan.Low.BlockCipher` module. See PR + [#74](https://github.com/haskell-cryptography/botan/pull/74). +* BREAKING: remove the `BlockCipher128Name` type synonym from + `Botan.Low.BlockCipher`. See PR + [#74](https://github.com/haskell-cryptography/botan/pull/74). +* NON-BREAKING: in the `BlockCipher` module, add new pattern synonyms `Lion` and + `Cascade` and accompanying utility functions `lion` and `cascade` for the + "Lion" and "Cascade" ciphers respectively. See PR + [#74](https://github.com/haskell-cryptography/botan/pull/74). +* PATCH: fix an "address out of bounds" bug in `blockCipherEncryptBlocks` and + `blockCipherDecryptBlocks` that occasionally caused segfaults. See PR + [#74](https://github.com/haskell-cryptography/botan/pull/74). +* PATCH: fix an "insufficient buffer space" bug in + `Botan.Low.PubKey.Encrypt.encrypt` and `Botan.Low.PubKey.Decrypt.decrypt`. See + PR [#79](https://github.com/haskell-cryptography/botan/pull/79), PR + [#87](https://github.com/haskell-cryptography/botan/pull/87). +* PATCH: Fix an "insufficient buffer space" bug in + `Botan.Low.Cipher.cipherUpdate`. See PR + [#84](https://github.com/haskell-cryptography/botan/pull/84). +* BREAKING: rework errors. See PR + [#94](https://github.com/haskell-cryptography/botan/pull/94). + - Change `BotanErrorCode` from a type synonym to a newtype around `CInt`. + - Add a new `BotanErrorMessage` newtype around `ByteString`, and use it in + `botanErrorLastExceptionMessage`. + - Remove pattern synonyms for `BotanErrorCode`. Use `BOTAN_FFI_ERROR` from + `botan-bindings` instead. + - Hide functions related to error number handling in the internals of the + library. This includes all function names starting with `throwBotan`. + - Remove `tryBotan`, `catchBotan`, and `handleBotan`. +* BREAKING: change flags from numbers into datatypes. See PR + [#95](https://github.com/haskell-cryptography/botan/pull/95) The flag + datatypes come with new helper functions to convert the datatype into a + number. For example, `CipherInitFlags` gets a `cipherInitFlags` function. The + changed flag types are: + - `CipherInitFlags` + - `CipherUpdateFlags` + - `FPEFlags` + - `CheckKeyFlags` + - `PrivKeyExportFlags` + - `HexEncodingFlags` +* BREAKING: remove the `botan-low-bench` benchmark. See PR + [#98](https://github.com/haskell-cryptography/botan/pull/98). +* PATCH: fix a bug where some functions returning a `Bool` were returning + `False` instead of throwing an exception and vice versa. See PR + [#105](https://github.com/haskell-cryptography/botan/pull/105). These + functions are: + - `pubKeyCheckKey` + - `x509CertHostnameMatch` + - `x509IsRevoked` +* BREAKING: enable `NoFieldSelectors`. See PR + [#106](https://github.com/haskell-cryptography/botan/pull/106). As a result, + this package no longer exports field selectors for datatypes defined in the + package. + ## 0.0.2.0 -- 2025-09-17 * PATCH: update the changelog to change the release date of version 0.0.1.0 from diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,12 @@ # Welcome to botan-low -Low-level bindings to the [Botan](https://botan.randombit.net/) cryptography library. +Low-level bindings to the [Botan](https://botan.randombit.net/) cryptography +library. -> Botan's goal is to be the best option for cryptography in C++ by offering the tools necessary to implement a range of practical systems, such as TLS protocol, X.509 certificates, modern AEAD ciphers, PKCS#11 and TPM hardware support, password hashing, and post quantum crypto schemes. +> Botan's goal is to be the best option for cryptography in C++ by offering the +> tools necessary to implement a range of practical systems, such as TLS +> protocol, X.509 certificates, modern AEAD ciphers, PKCS#11 and TPM hardware +> support, password hashing, and post quantum crypto schemes. -For more information, see the [README on Github](https://github.com/haskellfoundation/botan) +For more information, see the [README on +Github](https://github.com/haskell-cryptography/botan). diff --git a/bench/Bcrypt.hs b/bench/Bcrypt.hs deleted file mode 100644 --- a/bench/Bcrypt.hs +++ /dev/null @@ -1,74 +0,0 @@ -import Test.Tasty.Bench - -import Prelude - -import Data.ByteString (ByteString(..)) -import qualified Data.ByteString as ByteString - -import qualified Botan.Bindings.RNG as Botan -import qualified Botan.Bindings.Bcrypt as Botan -import qualified Botan.Low.RNG as Botan -import qualified Botan.Low.Bcrypt as Botan -import qualified Botan.Low.Hash as Botan - - -import qualified Crypto.KDF.BCrypt as Crypton -import qualified Crypto.Hash as Crypton -import qualified Crypto.Hash.Algorithms as Crypton - -password :: ByteString -password = "Fee fi fo fum!" - -cryptonBcrypt :: Int -> IO ByteString -cryptonBcrypt factor = Crypton.hashPassword factor password - -botanBcrypt :: Int -> IO ByteString -botanBcrypt factor = do - rng <- Botan.rngInit "system" - Botan.bcryptGenerate password rng factor - - -plaintext :: ByteString -plaintext = "Fee fi fo fum! I smell the blood of an Englishman! Be he alive or be he dead, I'll grind his bones to make my bread!" - -longtext :: ByteString -longtext = ByteString.concat $ replicate 10000 $ plaintext - -cryptonHash :: ByteString -> Crypton.Digest Crypton.SHA3_512 -cryptonHash = Crypton.hash - --- TODO: hashWithName is not exposed from Botan.Low.Hash. See issue #34. -{- botanHash :: ByteString -> IO Botan.HashDigest - botanHash = Botan.hashWithName "SHA-3(512)" --} - -main :: IO () -main = defaultMain - [ bgroup "Bcrypt work factor" - [ bgroup "Crypton" - [ bench "twelve" $ nfIO $ cryptonBcrypt 12 - , bench "fourteen" $ nfIO $ cryptonBcrypt 14 - , bench "sixteen" $ nfIO $ cryptonBcrypt 16 - ] - , bgroup "Botan" - [ bench "twelve" $ nfIO $ botanBcrypt 12 - , bench "fourteen" $ nfIO $ botanBcrypt 14 - , bench "sixteen" $ nfIO $ botanBcrypt 16 - ] - ] - , bgroup "Hash" - [ bgroup "Crypton" - [ bench "password" $ nf cryptonHash password - , bench "plaintext" $ nf cryptonHash plaintext - , bench "longtext" $ nf cryptonHash longtext - ] - -- TODO: hashWithName is not exposed from Botan.Low.Hash. See issue #34. - {- , bgroup "Botan" - [ bench "password" $ nfIO $ botanHash password - , bench "plaintext" $ nfIO $ botanHash plaintext - , bench "longtext" $ nfIO $ botanHash longtext - ] - -} - ] - ] - diff --git a/botan-low.cabal b/botan-low.cabal --- a/botan-low.cabal +++ b/botan-low.cabal @@ -1,7 +1,7 @@ -cabal-version: 3.0 -name: botan-low -version: 0.0.2.0 -synopsis: Low-level Botan bindings +cabal-version: 3.0 +name: botan-low +version: 0.1.0.0 +synopsis: Low-level Botan bindings description: Welcome to botan-low @@ -12,19 +12,18 @@ > X.509 certificates, modern AEAD ciphers, PKCS#11 and TPM hardware support, > password hashing, and post quantum crypto schemes. - For more information, see the [README on Github](https://github.com/haskellfoundation/botan) + For more information, see the [README on Github](https://github.com/haskell-cryptography/botan) -author: Leo D. -maintainer: joris@well-typed.com, leo@apotheca.io -license: BSD-3-Clause -license-file: LICENSE +author: Leo D. +maintainer: joris@well-typed.com, leo@apotheca.io +license: BSD-3-Clause +license-file: LICENSE copyright: Copyright (c) 2023-2024, Apotheca Labs Copyright (c) 2024-2025, Haskell Foundation -build-type: Simple -category: Cryptography - +build-type: Simple +category: Cryptography -- NOTE: Use data-files instead, if this is inappropriate -- NOTE: This causes a soft error: -- Ignoring trailing fields after sections: "extra-source-files" @@ -40,53 +39,64 @@ README.md tested-with: - GHC ==9.2 || ==9.4 || ==9.6 || ==9.8 || ==9.10 || ==9.12 + ghc ==9.2 || ==9.4 || ==9.6 || ==9.8 || ==9.10 || ==9.12 source-repository head - type: git - location: https://github.com/haskellfoundation/botan - subdir: botan-low + type: git + location: https://github.com/haskell-cryptography/botan + subdir: botan-low source-repository this - type: git - location: https://github.com/haskellfoundation/botan - subdir: botan-low - tag: botan-low-0.0.2.0 + type: git + location: https://github.com/haskell-cryptography/botan + subdir: botan-low + tag: botan-low-0.1.0.0 -flag XFFI - description: Enable experimental / upstream ffi support - manual: True - default: False +common warnings + ghc-options: + -Wall + -Wcompat + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wpartial-fields + -Widentities + -Wredundant-constraints + -Wmissing-export-lists + -Wno-unticked-promoted-constructors + -Wunused-packages + -Wmissing-deriving-strategies -library - hs-source-dirs: src - default-language: Haskell2010 +common language + default-language: GHC2021 default-extensions: - ExistentialQuantification - NoImplicitPrelude - OverloadedStrings + DerivingStrategies + DuplicateRecordFields + LambdaCase + NoFieldSelectors + OverloadedRecordDot PatternSynonyms - RankNTypes - ScopedTypeVariables - TupleSections - TypeApplications + RoleAnnotations + ViewPatterns +library + import: warnings, language + hs-source-dirs: src exposed-modules: Botan.Low.Bcrypt Botan.Low.BlockCipher Botan.Low.Cipher Botan.Low.Error Botan.Low.FPE - Botan.Low.Hash Botan.Low.HOTP + Botan.Low.Hash Botan.Low.KDF Botan.Low.KeyWrap Botan.Low.MAC Botan.Low.MPI Botan.Low.PubKey - Botan.Low.PubKey.Decrypt Botan.Low.PubKey.DH Botan.Low.PubKey.DSA + Botan.Low.PubKey.Decrypt Botan.Low.PubKey.ECDH Botan.Low.PubKey.ECDSA Botan.Low.PubKey.Ed25519 @@ -95,8 +105,8 @@ Botan.Low.PubKey.KeyAgreement Botan.Low.PubKey.KeyEncapsulation Botan.Low.PubKey.RSA - Botan.Low.PubKey.Sign Botan.Low.PubKey.SM2 + Botan.Low.PubKey.Sign Botan.Low.PubKey.Verify Botan.Low.PubKey.X25519 Botan.Low.PwdHash @@ -110,803 +120,77 @@ Botan.Low.ZFEC other-modules: + Botan.Low.Error.Internal + Botan.Low.Internal.ByteString + Botan.Low.Internal.String Botan.Low.Make - Botan.Low.Prelude Botan.Low.Remake - Paths_botan_low - autogen-modules: Paths_botan_low build-depends: - , base >=4.16 && <4.22 - , botan-bindings ^>=0.0 || ^>=0.1 - , bytestring >=0.11 && <0.13 - , deepseq >=1.1 && <2 - , text >=1.2 && <1.3 || >=2.0 && <2.2 - - if flag(xffi) - -- Botan.Low.X509.OCSP - exposed-modules: - Botan.Low.X509.CA - Botan.Low.X509.CRL - Botan.Low.X509.CSR - Botan.Low.X509.DN - Botan.Low.X509.Extensions - Botan.Low.X509.Options - Botan.Low.X509.Path - Botan.Low.X509.Store - - cpp-options: -DXFFI - --- --- Unit tests --- - -test-suite botan-low-bcrypt-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/BcryptSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-block-cipher-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/BlockCipherSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-cipher-tests - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - type: exitcode-stdio-1.0 - main-is: Botan/Low/CipherSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-fpe-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/FPESpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-hash-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/HashSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-hotp-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/HOTPSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-kdf-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/KDFSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-keywrap-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/KeyWrapSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-mac-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/MACSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-mpi-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/MPISpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKeySpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-decrypt-tests - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/DecryptSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-dh-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/DHSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-dsa-tests - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/DSASpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-ecdh-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/ECDHSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-ecdsa-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/ECDSASpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-ed25519-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/Ed25519Spec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-elgamal-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/ElGamalSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-encrypt-tests - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/EncryptSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-keyagreement-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/KeyAgreementSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-keyencapsulation-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/KeyEncapsulationSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-rsa-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/RSASpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-sign-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/SignSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-sm2-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/SM2Spec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-verify-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/VerifySpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-pubkey-x25519-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/PubKey/X25519Spec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - --- TODO: Pubkey folder tests - -test-suite botan-low-pwdhash-tests - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - type: exitcode-stdio-1.0 - main-is: Botan/Low/PwdHashSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-rng-tests - if os(osx) - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - - type: exitcode-stdio-1.0 - main-is: Botan/Low/RNGSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-srp6-tests - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - type: exitcode-stdio-1.0 - main-is: Botan/Low/SRP6Spec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-totp-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/TOTPSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-utility-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/UtilitySpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - -test-suite botan-low-x509-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/X509Spec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings + base >=4.16 && <4.22, + botan-bindings ^>=0.2, + bytestring >=0.11 && <0.13, + deepseq >=1.1 && <2, + text >=1.2 && <1.3 || >=2.0 && <2.2, -test-suite botan-low-zfec-tests - type: exitcode-stdio-1.0 - main-is: Botan/Low/ZFECSpec.hs - hs-source-dirs: test/ +test-suite test + import: warnings, language + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test/ build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck + QuickCheck, + async, + base, + botan-bindings, + botan-low, + bytestring, + containers, + hspec, + tasty, + tasty-hspec, + tasty-hunit, + tasty-quickcheck, + text, other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - --- --- Benchmarks --- - -benchmark botan-low-bench - hs-source-dirs: bench - main-is: Bcrypt.hs - type: exitcode-stdio-1.0 - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , crypton - , tasty-bench - - default-language: Haskell2010 - default-extensions: - NoImplicitPrelude - OverloadedStrings - - ghc-options: -with-rtsopts=-A32m + Test.Botan.Low.Bcrypt + Test.Botan.Low.BlockCipher + Test.Botan.Low.Cipher + Test.Botan.Low.FPE + Test.Botan.Low.HOTP + Test.Botan.Low.Hash + Test.Botan.Low.KDF + Test.Botan.Low.KeyWrap + Test.Botan.Low.MAC + Test.Botan.Low.MPI + Test.Botan.Low.PubKey + Test.Botan.Low.PubKey.DH + Test.Botan.Low.PubKey.DSA + Test.Botan.Low.PubKey.Decrypt + Test.Botan.Low.PubKey.ECDH + Test.Botan.Low.PubKey.ECDSA + Test.Botan.Low.PubKey.Ed25519 + Test.Botan.Low.PubKey.ElGamal + Test.Botan.Low.PubKey.Encrypt + Test.Botan.Low.PubKey.KeyAgreement + Test.Botan.Low.PubKey.KeyEncapsulation + Test.Botan.Low.PubKey.RSA + Test.Botan.Low.PubKey.SM2 + Test.Botan.Low.PubKey.Sign + Test.Botan.Low.PubKey.Verify + Test.Botan.Low.PubKey.X25519 + Test.Botan.Low.PwdHash + Test.Botan.Low.RNG + Test.Botan.Low.SRP6 + Test.Botan.Low.SRP6.Example + Test.Botan.Low.TOTP + Test.Botan.Low.Utility + Test.Botan.Low.Version + Test.Botan.Low.X509 + Test.Botan.Low.ZFEC + Test.Util.ByteString + Test.Util.Hspec - if impl(ghc >=8.6) - ghc-options: -fproc-alignment=64 + other-modules: Paths_botan_low + autogen-modules: Paths_botan_low diff --git a/src/Botan/Low/Bcrypt.hs b/src/Botan/Low/Bcrypt.hs --- a/src/Botan/Low/Bcrypt.hs +++ b/src/Botan/Low/Bcrypt.hs @@ -11,41 +11,40 @@ Generate and validate Bcrypt password hashes -} -module Botan.Low.Bcrypt -( +module Botan.Low.Bcrypt ( --- * Bcrypt --- $introduction + -- * Bcrypt + -- $introduction --- * Usage --- $usage + -- * Usage + -- $usage --- * Generate a bcrypt digest - bcryptGenerate + -- * Generate a bcrypt digest + bcryptGenerate --- * Validate a bcrypt digest -, bcryptIsValid + -- * Validate a bcrypt digest + , bcryptIsValid --- * Work factor -, BcryptWorkFactor(..) -, pattern BcryptFast -, pattern BcryptGood -, pattern BcryptStrong -, BcryptPassword(..) -, BcryptDigest(..) + -- * Work factor + , BcryptWorkFactor + , pattern BcryptFast + , pattern BcryptGood + , pattern BcryptStrong + , BcryptPassword + , BcryptDigest -) where + ) where +import Botan.Bindings.Bcrypt +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.RNG +import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString - -import Botan.Bindings.Bcrypt - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.RNG - -import Data.ByteString.Internal as ByteString +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable {- $introduction @@ -151,10 +150,11 @@ False if the combination is not valid (but otherwise well formed), and otherwise throws an exception on error. -} -bcryptIsValid - :: BcryptPassword -- ^ __password__: The password to check against - -> BcryptDigest -- ^ __hash__: The stored hash to check against - -> IO Bool -bcryptIsValid password hash = asCString password $ \ passwordPtr -> do - asCString hash $ \ hashPtr -> do - throwBotanCatchingSuccess $ botan_bcrypt_is_valid (ConstPtr passwordPtr) (ConstPtr hashPtr) +bcryptIsValid :: + BcryptPassword -- ^ __password__: The password to check against + -> BcryptDigest -- ^ __hash__: The stored hash to check against + -> IO Bool +bcryptIsValid password hash = + asCString password $ \ passwordPtr -> + asCString hash $ \ hashPtr -> + throwBotanCatchingInvalidVerifier $ botan_bcrypt_is_valid (ConstPtr passwordPtr) (ConstPtr hashPtr) diff --git a/src/Botan/Low/BlockCipher.hs b/src/Botan/Low/BlockCipher.hs --- a/src/Botan/Low/BlockCipher.hs +++ b/src/Botan/Low/BlockCipher.hs @@ -8,179 +8,456 @@ Stability : experimental Portability : POSIX -This is a ‘raw’ interface to ECB mode block ciphers. -Most applications want the higher level cipher API which provides authenticated encryption. -This API exists as an escape hatch for applications which need to implement custom primitives using a PRP. +This module is based on the [Block +Ciphers](https://botan.randombit.net/handbook/api_ref/ffi.html#block-ciphers) +section of the C Botan FFI documentation, and on the [Block +Ciphers](https://botan.randombit.net/handbook/api_ref/block_cipher.html) section +of the C++ API reference. -} -module Botan.Low.BlockCipher -( - --- * Block ciphers --- $introduction - --- * Usage --- $usage - - BlockCipher(..) -, BlockCipherName(..) -, BlockCipher128Name(..) -, BlockCipherKey(..) -, BlockCipherCiphertext(..) -, withBlockCipher -, blockCipherInit -, blockCipherDestroy -, blockCipherName -, blockCipherBlockSize -, blockCipherGetKeyspec -, blockCipherSetKey -, blockCipherEncryptBlocks -, blockCipherDecryptBlocks -, blockCipherClear - --- * 64-bit block ciphers - -, pattern Blowfish -, pattern CAST128 -, pattern DES -, pattern TripleDES -, pattern GOST_28147_89 -, pattern IDEA - --- * 128-bit block ciphers - -, pattern AES128 -, pattern AES192 -, pattern AES256 -, pattern ARIA128 -, pattern ARIA192 -, pattern ARIA256 -, pattern Camellia128 -, pattern Camellia192 -, pattern Camellia256 -, pattern Noekeon -, pattern SEED -, pattern SM4 -, pattern Serpent -, pattern Twofish - --- * 256-bit block ciphers - -, pattern SHACAL2 - --- * 512-bit block ciphers - -, pattern Threefish512 - --- * Convenience - -, blockCiphers -, blockCipher128s -, allBlockCiphers +{-# LANGUAGE OverloadedStrings #-} -) where +module Botan.Low.BlockCipher ( + -- * Introduction + -- $introduction + -- * Example usage + -- $usage + -- * Block ciphers + BlockCipher(..) + , BlockCipherName + , BlockCipherKey + , BlockCipherCiphertext + , withBlockCipher + , blockCipherInit + , blockCipherDestroy + , blockCipherName + , blockCipherBlockSize + , blockCipherGetKeyspec + , blockCipherSetKey + , blockCipherEncryptBlocks + , blockCipherDecryptBlocks + , blockCipherClear + -- * Available ciphers + -- $available-ciphers + , pattern AES128 + , pattern AES192 + , pattern AES256 + , pattern ARIA128 + , pattern ARIA192 + , pattern ARIA256 + , pattern Blowfish + , pattern Camellia128 + , pattern Camellia192 + , pattern Camellia256 + , pattern Cascade + , cascade + , pattern CAST128 + , pattern DES + , pattern TripleDES + , pattern GOST_28147_89 + , pattern IDEA + , pattern Lion + , lion + , pattern Noekeon + , pattern SEED + , pattern Serpent + , pattern SHACAL2 + , pattern SM4 + , pattern Threefish512 + , pattern Twofish + -- ** Convenience + , blockCiphers + , blockCipher128s + , allBlockCiphers + ) where -import qualified Data.ByteString as ByteString +import Botan.Bindings.BlockCipher +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Low.Error.Internal +import Botan.Low.Hash +import Botan.Low.Internal.ByteString +import Botan.Low.Internal.String +import Botan.Low.Make +import Botan.Low.Remake +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr -import Botan.Bindings.BlockCipher +{- $setup +>>> import Control.Monad +>>> import Botan.Low.Hash +-} -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake +{------------------------------------------------------------------------------- + Introduction +-------------------------------------------------------------------------------} {- $introduction -A `block cipher` is a deterministic, cryptographic primitive suitable for +A /block cipher/ is a deterministic, cryptographic primitive suitable for encrypting or decrypting a single, fixed-size block of data at a time. Block ciphers are used as building blocks for more complex cryptographic operations. If you are looking to encrypt user data, you are probably looking for -`Botan.Low.Cipher` instead. - +"Botan.Low.Cipher" instead. -} +{------------------------------------------------------------------------------- + Example usage +-------------------------------------------------------------------------------} + {- $usage -Unless you need a specific block cipher, it is strongly recommended that you use the `AES256` algorithm. +Unless you need a specific block cipher, it is strongly recommended that you use +the 'AES256' algorithm. -> import Botan.Low.BlockCipher -> blockCipher <- blockCipherInit AES256 +>>> :{ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +import Botan.Low.BlockCipher +import Botan.Low.RNG +import Control.Exception +import Data.ByteString as BS +:} -To use a block cipher, we first need to generate (if we haven't already) a secret key. +For this example, we will use the 'AES256' algorithm. To use a block cipher, we +first need a secret key of the appropriate length. Such keys should be generated +securely, but to keep it simple in this example, we will just use a random +number +generator to generate a secret key. -> import Botan.Low.RNG -> rng <- rngInit "user" -> -- We will use the maximum key size; AES256 keys are always 16 bytes -> (_,keySize,_) <- blockCipherGetKeyspec blockCipher -> -- Block cipher keys are randomly generated -> key <- rngGet rng keySize +>>> :{ +generateKey :: BlockCipher -> IO ByteString +generateKey blockCipher = do + rng <- rngInit "user" + (_,keySize,_) <- blockCipherGetKeyspec blockCipher + key <- rngGet rng keySize + pure key +:} -After the key is generated, we must set it as the block cipher key: +We can now initialise a block cipher object and set its secret key. -> blockCipherSetKey blockCipher key +>>> :{ +initBlockCipher :: IO BlockCipher +initBlockCipher = do + blockCipher <- blockCipherInit AES256 + key <- generateKey blockCipher + blockCipherSetKey blockCipher key + pure blockCipher +:} +Using the initialised block cipher, we can now encrypt a message. To encrypt a message, it must be a multiple of the block size. +To decrypt a message, simply reverse the process. As a sanity check, +we show that decryption after encryption yields the original message -> blockSize <- blockCipherBlockSize blockCipher -> -- AES256 block size is always 16 bytes -> message = "0000DEADBEEF0000" :: ByteString -> ciphertext <- blockCipherEncryptBlocks blockCipher message +>>> :{ +roundtrip :: BlockCipher -> ByteString -> IO () +roundtrip blockCipher message = do + ciphertext <- blockCipherEncryptBlocks blockCipher message + plaintext <- blockCipherDecryptBlocks blockCipher ciphertext + print $ message == plaintext +:} -To decrypt a message, simply reverse the process: +Now we tie together the program. We initialise the block cipher +(and set its secret key). Then, we generate a message, and check that it +roundtrips through the encryption and decryption functions. -> plaintext <- blockCipherDecryptBlocks blockCipher ciphertext -> message == plaintext -- True +>>> :{ +main :: IO () +main = do + blockCipher <- initBlockCipher + blockSize <- blockCipherBlockSize blockCipher + -- AES256 block size is always 16 bytes + let message = "0000DEADBEEF0000" + assert (BS.length message == blockSize) $ pure () + roundtrip blockCipher message +:} +All that is left to do is run the program. + +>>> main +True + -} +{------------------------------------------------------------------------------- + Block ciphers +-------------------------------------------------------------------------------} + -- | A mutable block cipher object newtype BlockCipher = MkBlockCipher { getBlockCipherForeignPtr :: ForeignPtr BotanBlockCipherStruct } -newBlockCipher :: BotanBlockCipher -> IO BlockCipher withBlockCipher :: BlockCipher -> (BotanBlockCipher -> IO a) -> IO a -- | Destroy a block cipher object immediately blockCipherDestroy :: BlockCipher -> IO () createBlockCipher :: (Ptr BotanBlockCipher -> IO CInt) -> IO BlockCipher -(newBlockCipher, withBlockCipher, blockCipherDestroy, createBlockCipher, _) +(withBlockCipher, blockCipherDestroy, createBlockCipher) = mkBindings - MkBotanBlockCipher runBotanBlockCipher - MkBlockCipher getBlockCipherForeignPtr + MkBotanBlockCipher (.runBotanBlockCipher) + MkBlockCipher (.getBlockCipherForeignPtr) botan_block_cipher_destroy --- | 128-bit block cipher name type -type BlockCipher128Name = BlockCipherName -pattern AES128 - , AES192 - , AES256 - , ARIA128 - , ARIA192 - , ARIA256 - , Camellia128 - , Camellia192 - , Camellia256 - , Noekeon - , SEED - , SM4 - , Serpent - , Twofish - :: BlockCipher128Name +-- | A block cipher secret key +type BlockCipherKey = ByteString -pattern AES128 = BOTAN_BLOCK_CIPHER_128_AES_128 -pattern AES192 = BOTAN_BLOCK_CIPHER_128_AES_192 -pattern AES256 = BOTAN_BLOCK_CIPHER_128_AES_256 -pattern ARIA128 = BOTAN_BLOCK_CIPHER_128_ARIA_128 -pattern ARIA192 = BOTAN_BLOCK_CIPHER_128_ARIA_192 -pattern ARIA256 = BOTAN_BLOCK_CIPHER_128_ARIA_256 -pattern Camellia128 = BOTAN_BLOCK_CIPHER_128_CAMELLIA_128 -pattern Camellia192 = BOTAN_BLOCK_CIPHER_128_CAMELLIA_192 -pattern Camellia256 = BOTAN_BLOCK_CIPHER_128_CAMELLIA_256 -pattern Noekeon = BOTAN_BLOCK_CIPHER_128_NOEKEON -pattern SEED = BOTAN_BLOCK_CIPHER_128_SEED -pattern SM4 = BOTAN_BLOCK_CIPHER_128_SM4 -pattern Serpent = BOTAN_BLOCK_CIPHER_128_SERPENT -pattern Twofish = BOTAN_BLOCK_CIPHER_128_TWOFISH +-- | A block cipher ciphertext +type BlockCipherCiphertext = ByteString +-- | Initialize a block cipher object +blockCipherInit :: + BlockCipherName -- ^ __cipher_name__ + -> IO BlockCipher -- ^ __bc__ +blockCipherInit = mkCreateObjectCString createBlockCipher botan_block_cipher_init + +-- | Reinitializes a block cipher +-- +-- You must call blockCipherSetKey in order to use the block cipher again. +blockCipherClear :: + BlockCipher -- ^ __bc__: The cipher object + -> IO () +blockCipherClear = mkWithObjectAction withBlockCipher botan_block_cipher_clear + +-- | Set the key for a block cipher +-- +-- Throws an error if the key is not valid. +blockCipherSetKey :: + BlockCipher -- ^ __bc__: The cipher object + -> BlockCipherKey -- ^ __key[]__: A cipher key + -> IO () +blockCipherSetKey = mkSetBytesLen withBlockCipher $ \cipher key -> + botan_block_cipher_set_key cipher (ConstPtr key) + +-- | Return the block size of a block cipher. +blockCipherBlockSize :: + BlockCipher -- ^ __bc__: The cipher object + -> IO Int +blockCipherBlockSize = mkGetIntCode withBlockCipher botan_block_cipher_block_size + +-- | Encrypt one or more blocks with a block cipher +-- +-- Precondition: the length of the plaintext should be a multiple of the block +-- size, or this function throws an error. +blockCipherEncryptBlocks :: + BlockCipher -- ^ __bc__: The cipher object + -> ByteString -- ^ __in[]__: The plaintext + -> IO BlockCipherCiphertext -- ^ __out[]__: The ciphertext +blockCipherEncryptBlocks blockCipher bytes = do + blockSize <- blockCipherBlockSize blockCipher + let (numBlocks,remBytes) = BS.length bytes `quotRem` blockSize + when (remBytes /= 0) $ + error "blockCipherEncryptBlocks: length of the input plaintext is not a\ + \multiple of the block size" + go (fromIntegral numBlocks) + where + go :: CSize -> IO BlockCipherCiphertext + go numBlocks = + withBlockCipher blockCipher $ \ blockCipherPtr -> + asBytesLen bytes $ \ bytesPtr bytesLen -> + allocBytes (fromIntegral bytesLen) $ \ destPtr -> + throwBotanIfNegative_ $ botan_block_cipher_encrypt_blocks + blockCipherPtr + (ConstPtr bytesPtr) + destPtr + numBlocks + +-- | Decrypt one or more blocks with a block cipher. +-- +-- Precondition: the length of the ciphertext should be a multiple of the block size, +-- or this function throws an error. +-- +-- If an incorrect key was set, the content of the decrypted plaintext is +-- unspecified. +blockCipherDecryptBlocks :: + BlockCipher -- ^ __bc__: The cipher object + -> BlockCipherCiphertext -- ^ __in[]__: The ciphertext + -> IO ByteString -- ^ __out[]__: The plaintext +blockCipherDecryptBlocks blockCipher bytes = do + blockSize <- blockCipherBlockSize blockCipher + let (numBlocks,remBytes) = BS.length bytes `quotRem` blockSize + when (remBytes /= 0) $ + error "blockCipherDecryptBlocks: length of the input plaintext is not a\ + \multiple of the block size" + go (fromIntegral numBlocks) + where + go :: CSize -> IO ByteString + go numBlocks = + withBlockCipher blockCipher $ \ blockCipherPtr -> + asBytesLen bytes $ \ bytesPtr bytesLen -> + allocBytes (fromIntegral bytesLen) $ \ destPtr -> + throwBotanIfNegative_ $ botan_block_cipher_decrypt_blocks + blockCipherPtr + (ConstPtr bytesPtr) + destPtr + numBlocks + +-- | Get the name of a block cipher. +-- +-- This function is not guaranteed to return the same exact value as used to initialize the context. +blockCipherName :: + BlockCipher -- ^ __bc__ + -> IO BlockCipherName -- ^ __name__ +blockCipherName = mkGetCString withBlockCipher botan_block_cipher_name + +-- | Get the key specification of a block cipher +-- +-- Returns the minimum, maximum, and modulo of valid keys. +blockCipherGetKeyspec :: + BlockCipher -- ^ __bc__ + -> IO (Int,Int,Int) -- ^ __(min,max,mod)__ +blockCipherGetKeyspec = mkGetSizes3 withBlockCipher botan_block_cipher_get_keyspec + +{------------------------------------------------------------------------------- + Available ciphers +-------------------------------------------------------------------------------} + +{- $available-ciphers + +A number of algorithms are available to be used as block ciphers. An algorithm +is selected by passing the /algorithm specification name/ of the algorithm as a +string to the block cipher functions. In some cases an algorithm specification +name is just the /algorithm name/, like @"AES-128"@. In other cases an algorithm +specification name is a combination of an algorithm name paired with some +parameters, such as @"Cascade(Serpent, AES-256)"@ where @"Cascade"@ is the +algorithm name followed by a 2-tuple of parameters. Pattern synonyms are +included for each available /algorithm name/. Where necessary, such as in the +@"Cascade"@ case, these algorithm names should be manually extended to full +algorithm specification names, or by using utility functions like 'cascade' that +this module also provides. + +WARNING: 64-bit block ciphers should be avoided. + +WARNING: the @Kuznyechik@ block ciphier is not included because its security is +disputed. + +See the [Available +Ciphers](https://botan.randombit.net/handbook/api_ref/block_cipher.html#available-ciphers) +section of the C++ API reference for more information about available ciphers. + +Each algorithm expects a certain size of block to encrypt or decrypt. For the +available algorithms, these block sizes in number of bits are listed below. For +algorithms that require parameters, the block size may vary depending on the +parameters. For the examples below, we pick some arbitrary parameters. + +>>> :{ +forM_ allBlockCiphers $ \name -> do + let name' = + if name == Cascade + then cascade Serpent AES256 + else if name == Lion + then lion SHA1 "RC4" (Just 64) + else name + blockCipher <- blockCipherInit name' + sz <- blockCipherBlockSize blockCipher + print (name, sz * 8) +:} +("AES-128",128) +("AES-192",128) +("AES-256",128) +("ARIA-128",128) +("ARIA-192",128) +("ARIA-256",128) +("Camellia-128",128) +("Camellia-192",128) +("Camellia-256",128) +("Noekeon",128) +("SEED",128) +("Serpent",128) +("SM4",128) +("Twofish",128) +("Blowfish",64) +("Cascade",128) +("CAST-128",64) +("DES",64) +("TripleDES",64) +("GOST-28147-89",64) +("IDEA",64) +("Lion",512) +("SHACAL2",256) +("Threefish-512",512) + +-} + +-- | Block cipher name type +type BlockCipherName = ByteString + +pattern + AES128 + , AES192 + , AES256 + , ARIA128 + , ARIA192 + , ARIA256 + , Blowfish + , Camellia128 + , Camellia192 + , Camellia256 + , Cascade + , CAST128 + , DES + , TripleDES + , GOST_28147_89 + , IDEA + , Lion + , Noekeon + , SEED + , Serpent + , SHACAL2 + , SM4 + , Threefish512 + , Twofish + :: BlockCipherName + +pattern AES128 = BOTAN_BLOCK_CIPHER_AES_128 +pattern AES192 = BOTAN_BLOCK_CIPHER_AES_192 +pattern AES256 = BOTAN_BLOCK_CIPHER_AES_256 +pattern ARIA128 = BOTAN_BLOCK_CIPHER_ARIA_128 +pattern ARIA192 = BOTAN_BLOCK_CIPHER_ARIA_192 +pattern ARIA256 = BOTAN_BLOCK_CIPHER_ARIA_256 +pattern Blowfish = BOTAN_BLOCK_CIPHER_BLOWFISH +pattern Camellia128 = BOTAN_BLOCK_CIPHER_CAMELLIA_128 +pattern Camellia192 = BOTAN_BLOCK_CIPHER_CAMELLIA_192 +pattern Camellia256 = BOTAN_BLOCK_CIPHER_CAMELLIA_256 +pattern Cascade = BOTAN_BLOCK_CIPHER_CASCADE + +-- | +-- >>> cascade Serpent AES256 +-- "Cascade(Serpent,AES-256)" +cascade :: BlockCipherName -> BlockCipherName -> BlockCipherName +cascade ciph1 ciph2 = Cascade /$ ciph1 <> "," <> ciph2 + +pattern CAST128 = BOTAN_BLOCK_CIPHER_CAST_128 +pattern DES = BOTAN_BLOCK_CIPHER_DES +pattern TripleDES = BOTAN_BLOCK_CIPHER_TRIPLEDES +pattern GOST_28147_89 = BOTAN_BLOCK_CIPHER_GOST_28147_89 +pattern IDEA = BOTAN_BLOCK_CIPHER_IDEA +pattern Lion = BOTAN_BLOCK_CIPHER_LION + +-- | +-- >>> lion SHA1 "RC4" Nothing +-- "Lion(SHA-1,RC4)" +-- +-- >>> lion SHA1 "RC4" (Just 64) +-- "Lion(SHA-1,RC4,64)" +lion :: HashName -> ByteString -> Maybe Word -> BlockCipherName +lion hashFun streamCiph optBlockSize = + Lion /$ hashFun <> "," <> streamCiph <> case optBlockSize of + Nothing -> "" + Just blockSize -> "," <> BSC.pack (show blockSize) + +pattern Noekeon = BOTAN_BLOCK_CIPHER_NOEKEON +pattern SEED = BOTAN_BLOCK_CIPHER_SEED +pattern Serpent = BOTAN_BLOCK_CIPHER_SERPENT +pattern SHACAL2 = BOTAN_BLOCK_CIPHER_SHACAL2 +pattern SM4 = BOTAN_BLOCK_CIPHER_SM4 +pattern Threefish512 = BOTAN_BLOCK_CIPHER_THREEFISH_512 +pattern Twofish = BOTAN_BLOCK_CIPHER_TWOFISH + +blockCipher128s :: [BlockCipherName] blockCipher128s = [ AES128 , AES192 @@ -193,144 +470,24 @@ , Camellia256 , Noekeon , SEED - , SM4 , Serpent + , SM4 , Twofish ] --- | Block cipher name type -type BlockCipherName = ByteString - -pattern Blowfish - , CAST128 - , DES - , TripleDES - , GOST_28147_89 - , IDEA - , SHACAL2 - , Threefish512 - :: BlockCipherName - -pattern Blowfish = BOTAN_BLOCK_CIPHER_BLOWFISH -pattern CAST128 = BOTAN_BLOCK_CIPHER_CAST_128 -pattern DES = BOTAN_BLOCK_CIPHER_DES -pattern TripleDES = BOTAN_BLOCK_CIPHER_TRIPLEDES -pattern GOST_28147_89 = BOTAN_BLOCK_CIPHER_GOST_28147_89 -pattern IDEA = BOTAN_BLOCK_CIPHER_IDEA -pattern SHACAL2 = BOTAN_BLOCK_CIPHER_SHACAL2 -pattern Threefish512 = BOTAN_BLOCK_CIPHER_THREEFISH_512 - +blockCiphers :: [BlockCipherName] blockCiphers = [ Blowfish + , Cascade , CAST128 , DES , TripleDES , GOST_28147_89 , IDEA + , Lion , SHACAL2 , Threefish512 ] allBlockCiphers :: [BlockCipherName] allBlockCiphers = blockCipher128s ++ blockCiphers - --- | A block cipher secret key -type BlockCipherKey = ByteString - --- | A block cipher ciphertext -type BlockCipherCiphertext = ByteString - --- | Initialize a block cipher object -blockCipherInit - :: BlockCipherName -- ^ __cipher_name__ - -> IO BlockCipher -- ^ __bc__ -blockCipherInit = mkCreateObjectCString createBlockCipher botan_block_cipher_init - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withBlockCipherInit :: BlockCipherName -> (BlockCipher -> IO a) -> IO a -withBlockCipherInit = mkWithTemp1 blockCipherInit blockCipherDestroy - -{- | -Reinitializes a block cipher - -You must call blockCipherSetKey in order to use the block cipher again. --} -blockCipherClear - :: BlockCipher -- ^ __bc__: The cipher object - -> IO () -blockCipherClear = mkWithObjectAction withBlockCipher botan_block_cipher_clear - -{- | -Set the key for a block cipher - -Throws an error if the key is not valid. --} -blockCipherSetKey - :: BlockCipher -- ^ __bc__: The cipher object - -> BlockCipherKey -- ^ __key[]__: A cipher key - -> IO () -blockCipherSetKey = mkSetBytesLen withBlockCipher (\ cipher key -> botan_block_cipher_set_key cipher (ConstPtr key)) - --- | Return the block size of a block cipher. -blockCipherBlockSize - :: BlockCipher -- ^ __bc__: The cipher object - -> IO Int -blockCipherBlockSize = mkGetIntCode withBlockCipher botan_block_cipher_block_size - -{- | -Encrypt one or more blocks with a block cipher - -The plaintext length should be a multiple of the block size. --} -blockCipherEncryptBlocks - :: BlockCipher -- ^ __bc__: The cipher object - -> ByteString -- ^ __in[]__: The plaintext - -> IO BlockCipherCiphertext -- ^ __out[]__: The ciphertext -blockCipherEncryptBlocks blockCipher bytes = withBlockCipher blockCipher $ \ blockCipherPtr -> do - asBytesLen bytes $ \ bytesPtr bytesLen -> do - allocBytes (fromIntegral bytesLen) $ \ destPtr -> do - throwBotanIfNegative_ $ botan_block_cipher_encrypt_blocks - blockCipherPtr - (ConstPtr bytesPtr) - destPtr - bytesLen - -{- | -Decrypt one or more blocks with a block cipher. - -The ciphertext length should be a multiple of the block size. - -If an incorrect key was set, the content of the decrypted plaintext is unspecified. --} -blockCipherDecryptBlocks - :: BlockCipher -- ^ __bc__: The cipher object - -> BlockCipherCiphertext -- ^ __in[]__: The ciphertext - -> IO ByteString -- ^ __out[]__: The plaintext -blockCipherDecryptBlocks blockCipher bytes = withBlockCipher blockCipher $ \ blockCipherPtr -> do - asBytesLen bytes $ \ bytesPtr bytesLen -> do - allocBytes (fromIntegral bytesLen) $ \ destPtr -> do - throwBotanIfNegative_ $ botan_block_cipher_decrypt_blocks - blockCipherPtr - (ConstPtr bytesPtr) - destPtr - bytesLen - -{- | -Get the name of a block cipher. - -This function is not guaranteed to return the same exact value as used to initialize the context. --} -blockCipherName - :: BlockCipher -- ^ __bc__ - -> IO BlockCipherName -- ^ __name__ -blockCipherName = mkGetCString withBlockCipher botan_block_cipher_name - -{- | -Get the key specification of a block cipher - -Returns the minimum, maximum, and modulo of valid keys. --} -blockCipherGetKeyspec - :: BlockCipher -- ^ __bc__ - -> IO (Int,Int,Int) -- ^ __(min,max,mod)__ -blockCipherGetKeyspec = mkGetSizes3 withBlockCipher botan_block_cipher_get_keyspec diff --git a/src/Botan/Low/Cipher.hs b/src/Botan/Low/Cipher.hs --- a/src/Botan/Low/Cipher.hs +++ b/src/Botan/Low/Cipher.hs @@ -14,101 +14,105 @@ repeatedly to encrypt an entire message. -} -module Botan.Low.Cipher -( - --- * Cipher --- $introduction - --- * Usage --- $usage +{-# LANGUAGE OverloadedStrings #-} - Cipher(..) -, CipherName(..) -, CipherKey(..) -, CipherNonce(..) -, CipherInitFlags(..) -, pattern MaskDirection -, pattern Encrypt -, pattern Decrypt -, CipherUpdateFlags(..) -, pattern CipherUpdate -, pattern CipherFinal -, withCipher -, cipherInit -, cipherDestroy -, cipherName -, cipherOutputLength -, cipherValidNonceLength -, cipherGetTagLength -, cipherGetDefaultNonceLength -, cipherGetUpdateGranularity -, cipherGetIdealUpdateGranularity -, cipherQueryKeylen -, cipherGetKeyspec -, cipherSetKey -, cipherReset -, cipherSetAssociatedData -, cipherStart -, cipherUpdate -, cipherEncrypt -, cipherDecrypt -, cipherClear +module Botan.Low.Cipher ( --- * Cipher modes -, CipherMode(..) -, cbcMode -, cfbMode -, cfbModeWith -, xtsMode + -- * Cipher + -- $introduction --- ** CBC padding -, CBCPaddingName(..) -, pattern PKCS7 -, pattern OneAndZeros -, pattern X9_23 -, pattern ESP -, pattern CTS -, pattern NoPadding + -- * Usage + -- $usage --- * AEAD -, AEADName(..) -, pattern ChaCha20Poly1305 -, chaCha20Poly1305 + Cipher(..) + , CipherName + , CipherKey + , CipherNonce + , CipherInitFlags (..) + , cipherInitFlags + , CipherUpdateFlags (..) + , cipherUpdateFlags + , withCipher + , cipherInit + , cipherDestroy + , cipherName + , cipherOutputLength + , cipherValidNonceLength + , cipherGetTagLength + , cipherGetDefaultNonceLength + , cipherGetUpdateGranularity + , cipherGetIdealUpdateGranularity + , cipherQueryKeylen + , cipherGetKeyspec + , cipherSetKey + , cipherReset + , cipherSetAssociatedData + , cipherStart + , cipherUpdate + , cipherEncrypt + , cipherDecrypt + , cipherClear --- * AEAD modes -, AEADMode(..) -, gcmMode -, gcmModeWith -, ocbMode -, ocbModeWith -, eaxMode -, eaxModeWith -, sivMode -, ccmMode -, ccmModeWith + -- * Cipher modes + , CipherMode + , cbcMode + , cfbMode + , cfbModeWith + , xtsMode --- * Convenience -, cipherEncryptOnline -, cipherDecryptOnline -, cipherModes -, cbcPaddings -, aeads -, allCiphers + -- ** CBC padding + , CBCPaddingName + , pattern PKCS7 + , pattern OneAndZeros + , pattern X9_23 + , pattern ESP + , pattern CTS + , pattern NoPadding -) where + -- * AEAD + , AEADName + , pattern ChaCha20Poly1305 + , chaCha20Poly1305 -import qualified Data.ByteString as ByteString + -- * AEAD modes + , AEADMode + , gcmMode + , gcmModeWith + , ocbMode + , ocbModeWith + , eaxMode + , eaxModeWith + , sivMode + , ccmMode + , ccmModeWith -import Botan.Bindings.Cipher + -- * Convenience + , cipherEncryptOnline + , cipherDecryptOnline + , cipherModes + , cbcPaddings + , aeads + , allCiphers -import Botan.Low.BlockCipher -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake + ) where -import Botan.Low.RNG +import Botan.Bindings.Cipher +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Low.BlockCipher +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Internal.String +import Botan.Low.Make +import Botan.Low.Remake +import Control.Exception +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable {- $introduction @@ -193,19 +197,16 @@ newtype Cipher = MkCipher { getCipherForeignPtr :: ForeignPtr BotanCipherStruct } -newCipher :: BotanCipher -> IO Cipher withCipher :: Cipher -> (BotanCipher -> IO a) -> IO a -- | Destroy the cipher object immediately cipherDestroy :: Cipher -> IO () createCipher :: (Ptr BotanCipher -> IO CInt) -> IO Cipher -(newCipher, withCipher, cipherDestroy, createCipher, _) +(withCipher, cipherDestroy, createCipher) = mkBindings - MkBotanCipher runBotanCipher - MkCipher getCipherForeignPtr + MkBotanCipher (.runBotanCipher) + MkCipher (.getCipherForeignPtr) botan_cipher_destroy -type CipherInitFlags = Word32 -type CipherUpdateFlags = Int type CipherNonce = ByteString type CipherKey = ByteString @@ -252,16 +253,16 @@ type AEADMode = ByteString -gcmMode :: BlockCipher128Name -> AEADName +gcmMode :: BlockCipherName -> AEADName gcmMode bc = bc // BOTAN_AEAD_MODE_GCM -gcmModeWith :: BlockCipher128Name -> Int -> AEADName +gcmModeWith :: BlockCipherName -> Int -> AEADName gcmModeWith bc tagSz = gcmMode bc /$ showBytes tagSz -ocbMode :: BlockCipher128Name -> AEADName +ocbMode :: BlockCipherName -> AEADName ocbMode bc = bc // BOTAN_AEAD_MODE_OCB -ocbModeWith :: BlockCipher128Name -> Int -> AEADName +ocbModeWith :: BlockCipherName -> Int -> AEADName ocbModeWith bc tagSz = ocbMode bc /$ showBytes tagSz eaxMode :: BlockCipherName -> AEADName @@ -270,15 +271,16 @@ eaxModeWith :: BlockCipherName -> Int -> AEADName eaxModeWith bc tagSz = eaxMode bc /$ showBytes tagSz -sivMode :: BlockCipher128Name -> AEADName +sivMode :: BlockCipherName -> AEADName sivMode bc = bc // BOTAN_AEAD_MODE_SIV -ccmMode :: BlockCipher128Name -> AEADName +ccmMode :: BlockCipherName -> AEADName ccmMode bc = bc // BOTAN_AEAD_MODE_CCM -ccmModeWith :: BlockCipher128Name -> Int -> Int -> AEADName +ccmModeWith :: BlockCipherName -> Int -> Int -> AEADName ccmModeWith bc tagSz l = ccmMode bc /$ showBytes tagSz <> "," <> showBytes l +cbcPaddings :: [CBCPaddingName] cbcPaddings = [ PKCS7 , OneAndZeros @@ -288,12 +290,14 @@ , NoPadding ] +cipherModes :: [CipherName] cipherModes = concat [ [ cbcMode bc pd | bc <- allBlockCiphers, pd <- cbcPaddings ] , [ cfbMode bc | bc <- allBlockCiphers ] , [ xtsMode bc | bc <- allBlockCiphers ] ] +aeads :: [AEADName] aeads = concat [ [ chaCha20Poly1305 ] , [ gcmMode bc | bc <- blockCipher128s ] @@ -303,36 +307,35 @@ , [ ccmMode bc | bc <- blockCipher128s ] ] +allCiphers :: [CipherName] allCiphers = cipherModes ++ aeads --- TODO: Rename CipherMaskDirection, CipherEncrypt, CipherDecrypt; --- Leave slim terminology for botan -pattern MaskDirection - , Encrypt -- ^ May be renamed Encipher to avoid confusion with PKEncrypt - , Decrypt -- ^ May be renamed Decipher to avoid confusion with PKDecrypt - :: CipherInitFlags +data CipherInitFlags = + CipherMaskDirection + | CipherEncrypt + | CipherDecrypt + deriving stock (Show, Eq) -pattern MaskDirection = BOTAN_CIPHER_INIT_FLAG_MASK_DIRECTION -pattern Encrypt = BOTAN_CIPHER_INIT_FLAG_ENCRYPT -pattern Decrypt = BOTAN_CIPHER_INIT_FLAG_DECRYPT +cipherInitFlags :: CipherInitFlags -> Word32 +cipherInitFlags CipherMaskDirection = BOTAN_CIPHER_INIT_FLAG_MASK_DIRECTION +cipherInitFlags CipherEncrypt = BOTAN_CIPHER_INIT_FLAG_ENCRYPT +cipherInitFlags CipherDecrypt = BOTAN_CIPHER_INIT_FLAG_DECRYPT -pattern CipherUpdate - , CipherFinal - :: CipherUpdateFlags +data CipherUpdateFlags = + CipherUpdate + | CipherFinal + deriving stock (Show, Eq) -pattern CipherUpdate = BOTAN_CIPHER_UPDATE_FLAG_NONE -pattern CipherFinal = BOTAN_CIPHER_UPDATE_FLAG_FINAL +cipherUpdateFlags :: CipherUpdateFlags -> Word32 +cipherUpdateFlags CipherUpdate = BOTAN_CIPHER_UPDATE_FLAG_NONE +cipherUpdateFlags CipherFinal = BOTAN_CIPHER_UPDATE_FLAG_FINAL -- |Initialize a cipher object cipherInit :: CipherName -- ^ __name__ -> CipherInitFlags -- ^ __flags__ -> IO Cipher -- ^ __cipher__ -cipherInit = mkCreateObjectCString1 createCipher botan_cipher_init - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withCipherInit :: CipherName -> CipherInitFlags -> (Cipher -> IO a) -> IO a -withCipherInit = mkWithTemp2 cipherInit cipherDestroy +cipherInit name flags = mkCreateObjectCString1 createCipher botan_cipher_init name (cipherInitFlags flags) -- |Return the name of the cipher object cipherName @@ -446,31 +449,50 @@ -- https://github.com/randombit/botan/blob/72dc18bbf598f2c3bef81a4fb2915e9c3c524ac4/src/lib/ffi/ffi_cipher.cpp#L133 -- -- Some ciphers (ChaChaPoly, EAX) may consume less input than the reported ideal granularity -cipherUpdate - :: Cipher -- ^ __cipher__ - -> CipherUpdateFlags -- ^ __flags__ - -> Int -- ^ __output_size__ - -> ByteString -- ^ __input_bytes[]__ - -> IO (Int,ByteString) -- ^ __(input_consumed,output[])__ -cipherUpdate ctx flags outputSz input = withCipher ctx $ \ ctxPtr -> do - unsafeAsBytesLen input $ \ inputPtr inputSz -> do - alloca $ \ consumedPtr -> do - alloca $ \ writtenPtr -> do - output <- allocBytes outputSz $ \ outputPtr -> do - throwBotanIfNegative_ $ botan_cipher_update - ctxPtr - (fromIntegral flags) - outputPtr - (fromIntegral outputSz) - writtenPtr - (ConstPtr inputPtr) - inputSz - consumedPtr - consumed <- fromIntegral <$> peek consumedPtr - written <- fromIntegral <$> peek writtenPtr - -- NOTE: The safety of this function is suspect - may require deepseq - let processed = ByteString.take written output - in processed `seq` return (consumed,processed) +cipherUpdate :: + Cipher -- ^ __cipher__ + -> CipherUpdateFlags -- ^ __flags__ + -> Int -- ^ __output_size__ + -> ByteString -- ^ __input_bytes[]__ + -> IO (Int,ByteString) -- ^ __(input_consumed,output[])__ +cipherUpdate ctx flags outputSz input = + withCipher ctx $ \ ctxPtr -> + unsafeAsBytesLen input $ \ inputPtr inputSz -> + alloca $ \ consumedPtr -> + alloca $ \ writtenPtr -> do + eithOutput <- + try $ allocBytes outputSz $ \ outputPtr ->do + throwBotanIfNegative_ $ botan_cipher_update + ctxPtr + (cipherUpdateFlags flags) + outputPtr + (fromIntegral outputSz) + writtenPtr + (ConstPtr inputPtr) + inputSz + consumedPtr + -- If inssuficient buffer space, try again + output <- case eithOutput of + Left InsufficientBufferSpaceException{} -> do + outputSz' <- peek writtenPtr + allocBytes (fromIntegral outputSz') $ \ outputPtr ->do + throwBotanIfNegative_ $ botan_cipher_update + ctxPtr + (cipherUpdateFlags flags) + outputPtr + outputSz' + writtenPtr + (ConstPtr inputPtr) + -- No input should be provided on the second try if the first + -- try had the FINAL flags set + (if flags == CipherFinal then 0 else inputSz) + consumedPtr + Right bs -> pure bs + consumed <- fromIntegral <$> peek consumedPtr + written <- fromIntegral <$> peek writtenPtr + -- NOTE: The safety of this function is suspect - may require deepseq + let processed = ByteString.take written output + in processed `seq` return (consumed,processed) {- | Encrypt and finalize a complete piece of data. @@ -504,7 +526,7 @@ o <- cipherOutputLength ctx input -- NOTE: Flawed but usable u <- cipherGetUpdateGranularity ctx -- TODO: When u == 1, it should be just input + t, right? t <- cipherGetTagLength ctx - if flags == BOTAN_CIPHER_INIT_FLAG_ENCRYPT + if flags == CipherEncrypt then return (o + u + t) else return (o + u - t) -- TODO: Maybe just 'o'... @@ -539,15 +561,15 @@ cipherProcessOffline ctx flags msg = do o <- cipherEstimateOutputLength ctx flags (ByteString.length msg) -- snd <$> cipherUpdate ctx BOTAN_CIPHER_UPDATE_FLAG_FINAL o msg - fst <$> cipherProcess ctx BOTAN_CIPHER_UPDATE_FLAG_FINAL o msg + fst <$> cipherProcess ctx CipherFinal o msg {-# WARNING cipherEncryptOffline "May be renamed to cipherEncrypt, may be moved to botan" #-} cipherEncryptOffline :: Cipher -> ByteString -> IO ByteString -cipherEncryptOffline ctx = cipherProcessOffline ctx BOTAN_CIPHER_INIT_FLAG_ENCRYPT +cipherEncryptOffline ctx = cipherProcessOffline ctx CipherEncrypt {-# WARNING cipherDecryptOffline "May be renamed to cipherDecrypt, may be moved to botan" #-} cipherDecryptOffline :: Cipher -> ByteString -> IO ByteString -cipherDecryptOffline ctx = cipherProcessOffline ctx BOTAN_CIPHER_INIT_FLAG_DECRYPT +cipherDecryptOffline ctx = cipherProcessOffline ctx CipherDecrypt {- Experiments with online processing @@ -570,14 +592,6 @@ -- encrest <- go (i + g) u t g rest -- return $! encblock : encrest --- NOTE: Some ciphers (SIV, CCM) are not online-capable algorithms, but Botan does not throw --- an error even though it should. -{-# DEPRECATED cipherProcessOnline "Moving from botan-low to botan" #-} -cipherProcessOnline :: Cipher -> CipherInitFlags -> ByteString -> IO ByteString -cipherProcessOnline ctx flags = if flags == BOTAN_CIPHER_INIT_FLAG_ENCRYPT - then cipherEncryptOnline ctx - else cipherDecryptOnline ctx - -- TODO: Consolidate online encipher / decipher -- TODO: Use Builder to do this -- https://hackage.haskell.org/package/bytestring-0.12.0.2/docs/Data-ByteString-Builder.html @@ -589,11 +603,11 @@ where go i g bs = case ByteString.splitAt g bs of (block,"") -> do - o <- cipherEstimateFinalOutputLength ctx BOTAN_CIPHER_INIT_FLAG_ENCRYPT i (ByteString.length block) - (processed,_) <- cipherProcess ctx BOTAN_CIPHER_UPDATE_FLAG_FINAL o block + o <- cipherEstimateFinalOutputLength ctx CipherEncrypt i (ByteString.length block) + (processed,_) <- cipherProcess ctx CipherFinal o block return [processed] (block,rest) -> do - (processed,remaining) <- cipherProcess ctx BOTAN_CIPHER_UPDATE_FLAG_NONE g block + (processed,remaining) <- cipherProcess ctx CipherUpdate g block (processed :) <$> go (i + g) g (remaining <> rest) -- Though this following version may be more efficient especially with lazy bytestrings -- or builder, though note *which* update function it uses - the original @@ -610,9 +624,9 @@ where go i g t bs = case ByteString.splitAt g bs of (block,"") -> do - o <- cipherEstimateFinalOutputLength ctx BOTAN_CIPHER_INIT_FLAG_DECRYPT i (ByteString.length block) - (processed,_) <- cipherProcess ctx BOTAN_CIPHER_UPDATE_FLAG_FINAL o block + o <- cipherEstimateFinalOutputLength ctx CipherDecrypt i (ByteString.length block) + (processed,_) <- cipherProcess ctx CipherFinal o block return [processed] (block,rest) -> do - (processed,remaining) <- cipherProcess ctx BOTAN_CIPHER_UPDATE_FLAG_NONE g block + (processed,remaining) <- cipherProcess ctx CipherUpdate g block (processed :) <$> go (i + g) g t (remaining <> rest) diff --git a/src/Botan/Low/Error.hs b/src/Botan/Low/Error.hs --- a/src/Botan/Low/Error.hs +++ b/src/Botan/Low/Error.hs @@ -7,401 +7,40 @@ Maintainer : joris@well-typed.com, leo@apotheca.io Stability : experimental Portability : POSIX --} -module Botan.Low.Error -( BotanErrorCode(..) -, pattern Success -, pattern InvalidIdentifier -, pattern InvalidInput -, pattern BadMAC -, pattern InsufficientBufferSpace -, pattern StringConversionError -, pattern ExceptionThrown -, pattern OutOfMemory -, pattern SystemError -, pattern InternalError -, pattern BadFlag -, pattern NullPointer -, pattern BadParameter -, pattern KeyNotSet -, pattern InvalidKeyLength -, pattern InvalidObjectState -, pattern NotImplemented -, pattern InvalidObject -, pattern TLSError -, pattern HttpError -, pattern RoughtimeError -, pattern UnknownError -, botanErrorDescription -, botanErrorLastExceptionMessage -, SomeBotanException(..) -, toBotanException -, fromBotanException -, InvalidInputException(..) -, BadMACException(..) -, InsufficientBufferSpaceException(..) -, StringConversionException(..) -, ExceptionThrownException(..) -, OutOfMemoryException(..) -, SystemErrorException(..) -, InternalErrorException(..) -, BadFlagException(..) -, NullPointerException(..) -, BadParameterException(..) -, KeyNotSetException(..) -, InvalidKeyLengthException(..) -, InvalidObjectStateException(..) -, NotImplementedException(..) -, InvalidObjectException(..) -, UnknownException(..) -, throwBotanError -, throwBotanIfNegative -, throwBotanIfNegative_ -, throwBotanCatchingSuccess -, throwBotanCatchingBool -, throwBotanCatchingInt -, throwBotanErrorWithCallstack -, tryBotan -, catchBotan -, handleBotan -) where - -import Data.Typeable - -import Botan.Bindings.Error - -import Botan.Low.Prelude - -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.Text as Text - --- | Botan error code data type -type BotanErrorCode = CInt - -{- -Botan error code patterns --} - -pattern Success - , InvalidIdentifier - , InvalidInput - , BadMAC - , InsufficientBufferSpace - , StringConversionError - , ExceptionThrown - , OutOfMemory - , SystemError - , InternalError - , BadFlag - , NullPointer - , BadParameter - , KeyNotSet - , InvalidKeyLength - , InvalidObjectState - , NotImplemented - , InvalidObject - , TLSError - , HttpError - , RoughtimeError - , UnknownError - :: BotanErrorCode - -pattern Success = BOTAN_FFI_SUCCESS -pattern InvalidIdentifier = BOTAN_FFI_INVALID_VERIFIER -pattern InvalidInput = BOTAN_FFI_ERROR_INVALID_INPUT -pattern BadMAC = BOTAN_FFI_ERROR_BAD_MAC -pattern InsufficientBufferSpace = BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -pattern StringConversionError = BOTAN_FFI_ERROR_STRING_CONVERSION_ERROR -pattern ExceptionThrown = BOTAN_FFI_ERROR_EXCEPTION_THROWN -pattern OutOfMemory = BOTAN_FFI_ERROR_OUT_OF_MEMORY -pattern SystemError = BOTAN_FFI_ERROR_SYSTEM_ERROR -pattern InternalError = BOTAN_FFI_ERROR_INTERNAL_ERROR -pattern BadFlag = BOTAN_FFI_ERROR_BAD_FLAG -pattern NullPointer = BOTAN_FFI_ERROR_NULL_POINTER -pattern BadParameter = BOTAN_FFI_ERROR_BAD_PARAMETER -pattern KeyNotSet = BOTAN_FFI_ERROR_KEY_NOT_SET -pattern InvalidKeyLength = BOTAN_FFI_ERROR_INVALID_KEY_LENGTH -pattern InvalidObjectState = BOTAN_FFI_ERROR_INVALID_OBJECT_STATE -pattern NotImplemented = BOTAN_FFI_ERROR_NOT_IMPLEMENTED -pattern InvalidObject = BOTAN_FFI_ERROR_INVALID_OBJECT -pattern TLSError = BOTAN_FFI_ERROR_TLS_ERROR -pattern HttpError = BOTAN_FFI_ERROR_HTTP_ERROR -pattern RoughtimeError = BOTAN_FFI_ERROR_ROUGHTIME_ERROR -pattern UnknownError = BOTAN_FFI_ERROR_UNKNOWN_ERROR - -{- -Botan error code functions --} - --- | Convert an error code into a string. Returns "Unknown error" if the error code is not a known one. -botanErrorDescription :: BotanErrorCode -> IO ByteString -botanErrorDescription e = do - descPtr <- botan_error_description e - peekCString (unConstPtr descPtr) - --- | Returns a static string stored in a thread local variable which contains the last exception message thrown. --- WARNING: This string buffer is overwritten on the next call to the FFI layer -botanErrorLastExceptionMessage :: IO ErrorMessage -botanErrorLastExceptionMessage = do - msgPtr <- botan_error_last_exception_message - peekCString (unConstPtr msgPtr) - -type ErrorMessage = ByteString - -{- -Exceptions --} - --- | The SomeBotanException type is the root of the botan exception type hierarchy. -data SomeBotanException = forall e . Exception e => SomeBotanException e - -instance Show SomeBotanException where - show (SomeBotanException e) = show e - -instance Exception SomeBotanException - -toBotanException :: Exception e => e -> SomeException -toBotanException = toException . SomeBotanException - -fromBotanException :: Exception e => SomeException -> Maybe e -fromBotanException x = do - SomeBotanException a <- fromException x - cast a - -data InvalidVerifierException - = InvalidVerifierException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception InvalidVerifierException where - toException = toBotanException - fromException = fromBotanException - -data InvalidInputException - = InvalidInputException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception InvalidInputException where - toException = toBotanException - fromException = fromBotanException - -data BadMACException - = BadMACException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception BadMACException where - toException = toBotanException - fromException = fromBotanException - -data InsufficientBufferSpaceException - = InsufficientBufferSpaceException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception InsufficientBufferSpaceException where - toException = toBotanException - fromException = fromBotanException - -data StringConversionException - = StringConversionException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception StringConversionException where - toException = toBotanException - fromException = fromBotanException - -data ExceptionThrownException - = ExceptionThrownException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception ExceptionThrownException where - toException = toBotanException - fromException = fromBotanException - -data OutOfMemoryException - = OutOfMemoryException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception OutOfMemoryException where - toException = toBotanException - fromException = fromBotanException - -data SystemErrorException - = SystemErrorException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception SystemErrorException where - toException = toBotanException - fromException = fromBotanException - -data InternalErrorException - = InternalErrorException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception InternalErrorException where - toException = toBotanException - fromException = fromBotanException - -data BadFlagException - = BadFlagException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception BadFlagException where - toException = toBotanException - fromException = fromBotanException - -data NullPointerException - = NullPointerException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception NullPointerException where - toException = toBotanException - fromException = fromBotanException - -data BadParameterException - = BadParameterException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception BadParameterException where - toException = toBotanException - fromException = fromBotanException - -data KeyNotSetException - = KeyNotSetException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception KeyNotSetException where - toException = toBotanException - fromException = fromBotanException - -data InvalidKeyLengthException - = InvalidKeyLengthException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception InvalidKeyLengthException where - toException = toBotanException - fromException = fromBotanException - -data InvalidObjectStateException - = InvalidObjectStateException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception InvalidObjectStateException where - toException = toBotanException - fromException = fromBotanException - -data NotImplementedException - = NotImplementedException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception NotImplementedException where - toException = toBotanException - fromException = fromBotanException - -data InvalidObjectException - = InvalidObjectException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception InvalidObjectException where - toException = toBotanException - fromException = fromBotanException - -data UnknownException - = UnknownException BotanErrorCode ErrorMessage CallStack - deriving (Show) - -instance Exception UnknownException where - toException = toBotanException - fromException = fromBotanException - -{- -Throwing exceptions +This module is based on the [Return +codes](https://botan.randombit.net/handbook/api_ref/ffi.html#return-codes) +section of the C Botan FFI documentation. -} -throwBotanError :: HasCallStack => BotanErrorCode -> IO a -throwBotanError r = throwBotanErrorWithCallstack r callStack - -throwBotanIfNegative :: HasCallStack => IO BotanErrorCode -> IO BotanErrorCode -throwBotanIfNegative act = do - e <- act - when (e < 0) $ throwBotanErrorWithCallstack (fromIntegral e) callStack - return e - -throwBotanIfNegative_ :: HasCallStack => IO BotanErrorCode -> IO () -throwBotanIfNegative_ act = do - e <- act - when (e < 0) $ throwBotanErrorWithCallstack (fromIntegral e) callStack - --- TODO: Rename to throwBotanCatchingInvalidIdentifier, make: --- throwBotanCatchingSuccess :: HasCallStack => IO BotanErrorCode -> IO Bool --- throwBotanCatchingSuccess act = do --- result <- act --- case result of --- BOTAN_FFI_SUCCESS -> return True --- _ -> throwBotanErrorWithCallstack (fromIntegral result) callStack --- NOTE: Catches 0 / Success as True and 1 / InvalidIdentifier as False, throws all other values -throwBotanCatchingSuccess :: HasCallStack => IO BotanErrorCode -> IO Bool -throwBotanCatchingSuccess act = do - result <- act - case result of - BOTAN_FFI_SUCCESS -> return True - BOTAN_FFI_INVALID_VERIFIER -> return False - _ -> throwBotanErrorWithCallstack (fromIntegral result) callStack - --- NOTE: Catches 1 as True and 0 as False, throws all other values -throwBotanCatchingBool :: HasCallStack => IO BotanErrorCode -> IO Bool -throwBotanCatchingBool act = do - result <- act - case result of - 0 -> return False - 1 -> return True - _ -> throwBotanErrorWithCallstack result callStack - - --- NOTE: Catches positive numbers including zero, throws all other values --- Equivalent to fromIntegral . throwBotanIfNegative -throwBotanCatchingInt :: HasCallStack => IO BotanErrorCode -> IO Int -throwBotanCatchingInt act = do - result <- act - when (result < 0) $ throwBotanErrorWithCallstack (fromIntegral result) callStack - return (fromIntegral result) - -throwBotanErrorWithCallstack :: BotanErrorCode -> CallStack -> IO a -throwBotanErrorWithCallstack e cs = do - emsg <- botanErrorLastExceptionMessage - case e of - -- BOTAN_FFI_SUCCESS -> throwIO $ SUCCESS e cs - BOTAN_FFI_INVALID_VERIFIER -> throwIO $ InvalidVerifierException e emsg cs - BOTAN_FFI_ERROR_INVALID_INPUT -> throwIO $ InvalidInputException e emsg cs - BOTAN_FFI_ERROR_BAD_MAC -> throwIO $ BadMACException e emsg cs - BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -> throwIO $ InsufficientBufferSpaceException e emsg cs - BOTAN_FFI_ERROR_STRING_CONVERSION_ERROR -> throwIO $ StringConversionException e emsg cs - BOTAN_FFI_ERROR_EXCEPTION_THROWN -> throwIO $ ExceptionThrownException e emsg cs - BOTAN_FFI_ERROR_OUT_OF_MEMORY -> throwIO $ OutOfMemoryException e emsg cs - BOTAN_FFI_ERROR_SYSTEM_ERROR -> throwIO $ SystemErrorException e emsg cs - BOTAN_FFI_ERROR_INTERNAL_ERROR -> throwIO $ InternalErrorException e emsg cs - BOTAN_FFI_ERROR_BAD_FLAG -> throwIO $ BadFlagException e emsg cs - BOTAN_FFI_ERROR_NULL_POINTER -> throwIO $ NullPointerException e emsg cs - BOTAN_FFI_ERROR_BAD_PARAMETER -> throwIO $ BadParameterException e emsg cs - BOTAN_FFI_ERROR_KEY_NOT_SET -> throwIO $ KeyNotSetException e emsg cs - BOTAN_FFI_ERROR_INVALID_KEY_LENGTH -> throwIO $ InvalidKeyLengthException e emsg cs - BOTAN_FFI_ERROR_INVALID_OBJECT_STATE -> throwIO $ InvalidObjectStateException e emsg cs - BOTAN_FFI_ERROR_NOT_IMPLEMENTED -> throwIO $ NotImplementedException e emsg cs - BOTAN_FFI_ERROR_INVALID_OBJECT -> throwIO $ InvalidObjectException e emsg cs - _ -> throwIO $ UnknownException e emsg cs - --- TODO: catchingBotan --- r0 <- botan_foo --- if r0 < 0 --- then pure r0 --- else do --- r1 <- botan_bar - -tryBotan :: IO a -> IO (Either SomeBotanException a) -tryBotan = try - -catchBotan :: IO a -> (SomeBotanException -> IO a) -> IO a -catchBotan = catch +module Botan.Low.Error ( + -- * Error codes + Internal.BotanErrorCode + , Internal.botanErrorDescription + , Internal.BotanErrorMessage(..) + , Internal.botanErrorLastExceptionMessage + -- * Exception hierarchy + , Internal.SomeBotanException(..) + , Internal.toBotanException + , Internal.fromBotanException + -- * Individual exceptions + , Internal.InvalidInputException(..) + , Internal.BadMACException(..) + , Internal.InsufficientBufferSpaceException(..) + , Internal.StringConversionException(..) + , Internal.ExceptionThrownException(..) + , Internal.OutOfMemoryException(..) + , Internal.SystemErrorException(..) + , Internal.InternalErrorException(..) + , Internal.BadFlagException(..) + , Internal.NullPointerException(..) + , Internal.BadParameterException(..) + , Internal.KeyNotSetException(..) + , Internal.InvalidKeyLengthException(..) + , Internal.InvalidObjectStateException(..) + , Internal.NotImplementedException(..) + , Internal.InvalidObjectException(..) + , Internal.UnknownException(..) + ) where -handleBotan :: (SomeBotanException -> IO a) -> IO a -> IO a -handleBotan = flip catch +import Botan.Low.Error.Internal as Internal diff --git a/src/Botan/Low/Error/Internal.hs b/src/Botan/Low/Error/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Botan/Low/Error/Internal.hs @@ -0,0 +1,282 @@ +{-| +Module : Botan.Low.Error +Description : Error codes and exception handling +Copyright : (c) 2023-2024, Apotheca Labs + (c) 2024-2025, Haskell Foundation +License : BSD-3-Clause +Maintainer : joris@well-typed.com, leo@apotheca.io +Stability : experimental +Portability : POSIX +-} + +{-# LANGUAGE DerivingVia #-} + +module Botan.Low.Error.Internal ( + -- * Error codes + BotanErrorCode + , botanErrorDescription + , BotanErrorMessage(..) + , botanErrorLastExceptionMessage + -- * Exception hierarchy + , SomeBotanException(..) + , toBotanException + , fromBotanException + -- ** Individual exceptions + , InvalidInputException(..) + , BadMACException(..) + , InsufficientBufferSpaceException(..) + , StringConversionException(..) + , ExceptionThrownException(..) + , OutOfMemoryException(..) + , SystemErrorException(..) + , InternalErrorException(..) + , BadFlagException(..) + , NullPointerException(..) + , BadParameterException(..) + , KeyNotSetException(..) + , InvalidKeyLengthException(..) + , InvalidObjectStateException(..) + , NotImplementedException(..) + , InvalidObjectException(..) + , UnknownException(..) + -- ** Throwing and catching + , throwBotanError + , throwBotanIfNegative + , throwBotanIfNegative_ + , throwBotanCatchingInvalidVerifier + , throwBotanCatchingInvalidInput + , throwBotanCatchingBool + , throwBotanCatching + , throwBotanErrorWithCallstack + ) where + +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.Error +import Botan.Low.Internal.ByteString +import Control.Exception +import Control.Monad +import Data.ByteString (ByteString) +import Data.Typeable +import Foreign.C.Types +import GHC.Stack +import Prelude + +{------------------------------------------------------------------------------- + Errors +-------------------------------------------------------------------------------} + +newtype BotanErrorCode = BotanErrorCode CInt + deriving stock (Show, Eq) + +-- | Convert an error code into a string. Returns "Unknown error" if the error +-- code is not a known one. +botanErrorDescription :: BotanErrorCode -> IO ByteString +botanErrorDescription (BotanErrorCode e) = do + descPtr <- botan_error_description e + peekCString descPtr.unConstPtr + +newtype BotanErrorMessage = BotanErrorMessage ByteString + deriving newtype Show + +-- | Returns a static string stored in a thread local variable which contains +-- the last exception message thrown. WARNING: This string buffer is +-- overwritten on the next call to the FFI layer +botanErrorLastExceptionMessage :: IO BotanErrorMessage +botanErrorLastExceptionMessage = do + msgPtr <- botan_error_last_exception_message + BotanErrorMessage <$> peekCString msgPtr.unConstPtr + +{------------------------------------------------------------------------------- + Exception hierarchy +-------------------------------------------------------------------------------} + +-- | The SomeBotanException type is the root of the botan exception type +-- hierarchy. +data SomeBotanException = forall e . Exception e => SomeBotanException e + +instance Show SomeBotanException where + show (SomeBotanException e) = show e + +instance Exception SomeBotanException + +toBotanException :: Exception e => e -> SomeException +toBotanException = toException . SomeBotanException + +fromBotanException :: Exception e => SomeException -> Maybe e +fromBotanException x = do + SomeBotanException a <- fromException x + cast a + +newtype ViaSomeBotanException e = ViaSomeBotanException e + deriving stock Show + +instance (Show e, Typeable e) => Exception (ViaSomeBotanException e) where + toException = toBotanException + fromException = fromBotanException + +{------------------------------------------------------------------------------- + Individual exceptions +-------------------------------------------------------------------------------} + +data InvalidVerifierException + = InvalidVerifierException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException InvalidVerifierException + +data InvalidInputException + = InvalidInputException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException InvalidInputException + +data BadMACException + = BadMACException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException BadMACException + +data InsufficientBufferSpaceException + = InsufficientBufferSpaceException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException InsufficientBufferSpaceException + +data StringConversionException + = StringConversionException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException StringConversionException + +data ExceptionThrownException + = ExceptionThrownException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException ExceptionThrownException + +data OutOfMemoryException + = OutOfMemoryException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException OutOfMemoryException + +data SystemErrorException + = SystemErrorException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException SystemErrorException + +data InternalErrorException + = InternalErrorException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException InternalErrorException + +data BadFlagException + = BadFlagException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException BadFlagException + +data NullPointerException + = NullPointerException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException NullPointerException + +data BadParameterException + = BadParameterException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException BadParameterException + +data KeyNotSetException + = KeyNotSetException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException KeyNotSetException + +data InvalidKeyLengthException + = InvalidKeyLengthException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException InvalidKeyLengthException + +data InvalidObjectStateException + = InvalidObjectStateException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException InvalidObjectStateException + +data NotImplementedException + = NotImplementedException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException NotImplementedException + +data InvalidObjectException + = InvalidObjectException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException InvalidObjectException + +data UnknownException + = UnknownException BotanErrorCode BotanErrorMessage CallStack + deriving stock (Show) + deriving Exception via ViaSomeBotanException UnknownException + +{------------------------------------------------------------------------------- + Exceptions: throwing and catching +-------------------------------------------------------------------------------} + +throwBotanError :: HasCallStack => CInt -> IO a +throwBotanError r = throwBotanErrorWithCallstack r callStack + +throwBotanIfNegative :: HasCallStack => IO CInt -> IO CInt +throwBotanIfNegative act = do + e <- act + when (e < 0) $ throwBotanErrorWithCallstack e callStack + return e + +throwBotanIfNegative_ :: HasCallStack => IO CInt -> IO () +throwBotanIfNegative_ act = do + e <- act + when (e < 0) $ throwBotanErrorWithCallstack e callStack + +-- | 'throwBotanCatching' with @retCode = 'BOTAN_FFI_INVALID_VERIFIER'@. +throwBotanCatchingInvalidVerifier :: HasCallStack => IO CInt -> IO Bool +throwBotanCatchingInvalidVerifier = throwBotanCatching BOTAN_FFI_INVALID_VERIFIER + +-- | 'throwBotanCatching' with @retCode = 'BOTAN_FFI_ERROR_INVALID_INPUT'@. +throwBotanCatchingInvalidInput :: HasCallStack => IO CInt -> IO Bool +throwBotanCatchingInvalidInput = throwBotanCatching BOTAN_FFI_ERROR_INVALID_INPUT + +-- | @'throwBotanCatching' retCode action@ runs the @action@ and catches return +-- code 0 (Success) as True and @retCode@ as False. All other return codes are +-- thrown as exceptions. +throwBotanCatching :: HasCallStack => CInt -> IO CInt -> IO Bool +throwBotanCatching x act = do + result <- act + case result of + BOTAN_FFI_SUCCESS -> return True + _ | x == result -> return False + | otherwise -> throwBotanErrorWithCallstack result callStack + +-- NOTE: Catches 1 as True and 0 as False, throws all other values +throwBotanCatchingBool :: HasCallStack => IO CInt -> IO Bool +throwBotanCatchingBool act = do + result <- act + case result of + 0 -> return False + 1 -> return True + _ -> throwBotanErrorWithCallstack result callStack + +throwBotanErrorWithCallstack :: CInt -> CallStack -> IO a +throwBotanErrorWithCallstack e cs = do + emsg <- botanErrorLastExceptionMessage + case e of + -- Note: we do not include a case for @BOTAN_FFI_SUCCESS@ since it + -- signals that the function call was successful. + BOTAN_FFI_INVALID_VERIFIER -> throwIO $ InvalidVerifierException bec emsg cs + BOTAN_FFI_ERROR_INVALID_INPUT -> throwIO $ InvalidInputException bec emsg cs + BOTAN_FFI_ERROR_BAD_MAC -> throwIO $ BadMACException bec emsg cs + BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -> throwIO $ InsufficientBufferSpaceException bec emsg cs + BOTAN_FFI_ERROR_STRING_CONVERSION_ERROR -> throwIO $ StringConversionException bec emsg cs + BOTAN_FFI_ERROR_EXCEPTION_THROWN -> throwIO $ ExceptionThrownException bec emsg cs + BOTAN_FFI_ERROR_OUT_OF_MEMORY -> throwIO $ OutOfMemoryException bec emsg cs + BOTAN_FFI_ERROR_SYSTEM_ERROR -> throwIO $ SystemErrorException bec emsg cs + BOTAN_FFI_ERROR_INTERNAL_ERROR -> throwIO $ InternalErrorException bec emsg cs + BOTAN_FFI_ERROR_BAD_FLAG -> throwIO $ BadFlagException bec emsg cs + BOTAN_FFI_ERROR_NULL_POINTER -> throwIO $ NullPointerException bec emsg cs + BOTAN_FFI_ERROR_BAD_PARAMETER -> throwIO $ BadParameterException bec emsg cs + BOTAN_FFI_ERROR_KEY_NOT_SET -> throwIO $ KeyNotSetException bec emsg cs + BOTAN_FFI_ERROR_INVALID_KEY_LENGTH -> throwIO $ InvalidKeyLengthException bec emsg cs + BOTAN_FFI_ERROR_INVALID_OBJECT_STATE -> throwIO $ InvalidObjectStateException bec emsg cs + BOTAN_FFI_ERROR_NOT_IMPLEMENTED -> throwIO $ NotImplementedException bec emsg cs + BOTAN_FFI_ERROR_INVALID_OBJECT -> throwIO $ InvalidObjectException bec emsg cs + _ -> throwIO $ UnknownException bec emsg cs + where + bec = BotanErrorCode e diff --git a/src/Botan/Low/FPE.hs b/src/Botan/Low/FPE.hs --- a/src/Botan/Low/FPE.hs +++ b/src/Botan/Low/FPE.hs @@ -33,30 +33,30 @@ the number of words in the dictionary. -} -module Botan.Low.FPE -( - - FPE(..) -, FPEFlags(..) -, pattern FPENone -, pattern FPEFE1CompatMode -, withFPE -, fpeInitFE1 -, fpeDestroy -, fpeEncrypt -, fpeDecrypt - -) where +module Botan.Low.FPE ( -import qualified Data.ByteString as ByteString + FPE(..) + , FPEFlags(..) + , fPEFlags + , withFPE + , fpeInitFE1 + , fpeDestroy + , fpeEncrypt + , fpeDecrypt -import Botan.Bindings.FPE + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.Remake +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.FPE +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.MPI +import Botan.Low.Remake +import Data.ByteString (ByteString) +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr -- NOTE: This module lacks documentation, and is not mentioned in the FFI bindings. -- It is mentioned in the C++ docs, but the construction significantly differs. @@ -75,23 +75,22 @@ newtype FPE = MkFPE { getFPEForeignPtr :: ForeignPtr BotanFPEStruct } -newFPE :: BotanFPE -> IO FPE withFPE :: FPE -> (BotanFPE -> IO a) -> IO a fpeDestroy :: FPE -> IO () createFPE :: (Ptr BotanFPE -> IO CInt) -> IO FPE -(newFPE, withFPE, fpeDestroy, createFPE, _) +(withFPE, fpeDestroy, createFPE) = mkBindings - MkBotanFPE runBotanFPE - MkFPE getFPEForeignPtr + MkBotanFPE (.runBotanFPE) + MkFPE (.getFPEForeignPtr) botan_fpe_destroy -type FPEFlags = Word32 +data FPEFlags = + FPENone + | FPEFE1CompatMode -pattern FPENone - , FPEFE1CompatMode - :: FPEFlags -pattern FPENone = BOTAN_FPE_FLAG_NONE -pattern FPEFE1CompatMode = BOTAN_FPE_FLAG_FE1_COMPAT_MODE +fPEFlags :: FPEFlags -> Word32 +fPEFlags FPENone = BOTAN_FPE_FLAG_NONE +fPEFlags FPEFE1CompatMode = BOTAN_FPE_FLAG_FE1_COMPAT_MODE -- | Initialize a FE1 FPE context fpeInitFE1 @@ -108,11 +107,7 @@ (ConstPtr keyPtr) keyLen (fromIntegral rounds) - flags - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withFPEInitFE1 :: MP -> ByteString -> Int -> FPEFlags -> (FPE -> IO a) -> IO a -withFPEInitFE1 = mkWithTemp4 fpeInitFE1 fpeDestroy + (fPEFlags flags) -- -- NOTE: Referentially transparent, move to botan -- fpeEncrypt :: FPE -> MP -> ByteString -> IO MP @@ -155,7 +150,3 @@ withMP mp $ \ mpPtr -> do asBytesLen tweak $ \ tweakPtr tweakLen -> do throwBotanIfNegative_ $ botan_fpe_decrypt fpePtr mpPtr (ConstPtr tweakPtr) tweakLen - -data FE1InitFlags - = FE1None -- BOTAN_FPE_FLAG_NONE - | FE1CompatMode -- BOTAN_FPE_FLAG_FE1_COMPAT_MODE diff --git a/src/Botan/Low/HOTP.hs b/src/Botan/Low/HOTP.hs --- a/src/Botan/Low/HOTP.hs +++ b/src/Botan/Low/HOTP.hs @@ -17,47 +17,51 @@ as a mobile phone. -} -module Botan.Low.HOTP -( - --- * Hash-based One Time Password --- $introduction --- * Usage --- $usage - --- * HOTP +module Botan.Low.HOTP ( - HOTP(..) -, HOTPHashName(..) -, HOTPCounter(..) -, HOTPCode(..) -, withHOTP -, hotpInit -, hotpDestroy -, hotpGenerate -, hotpCheck + -- * Hash-based One Time Password + -- $introduction + -- * Usage + -- $usage --- * HOTP Hashes + -- * HOTP -, pattern HOTP_SHA1 -, pattern HOTP_SHA256 -, pattern HOTP_SHA512 + HOTP(..) + , HOTPHashName + , HOTPCounter + , HOTPCode + , withHOTP + , hotpInit + , hotpDestroy + , hotpGenerate + , hotpCheck --- * Convenience + -- * HOTP Hashes -, hotpHashes + , pattern HOTP_SHA1 + , pattern HOTP_SHA256 + , pattern HOTP_SHA512 -) where + -- * Convenience -import qualified Data.ByteString as ByteString + , hotpHashes -import Botan.Bindings.HOTP -import Botan.Low.Hash + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.HOTP +import Botan.Low.Error.Internal +import Botan.Low.Hash +import Botan.Low.Internal.ByteString +import Botan.Low.Remake +import Control.Monad +import Data.ByteString (ByteString) +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable -- NOTE: RFC 4226 -- NOTE: I think this *only* takes SHA-2, specificaly "SHA-256" and "SHA-512", @@ -164,14 +168,13 @@ newtype HOTP = MkHOTP { getHOTPForeignPtr :: ForeignPtr BotanHOTPStruct } -newHOTP :: BotanHOTP -> IO HOTP withHOTP :: HOTP -> (BotanHOTP -> IO a) -> IO a hotpDestroy :: HOTP -> IO () createHOTP :: (Ptr BotanHOTP -> IO CInt) -> IO HOTP -(newHOTP, withHOTP, hotpDestroy, createHOTP, _) +(withHOTP, hotpDestroy, createHOTP) = mkBindings - MkBotanHOTP runBotanHOTP - MkHOTP getHOTPForeignPtr + MkBotanHOTP (.runBotanHOTP) + MkHOTP (.getHOTPForeignPtr) botan_hotp_destroy type HOTPHashName = HashName @@ -186,6 +189,7 @@ pattern HOTP_SHA512 = SHA512 -- TODO: Do any other hashes work? +hotpHashes :: [HOTPHashName] hotpHashes = [ HOTP_SHA1 , HOTP_SHA256 @@ -210,10 +214,6 @@ (ConstPtr algoPtr) (fromIntegral digits) --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withHOTPInit :: ByteString -> ByteString -> Int -> (HOTP -> IO a) -> IO a -withHOTPInit = mkWithTemp3 hotpInit hotpDestroy - -- NOTE: User is responsible for incrementing counter at this level hotpGenerate :: HOTP -- ^ __hotp__ @@ -221,7 +221,7 @@ -> IO HOTPCode -- ^ __hotp_code__ hotpGenerate hotp counter = withHOTP hotp $ \ hotpPtr -> do alloca $ \ outPtr -> do - throwBotanIfNegative $ botan_hotp_generate hotpPtr outPtr counter + void $ throwBotanIfNegative $ botan_hotp_generate hotpPtr outPtr counter peek outPtr -- NOTE: @@ -229,14 +229,15 @@ -- invalid then always returns (false,starting_counter), since the -- last successful authentication counter has not changed. "" -- NOTE: "Depending on the environment a resync_range of 3 to 10 might be appropriate." -hotpCheck - :: HOTP -- ^ __hotp__ - -> HOTPCode -- ^ __hotp_code__ - -> HOTPCounter -- ^ __hotp_counter__ - -> Int -- ^ __resync_range__ - -> IO (Bool, HOTPCounter) -- ^ __(valid,next_counter)__ -hotpCheck hotp code counter resync = withHOTP hotp $ \ hotpPtr -> do +hotpCheck :: + HOTP -- ^ __hotp__ + -> HOTPCode -- ^ __hotp_code__ + -> HOTPCounter -- ^ __hotp_counter__ + -> Int -- ^ __resync_range__ + -> IO (Bool, HOTPCounter) -- ^ __(valid,next_counter)__ +hotpCheck hotp code counter resync = + withHOTP hotp $ \ hotpPtr -> alloca $ \ outPtr -> do - valid <- throwBotanCatchingSuccess $ botan_hotp_check hotpPtr outPtr code counter (fromIntegral resync) - nextCounter <- peek outPtr - return (valid, nextCounter) + valid <- throwBotanCatchingInvalidVerifier $ botan_hotp_check hotpPtr outPtr code counter (fromIntegral resync) + nextCounter <- peek outPtr + return (valid, nextCounter) diff --git a/src/Botan/Low/Hash.hs b/src/Botan/Low/Hash.hs --- a/src/Botan/Low/Hash.hs +++ b/src/Botan/Low/Hash.hs @@ -26,83 +26,84 @@ hashFinal), the internal state is reset to begin hashing a new message. -} -module Botan.Low.Hash -( - --- * Hashing --- $introduction - --- * Usage --- $usage +{-# LANGUAGE OverloadedStrings #-} - Hash(..) -, HashName(..) -, HashDigest(..) -, withHash -, hashInit -, hashDestroy -, hashName -, hashBlockSize -, hashOutputLength -, hashCopyState -, hashUpdate -, hashFinal -, hashUpdateFinalize -, hashUpdateFinalizeClear -, hashClear +module Botan.Low.Hash ( --- * Hash algorithms + -- * Hashing + -- $introduction -, pattern BLAKE2b -, blake2b -, pattern Keccak1600 -, keccak1600 -, pattern GOST_34_11 -, pattern MD4 -, pattern MD5 -, pattern RIPEMD160 -, pattern SHA1 -, pattern SHA224 -, pattern SHA256 -, pattern SHA384 -, pattern SHA512 -, pattern SHA512_256 -, pattern SHA3 -, sha3 -, pattern SHAKE128 -, shake128 -, pattern SHAKE256 -, shake256 -, pattern SM3 -, pattern Skein512 -, skein512 -, pattern Streebog256 -, pattern Streebog512 -, pattern Whirlpool -, pattern Parallel -, pattern Comb4P -, pattern Adler32 -, pattern CRC24 -, pattern CRC32 + -- * Usage + -- $usage --- * Convenience + Hash(..) + , HashName + , HashDigest + , withHash + , hashInit + , hashDestroy + , hashName + , hashBlockSize + , hashOutputLength + , hashCopyState + , hashUpdate + , hashFinal + , hashUpdateFinalize + , hashUpdateFinalizeClear + , hashClear -, cryptohashes -, checksums -, allHashes + -- * Hash algorithms -) where + , pattern BLAKE2b + , blake2b + , pattern Keccak1600 + , keccak1600 + , pattern GOST_34_11 + , pattern MD4 + , pattern MD5 + , pattern RIPEMD160 + , pattern SHA1 + , pattern SHA224 + , pattern SHA256 + , pattern SHA384 + , pattern SHA512 + , pattern SHA512_256 + , pattern SHA3 + , sha3 + , pattern SHAKE128 + , shake128 + , pattern SHAKE256 + , shake256 + , pattern SM3 + , pattern Skein512 + , skein512 + , pattern Streebog256 + , pattern Streebog512 + , pattern Whirlpool + , pattern Parallel + , pattern Comb4P + , pattern Adler32 + , pattern CRC24 + , pattern CRC32 -import qualified Data.ByteString as ByteString + -- * Convenience -import System.IO.Unsafe + , cryptohashes + , checksums + , allHashes -import Botan.Bindings.Hash + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake +import Botan.Bindings.Hash +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Internal.String +import Botan.Low.Make +import Botan.Low.Remake +import Data.ByteString (ByteString) +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr {- $introduction @@ -140,14 +141,13 @@ newtype Hash = MkHash { getHashForeignPtr :: ForeignPtr BotanHashStruct } -newHash :: BotanHash -> IO Hash withHash :: Hash -> (BotanHash -> IO a) -> IO a hashDestroy :: Hash -> IO () createHash :: (Ptr BotanHash -> IO CInt) -> IO Hash -(newHash, withHash, hashDestroy, createHash, _) +(withHash, hashDestroy, createHash) = mkBindings - MkBotanHash runBotanHash - MkHash getHashForeignPtr + MkBotanHash (.runBotanHash) + MkHash (.getHashForeignPtr) botan_hash_destroy type HashName = ByteString @@ -182,10 +182,12 @@ pattern BLAKE2b = BOTAN_HASH_BLAKE2B -- TODO: function -- sz is digest size in bits, must be 1-64 bytes, eg: 8-512 in multiples of 8 +blake2b :: (Ord a, Num a, Show a) => a -> HashName blake2b sz | sz <= 512 = BLAKE2b /$ showBytes sz blake2b _ = error "Invalid BLAKE2b variant" pattern Keccak1600 = BOTAN_HASH_KECCAK_1600 -- TODO: function or pattern +keccak1600 :: (Eq a, Num a, Show a) => a -> HashName keccak1600 n | n `elem` [224, 256, 384, 512] = Keccak1600 /$ showBytes n keccak1600 _ = error "Invalid Keccak-1600 variant" -- pattern Keccak1600_224 = "Keccak-1600(224)" @@ -204,6 +206,7 @@ pattern SHA512_256 = BOTAN_HASH_SHA_512_256 pattern SHA3 = BOTAN_HASH_SHA_3 -- TODO: function or pattern +sha3 :: (Eq a, Num a, Show a) => a -> HashName sha3 n | n `elem` [224, 256, 384, 512] = SHA3 /$ showBytes n sha3 _ = error "Invalid SHA-3 variant" -- pattern SHA3_224 = "SHA-3(224)" @@ -212,13 +215,16 @@ -- pattern SHA3_512 = "SHA-3(512)" pattern SHAKE128 = BOTAN_HASH_SHAKE_128 -- TODO: function +shake128 :: Show a => a -> HashName shake128 sz = SHAKE128 /$ showBytes sz pattern SHAKE256 = BOTAN_HASH_SHAKE_256 -- TODO: function +shake256 :: Show a => a -> HashName shake256 sz = SHAKE256 /$ showBytes sz pattern SM3 = BOTAN_HASH_SM3 pattern Skein512 = BOTAN_HASH_SKEIN_512 -- TODO: function +skein512 :: Show a => a -> HashName -> HashName skein512 sz salt = Skein512 /$ showBytes sz <> "," <> salt pattern Streebog256 = BOTAN_HASH_STREEBOG_256 pattern Streebog512 = BOTAN_HASH_STREEBOG_512 @@ -260,12 +266,12 @@ -- , "SHA-3(384)" -- , "SHA-3(512)" -- NOTE: SHAKE-128 has no default value, a parameter *MUST* be supplied - , shake128 128 + , shake128 @Int 128 -- , "SHAKE-128(128)" -- , "SHAKE-128(256)" -- , "SHAKE-128(512)" -- NOTE: SHAKE-256 has no default value, a parameter *MUST* be supplied - , shake256 128 + , shake256 @Int 128 -- , "SHAKE-256(128)" -- , "SHAKE-256(256)" -- , "SHAKE-256(512)" @@ -283,12 +289,14 @@ -- hashStrategies :: [HashName] -- hashStrategies = undefined +checksums :: [HashName] checksums = [ Adler32 , CRC24 , CRC32 ] +allHashes :: [HashName] allHashes = cryptohashes ++ checksums type HashDigest = ByteString @@ -298,10 +306,6 @@ -> IO Hash -- ^ __hash__: hash object hashInit = mkCreateObjectCString createHash (\ out name -> botan_hash_init out name 0) --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withHashInit :: HashName -> (Hash -> IO a) -> IO a -withHashInit = mkWithTemp1 hashInit hashDestroy - hashName :: Hash -- ^ __hash__: the object to read -> IO HashDigest -- ^ __name__: output buffer @@ -366,11 +370,3 @@ hashClear ctx return dg -- Or: hashUpdateFinalize ctx bytes <* hashClear ctx - -hashWithHash :: Hash -> ByteString -> IO HashDigest -hashWithHash = hashUpdateFinalizeClear - -hashWithName :: HashName -> ByteString -> IO HashDigest -hashWithName name bytes = do - ctx <- hashInit name - hashWithHash ctx bytes diff --git a/src/Botan/Low/Internal/ByteString.hs b/src/Botan/Low/Internal/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/Botan/Low/Internal/ByteString.hs @@ -0,0 +1,107 @@ +module Botan.Low.Internal.ByteString ( + peekCString + , withCString + , withCBytes + , withCBytesLen + , allocBytes + , allocBytesWith + , asCString + , asCStringLen + , asBytes + , unsafeAsBytes + , asBytesLen + , unsafeAsBytesLen + , showBytes + ) where + +import Control.DeepSeq +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Char8 as Char8 +import qualified Data.ByteString.Internal as ByteString +import qualified Data.ByteString.Unsafe as ByteString +import Data.Word +import Foreign.C.String hiding (peekCString, peekCStringLen, + withCString, withCStringLen) +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr + +{- +Small rant: CString is a bit of a mess + +- CString doesn't work with const +- There is no CBytes +- Doesn't work with ConstPtr +- Different names for different types (peek vs pack, useAs vs with) + - Data.ByteString + - packCString :: CString -> IO ByteString + - useAsCString :: ByteString -> (CString -> IO a) -> IO a + - Text + - Foreign.C.String + - peekCString :: CString -> IO String + - withCString :: String -> (CString -> IO a) -> IO a +-} + +peekCString :: CString -> IO ByteString +peekCString = ByteString.packCString + +withCString :: ByteString -> (CString -> IO a) -> IO a +withCString = ByteString.useAsCString + +type CBytes = Ptr Word8 + +withCBytes :: ByteString -> (CBytes -> IO a) -> IO a +withCBytes bs act = ByteString.useAsCStringLen bs (\ (ptr,_) -> act (castPtr ptr)) + +type CBytesLen = (Ptr Word8, Int) + +withCBytesLen :: ByteString -> (CBytesLen -> IO a) -> IO a +withCBytesLen bs act = ByteString.useAsCStringLen bs (\ (ptr,len) -> act (castPtr ptr, len)) + +-- A cheap knockoff of ByteArray.alloc / allocRet +-- We'll make this safer in the future +-- NOTE: THIS IS NOT LIKE Foriegn.Marshal.Alloc.allocaBytes, though it is close +-- Instead of returning the thing, we always return a bytestring. +-- Also, allocaBytes frees the memory after, but this is a malloc freed on garbage collect. +-- I basically ripped the relevant bits from ByteArray for ease of continuity +allocBytes :: Int -> (Ptr byte -> IO ()) -> IO ByteString +-- allocBytes sz f = snd <$> allocBytesWith sz f +-- NOTE: This is probably better than mallocByteString withForeignPtr +-- Use of mallocByteString without mkDeferredByteString / deferForeignPtrAvailability +-- is possibly a factor in our InsufficientBufferSpaceException issues +-- NOTE: Most of the comments are rendered moot now :) this needs cleanup +allocBytes sz f = ByteString.create sz (f . castPtr) + +allocBytesWith :: Int -> (Ptr byte -> IO a) -> IO (a, ByteString) +allocBytesWith sz f + | sz < 0 = allocBytesWith 0 f + | otherwise = do + fptr <- ByteString.mallocByteString sz + a <- withForeignPtr fptr (f . castPtr) + -- return (a, ByteString.PS fptr 0 sz) + -- NOTE: The safety of this function is suspect, may require deepseq + let bs = ByteString.PS fptr 0 sz + in bs `deepseq` return (a,bs) + +asCString :: ByteString -> (Ptr CChar -> IO a) -> IO a +asCString = ByteString.useAsCString + +asCStringLen :: ByteString -> (Ptr CChar -> CSize -> IO a) -> IO a +asCStringLen bs f = ByteString.useAsCStringLen bs (\ (ptr,len) -> f ptr (fromIntegral len)) + +asBytes :: ByteString -> (Ptr byte -> IO a) -> IO a +asBytes bs f = asBytesLen bs (\ ptr _ -> f ptr) + +unsafeAsBytes :: ByteString -> (Ptr byte -> IO a) -> IO a +unsafeAsBytes bs f = unsafeAsBytesLen bs (\ ptr _ -> f ptr) + +-- WARNING: This should not be using `useAsCStringLen` +asBytesLen :: ByteString -> (Ptr byte -> CSize -> IO a) -> IO a +asBytesLen bs f = ByteString.useAsCStringLen bs (\ (ptr,len) -> f (castPtr ptr) (fromIntegral len)) + +unsafeAsBytesLen :: ByteString -> (Ptr byte -> CSize -> IO a) -> IO a +unsafeAsBytesLen bs f = ByteString.unsafeUseAsCStringLen bs (\ (ptr,len) -> f (castPtr ptr) (fromIntegral len)) + +showBytes :: (Show a) => a -> ByteString +showBytes = Char8.pack . show diff --git a/src/Botan/Low/Internal/String.hs b/src/Botan/Low/Internal/String.hs new file mode 100644 --- /dev/null +++ b/src/Botan/Low/Internal/String.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Botan.Low.Internal.String ( + (//) + , (/$) + ) where + +import Data.String (IsString (..)) + +infixr 6 // +(//) :: (IsString a, Semigroup a) => a -> a -> a +a // b = a <> "/" <> b + +infixr 0 /$ +(/$) :: (IsString a, Semigroup a) => a -> a -> a +a /$ b = a <> "(" <> b <> ")" diff --git a/src/Botan/Low/KDF.hs b/src/Botan/Low/KDF.hs --- a/src/Botan/Low/KDF.hs +++ b/src/Botan/Low/KDF.hs @@ -27,58 +27,56 @@ still use different keys in the two contexts. -} -module Botan.Low.KDF -( - --- * Key derivation function - - KDFName(..) -, kdf +module Botan.Low.KDF ( --- * KDF algorithms + -- * Key derivation function -, pattern HKDF -, hkdf -, pattern HKDF_Extract -, hkdf_extract -, pattern HKDF_Expand -, hkdf_expand -, pattern KDF2 -, kdf2 -, pattern KDF1_18033 -, kdf1_18033 -, pattern KDF1 -, kdf1 -, pattern TLS_12_PRF -, tls_12_prf -, pattern X9_42_PRF -, x9_42_prf -, pattern SP800_108_Counter -, sp800_108_counter -, pattern SP800_108_Feedback -, sp800_108_feedback -, pattern SP800_108_Pipeline -, sp800_108_pipeline -, pattern SP800_56A -, sp800_56A -, pattern SP800_56C -, sp800_56C + KDFName + , kdf --- * Convenience + -- * KDF algorithms -, kdfs + , pattern HKDF + , hkdf + , pattern HKDF_Extract + , hkdf_extract + , pattern HKDF_Expand + , hkdf_expand + , pattern KDF2 + , kdf2 + , pattern KDF1_18033 + , kdf1_18033 + , pattern KDF1 + , kdf1 + , pattern TLS_12_PRF + , tls_12_prf + , pattern X9_42_PRF + , x9_42_prf + , pattern SP800_108_Counter + , sp800_108_counter + , pattern SP800_108_Feedback + , sp800_108_feedback + , pattern SP800_108_Pipeline + , sp800_108_pipeline + , pattern SP800_56A + , sp800_56A + , pattern SP800_56C + , sp800_56C -) where + -- * Convenience -import qualified Data.ByteString as ByteString + , kdfs -import Botan.Bindings.KDF + ) where -import Botan.Low.Hash -import Botan.Low.MAC -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.KDF +import Botan.Low.Error.Internal +import Botan.Low.Hash +import Botan.Low.Internal.ByteString +import Botan.Low.Internal.String +import Botan.Low.MAC +import Data.ByteString (ByteString) type KDFName = ByteString @@ -113,19 +111,32 @@ hkdf :: HashName -> KDFName hkdf h = HKDF /$ h +hkdf_extract :: KDFName -> KDFName hkdf_extract h = HKDF_Extract /$ h +hkdf_expand :: KDFName -> KDFName hkdf_expand h = HKDF_Expand /$ h +kdf2 :: KDFName -> KDFName kdf2 h = KDF2 /$ h +kdf1_18033 :: KDFName -> KDFName kdf1_18033 h = KDF1_18033 /$ h +kdf1 :: KDFName -> KDFName kdf1 h = KDF1 /$ h +tls_12_prf :: KDFName -> KDFName tls_12_prf h = TLS_12_PRF /$ h +x9_42_prf :: KDFName -> KDFName x9_42_prf h = X9_42_PRF /$ h +sp800_108_counter :: KDFName -> KDFName sp800_108_counter h = SP800_108_Counter /$ HMAC /$ h +sp800_108_feedback :: KDFName -> KDFName sp800_108_feedback h = SP800_108_Feedback /$ HMAC /$ h +sp800_108_pipeline :: KDFName -> KDFName sp800_108_pipeline h = SP800_108_Pipeline /$ HMAC /$ h +sp800_56A :: KDFName -> KDFName sp800_56A h = SP800_56A /$ HMAC /$ h +sp800_56C :: KDFName -> KDFName sp800_56C h = SP800_56C /$ HMAC /$ h +kdfs :: [KDFName] kdfs = concat [ [ hkdf h | h <- cryptohashes ] , [ hkdf_extract h | h <- cryptohashes ] diff --git a/src/Botan/Low/KeyWrap.hs b/src/Botan/Low/KeyWrap.hs --- a/src/Botan/Low/KeyWrap.hs +++ b/src/Botan/Low/KeyWrap.hs @@ -22,22 +22,19 @@ Use AES for best interop. -} -module Botan.Low.KeyWrap -( - - nistKeyWrapEncode -, nistKeyWrapDecode - -) where +module Botan.Low.KeyWrap ( -import qualified Data.ByteString as ByteString + nistKeyWrapEncode + , nistKeyWrapDecode -import Botan.Bindings.KeyWrap + ) where -import Botan.Low.BlockCipher -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.KeyWrap +import Botan.Low.BlockCipher +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Data.ByteString (ByteString) nistKeyWrapEncode :: BlockCipherName -- ^ __cipher_algo__ diff --git a/src/Botan/Low/MAC.hs b/src/Botan/Low/MAC.hs --- a/src/Botan/Low/MAC.hs +++ b/src/Botan/Low/MAC.hs @@ -35,59 +35,61 @@ - Finalize the MAC computation. -} -module Botan.Low.MAC -( - --- * Message authentication codes --- $introduction +{-# LANGUAGE OverloadedStrings #-} --- * Usage --- $usage +module Botan.Low.MAC ( - MAC(..) -, MACName(..) -, MACKey(..) -, MACNonce(..) -, MACDigest(..) -, withMAC -, macInit -, macDestroy -, macName -, macOutputLength -, macGetKeyspec -, macSetKey -, macSetNonce -, macUpdate -, macFinal -, macClear + -- * Message authentication codes + -- $introduction --- * MAC algorithms + -- * Usage + -- $usage -, pattern CMAC -, cmac -, pattern GMAC -, gmac -, pattern HMAC -, hmac -, pattern Poly1305 -, pattern SipHash -, sipHash -, pattern X9_19_MAC + MAC(..) + , MACName + , MACKey + , MACNonce + , MACDigest + , withMAC + , macInit + , macDestroy + , macName + , macOutputLength + , macGetKeyspec + , macSetKey + , macSetNonce + , macUpdate + , macFinal + , macClear --- * Convenience + -- * MAC algorithms -) where + , pattern CMAC + , cmac + , pattern GMAC + , gmac + , pattern HMAC + , hmac + , pattern Poly1305 + , pattern SipHash + , sipHash + , pattern X9_19_MAC -import qualified Data.ByteString as ByteString + -- * Convenience -import Botan.Bindings.MAC + ) where -import Botan.Low.BlockCipher -import Botan.Low.Error -import Botan.Low.Hash -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake +import Botan.Bindings.MAC +import Botan.Low.BlockCipher +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Internal.String +import Botan.Low.Make +import Botan.Low.Remake +import Data.ByteString (ByteString) +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr {- $introduction @@ -162,14 +164,13 @@ newtype MAC = MkMAC { getMACForeignPtr :: ForeignPtr BotanMACStruct } -newMAC :: BotanMAC -> IO MAC withMAC :: MAC -> (BotanMAC -> IO a) -> IO a macDestroy :: MAC -> IO () createMAC :: (Ptr BotanMAC -> IO CInt) -> IO MAC -(newMAC, withMAC, macDestroy, createMAC, _) +(withMAC, macDestroy, createMAC) = mkBindings - MkBotanMAC runBotanMAC - MkMAC getMACForeignPtr + MkBotanMAC (.runBotanMAC) + MkMAC (.getMACForeignPtr) botan_mac_destroy type MACName = ByteString @@ -228,10 +229,6 @@ :: MACName -- ^ __mac_name__: name of the hash function, e.g., "HMAC(SHA-384)" -> IO MAC -- ^ __mac__: mac object macInit = mkCreateObjectCString createMAC (\ out name -> botan_mac_init out name 0) - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withMACInit :: MACName -> (MAC -> IO a) -> IO a -withMACInit = mkWithTemp1 macInit macDestroy -- | Writes the output length of the message authentication code to *output_length macOutputLength diff --git a/src/Botan/Low/MPI.hs b/src/Botan/Low/MPI.hs --- a/src/Botan/Low/MPI.hs +++ b/src/Botan/Low/MPI.hs @@ -9,63 +9,68 @@ Portability : POSIX -} -module Botan.Low.MPI -( +module Botan.Low.MPI ( - MP(..) -, withMP -, mpInit -, mpDestroy -, mpToHex -, mpToStr -, mpClear -, mpSetFromInt -, mpSetFromMP -, mpCopy -, mpSetFromStr -, mpSetFromRadixStr -, mpNumBits -, mpNumBytes -, mpToBin -, mpFromBin -, mpToWord32 -, mpIsPositive -, mpIsNegative -, mpFlipSign -, mpIsZero -, mpAddWord32 -, mpSubWord32 -, mpAdd -, mpSub -, mpMul -, mpDiv -, mpModMul -, mpEqual -, mpCmp -, mpSwap -, mpPowMod -, mpLeftShift -, mpRightShift -, mpModInverse -, mpRandBits -, mpRandRange -, mpGCD -, mpIsPrime -, mpGetBit -, mpSetBit -, mpClearBit + MP(..) + , withMP + , mpInit + , mpDestroy + , mpToHex + , mpToStr + , mpClear + , mpSetFromInt + , mpSetFromMP + , mpCopy + , mpSetFromStr + , mpSetFromRadixStr + , mpNumBits + , mpNumBytes + , mpToBin + , mpFromBin + , mpToWord32 + , mpIsPositive + , mpIsNegative + , mpFlipSign + , mpIsZero + , mpAddWord32 + , mpSubWord32 + , mpAdd + , mpSub + , mpMul + , mpDiv + , mpModMul + , mpEqual + , mpCmp + , mpSwap + , mpPowMod + , mpLeftShift + , mpRightShift + , mpModInverse + , mpRandBits + , mpRandRange + , mpGCD + , mpIsPrime + , mpGetBit + , mpSetBit + , mpClearBit -) where + ) where +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.MPI +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Botan.Low.Remake +import Botan.Low.RNG +import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString - -import Botan.Bindings.MPI - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake -import Botan.Low.RNG +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable -- Yes, the module is named MPI, but the type is MP. -- I'm probably renaming the module / type to `Botan.Integer` for ergonomics, @@ -82,14 +87,13 @@ newtype MP = MkMP { getMPForeignPtr :: ForeignPtr BotanMPStruct } -newMP :: BotanMP -> IO MP withMP :: MP -> (BotanMP -> IO a) -> IO a mpDestroy :: MP -> IO () createMP :: (Ptr BotanMP -> IO CInt) -> IO MP -(newMP, withMP, mpDestroy, createMP, _) +(withMP, mpDestroy, createMP) = mkBindings - MkBotanMP runBotanMP - MkMP getMPForeignPtr + MkBotanMP (.runBotanMP) + MkMP (.getMPForeignPtr) botan_mp_destroy mpInit :: IO MP @@ -261,7 +265,7 @@ -- -- int botan_...(botan_mp_t dest, const botan_mp_t source); -type UnaryOp ptr = ptr -> ptr -> IO BotanErrorCode +type UnaryOp ptr = ptr -> ptr -> IO CInt mkUnaryOp :: WithPtr typ ptr -> UnaryOp ptr -> typ -> typ -> IO () mkUnaryOp withPtr unary dest source = withPtr dest $ \ destPtr -> do @@ -269,7 +273,7 @@ throwBotanIfNegative_ $ unary destPtr sourcePtr -- int botan_...(botan_mp_t dest, const botan_mp_t source, size_t factor); -type UnaryOp_csize ptr = ptr -> ptr -> CSize -> IO BotanErrorCode +type UnaryOp_csize ptr = ptr -> ptr -> CSize -> IO CInt mkUnaryOp_csize :: WithPtr typ ptr -> UnaryOp_csize ptr -> typ -> typ -> Int -> IO () mkUnaryOp_csize withPtr unary dest source factor = withPtr dest $ \ destPtr -> do @@ -277,7 +281,7 @@ throwBotanIfNegative_ $ unary destPtr sourcePtr (fromIntegral factor) -- int botan_...(botan_mp_t dest, const botan_mp_t a, const botan_mp_t b); -type BinaryOp ptr = ptr -> ptr -> ptr -> IO BotanErrorCode +type BinaryOp ptr = ptr -> ptr -> ptr -> IO CInt mkBinaryOp :: WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO () mkBinaryOp withPtr binary dest a b = withPtr dest $ \ destPtr -> do @@ -286,7 +290,7 @@ throwBotanIfNegative_ $ binary destPtr aPtr bPtr -- int botan_...(botan_mp_t a, botan_mp_t b, const botan_mp_t x, const botan_mp_t y); -type BinaryDuplexOp ptr = ptr -> ptr -> ptr -> ptr -> IO BotanErrorCode +type BinaryDuplexOp ptr = ptr -> ptr -> ptr -> ptr -> IO CInt -- NOTE: Do not confuse for mkTrinaryOp mkBinaryDuplexOp :: WithPtr typ ptr -> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO () @@ -297,7 +301,7 @@ throwBotanIfNegative_ $ binary aPtr bPtr xPtr yPtr -- int botan_...(botan_mp_t a, botan_mp_t b, const botan_mp_t x, const botan_mp_t y); -type TrinaryOp ptr = ptr -> ptr -> ptr -> ptr -> IO BotanErrorCode +type TrinaryOp ptr = ptr -> ptr -> ptr -> ptr -> IO CInt -- NOTE: Do not confuse for mkBinaryDuplexOp mkTrinaryOp :: WithPtr typ ptr -> TrinaryOp ptr -> typ -> typ -> typ -> typ -> IO () diff --git a/src/Botan/Low/Make.hs b/src/Botan/Low/Make.hs --- a/src/Botan/Low/Make.hs +++ b/src/Botan/Low/Make.hs @@ -1,9 +1,80 @@ -module Botan.Low.Make where +module Botan.Low.Make ( + WithPtr + , Constr + , Initializer + , Initializer_name + , Initializer_name_flags + , Initializer_bytes + , Initializer_bytes_len + , Destructor + , mkInit + , mkInit_name + , mkInit_name_flags + , mkInit_bytes + , mkInit_bytes_len + , Initializer_with + , mkInit_with + , GetBytes + , mkGetBytes + , GetCString + , mkGetCString + , GetInt + , mkGetInt + , GetSize + , GetSize_csize + , GetSizes2 + , GetSizes3 + , mkGetSize + , mkGetSize_csize + , mkGetSizes2 + , mkGetSizes3 + , GetBoolCode + , GetBoolCode_csize + , mkGetBoolCode + , mkGetBoolCode_csize + , GetIntCode + , GetIntCode_csize + , mkGetIntCode + , mkGetIntCode_csize + , Action + , mkAction + , mkSet + , mkSetOn + , SetCSize + , SetCInt + , mkSetCSize + , mkSetCInt + , SetCString + , SetCString_csize + , mkSetCString + , mkSetCString_csize + , SetBytesLen + , mkSetBytesLen + , allocBytesQuerying + , allocBytesQueryingCString + , mkWithTemp + , mkWithTemp1 + , mkWithTemp2 + , mkWithTemp3 + , mkWithTemp4 + , withPtrs + ) where +import Botan.Bindings.Error +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Control.DeepSeq +import Control.Exception +import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString - -import Botan.Low.Error -import Botan.Low.Prelude +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import Prelude hiding (init) {- Basic botan type template @@ -45,7 +116,7 @@ {- type Construct struct typ = ForeignPtr struct -> typ type Destruct struct = FinalizerPtr struct -type Initialize0 struct = Ptr (Ptr struct) -> IO BotanErrorCode +type Initialize0 struct = Ptr (Ptr struct) -> IO CInt mkInit0 :: Construct struct typ @@ -93,11 +164,11 @@ type Constr struct typ = ForeignPtr struct -> typ -type Initializer struct = Ptr (Ptr struct) -> IO BotanErrorCode -type Initializer_name struct = Ptr (Ptr struct) -> CString -> IO BotanErrorCode -type Initializer_name_flags struct = Ptr (Ptr struct) -> CString -> Word32 -> IO BotanErrorCode -type Initializer_bytes struct = Ptr (Ptr struct) -> Ptr Word8 -> IO BotanErrorCode -type Initializer_bytes_len struct = Ptr (Ptr struct) -> Ptr Word8 -> CSize -> IO BotanErrorCode +type Initializer struct = Ptr (Ptr struct) -> IO CInt +type Initializer_name struct = Ptr (Ptr struct) -> CString -> IO CInt +type Initializer_name_flags struct = Ptr (Ptr struct) -> CString -> Word32 -> IO CInt +type Initializer_bytes struct = Ptr (Ptr struct) -> Ptr Word8 -> IO CInt +type Initializer_bytes_len struct = Ptr (Ptr struct) -> Ptr Word8 -> CSize -> IO CInt type Destructor struct = FinalizerPtr struct @@ -169,7 +240,7 @@ -- Initializing with another botan object -- TODO: Use this in already-implemented functions as appropriate -type Initializer_with struct withptr = Ptr (Ptr struct) -> withptr -> IO BotanErrorCode +type Initializer_with struct withptr = Ptr (Ptr struct) -> withptr -> IO CInt mkInit_with :: Constr struct typ @@ -188,7 +259,7 @@ Non-effectful queries -} --- type GetName ptr = ptr -> Ptr CChar -> Ptr CSize -> IO BotanErrorCode +-- type GetName ptr = ptr -> Ptr CChar -> Ptr CSize -> IO CInt -- Replaced by the new mkGetCString -- -- TODO: Prefer mkGetBytes / mkGetCString to mkGetName @@ -209,7 +280,7 @@ -- NOTE: This now handles both Ptr Word8 and Ptr CChar -- This reads the entire byte buffer, including any \NUL bytes -type GetBytes ptr byte = ptr -> Ptr byte -> Ptr CSize -> IO BotanErrorCode +type GetBytes ptr byte = ptr -> Ptr byte -> Ptr CSize -> IO CInt mkGetBytes :: WithPtr typ ptr @@ -219,7 +290,7 @@ allocBytesQuerying $ \ outPtr outLen -> get typPtr outPtr outLen -- NOTE This reads a CString, up to the first \NUL -type GetCString ptr byte = ptr -> Ptr byte -> Ptr CSize -> IO BotanErrorCode +type GetCString ptr byte = ptr -> Ptr byte -> Ptr CSize -> IO CInt mkGetCString :: WithPtr typ ptr @@ -228,7 +299,7 @@ mkGetCString withPtr get typ = withPtr typ $ \ typPtr -> do allocBytesQueryingCString $ \ outPtr outLen -> get typPtr outPtr outLen -type GetInt ptr = ptr -> Ptr CInt -> IO BotanErrorCode +type GetInt ptr = ptr -> Ptr CInt -> IO CInt mkGetInt :: WithPtr typ ptr @@ -239,10 +310,10 @@ throwBotanIfNegative_ $ get typPtr szPtr fromIntegral <$> peek szPtr -type GetSize ptr = ptr -> Ptr CSize -> IO BotanErrorCode -type GetSize_csize ptr = ptr -> CSize -> Ptr CSize -> IO BotanErrorCode -type GetSizes2 ptr = ptr -> Ptr CSize -> Ptr CSize -> IO BotanErrorCode -type GetSizes3 ptr = ptr -> Ptr CSize -> Ptr CSize -> Ptr CSize -> IO BotanErrorCode +type GetSize ptr = ptr -> Ptr CSize -> IO CInt +type GetSize_csize ptr = ptr -> CSize -> Ptr CSize -> IO CInt +type GetSizes2 ptr = ptr -> Ptr CSize -> Ptr CSize -> IO CInt +type GetSizes3 ptr = ptr -> Ptr CSize -> Ptr CSize -> Ptr CSize -> IO CInt mkGetSize :: WithPtr typ ptr @@ -285,33 +356,14 @@ szC <- fromIntegral <$> peek szPtrC return (szA,szB,szC) --- type GetBytes ptr = ptr -> Ptr Word8 -> CSize -> IO BotanErrorCode +-- type GetBytes ptr = ptr -> Ptr Word8 -> CSize -> IO CInt -- NOTE: Get...Code nomenclature signifies that we get the desired return value -- from the error code error code, eg they use something other than throwBotanIfNegative_ -- - -type GetSuccessCode ptr = ptr -> IO BotanErrorCode -type GetSuccessCode_csize ptr = ptr -> CSize -> IO BotanErrorCode - -mkGetSuccessCode - :: WithPtr typ ptr - -> GetSuccessCode ptr - -> typ -> IO Bool -mkGetSuccessCode withPtr get typ = withPtr typ $ \ typPtr -> do - throwBotanCatchingSuccess $ get typPtr - -mkGetSuccessCode_csize - :: WithPtr typ ptr - -> GetSuccessCode_csize ptr - -> typ -> Int -> IO Bool -mkGetSuccessCode_csize withPtr get typ sz = withPtr typ $ \ typPtr -> do - throwBotanCatchingSuccess $ get typPtr (fromIntegral sz) - - -type GetBoolCode ptr = ptr -> IO BotanErrorCode -type GetBoolCode_csize ptr = ptr -> CSize -> IO BotanErrorCode +type GetBoolCode ptr = ptr -> IO CInt +type GetBoolCode_csize ptr = ptr -> CSize -> IO CInt mkGetBoolCode :: WithPtr typ ptr @@ -327,28 +379,28 @@ mkGetBoolCode_csize withPtr get typ sz = withPtr typ $ \ typPtr -> do throwBotanCatchingBool $ get typPtr (fromIntegral sz) -type GetIntCode ptr = ptr -> IO BotanErrorCode -type GetIntCode_csize ptr = ptr -> CSize -> IO BotanErrorCode +type GetIntCode ptr = ptr -> IO CInt +type GetIntCode_csize ptr = ptr -> CSize -> IO CInt -mkGetIntCode - :: WithPtr typ ptr - -> GetIntCode ptr - -> typ -> IO Int +mkGetIntCode :: + WithPtr typ ptr + -> GetIntCode ptr + -> typ -> IO Int mkGetIntCode withPtr get typ = withPtr typ $ \ typPtr -> do - throwBotanCatchingInt $ get typPtr + fmap fromIntegral $ throwBotanIfNegative $ get typPtr -mkGetIntCode_csize - :: WithPtr typ ptr - -> GetIntCode_csize ptr - -> typ -> CSize -> IO Int +mkGetIntCode_csize :: + WithPtr typ ptr + -> GetIntCode_csize ptr + -> typ -> CSize -> IO Int mkGetIntCode_csize withPtr get typ sz = withPtr typ $ \ typPtr -> do - throwBotanCatchingInt $ get typPtr sz + fmap fromIntegral $ throwBotanIfNegative $ get typPtr sz {- Effectful actions -} -type Action ptr = ptr -> IO BotanErrorCode +type Action ptr = ptr -> IO CInt mkAction :: WithPtr typ ptr -> Action ptr @@ -358,7 +410,7 @@ mkSet :: WithPtr typ ptr - -> (ptr -> a -> IO BotanErrorCode) + -> (ptr -> a -> IO CInt) -> typ -> a -> IO () mkSet withPtr set typ a = withPtr typ $ \ typPtr -> do throwBotanIfNegative_ $ set typPtr a @@ -366,13 +418,13 @@ mkSetOn :: WithPtr typ ptr -> (a -> b) - -> (ptr -> b -> IO BotanErrorCode) + -> (ptr -> b -> IO CInt) -> typ -> a -> IO () mkSetOn withPtr fn set typ sz = withPtr typ $ \ typPtr -> do throwBotanIfNegative_ $ set typPtr (fn sz) -type SetCSize ptr = ptr -> CSize -> IO BotanErrorCode -type SetCInt ptr = ptr -> CInt -> IO BotanErrorCode +type SetCSize ptr = ptr -> CSize -> IO CInt +type SetCInt ptr = ptr -> CInt -> IO CInt mkSetCSize :: WithPtr typ ptr @@ -388,8 +440,8 @@ mkSetCInt withPtr set typ sz = withPtr typ $ \ typPtr -> do throwBotanIfNegative_ $ set typPtr (fromIntegral sz) -type SetCString ptr = ptr -> CString -> IO BotanErrorCode -type SetCString_csize ptr = ptr -> CString -> CSize -> IO BotanErrorCode +type SetCString ptr = ptr -> CString -> IO CInt +type SetCString_csize ptr = ptr -> CString -> CSize -> IO CInt mkSetCString :: WithPtr typ ptr @@ -407,7 +459,7 @@ asCString cstring $ \ cstringPtr -> do throwBotanIfNegative_ $ set typPtr cstringPtr (fromIntegral sz) -type SetBytesLen ptr = ptr -> Ptr Word8 -> CSize -> IO BotanErrorCode +type SetBytesLen ptr = ptr -> Ptr Word8 -> CSize -> IO CInt mkSetBytesLen :: WithPtr typ ptr @@ -423,20 +475,20 @@ -- NOTE: This properly takes advantage of szPtr, queries the buffer size - use this elsewhere -- NOTE: This throws any botan codes other than BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -allocBytesQuerying :: (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString +allocBytesQuerying :: (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString allocBytesQuerying fn = do alloca $ \ szPtr -> do - -- TODO: Maybe poke szPtr 0 for extra safety in cas its not initially zero + poke szPtr 0 code <- fn nullPtr szPtr case code of - InsufficientBufferSpace -> do + BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -> do sz <- fromIntegral <$> peek szPtr allocBytes sz $ \ outPtr -> throwBotanIfNegative_ $ fn outPtr szPtr _ -> do throwBotanError code -- NOTE: Does not check length of taken string, vulnerable to null byte injection -allocBytesQueryingCString :: (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString +allocBytesQueryingCString :: (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString allocBytesQueryingCString action = do cstring <- allocBytesQuerying action return $!! ByteString.takeWhile (/= 0) cstring @@ -463,8 +515,8 @@ -- withPtrs :: (forall a . typ -> (ptr -> IO a) -> IO a) -> [typ] -> ([ptr] -> IO b) -> IO b -withPtrs withPtr [] act = act [] -withPtrs withPtr (typ:typs) act = withPtr typ $ \ typPtr -> withPtrs withPtr typs (act . (typPtr:)) +withPtrs _withPtr [] act = act [] +withPtrs withPtr (typ:typs) act = withPtr typ $ \ typPtr -> withPtrs withPtr typs (act . (typPtr:)) -- withNullablePtr diff --git a/src/Botan/Low/Prelude.hs b/src/Botan/Low/Prelude.hs deleted file mode 100644 --- a/src/Botan/Low/Prelude.hs +++ /dev/null @@ -1,247 +0,0 @@ -module Botan.Low.Prelude -( module Prelude -, module Control.Monad -, module Control.Exception -, module Control.DeepSeq -, module Data.ByteString -, module Data.String -, module Data.Text -, module Data.Word -, module System.IO -, module Foreign.C.String -, module Foreign.C.Types -, module Foreign.ForeignPtr -, module Foreign.Marshal.Alloc -, module Foreign.Marshal.Array -, module Foreign.Ptr -, module Foreign.Storable -, module GHC.Stack -, ConstPtr(..) -, peekCString -, withCString -, withCBytes -, withCBytesLen -, withConstCString -, withMany --- Old -, peekCStringText -, allocBytes -, allocBytesWith -, asCString -, asCStringLen -, asBytes -, unsafeAsBytes -, asBytesLen -, unsafeAsBytesLen --- Helpers -, (//) -, (/$) -, showBytes -) where - --- Re-exported modules - -import Prelude - -import Control.Monad -import Control.Exception -import Control.DeepSeq - -import Data.ByteString (ByteString) -import Data.String (IsString(..)) -import Data.Text (Text) - -import Data.Word - -import System.IO - -import Foreign.C.String hiding (peekCString, peekCStringLen, withCString, withCStringLen) -import Foreign.C.Types -import Foreign.ForeignPtr -import Foreign.Marshal.Alloc -import Foreign.Marshal.Array -import Foreign.Ptr -import Foreign.Storable - -import GHC.Stack - --- Other Imports - -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Internal as ByteString -import qualified Data.ByteString.Unsafe as ByteString - -import qualified Data.ByteString.Char8 as Char8 - -import qualified Data.Text.Encoding as Text - -import Botan.Bindings.Prelude (ConstPtr(..)) - -{- -Small rant: CString is a bit of a mess - -- CString doesn't work with const -- There is no CBytes -- Doesn't work with ConstPtr -- Different names for different types (peek vs pack, useAs vs with) - - Data.ByteString - - packCString :: CString -> IO ByteString - - useAsCString :: ByteString -> (CString -> IO a) -> IO a - - Text - - Foreign.C.String - - peekCString :: CString -> IO String - - withCString :: String -> (CString -> IO a) -> IO a --} - -{- -BETTER VERSIONS --} - --- Types - --- Safe functions that make a temporary copy --- Only care about ByteString, leave Text for higher-level botan - --- type CString = Ptr CChar - -peekCString :: CString -> IO ByteString -peekCString = ByteString.packCString - --- Replaces 'asCString' -withCString :: ByteString -> (CString -> IO a) -> IO a -withCString = ByteString.useAsCString - --- type CStringLen = (Ptr CChar, Int) - -peekCStringLen :: CStringLen -> IO ByteString -peekCStringLen = ByteString.packCStringLen - --- Replaces 'asCStringLen' -withCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a -withCStringLen = ByteString.useAsCStringLen - -type CBytes = Ptr Word8 - --- peekCBytes :: CBytes -> Int -> IO ByteString --- peekCBytes = undefined - -withCBytes :: ByteString -> (CBytes -> IO a) -> IO a -withCBytes bs act = ByteString.useAsCStringLen bs (\ (ptr,_) -> act (castPtr ptr)) - -type CBytesLen = (Ptr Word8, Int) - -peekCBytesLen :: CBytesLen -> IO ByteString -peekCBytesLen (ptr, len) = ByteString.packCStringLen (castPtr ptr, len) - --- Replaces 'asBytesLen' -withCBytesLen :: ByteString -> (CBytesLen -> IO a) -> IO a -withCBytesLen bs act = ByteString.useAsCStringLen bs (\ (ptr,len) -> act (castPtr ptr, len)) - --- QUESTION: Is it worth it to have extra types for ConstPtr versions? - -{- -type ConstCString = ConstPtr CChar -type ConstCStringLen = (ConstPtr CChar, Int) - -type ConstCBytes = ConstPtr Word8 -type ConstCBytesLen = (ConstPtr Word8, Int) --} - --- TODO: Replace --- withCString str $ \ cstr -> ... (ConstPtr cstr) ... --- with --- withConstCString str $ \ cstr -> ... cstr ... -withConstCString :: ByteString -> (ConstPtr CChar -> IO a) -> IO a -withConstCString bs act = ByteString.useAsCString bs (act . ConstPtr) - -{- -Misc --} - -withMany - :: (forall a . object -> (cobject -> IO a) -> IO a) - -> [object] - -> ([cobject] -> IO b) - -> IO b -withMany withObject [] act = act [] -withMany withObject (obj:objs) act = withObject obj $ \ cobj -> withMany withObject objs (act . (cobj:)) - -{- -OLD --} - - --- Because: --- https://github.com/haskell/text/issues/239 --- Is still an issue -peekCStringText :: CString -> IO Text -peekCStringText cs = do - bs <- ByteString.unsafePackCString cs - return $! Text.decodeUtf8 bs - --- A cheap knockoff of ByteArray.alloc / allocRet --- We'll make this safer in the future --- NOTE: THIS IS NOT LIKE Foriegn.Marshal.Alloc.allocaBytes, though it is close --- Instead of returning the thing, we always return a bytestring. --- Also, allocaBytes frees the memory after, but this is a malloc freed on garbage collect. --- I basically ripped the relevant bits from ByteArray for ease of continuity -allocBytes :: Int -> (Ptr byte -> IO ()) -> IO ByteString --- allocBytes sz f = snd <$> allocBytesWith sz f --- NOTE: This is probably better than mallocByteString withForeignPtr --- Use of mallocByteString without mkDeferredByteString / deferForeignPtrAvailability --- is possibly a factor in our InsufficientBufferSpaceException issues --- NOTE: Most of the comments are rendered moot now :) this needs cleanup -allocBytes sz f = ByteString.create sz (f . castPtr) - -allocBytesWith :: Int -> (Ptr byte -> IO a) -> IO (a, ByteString) -allocBytesWith sz f - | sz < 0 = allocBytesWith 0 f - | otherwise = do - fptr <- ByteString.mallocByteString sz - a <- withForeignPtr fptr (f . castPtr) - -- return (a, ByteString.PS fptr 0 sz) - -- NOTE: The safety of this function is suspect, may require deepseq - let bs = ByteString.PS fptr 0 sz - in bs `deepseq` return (a,bs) - --- ByteString.create' doesn't exist --- TODO: Replace allocBytesWith with this -createByteString' :: Int -> (Ptr byte -> IO a) -> IO (ByteString,a) -createByteString' sz action = ByteString.createUptoN' sz $ \ ptr -> do - a <- action (castPtr ptr) - return (sz,a) -{-# INLINE createByteString' #-} - --- - -asCString :: ByteString -> (Ptr CChar -> IO a) -> IO a -asCString = ByteString.useAsCString - -asCStringLen :: ByteString -> (Ptr CChar -> CSize -> IO a) -> IO a -asCStringLen bs f = ByteString.useAsCStringLen bs (\ (ptr,len) -> f ptr (fromIntegral len)) - -asBytes :: ByteString -> (Ptr byte -> IO a) -> IO a -asBytes bs f = asBytesLen bs (\ ptr _ -> f ptr) - -unsafeAsBytes :: ByteString -> (Ptr byte -> IO a) -> IO a -unsafeAsBytes bs f = unsafeAsBytesLen bs (\ ptr _ -> f ptr) - --- WARNING: This should not be using `useAsCStringLen` -asBytesLen :: ByteString -> (Ptr byte -> CSize -> IO a) -> IO a -asBytesLen bs f = ByteString.useAsCStringLen bs (\ (ptr,len) -> f (castPtr ptr) (fromIntegral len)) - -unsafeAsBytesLen :: ByteString -> (Ptr byte -> CSize -> IO a) -> IO a -unsafeAsBytesLen bs f = ByteString.unsafeUseAsCStringLen bs (\ (ptr,len) -> f (castPtr ptr) (fromIntegral len)) - --- Helpers used in a few name constructors - -infixr 6 // -(//) :: (IsString a, Semigroup a) => a -> a -> a -a // b = a <> "/" <> b - -infixr 0 /$ -(/$) :: (IsString a, Semigroup a) => a -> a -> a -a /$ b = a <> "(" <> b <> ")" - -showBytes :: (Show a) => a -> ByteString -showBytes = Char8.pack . show diff --git a/src/Botan/Low/PubKey.hs b/src/Botan/Low/PubKey.hs --- a/src/Botan/Low/PubKey.hs +++ b/src/Botan/Low/PubKey.hs @@ -12,187 +12,192 @@ for encryption, signatures, and key agreement. -} -module Botan.Low.PubKey -( - --- * Private keys - PrivKey(..) -, CheckKeyFlags(..) -, pattern CheckKeyNormalTests -, pattern CheckKeyExpensiveTests -, PrivKeyExportFlags(..) -, pattern PrivKeyExportDER -, pattern PrivKeyExportPEM -, withPrivKey -, privKeyCreate -, privKeyLoad -, privKeyDestroy -, privKeyAlgoName -, privKeyCheckKey -, privKeyGetField -, privKeyExport -, privKeyExportPubKey +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} --- * Public Keys +module Botan.Low.PubKey ( -, PubKey(..) -, withPubKey -, pubKeyLoad -, pubKeyDestroy -, pubKeyAlgoName -, pubKeyCheckKey -, pubKeyEstimatedStrength -, pubKeyFingerprint -, pubKeyGetField -, pubKeyExport + -- * Private keys + PrivKey(..) + , CheckKeyFlags(..) + , checkKeyFlags + , PrivKeyExportFlags(..) + , privKeyExportFlags + , withPrivKey + , privKeyCreate + , privKeyLoad + , privKeyDestroy + , privKeyAlgoName + , privKeyCheckKey + , privKeyGetField + , privKeyExport + , privKeyExportPubKey --- * PK Algorithms + -- * Public Keys -, PKName(..) -, pattern RSA -, pattern SM2 -, pattern ElGamal -, pattern DSA -, pattern ECDSA -, pattern ECKCDSA -, pattern ECGDSA -, pattern GOST_34_10 -, pattern Ed25519 -, pattern XMSS -, pattern DH -, pattern ECDH -, pattern Curve25519 -, pattern Dilithium -, pattern Kyber -, pattern McEliece + , PubKey(..) + , withPubKey + , pubKeyLoad + , pubKeyDestroy + , pubKeyAlgoName + , pubKeyCheckKey + , pubKeyEstimatedStrength + , pubKeyFingerprint + , pubKeyGetField + , pubKeyExport --- ** DLGroup + -- * PK Algorithms -, DLGroupName(..) -, pattern FFDHE_IETF_2048 -, pattern FFDHE_IETF_3072 -, pattern FFDHE_IETF_4096 -, pattern FFDHE_IETF_6144 -, pattern FFDHE_IETF_8192 -, pattern MODP_IETF_1024 -, pattern MODP_IETF_1536 -, pattern MODP_IETF_2048 -, pattern MODP_IETF_3072 -, pattern MODP_IETF_4096 -, pattern MODP_IETF_6144 -, pattern MODP_IETF_8192 -, pattern MODP_SRP_1024 -, pattern MODP_SRP_1536 -, pattern MODP_SRP_2048 -, pattern MODP_SRP_3072 -, pattern MODP_SRP_4096 -, pattern MODP_SRP_6144 -, pattern MODP_SRP_8192 -, pattern DSA_JCE_1024 -, pattern DSA_BOTAN_2048 -, pattern DSA_BOTAN_3072 + , PKName + , pattern RSA + , pattern SM2 + , pattern ElGamal + , pattern DSA + , pattern ECDSA + , pattern ECKCDSA + , pattern ECGDSA + , pattern GOST_34_10 + , pattern Ed25519 + , pattern XMSS + , pattern DH + , pattern ECDH + , pattern Curve25519 + , pattern Dilithium + , pattern Kyber + , pattern McEliece --- ** ECGroup + -- ** DLGroup -, ECGroupName(..) -, pattern Secp160k1 -, pattern Secp160r1 -, pattern Secp160r2 -, pattern Secp192k1 -, pattern Secp192r1 -, pattern Secp224k1 -, pattern Secp224r1 -, pattern Secp256k1 -, pattern Secp256r1 -, pattern Secp384r1 -, pattern Secp521r1 -, pattern Brainpool160r1 -, pattern Brainpool192r1 -, pattern Brainpool224r1 -, pattern Brainpool256r1 -, pattern Brainpool320r1 -, pattern Brainpool384r1 -, pattern Brainpool512r1 -, pattern X962_p192v2 -, pattern X962_p192v3 -, pattern X962_p239v1 -, pattern X962_p239v2 -, pattern X962_p239v3 -, pattern Gost_256A -, pattern Gost_512A -, pattern Frp256v1 -, pattern Sm2p256v1 + , DLGroupName + , pattern FFDHE_IETF_2048 + , pattern FFDHE_IETF_3072 + , pattern FFDHE_IETF_4096 + , pattern FFDHE_IETF_6144 + , pattern FFDHE_IETF_8192 + , pattern MODP_IETF_1024 + , pattern MODP_IETF_1536 + , pattern MODP_IETF_2048 + , pattern MODP_IETF_3072 + , pattern MODP_IETF_4096 + , pattern MODP_IETF_6144 + , pattern MODP_IETF_8192 + , pattern MODP_SRP_1024 + , pattern MODP_SRP_1536 + , pattern MODP_SRP_2048 + , pattern MODP_SRP_3072 + , pattern MODP_SRP_4096 + , pattern MODP_SRP_6144 + , pattern MODP_SRP_8192 + , pattern DSA_JCE_1024 + , pattern DSA_BOTAN_2048 + , pattern DSA_BOTAN_3072 --- ** XMSS + -- ** ECGroup -, XMSSName(..) -, pattern XMSS_SHA2_10_256 -, pattern XMSS_SHA2_16_256 -, pattern XMSS_SHA2_20_256 -, pattern XMSS_SHA2_10_512 -, pattern XMSS_SHA2_16_512 -, pattern XMSS_SHA2_20_512 -, pattern XMSS_SHAKE_10_256 -, pattern XMSS_SHAKE_16_256 -, pattern XMSS_SHAKE_20_256 -, pattern XMSS_SHAKE_10_512 -, pattern XMSS_SHAKE_16_512 -, pattern XMSS_SHAKE_20_512 + , ECGroupName + , pattern Secp160k1 + , pattern Secp160r1 + , pattern Secp160r2 + , pattern Secp192k1 + , pattern Secp192r1 + , pattern Secp224k1 + , pattern Secp224r1 + , pattern Secp256k1 + , pattern Secp256r1 + , pattern Secp384r1 + , pattern Secp521r1 + , pattern Brainpool160r1 + , pattern Brainpool192r1 + , pattern Brainpool224r1 + , pattern Brainpool256r1 + , pattern Brainpool320r1 + , pattern Brainpool384r1 + , pattern Brainpool512r1 + , pattern X962_p192v2 + , pattern X962_p192v3 + , pattern X962_p239v1 + , pattern X962_p239v2 + , pattern X962_p239v3 + , pattern Gost_256A + , pattern Gost_512A + , pattern Frp256v1 + , pattern Sm2p256v1 --- * EME + -- ** XMSS -, EMEName(..) -, pattern EME_RAW -, pattern EME_PKCS1_v1_5 -, pattern EME_OAEP -, eme_raw -, eme_pkcs1_v1_5 -, eme_oaep --- , eme_oaep_mgf -, eme_hash -, eme_sm2EncParam + , XMSSName + , pattern XMSS_SHA2_10_256 + , pattern XMSS_SHA2_16_256 + , pattern XMSS_SHA2_20_256 + , pattern XMSS_SHA2_10_512 + , pattern XMSS_SHA2_16_512 + , pattern XMSS_SHA2_20_512 + , pattern XMSS_SHAKE_10_256 + , pattern XMSS_SHAKE_16_256 + , pattern XMSS_SHAKE_20_256 + , pattern XMSS_SHAKE_10_512 + , pattern XMSS_SHAKE_16_512 + , pattern XMSS_SHAKE_20_512 --- * EMSA + -- * EME -, EMSAName(..) -, emsa_none -, emsa_emsa4 -, emsa_hash -, emsa_ed25519Pure -, emsa_ed25519Prehashed -, emsa_ed25519GnuPG -, emsa_sm2SignParam + , EMEName + , pattern EME_RAW + , pattern EME_PKCS1_v1_5 + , pattern EME_OAEP + , eme_raw + , eme_pkcs1_v1_5 + , eme_oaep + -- , eme_oaep_mgf + , eme_hash + , eme_sm2EncParam --- * Convenience + -- * EMSA --- , PKPaddingName(..) -, createPrivKey -, createPubKey -, mkPrivKeyLoad1_name -, mkPrivKeyLoad3 -, mkPrivKeyLoad4 -, mkPubKeyLoad2 -, mkPubKeyLoad2_name -, mkPubKeyLoad3 -, mkPubKeyLoad4 + , EMSAName + , emsa_none + , emsa_emsa4 + , emsa_hash + , emsa_ed25519Pure + , emsa_ed25519Prehashed + , emsa_ed25519GnuPG + , emsa_sm2SignParam -) where + -- * Convenience -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Unsafe as ByteString + -- , PKPaddingName(..) + , createPrivKey + , createPubKey + , mkPrivKeyLoad1_name + , mkPrivKeyLoad3 + , mkPrivKeyLoad4 + , mkPubKeyLoad2 + , mkPubKeyLoad2_name + , mkPubKeyLoad3 + , mkPubKeyLoad4 -import Botan.Bindings.MPI -import Botan.Bindings.PubKey -import Botan.Bindings.RNG + ) where -import Botan.Low.Error -import Botan.Low.Hash -import Botan.Low.Make -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.Remake -import Botan.Low.RNG -import Botan.Low.View +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.MPI +import Botan.Bindings.PubKey +import Botan.Bindings.RNG +import Botan.Low.Error.Internal +import Botan.Low.Hash +import Botan.Low.Internal.ByteString +import Botan.Low.Internal.String +import Botan.Low.Make +import Botan.Low.MPI +import Botan.Low.Remake +import Botan.Low.RNG +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable {- $introduction @@ -272,26 +277,21 @@ -- Associated types -type PKPaddingName = ByteString - -- /* -- * Public/private key creation, import, ... -- */ newtype PrivKey = MkPrivKey { getPrivKeyForeignPtr :: ForeignPtr BotanPrivKeyStruct } -newPrivKey :: BotanPrivKey -> IO PrivKey withPrivKey :: PrivKey -> (BotanPrivKey -> IO a) -> IO a privKeyDestroy :: PrivKey -> IO () createPrivKey :: (Ptr BotanPrivKey -> IO CInt) -> IO PrivKey -(newPrivKey, withPrivKey, privKeyDestroy, createPrivKey, _) +(withPrivKey, privKeyDestroy, createPrivKey) = mkBindings - MkBotanPrivKey runBotanPrivKey - MkPrivKey getPrivKeyForeignPtr + MkBotanPrivKey (.runBotanPrivKey) + MkPrivKey (.getPrivKeyForeignPtr) botan_privkey_destroy -type PrivKeyName = ByteString - type PKName = ByteString pattern RSA @@ -503,16 +503,7 @@ eme_sm2EncParam :: HashName -> EMEName eme_sm2EncParam h = h -type MGFName = ByteString -pattern MGF1 - :: MGFName - -pattern MGF1 = BOTAN_MGF_MGF1 - -mgf1 :: HashName -> MGFName -mgf1 h = MGF1 /$ h - {- | Encoding Method for Signature with Appendix @@ -562,17 +553,13 @@ (ConstPtr paramsPtr) botanRNG --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withPrivKeyCreate :: ByteString -> ByteString -> RNG -> (PrivKey -> IO a) -> IO a -withPrivKeyCreate = mkWithTemp3 privKeyCreate privKeyDestroy - -type CheckKeyFlags = Word32 +data CheckKeyFlags = + CheckKeyNormalTests + | CheckKeyExpensiveTests -pattern CheckKeyNormalTests - , CheckKeyExpensiveTests - :: CheckKeyFlags -pattern CheckKeyNormalTests = BOTAN_CHECK_KEY_NORMAL_TESTS -pattern CheckKeyExpensiveTests = BOTAN_CHECK_KEY_EXPENSIVE_TESTS +checkKeyFlags :: CheckKeyFlags -> Word32 +checkKeyFlags CheckKeyNormalTests = BOTAN_CHECK_KEY_NORMAL_TESTS +checkKeyFlags CheckKeyExpensiveTests = BOTAN_CHECK_KEY_EXPENSIVE_TESTS -- TODO: Probably catch -1 (INVALID_INPUT), return Bool -- | Check the validity of a private key @@ -583,7 +570,7 @@ -> IO () privKeyCheckKey sk rng flags = withPrivKey sk $ \ skPtr -> do withRNG rng $ \ botanRNG -> do - throwBotanIfNegative_ $ botan_privkey_check_key skPtr botanRNG flags + throwBotanIfNegative_ $ botan_privkey_check_key skPtr botanRNG (checkKeyFlags flags) -- NOTE: Expectes PKCS #8 / PEM structure -- botan_privkey_export -> null password? and botan_privkey_export_encrypted_... -> use a password? @@ -611,14 +598,13 @@ bitsLen (ConstPtr passwordPtr) -type PrivKeyExportFlags = Word32 - -pattern PrivKeyExportDER - , PrivKeyExportPEM - :: PrivKeyExportFlags +data PrivKeyExportFlags = + PrivKeyExportDER + | PrivKeyExportPEM -pattern PrivKeyExportDER = BOTAN_PRIVKEY_EXPORT_FLAG_DER -pattern PrivKeyExportPEM = BOTAN_PRIVKEY_EXPORT_FLAG_PEM +privKeyExportFlags :: PrivKeyExportFlags -> Word32 +privKeyExportFlags PrivKeyExportDER = BOTAN_PRIVKEY_EXPORT_FLAG_DER +privKeyExportFlags PrivKeyExportPEM = BOTAN_PRIVKEY_EXPORT_FLAG_PEM -- NOTE: Different from allocBytesQuerying / INSUFFICIENT_BUFFER_SPACE {- | @@ -636,13 +622,13 @@ alloca $ \szPtr -> do poke szPtr 0 -- NOTE: Presumed be -1 - _ <- botan_privkey_export skPtr nullPtr szPtr flags + _ <- botan_privkey_export skPtr nullPtr szPtr (privKeyExportFlags flags) sz <- peek szPtr allocBytes (fromIntegral sz) $ \ bytesPtr -> do - throwBotanIfNegative_ $ botan_privkey_export skPtr bytesPtr szPtr flags + throwBotanIfNegative_ $ botan_privkey_export skPtr bytesPtr szPtr (privKeyExportFlags flags) -- TODO: --- | View the private key's DER encoding +-- View the private key's DER encoding -- privKeyViewDER -- :: BotanPrivKey -- ^ __key__ -- -> BotanViewContext ctx -- ^ __ctx__ @@ -650,7 +636,7 @@ -- -> IO CInt -- TODO: --- | View the private key's PEM encoding +-- View the private key's PEM encoding -- privKeyViewPEM -- :: BotanPrivKey -- ^ __key__ -- -> BotanViewContext ctx -- ^ __ctx__ @@ -688,27 +674,20 @@ newtype PubKey = MkPubKey { getPubKeyForeignPtr :: ForeignPtr BotanPubKeyStruct } -newPubKey :: BotanPubKey -> IO PubKey withPubKey :: PubKey -> (BotanPubKey -> IO a) -> IO a pubKeyDestroy :: PubKey -> IO () createPubKey :: (Ptr BotanPubKey -> IO CInt) -> IO PubKey -(newPubKey, withPubKey, pubKeyDestroy, createPubKey, _) +(withPubKey, pubKeyDestroy, createPubKey) = mkBindings - MkBotanPubKey runBotanPubKey - MkPubKey getPubKeyForeignPtr + MkBotanPubKey (.runBotanPubKey) + MkPubKey (.getPubKeyForeignPtr) botan_pubkey_destroy -type PubKeyName = ByteString - pubKeyLoad :: ByteString -- ^ __bits[]__ -> IO PubKey -- ^ __key__ pubKeyLoad = mkCreateObjectCBytesLen createPubKey botan_pubkey_load --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withPubKeyLoad :: ByteString -> (PubKey -> IO a) -> IO a -withPubKeyLoad = mkWithTemp1 pubKeyLoad pubKeyDestroy - privKeyExportPubKey :: PrivKey -- ^ __in__ -> IO PubKey -- ^ __out__ @@ -716,13 +695,7 @@ type PubKeyExportFlags = PrivKeyExportFlags -pattern PubKeyExportDER - , PubKeyExportPEM - :: PubKeyExportFlags -pattern PubKeyExportDER = PrivKeyExportDER -pattern PubKeyExportPEM = PrivKeyExportPEM - -- NOTE: Different from allocBytesQuerying / INSUFFICIENT_BUFFER_SPACE pubKeyExport :: PubKey -- ^ __key__ @@ -732,10 +705,10 @@ alloca $ \szPtr -> do poke szPtr 0 -- NOTE: Presumed be -1 - _ <- botan_pubkey_export pkPtr nullPtr szPtr flags + _ <- botan_pubkey_export pkPtr nullPtr szPtr (privKeyExportFlags flags) sz <- peek szPtr allocBytes (fromIntegral sz) $ \ bytesPtr -> do - throwBotanIfNegative_ $ botan_pubkey_export pkPtr bytesPtr szPtr flags + throwBotanIfNegative_ $ botan_pubkey_export pkPtr bytesPtr szPtr (privKeyExportFlags flags) pubKeyAlgoName @@ -743,21 +716,22 @@ -> IO ByteString -- ^ __out[]__ pubKeyAlgoName = mkGetCString withPubKey botan_pubkey_algo_name -pubKeyCheckKey - :: PubKey -- ^ __key__ - -> RNG -- ^ __rng__ - -> CheckKeyFlags -- ^ __flags__ - -> IO Bool -pubKeyCheckKey pk rng flags = withPubKey pk $ \ pkPtr -> do - withRNG rng $ \ botanRNG -> do - throwBotanCatchingSuccess $ botan_pubkey_check_key pkPtr botanRNG flags +pubKeyCheckKey :: + PubKey -- ^ __key__ + -> RNG -- ^ __rng__ + -> CheckKeyFlags -- ^ __flags__ + -> IO Bool +pubKeyCheckKey pk rng flags = + withPubKey pk $ \ pkPtr -> + withRNG rng $ \ botanRNG -> + throwBotanCatchingInvalidInput $ botan_pubkey_check_key pkPtr botanRNG (checkKeyFlags flags) -- Annoying - this mixes cint and csize -- I need to consolidate getsize / getint pubKeyEstimatedStrength :: PubKey -- ^ __key__ -> IO Int -- ^ __estimate__ -pubKeyEstimatedStrength pk = fromIntegral <$> mkGetSize withPubKey botan_pubkey_estimated_strength pk +pubKeyEstimatedStrength pk = mkGetSize withPubKey botan_pubkey_estimated_strength pk pubKeyFingerprint :: PubKey -- ^ __key__ @@ -802,47 +776,67 @@ -- Helpers mkPrivKeyLoad1_name - :: (Ptr BotanPrivKey -> BotanMP -> ConstPtr CChar -> IO BotanErrorCode) + :: (Ptr BotanPrivKey -> BotanMP -> ConstPtr CChar -> IO CInt) -> MP -> ByteString -> IO PrivKey mkPrivKeyLoad1_name load a name = withMP a $ \ aPtr -> do asCString name $ \ namePtr -> do createPrivKey $ \ out -> load out aPtr (ConstPtr namePtr) mkPrivKeyLoad3 - :: (Ptr BotanPrivKey -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode) + :: (Ptr BotanPrivKey -> BotanMP -> BotanMP -> BotanMP -> IO CInt) -> MP -> MP -> MP -> IO PrivKey -mkPrivKeyLoad3 load a b c = withMany withMP [a,b,c] $ \ [aPtr,bPtr,cPtr] -> do - createPrivKey $ \ out -> load out aPtr bPtr cPtr +mkPrivKeyLoad3 load a b c = withMany withMP [a,b,c] $ \case + [aPtr,bPtr,cPtr] -> do + createPrivKey $ \ out -> load out aPtr bPtr cPtr + _ -> error "mkPrivKeyLoad3: impossible" mkPrivKeyLoad4 - :: (Ptr BotanPrivKey -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode) + :: (Ptr BotanPrivKey -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO CInt) -> MP -> MP -> MP -> MP -> IO PrivKey -mkPrivKeyLoad4 load a b c d = withMany withMP [a,b,c,d] $ \ [aPtr,bPtr,cPtr,dPtr] -> do - createPrivKey $ \ out -> load out aPtr bPtr cPtr dPtr +mkPrivKeyLoad4 load a b c d = withMany withMP [a,b,c,d] $ \case + [aPtr,bPtr,cPtr,dPtr] -> do + createPrivKey $ \ out -> load out aPtr bPtr cPtr dPtr + _ -> error "mkPrivKeyLoad4: impossible" -- mkPubKeyLoad2 - :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> IO BotanErrorCode) + :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> IO CInt) -> MP -> MP -> IO PubKey -mkPubKeyLoad2 load a b = withMany withMP [a,b] $ \ [aPtr,bPtr] -> do - createPubKey $ \ out -> load out aPtr bPtr +mkPubKeyLoad2 load a b = withMany withMP [a,b] $ \case + [aPtr,bPtr] -> do + createPubKey $ \ out -> load out aPtr bPtr + _ -> error "mkPubKeyLoad2: impossible" mkPubKeyLoad2_name - :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> ConstPtr CChar -> IO BotanErrorCode) + :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> ConstPtr CChar -> IO CInt) -> MP -> MP -> ByteString -> IO PubKey -mkPubKeyLoad2_name load x y name = withMany withMP [x,y] $ \ [xPtr,yPtr] -> do - asCString name $ \ namePtr -> do +mkPubKeyLoad2_name load x y name = withMany withMP [x,y] $ \case + [xPtr,yPtr] -> do + asCString name $ \ namePtr -> do createPubKey $ \ out -> load out xPtr yPtr (ConstPtr namePtr) + _ -> error "mkPubKeyLoad2_name: impossible" mkPubKeyLoad3 - :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode) + :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> BotanMP -> IO CInt) -> MP -> MP -> MP -> IO PubKey -mkPubKeyLoad3 load a b c = withMany withMP [a,b,c] $ \ [aPtr,bPtr,cPtr] -> do - createPubKey $ \ out -> load out aPtr bPtr cPtr +mkPubKeyLoad3 load a b c = withMany withMP [a,b,c] $ \case + [aPtr,bPtr,cPtr] -> do + createPubKey $ \ out -> load out aPtr bPtr cPtr + _ -> error "mkPubKeyLoad3: impossible" mkPubKeyLoad4 - :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode) + :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO CInt) -> MP -> MP -> MP -> MP -> IO PubKey -mkPubKeyLoad4 load a b c d = withMany withMP [a,b,c,d] $ \ [aPtr,bPtr,cPtr,dPtr] -> do - createPubKey $ \ out -> load out aPtr bPtr cPtr dPtr +mkPubKeyLoad4 load a b c d = withMany withMP [a,b,c,d] $ \case + [aPtr,bPtr,cPtr,dPtr] -> do + createPubKey $ \ out -> load out aPtr bPtr cPtr dPtr + _ -> error "mkPubKeyLoad4: impossible" + +withMany :: + (forall a . object -> (cobject -> IO a) -> IO a) + -> [object] + -> ([cobject] -> IO b) + -> IO b +withMany _withObject [] act = act [] +withMany withObject (obj:objs) act = withObject obj $ \ cobj -> withMany withObject objs (act . (cobj:)) diff --git a/src/Botan/Low/PubKey/DH.hs b/src/Botan/Low/PubKey/DH.hs --- a/src/Botan/Low/PubKey/DH.hs +++ b/src/Botan/Low/PubKey/DH.hs @@ -9,17 +9,14 @@ Portability : POSIX -} -module Botan.Low.PubKey.DH where - -import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey.DH +module Botan.Low.PubKey.DH ( + privKeyLoadDH + , pubKeyLoadDH + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey +import Botan.Bindings.PubKey.DH +import Botan.Low.MPI +import Botan.Low.PubKey privKeyLoadDH :: MP -- ^ __p__: prime order of a Z_p group diff --git a/src/Botan/Low/PubKey/DSA.hs b/src/Botan/Low/PubKey/DSA.hs --- a/src/Botan/Low/PubKey/DSA.hs +++ b/src/Botan/Low/PubKey/DSA.hs @@ -9,19 +9,16 @@ Portability : POSIX -} -module Botan.Low.PubKey.DSA where - -import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey -import Botan.Bindings.PubKey.DSA +module Botan.Low.PubKey.DSA ( + privKeyCreateDSA + , privKeyLoadDSA + , pubKeyLoadDSA + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.RNG +import Botan.Bindings.PubKey.DSA +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.RNG privKeyCreateDSA :: RNG -- ^ __rng__: initialized PRNG diff --git a/src/Botan/Low/PubKey/Decrypt.hs b/src/Botan/Low/PubKey/Decrypt.hs --- a/src/Botan/Low/PubKey/Decrypt.hs +++ b/src/Botan/Low/PubKey/Decrypt.hs @@ -9,29 +9,33 @@ Portability : POSIX -} -module Botan.Low.PubKey.Decrypt -( - --- * Public key decryption - Decrypt(..) -, withDecrypt -, decryptCreate -, decryptDestroy -, decryptOutputLength -, decrypt - -) where +module Botan.Low.PubKey.Decrypt ( -import qualified Data.ByteString as ByteString + -- * Public key decryption + Decrypt(..) + , withDecrypt + , decryptCreate + , decryptDestroy + , decryptOutputLength + , decrypt -import Botan.Bindings.PubKey.Decrypt + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.Remake +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.PubKey.Decrypt +import Botan.Low.Error.Internal (throwBotanIfNegative_) +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Botan.Low.PubKey +import Botan.Low.Remake +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable -- /* -- * Public Key Decryption @@ -39,14 +43,13 @@ newtype Decrypt = MkDecrypt { getDecryptForeignPtr :: ForeignPtr BotanPKOpDecryptStruct } -newDecrypt :: BotanPKOpDecrypt -> IO Decrypt withDecrypt :: Decrypt -> (BotanPKOpDecrypt -> IO a) -> IO a decryptDestroy :: Decrypt -> IO () createDecrypt :: (Ptr BotanPKOpDecrypt -> IO CInt) -> IO Decrypt -(newDecrypt, withDecrypt, decryptDestroy, createDecrypt, _) +(withDecrypt, decryptDestroy, createDecrypt) = mkBindings - MkBotanPKOpDecrypt runBotanPKOpDecrypt - MkDecrypt getDecryptForeignPtr + MkBotanPKOpDecrypt (.runBotanPKOpDecrypt) + MkDecrypt (.getDecryptForeignPtr) botan_pk_op_decrypt_destroy decryptCreate @@ -61,25 +64,28 @@ paddingPtr BOTAN_PUBKEY_DECRYPT_FLAGS_NONE --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withDecryptCreate :: PrivKey -> EMEName -> (Decrypt -> IO a) -> IO a -withDecryptCreate = mkWithTemp2 decryptCreate decryptDestroy - decryptOutputLength :: Decrypt -- ^ __op__ -> Int -- ^ __ctext_len__ -> IO Int -- ^ __ptext_len__ decryptOutputLength = mkGetSize_csize withDecrypt botan_pk_op_decrypt_output_length -decrypt - :: Decrypt -- ^ __op__ - -> ByteString -- ^ __ciphertext__ - -> IO ByteString -- ^ __plaintext__ -decrypt dec ctext = withDecrypt dec $ \ decPtr -> do - asBytesLen ctext $ \ ctextPtr ctextLen -> do - allocBytesQuerying $ \ outPtr szPtr -> botan_pk_op_decrypt +decrypt :: + Decrypt -- ^ __op__ + -> ByteString -- ^ __ciphertext__ + -> IO ByteString -- ^ __plaintext__ +decrypt dec ctext = + withDecrypt dec $ \ decPtr -> + asBytesLen ctext $ \ ctextPtr ctextLen -> + alloca $ \szPtr -> do + sz <- decryptOutputLength dec (BS.length ctext) + poke szPtr (fromIntegral sz) + BSI.createAndTrim sz $ \outPtr -> do + throwBotanIfNegative_ $ + botan_pk_op_decrypt decPtr outPtr szPtr (ConstPtr ctextPtr) ctextLen + fromIntegral <$> peek szPtr diff --git a/src/Botan/Low/PubKey/ECDH.hs b/src/Botan/Low/PubKey/ECDH.hs --- a/src/Botan/Low/PubKey/ECDH.hs +++ b/src/Botan/Low/PubKey/ECDH.hs @@ -1,11 +1,12 @@ -module Botan.Low.PubKey.ECDH where - -import Botan.Bindings.PubKey -import Botan.Bindings.PubKey.ECDH +module Botan.Low.PubKey.ECDH ( + privKeyLoadECDH + , pubKeyLoadECDH + ) where -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey +import Botan.Bindings.PubKey.ECDH +import Botan.Low.MPI +import Botan.Low.PubKey +import Data.ByteString (ByteString) privKeyLoadECDH :: MP -- ^ __scalar__ diff --git a/src/Botan/Low/PubKey/ECDSA.hs b/src/Botan/Low/PubKey/ECDSA.hs --- a/src/Botan/Low/PubKey/ECDSA.hs +++ b/src/Botan/Low/PubKey/ECDSA.hs @@ -1,11 +1,12 @@ -module Botan.Low.PubKey.ECDSA where - -import Botan.Bindings.PubKey -import Botan.Bindings.PubKey.ECDSA +module Botan.Low.PubKey.ECDSA ( + privKeyLoadECDSA + , pubKeyLoadECDSA + ) where -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey +import Botan.Bindings.PubKey.ECDSA +import Botan.Low.MPI +import Botan.Low.PubKey +import Data.ByteString (ByteString) privKeyLoadECDSA :: MP -- ^ __scalar__ diff --git a/src/Botan/Low/PubKey/Ed25519.hs b/src/Botan/Low/PubKey/Ed25519.hs --- a/src/Botan/Low/PubKey/Ed25519.hs +++ b/src/Botan/Low/PubKey/Ed25519.hs @@ -9,18 +9,19 @@ Portability : POSIX -} -module Botan.Low.PubKey.Ed25519 where - -import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey -import Botan.Bindings.PubKey.Ed25519 +module Botan.Low.PubKey.Ed25519 ( + privKeyLoadEd25519 + , pubKeyLoadEd25519 + , privKeyEd25519GetPrivKey + , pubKeyEd25519GetPubKey + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.Remake +import Botan.Bindings.PubKey.Ed25519 +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.PubKey +import Botan.Low.Remake +import Data.ByteString (ByteString) -- /* -- * Algorithm specific key operations: Ed25519 diff --git a/src/Botan/Low/PubKey/ElGamal.hs b/src/Botan/Low/PubKey/ElGamal.hs --- a/src/Botan/Low/PubKey/ElGamal.hs +++ b/src/Botan/Low/PubKey/ElGamal.hs @@ -9,19 +9,16 @@ Portability : POSIX -} -module Botan.Low.PubKey.ElGamal where - -import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey -import Botan.Bindings.PubKey.ElGamal +module Botan.Low.PubKey.ElGamal ( + privKeyCreateElGamal + , privKeyLoadElGamal + , pubKeyLoadElGamal + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.RNG +import Botan.Bindings.PubKey.ElGamal +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.RNG -- /* -- * Algorithm specific key operations: ElGamal diff --git a/src/Botan/Low/PubKey/Encrypt.hs b/src/Botan/Low/PubKey/Encrypt.hs --- a/src/Botan/Low/PubKey/Encrypt.hs +++ b/src/Botan/Low/PubKey/Encrypt.hs @@ -9,29 +9,34 @@ Portability : POSIX -} -module Botan.Low.PubKey.Encrypt -( - --- * Public key encryption - Encrypt(..) -, withEncrypt -, encryptCreate -, encryptDestroy -, encryptOutputLength -, encrypt - -) where +module Botan.Low.PubKey.Encrypt ( -import qualified Data.ByteString as ByteString + -- * Public key encryption + Encrypt(..) + , withEncrypt + , encryptCreate + , encryptDestroy + , encryptOutputLength + , encrypt -import Botan.Bindings.PubKey.Encrypt + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.Remake +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.PubKey.Encrypt +import Botan.Low.Error.Internal (throwBotanIfNegative_) +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Botan.Low.PubKey +import Botan.Low.Remake +import Botan.Low.RNG +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable -- /* -- * Public Key Encryption @@ -39,14 +44,13 @@ newtype Encrypt = MkEncrypt { getEncryptForeignPtr :: ForeignPtr BotanPKOpEncryptStruct } -newEncrypt :: BotanPKOpEncrypt -> IO Encrypt withEncrypt :: Encrypt -> (BotanPKOpEncrypt -> IO a) -> IO a encryptDestroy :: Encrypt -> IO () createEncrypt :: (Ptr BotanPKOpEncrypt -> IO CInt) -> IO Encrypt -(newEncrypt, withEncrypt, encryptDestroy, createEncrypt, _) +(withEncrypt, encryptDestroy, createEncrypt) = mkBindings - MkBotanPKOpEncrypt runBotanPKOpEncrypt - MkEncrypt getEncryptForeignPtr + MkBotanPKOpEncrypt (.runBotanPKOpEncrypt) + MkEncrypt (.getEncryptForeignPtr) botan_pk_op_encrypt_destroy encryptCreate @@ -61,34 +65,31 @@ (ConstPtr paddingPtr) 0 --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withEncryptCreate :: PubKey -> EMEName -> (Encrypt -> IO a) -> IO a -withEncryptCreate = mkWithTemp2 encryptCreate encryptDestroy - encryptOutputLength :: Encrypt -- ^ __op__ -> Int -- ^ __ptext_len__ -> IO Int -- ^ __ctext_len__ encryptOutputLength = mkGetSize_csize withEncrypt botan_pk_op_encrypt_output_length --- NOTE: This properly takes advantage of szPtr, queries the buffer size - do this elsewhere --- NOTE: SM2 take a hash instead of a padding, and encrypt fails with InsufficientBufferSpace --- if sm2p256v1 is not used as the curve when creating the key (but creating the key and --- the encryption context do not fail) --- This implies that encryptOutputLength may be wrong or hardcoded for SM2 or that we --- are not supposed to use curves other than sm2p256v1 - this needs investigating -encrypt - :: Encrypt -- ^ __op__ - -> RNG -- ^ __rng__ - -> ByteString -- ^ __plaintext[]__ - -> IO ByteString -- ^ __ciphertext[]__ -encrypt enc rng ptext = withEncrypt enc $ \ encPtr -> do - withRNG rng $ \ botanRNG -> do - asBytesLen ptext $ \ ptextPtr ptextLen -> do - allocBytesQuerying $ \ outPtr szPtr -> botan_pk_op_encrypt - encPtr - botanRNG - outPtr - szPtr - ptextPtr - ptextLen +encrypt :: + Encrypt -- ^ __op__ + -> RNG -- ^ __rng__ + -> ByteString -- ^ __plaintext[]__ + -> IO ByteString -- ^ __ciphertext[]__ +encrypt enc rng ptext = + withEncrypt enc $ \ encPtr -> + withRNG rng $ \ botanRNG -> + asBytesLen ptext $ \ ptextPtr ptextLen -> + alloca $ \szPtr -> do + sz <- encryptOutputLength enc (BS.length ptext) + poke szPtr (fromIntegral sz) + BSI.createAndTrim sz $ \outPtr -> do + throwBotanIfNegative_ $ + botan_pk_op_encrypt + encPtr + botanRNG + outPtr + szPtr + ptextPtr + ptextLen + fromIntegral <$> peek szPtr diff --git a/src/Botan/Low/PubKey/KeyAgreement.hs b/src/Botan/Low/PubKey/KeyAgreement.hs --- a/src/Botan/Low/PubKey/KeyAgreement.hs +++ b/src/Botan/Low/PubKey/KeyAgreement.hs @@ -9,35 +9,39 @@ Portability : POSIX -} -module Botan.Low.PubKey.KeyAgreement -( +module Botan.Low.PubKey.KeyAgreement ( --- * PK Key Agreement --- $introduction --- * Usage --- $usage + -- * PK Key Agreement + -- $introduction + -- * Usage + -- $usage --- * Key agreement - KeyAgreement(..) -, withKeyAgreement -, keyAgreementCreate -, keyAgreementDestroy -, keyAgreementExportPublic -, keyAgreementSize -, keyAgreement + -- * Key agreement + KeyAgreement(..) + , withKeyAgreement + , keyAgreementCreate + , keyAgreementDestroy + , keyAgreementExportPublic + , keyAgreementSize + , keyAgreement -) where + ) where +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.PubKey.KeyAgreement +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.KDF +import Botan.Low.Make +import Botan.Low.PubKey +import Botan.Low.Remake +import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey.KeyAgreement - -import Botan.Low.Error -import Botan.Low.KDF -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.Remake +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable {- $introduction @@ -113,89 +117,70 @@ newtype KeyAgreement = MkKeyAgreement { getKeyAgreementForeignPtr :: ForeignPtr BotanPKOpKeyAgreementStruct } -newKeyAgreement :: BotanPKOpKeyAgreement -> IO KeyAgreement withKeyAgreement :: KeyAgreement -> (BotanPKOpKeyAgreement -> IO a) -> IO a keyAgreementDestroy :: KeyAgreement -> IO () createKeyAgreement :: (Ptr BotanPKOpKeyAgreement -> IO CInt) -> IO KeyAgreement -(newKeyAgreement, withKeyAgreement, keyAgreementDestroy, createKeyAgreement, _) +(withKeyAgreement, keyAgreementDestroy, createKeyAgreement) = mkBindings - MkBotanPKOpKeyAgreement runBotanPKOpKeyAgreement - MkKeyAgreement getKeyAgreementForeignPtr + MkBotanPKOpKeyAgreement (.runBotanPKOpKeyAgreement) + MkKeyAgreement (.getKeyAgreementForeignPtr) botan_pk_op_key_agreement_destroy -- NOTE: Silently uses the system RNG -keyAgreementCreate - :: PrivKey -- ^ __key__ - -> KDFName -- ^ __kdf__ - -> IO KeyAgreement -- ^ __op__ -keyAgreementCreate sk algo = withPrivKey sk $ \ skPtr -> do - asCString algo $ \ algoPtr -> do - createKeyAgreement $ \ out -> botan_pk_op_key_agreement_create - out - skPtr - (ConstPtr algoPtr) - 0 - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withKeyAgreementCreate :: PrivKey -> KDFName -> (KeyAgreement -> IO a) -> IO a -withKeyAgreementCreate = mkWithTemp2 keyAgreementCreate keyAgreementDestroy +keyAgreementCreate :: + PrivKey -- ^ __key__ + -> KDFName -- ^ __kdf__ + -> IO KeyAgreement -- ^ __op__ +keyAgreementCreate sk algo = + withPrivKey sk $ \ skPtr -> + asCString algo $ \ algoPtr -> + createKeyAgreement $ \ out -> + botan_pk_op_key_agreement_create + out + skPtr + (ConstPtr algoPtr) + 0 -- NOTE: I do not know if this provides a different functionality than just being -- an alias for botan_privkey_export_pubkey / privKeyExportPubKey -- Observe that it *does* just take a privkey, instead of a keyagreement -- It may simply be here for convenience. -{- -int botan_pk_op_key_agreement_export_public(botan_privkey_t key, uint8_t out[], size_t* out_len) { - return copy_view_bin(out, out_len, botan_pk_op_key_agreement_view_public, key); -} - -int botan_pk_op_key_agreement_view_public(botan_privkey_t key, botan_view_ctx ctx, botan_view_bin_fn view) { - return BOTAN_FFI_VISIT(key, [=](const auto& k) -> int { - if(auto kak = dynamic_cast(&k)) - return invoke_view_callback(view, ctx, kak->public_value()); - else - return BOTAN_FFI_ERROR_INVALID_INPUT; - }); -} --} -keyAgreementExportPublic - :: PrivKey -- ^ __key__ - -> IO ByteString -- ^ __out[]__ -keyAgreementExportPublic sk = withPrivKey sk $ \ skPtr -> do - allocBytesQuerying $ \ outPtr outLen -> botan_pk_op_key_agreement_export_public +keyAgreementExportPublic :: + PrivKey -- ^ __key__ + -> IO ByteString -- ^ __out[]__ +keyAgreementExportPublic sk = + withPrivKey sk $ \ skPtr -> + allocBytesQuerying $ \ outPtr outLen -> + botan_pk_op_key_agreement_export_public skPtr outPtr outLen -keyAgreementSize - :: KeyAgreement -- ^ __op__ - -> IO Int -- ^ __out_len__ +keyAgreementSize :: + KeyAgreement -- ^ __op__ + -> IO Int -- ^ __out_len__ keyAgreementSize = mkGetSize withKeyAgreement botan_pk_op_key_agreement_size --- | TODO: This function was leaking memory and causing crashes. Please observe --- carefully and report any future leaks. See issue #35. -keyAgreement - :: KeyAgreement -- ^ __op__ - -> ByteString -- ^ __out[]__ - -> ByteString -- ^ __other_key[]__ - -> IO ByteString -- ^ __salt[]__ -keyAgreement ka key salt = withKeyAgreement ka $ \ kaPtr -> do - asBytesLen key $ \ keyPtr keyLen -> do - asBytesLen salt $ \ saltPtr saltLen -> do - outSz <- keyAgreementSize ka - alloca $ \ szPtr -> do - -- NOTE: This poke was necessary to stop a memory leak - -- Similar pokes have been needed elsewere - -- TODO: Ensure that all alloca szPtr elsewhere are properly poked - poke szPtr (fromIntegral outSz) - out <- allocBytes outSz $ \ outPtr -> do - throwBotanIfNegative_ $ botan_pk_op_key_agreement - kaPtr - outPtr - szPtr - (ConstPtr keyPtr) - keyLen - (ConstPtr saltPtr) - saltLen - sz <- fromIntegral <$> peek szPtr - return $! ByteString.take sz out +keyAgreement :: + KeyAgreement -- ^ __op__ + -> ByteString -- ^ __out[]__ + -> ByteString -- ^ __other_key[]__ + -> IO ByteString -- ^ __salt[]__ +keyAgreement ka key salt = + withKeyAgreement ka $ \ kaPtr -> + asBytesLen key $ \ keyPtr keyLen -> + asBytesLen salt $ \ saltPtr saltLen -> do + outSz <- keyAgreementSize ka + alloca $ \ szPtr -> do + poke szPtr (fromIntegral outSz) + out <- allocBytes outSz $ \ outPtr -> do + throwBotanIfNegative_ $ botan_pk_op_key_agreement + kaPtr + outPtr + szPtr + (ConstPtr keyPtr) + keyLen + (ConstPtr saltPtr) + saltLen + sz <- fromIntegral <$> peek szPtr + return $! ByteString.take sz out diff --git a/src/Botan/Low/PubKey/KeyEncapsulation.hs b/src/Botan/Low/PubKey/KeyEncapsulation.hs --- a/src/Botan/Low/PubKey/KeyEncapsulation.hs +++ b/src/Botan/Low/PubKey/KeyEncapsulation.hs @@ -9,46 +9,51 @@ Portability : POSIX -} -module Botan.Low.PubKey.KeyEncapsulation -( +module Botan.Low.PubKey.KeyEncapsulation ( --- * PK Key Encapsulation --- $introduction --- * Usage --- $usage + -- * PK Key Encapsulation + -- $introduction + -- * Usage + -- $usage --- * KEM Encryption - KEMSharedKey(..) -, KEMEncapsulatedKey(..) -, KEMEncrypt(..) -, withKEMEncrypt -, kemEncryptDestroy -, kemEncryptCreate -, kemEncryptSharedKeyLength -, kemEncryptEncapsulatedKeyLength -, kemEncryptCreateSharedKey + -- * KEM Encryption + KEMSharedKey + , KEMEncapsulatedKey + , KEMEncrypt(..) + , withKEMEncrypt + , kemEncryptDestroy + , kemEncryptCreate + , kemEncryptSharedKeyLength + , kemEncryptEncapsulatedKeyLength + , kemEncryptCreateSharedKey --- * KEM Decryption -, KEMDecrypt(..) -, withKEMDecrypt -, kemDecryptDestroy -, kemDecryptCreate -, kemDecryptSharedKeyLength -, kemDecryptSharedKey + -- * KEM Decryption + , KEMDecrypt(..) + , withKEMDecrypt + , kemDecryptDestroy + , kemDecryptCreate + , kemDecryptSharedKeyLength + , kemDecryptSharedKey -) where + ) where +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.PubKey.KeyEncapsulation +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.KDF +import Botan.Low.Make +import Botan.Low.PubKey +import Botan.Low.Remake +import Botan.Low.RNG +import Control.DeepSeq +import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey.KeyEncapsulation - -import Botan.Low.Error -import Botan.Low.KDF -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.Remake -import Botan.Low.RNG +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable {- $introduction @@ -117,14 +122,13 @@ newtype KEMEncrypt = MkKEMEncrypt { getKEMEncryptForeignPtr :: ForeignPtr BotanPKOpKEMEncryptStruct } -newKEMEncrypt :: BotanPKOpKEMEncrypt -> IO KEMEncrypt withKEMEncrypt :: KEMEncrypt -> (BotanPKOpKEMEncrypt -> IO a) -> IO a kemEncryptDestroy :: KEMEncrypt -> IO () createKEMEncrypt :: (Ptr BotanPKOpKEMEncrypt -> IO CInt) -> IO KEMEncrypt -(newKEMEncrypt, withKEMEncrypt, kemEncryptDestroy, createKEMEncrypt, _) +(withKEMEncrypt, kemEncryptDestroy, createKEMEncrypt) = mkBindings - MkBotanPKOpKEMEncrypt runBotanPKOpKEMEncrypt - MkKEMEncrypt getKEMEncryptForeignPtr + MkBotanPKOpKEMEncrypt (.runBotanPKOpKEMEncrypt) + MkKEMEncrypt (.getKEMEncryptForeignPtr) botan_pk_op_kem_encrypt_destroy @@ -142,10 +146,6 @@ pkPtr (ConstPtr algoPtr) --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withKEMEncryptCreate :: PubKey -> KDFName -> (KEMEncrypt -> IO a) -> IO a -withKEMEncryptCreate = mkWithTemp2 kemEncryptCreate kemEncryptDestroy - kemEncryptSharedKeyLength :: KEMEncrypt -- ^ __op__ -> Int -- ^ __desired_shared_key_length__ @@ -193,14 +193,13 @@ newtype KEMDecrypt = MkKEMDecrypt { getKEMDecryptForeignPtr :: ForeignPtr BotanPKOpKEMDecryptStruct } -newKEMDecrypt :: BotanPKOpKEMDecrypt -> IO KEMDecrypt withKEMDecrypt :: KEMDecrypt -> (BotanPKOpKEMDecrypt -> IO a) -> IO a kemDecryptDestroy :: KEMDecrypt -> IO () createKEMDecrypt :: (Ptr BotanPKOpKEMDecrypt -> IO CInt) -> IO KEMDecrypt -(newKEMDecrypt, withKEMDecrypt, kemDecryptDestroy, createKEMDecrypt, _) +(withKEMDecrypt, kemDecryptDestroy, createKEMDecrypt) = mkBindings - MkBotanPKOpKEMDecrypt runBotanPKOpKEMDecrypt - MkKEMDecrypt getKEMDecryptForeignPtr + MkBotanPKOpKEMDecrypt (.runBotanPKOpKEMDecrypt) + MkKEMDecrypt (.getKEMDecryptForeignPtr) botan_pk_op_kem_decrypt_destroy kemDecryptCreate @@ -213,10 +212,6 @@ out skPtr (ConstPtr algoPtr) - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withKEMDecryptCreate :: PrivKey -> KDFName -> (KEMDecrypt -> IO a) -> IO a -withKEMDecryptCreate = mkWithTemp2 kemDecryptCreate kemDecryptDestroy kemDecryptSharedKeyLength :: KEMDecrypt -- ^ __op__ diff --git a/src/Botan/Low/PubKey/RSA.hs b/src/Botan/Low/PubKey/RSA.hs --- a/src/Botan/Low/PubKey/RSA.hs +++ b/src/Botan/Low/PubKey/RSA.hs @@ -9,17 +9,19 @@ Portability : POSIX -} -module Botan.Low.PubKey.RSA where - -import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey.RSA +module Botan.Low.PubKey.RSA ( + privKeyLoadRSA + , privKeyLoadRSA_PKCS1 + , privKeyRSAGetPrivKey + , pubKeyLoadRSA + ) where -import Botan.Low.Error -import Botan.Low.Remake -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey +import Botan.Bindings.PubKey.RSA +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.Remake +import Data.ByteString (ByteString) +import Data.Word -- /* -- * Algorithm specific key operations: RSA diff --git a/src/Botan/Low/PubKey/SM2.hs b/src/Botan/Low/PubKey/SM2.hs --- a/src/Botan/Low/PubKey/SM2.hs +++ b/src/Botan/Low/PubKey/SM2.hs @@ -1,11 +1,12 @@ -module Botan.Low.PubKey.SM2 where - -import Botan.Bindings.PubKey -import Botan.Bindings.PubKey.SM2 +module Botan.Low.PubKey.SM2 ( + privKeyLoadSM2 + , pubKeyLoadSM2 + ) where -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey +import Botan.Bindings.PubKey.SM2 +import Botan.Low.MPI +import Botan.Low.PubKey +import Data.ByteString (ByteString) privKeyLoadSM2 :: MP -- ^ __scalar__ diff --git a/src/Botan/Low/PubKey/Sign.hs b/src/Botan/Low/PubKey/Sign.hs --- a/src/Botan/Low/PubKey/Sign.hs +++ b/src/Botan/Low/PubKey/Sign.hs @@ -9,33 +9,39 @@ Portability : POSIX -} -module Botan.Low.PubKey.Sign -( +module Botan.Low.PubKey.Sign ( --- * Public key signatures - Sign(..) -, SigningFlags(..) -, pattern StandardFormatSignature -, pattern DERFormatSignature -, withSign -, signCreate -, signDestroy -, signOutputLength -, signUpdate -, signFinish + -- * Public key signatures + Sign(..) + , SigningFlags + , pattern StandardFormatSignature + , pattern DERFormatSignature + , withSign + , signCreate + , signDestroy + , signOutputLength + , signUpdate + , signFinish -) where + ) where +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.PubKey.Sign +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Botan.Low.PubKey +import Botan.Low.Remake +import Botan.Low.RNG +import Control.DeepSeq +import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey.Sign - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.Remake +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable -- /* -- * Signature Generation @@ -43,19 +49,15 @@ newtype Sign = MkSign { getSignForeignPtr :: ForeignPtr BotanPKOpSignStruct } -newSign :: BotanPKOpSign -> IO Sign withSign :: Sign -> (BotanPKOpSign -> IO a) -> IO a signDestroy :: Sign -> IO () createSign :: (Ptr BotanPKOpSign -> IO CInt) -> IO Sign -(newSign, withSign, signDestroy, createSign, _) +(withSign, signDestroy, createSign) = mkBindings - MkBotanPKOpSign runBotanPKOpSign - MkSign getSignForeignPtr + MkBotanPKOpSign (.runBotanPKOpSign) + MkSign (.getSignForeignPtr) botan_pk_op_sign_destroy --- TODO: Rename SignAlgoParams / SigningParams -type SignAlgoName = ByteString - type SigningFlags = Word32 pattern StandardFormatSignature -- ^ Not an actual flags @@ -76,10 +78,6 @@ skPtr (ConstPtr algoPtr) flags - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withSignCreate :: PrivKey -> EMSAName -> SigningFlags -> (Sign -> IO a) -> IO a -withSignCreate = mkWithTemp3 signCreate signDestroy signOutputLength :: Sign -- ^ __op__ diff --git a/src/Botan/Low/PubKey/Verify.hs b/src/Botan/Low/PubKey/Verify.hs --- a/src/Botan/Low/PubKey/Verify.hs +++ b/src/Botan/Low/PubKey/Verify.hs @@ -9,30 +9,29 @@ Portability : POSIX -} -module Botan.Low.PubKey.Verify -( - --- * Public key signature verification - Verify(..) -, withVerify -, verifyCreate -, verifyDestroy -, verifyUpdate -, verifyFinish - -) where +module Botan.Low.PubKey.Verify ( -import qualified Data.ByteString as ByteString + -- * Public key signature verification + Verify(..) + , withVerify + , verifyCreate + , verifyDestroy + , verifyUpdate + , verifyFinish -import Botan.Bindings.PubKey.Verify + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.Sign (SigningFlags(..)) -import Botan.Low.Remake +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.PubKey.Verify +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.PubKey +import Botan.Low.PubKey.Sign (SigningFlags) +import Botan.Low.Remake +import Data.ByteString (ByteString) +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr -- /* -- * Signature Verification @@ -40,18 +39,15 @@ newtype Verify = MkVerify { getVerifyForeignPtr :: ForeignPtr BotanPKOpVerifyStruct } -newVerify :: BotanPKOpVerify -> IO Verify withVerify :: Verify -> (BotanPKOpVerify -> IO a) -> IO a verifyDestroy :: Verify -> IO () createVerify :: (Ptr BotanPKOpVerify -> IO CInt) -> IO Verify -(newVerify, withVerify, verifyDestroy, createVerify, _) +(withVerify, verifyDestroy, createVerify) = mkBindings - MkBotanPKOpVerify runBotanPKOpVerify - MkVerify getVerifyForeignPtr + MkBotanPKOpVerify (.runBotanPKOpVerify) + MkVerify (.getVerifyForeignPtr) botan_pk_op_verify_destroy -type VerifyAlgo = ByteString - verifyCreate :: PubKey -- ^ __key__ -> EMSAName -- ^ __hash_and_padding__ @@ -65,10 +61,6 @@ (ConstPtr algoPtr) flags --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withVerifyCreate :: PubKey -> EMSAName -> SigningFlags -> (Verify -> IO a) -> IO a -withVerifyCreate = mkWithTemp3 verifyCreate verifyDestroy - verifyUpdate :: Verify -- ^ __op__ -> ByteString -- ^ __in[]__ @@ -76,13 +68,14 @@ verifyUpdate = mkWithObjectSetterCBytesLen withVerify botan_pk_op_verify_update -- TODO: Signature type -verifyFinish - :: Verify -- ^ __op__ - -> ByteString -- ^ __sig[]__ - -> IO Bool -verifyFinish verify sig = withVerify verify $ \ verifyPtr -> do - asBytesLen sig $ \ sigPtr sigLen -> do - throwBotanCatchingSuccess $ botan_pk_op_verify_finish - verifyPtr - (ConstPtr sigPtr) - sigLen +verifyFinish :: + Verify -- ^ __op__ + -> ByteString -- ^ __sig[]__ + -> IO Bool +verifyFinish verify sig = + withVerify verify $ \ verifyPtr -> + asBytesLen sig $ \ sigPtr sigLen -> + throwBotanCatchingInvalidVerifier $ botan_pk_op_verify_finish + verifyPtr + (ConstPtr sigPtr) + sigLen diff --git a/src/Botan/Low/PubKey/X25519.hs b/src/Botan/Low/PubKey/X25519.hs --- a/src/Botan/Low/PubKey/X25519.hs +++ b/src/Botan/Low/PubKey/X25519.hs @@ -9,20 +9,19 @@ Portability : POSIX -} -module Botan.Low.PubKey.X25519 where - -import qualified Data.ByteString as ByteString - -import Botan.Bindings.PubKey - -import Botan.Bindings.PubKey.X25519 +module Botan.Low.PubKey.X25519 ( + privKeyLoadX25519 + , pubKeyLoadX25519 + , privKeyX25519GetPrivKey + , pubKeyX25519GetPubKey + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.MPI -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.Remake +import Botan.Bindings.PubKey.X25519 +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.PubKey +import Botan.Low.Remake +import Data.ByteString (ByteString) -- /* -- * Algorithm specific key operations: X25519 diff --git a/src/Botan/Low/PwdHash.hs b/src/Botan/Low/PwdHash.hs --- a/src/Botan/Low/PwdHash.hs +++ b/src/Botan/Low/PwdHash.hs @@ -8,129 +8,224 @@ Stability : experimental Portability : POSIX -Derive a key from a passphrase +This module is based on the [Password Based Key +Deriviation](https://botan.randombit.net/handbook/api_ref/pbkdf.html) section of +the C++ API reference. -} -module Botan.Low.PwdHash -( +module Botan.Low.PwdHash ( + pwdhash + , pwdhashTimed + -- * Available schemes + -- $available-schemes + , PBKDFName + , pattern PBKDF2 + , pbkdf2 + , pattern Scrypt + , pattern Argon2d + , pattern Argon2i + , pattern Argon2id + , pattern Bcrypt_PBKDF + , pattern OpenPGP_S2K + , openPGP_S2K + ) where --- * Password hashing +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.PwdHash +import Botan.Low.Error.Internal +import Botan.Low.Hash +import Botan.Low.Internal.ByteString +import Botan.Low.Internal.String +import Data.ByteString (ByteString) +import Foreign.Marshal.Alloc +import Foreign.Storable - PBKDFName(..) -, pwdhash -, pwdhashTimed +{- $setup +>>> import Botan.Low.Hash +-} --- * Password hashing algorithms +{------------------------------------------------------------------------------- + Password hashing +-------------------------------------------------------------------------------} -, pattern PBKDF2 -, pbkdf2 -, pattern Scrypt -, pattern Argon2d -, pattern Argon2i -, pattern Argon2id -, pattern Bcrypt_PBKDF -, pattern OpenPGP_S2K -, openPGP_S2K +-- | Derive a cryptographic key from a passphrase using algorithm-specific parameters +-- +-- NOTE: the interpretation of parameters @param1@, @param2@, and @param3@ are +-- different depending on the PBKDF algorithm that is picked. See the +-- documentation of the +-- [@from_params@](https://botan.randombit.net/handbook/api_ref/pbkdf.html#passwordhash) +-- C++ function for more information about the meaning of the parameters. +-- +pwdhash :: + PBKDFName -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" + -> Int -- ^ __param1__: the first PBKDF algorithm parameter + -> Int -- ^ __param2__: the second PBKDF algorithm parameter (may be zero if unneeded) + -> Int -- ^ __param3__: the third PBKDF algorithm parameter (may be zero if unneeded) + -> Int -- ^ __out_len__: the desired length of the key to produce + -> ByteString -- ^ __passphrase__: the password to derive the key from + -> ByteString -- ^ __salt[]__: a randomly chosen salt + -> IO ByteString -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes +pwdhash algo p1 p2 p3 outLen passphrase salt = + allocBytes outLen $ \ outPtr -> + asCString algo $ \ algoPtr -> + asCStringLen passphrase $ \ passphrasePtr passphraseLen -> + asBytesLen salt $ \ saltPtr saltLen -> + throwBotanIfNegative_ $ botan_pwdhash + (ConstPtr algoPtr) + (fromIntegral p1) + (fromIntegral p2) + (fromIntegral p3) + outPtr + (fromIntegral outLen) + (ConstPtr passphrasePtr) + passphraseLen + (ConstPtr saltPtr) + saltLen -) where +-- | Derive a cryptographic key from a passphrase using algorithm-specific +-- parameters that are tuned automatically for a desired running time of the +-- algorithm. +-- +-- NOTE: for the @Argon2@ and @Scrypt@ PBKDF algorithms, 'pwdhashTimed' returns +-- parameters in a different order than the order in which they should be passed +-- to 'pwdhash'. This is a known issue with the Botan C++ library. See +-- for more information. +-- +-- 'pwdhashTimed' always returns parameters in this order: +-- +-- > (iterations, parallelism, memoryParam) +-- +-- 'pwdhash' shoulds be given parameters in this order for the +-- @Argon2@ and @Scrypt@ algorithms: +-- +-- > param1 = memoryParam +-- > param2 = iterations +-- > param3 = parallelism +-- +pwdhashTimed :: + -- | __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" + PBKDFName + -- | __msec__: the desired runtime in milliseconds + -> Int + -- | __out_len__: the desired length of the key to produce + -> Int + -- | __passphrase__: the password to derive the key from + -> ByteString + -- | __salt[]__: a randomly chosen salt + -> ByteString + -- | A tuple of four elements (in order): + -- + -- * __param1__: the first PBKDF algorithm parameter + -- * __param2__: the second PBKDF algorithm parameter (may be zero if unneeded) + -- * __param3__: the third PBKDF algorithm parameter (may be zero if unneeded) + -- * __out[]__: buffer to store the derived key, must be of out_len bytes + -> IO (Int, Int, Int, ByteString) +pwdhashTimed algo msec outLen passphrase salt = + alloca $ \ p1Ptr -> + alloca $ \ p2Ptr -> + alloca $ \ p3Ptr -> do + out <- allocBytes outLen $ \ outPtr -> + asCString algo $ \ algoPtr -> + asCStringLen passphrase $ \ passphrasePtr passphraseLen -> + asBytesLen salt $ \ saltPtr saltLen -> do + throwBotanIfNegative_ $ botan_pwdhash_timed + (ConstPtr algoPtr) + (fromIntegral msec) + p1Ptr + p2Ptr + p3Ptr + outPtr + (fromIntegral outLen) + (ConstPtr passphrasePtr) + passphraseLen + (ConstPtr saltPtr) + saltLen + p1 <- fromIntegral <$> peek p1Ptr + p2 <- fromIntegral <$> peek p2Ptr + p3 <- fromIntegral <$> peek p3Ptr + return (p1, p2, p3, out) -import qualified Data.ByteString as ByteString +{------------------------------------------------------------------------------- + Available schemes +-------------------------------------------------------------------------------} -import Botan.Bindings.PwdHash +{- $available-schemes -import Botan.Low.Hash -import Botan.Low.MAC -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude +A number of algorithms are available to be used as password derivation schemes. +An algorithm is selected by passing the /algorithm specification name/ of the +algorithm as a string to the password hashing functions. In some cases an +algorithm specification name is just the /algorithm name/, like @"Scrypt"@. In +other cases an algorithm specification name is a combination of an algorithm +name paired with some parameters, such as @"PKBDF2(SHA-256)"@ where @"PBKDF2"@ +is the algorithm name followed by a single parameter. Pattern synonyms are +included for each available /algorithm name/. Where necessary, such as in the +@"PBKDF2"@ case, these algorithm names can be be manually extended to full +algorithm specification names, or by using utility functions like 'pbkdf2' that +this module also provides. +See the [Available +Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes) +section of the C++ API reference for more information about available schemes. +-} + +-- | The name of a key derivation scheme used as a PBKDF algorithm type PBKDFName = ByteString pattern PBKDF2 - , Scrypt - , Argon2d - , Argon2i - , Argon2id - , Bcrypt_PBKDF - , OpenPGP_S2K - :: PBKDFName + , Scrypt + , Argon2d + , Argon2i + , Argon2id + , Bcrypt_PBKDF + , OpenPGP_S2K + :: PBKDFName +-- | +-- >>> PBKDF2 +-- "PBKDF2" pattern PBKDF2 = BOTAN_PBKDF_PBKDF2 + +-- | +-- >>> pbkdf2 SHA256 +-- "PBKDF2(SHA-256)" +-- +-- NOTE: "PBKDF(HMAC(SHA-256))" is equivalent to "PBKDF(SHA-256)". 'pbkdf2' +-- always outputs the latter given a hash function name. +pbkdf2 :: HashName -> PBKDFName +pbkdf2 m = PBKDF2 /$ m + +-- | +-- >>> Scrypt +-- "Scrypt" pattern Scrypt = BOTAN_PBKDF_SCRYPT + +-- | +-- >>> Argon2d +-- "Argon2d" pattern Argon2d = BOTAN_PBKDF_ARGON2D + +-- | +-- >>> Argon2i +-- "Argon2i" pattern Argon2i = BOTAN_PBKDF_ARGON2I + +-- | +-- >>> Argon2id +-- "Argon2id" pattern Argon2id = BOTAN_PBKDF_ARGON2ID + +-- | +-- >>> Bcrypt_PBKDF +-- "Bcrypt-PBKDF" pattern Bcrypt_PBKDF = BOTAN_PBKDF_BCRYPT_PBKDF -pattern OpenPGP_S2K = BOTAN_PBKDF_OPENPGP_S2K --- NOTE: May require HMAC -pbkdf2 :: MACName -> PBKDFName -pbkdf2 m = PBKDF2 /$ m +-- | +-- >>> OpenPGP_S2K +-- "OpenPGP-S2K" +pattern OpenPGP_S2K = BOTAN_PBKDF_OPENPGP_S2K +-- | +-- >>> openPGP_S2K SHA256 +-- "OpenPGP-S2K(SHA-256)" openPGP_S2K:: HashName -> PBKDFName openPGP_S2K h = OpenPGP_S2K /$ h - --- NOTE: Should passphrase be Text or ByteString? Text is implied by use of const char* --- as well as the non-null context implied by passphrase_len == 0. ByteString for now. - --- | Password hash --- --- 'pwdhash' and 'pwdhashTimed'\'s parameter order may be inconsistent. See --- botan-low\/test\/Botan\/Low\/PwdHashSpec.hs for more information. -pwdhash - :: PBKDFName -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" - -> Int -- ^ __param1__: the first PBKDF algorithm parameter - -> Int -- ^ __param2__: the second PBKDF algorithm parameter (may be zero if unneeded) - -> Int -- ^ __param3__: the third PBKDF algorithm parameter (may be zero if unneeded) - -> Int -- ^ __out_len__: the desired length of the key to produce - -> ByteString -- ^ __passphrase__: the password to derive the key from - -> ByteString -- ^ __salt[]__: a randomly chosen salt - -> IO ByteString -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes -pwdhash algo p1 p2 p3 outLen passphrase salt = allocBytes outLen $ \ outPtr -> do - asCString algo $ \ algoPtr -> do - asCStringLen passphrase $ \ passphrasePtr passphraseLen -> do - asBytesLen salt $ \ saltPtr saltLen -> do - throwBotanIfNegative_ $ botan_pwdhash - (ConstPtr algoPtr) - (fromIntegral p1) - (fromIntegral p2) - (fromIntegral p3) - outPtr - (fromIntegral outLen) - (ConstPtr passphrasePtr) - passphraseLen - (ConstPtr saltPtr) - saltLen - --- | Timed password hash --- --- 'pwdhash' and 'pwdhashTimed'\'s parameter order may be inconsistent. See --- botan-low\/test\/Botan\/Low\/PwdHashSpec.hs for more information. -pwdhashTimed - :: PBKDFName -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" - -> Int -- ^ __msec__: the desired runtime in milliseconds - -> Int -- ^ __out_len__: the desired length of the key to produce - -> ByteString -- ^ __passphrase__: the password to derive the key from - -> ByteString -- ^ __salt[]__: a randomly chosen salt - -> IO (Int,Int,Int,ByteString) -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes -pwdhashTimed algo msec outLen passphrase salt = alloca $ \ p1Ptr -> alloca $ \ p2Ptr -> alloca $ \ p3Ptr -> do - out <- allocBytes outLen $ \ outPtr -> do - asCString algo $ \ algoPtr -> do - asCStringLen passphrase $ \ passphrasePtr passphraseLen -> do - asBytesLen salt $ \ saltPtr saltLen -> do - throwBotanIfNegative_ $ botan_pwdhash_timed - (ConstPtr algoPtr) - (fromIntegral msec) - p1Ptr - p2Ptr - p3Ptr - outPtr - (fromIntegral outLen) - (ConstPtr passphrasePtr) - passphraseLen - (ConstPtr saltPtr) - saltLen - p1 <- fromIntegral <$> peek p1Ptr - p2 <- fromIntegral <$> peek p2Ptr - p3 <- fromIntegral <$> peek p3Ptr - return (p1,p2,p3,out) diff --git a/src/Botan/Low/RNG.hs b/src/Botan/Low/RNG.hs --- a/src/Botan/Low/RNG.hs +++ b/src/Botan/Low/RNG.hs @@ -11,43 +11,43 @@ Pseudo-random number generation. -} -module Botan.Low.RNG -( - --- * Random number generators --- $introduction - --- * Usage --- $usage +module Botan.Low.RNG ( - RNG(..) -, RNGType(..) -, withRNG -, rngInit -, rngDestroy -, rngGet -, systemRNGGet -, rngReseed -, rngReseedFromRNG -, rngAddEntropy + -- * Random number generators + -- $introduction --- * RNG Types + -- * Usage + -- $usage -, pattern SystemRNG -, pattern UserRNG -, pattern UserThreadsafeRNG -, pattern RDRandRNG + RNG(..) + , RNGType + , withRNG + , rngInit + , rngDestroy + , rngGet + , systemRNGGet + , rngReseed + , rngReseedFromRNG + , rngAddEntropy -) where + -- * RNG Types -import qualified Data.ByteString as ByteString + , pattern SystemRNG + , pattern UserRNG + , pattern UserThreadsafeRNG + , pattern RDRandRNG -import Botan.Bindings.RNG + ) where -import Botan.Low.Error ( throwBotanIfNegative_ ) -import Botan.Low.Make ( mkWithTemp1 ) -import Botan.Low.Remake -import Botan.Low.Prelude +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.RNG +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Remake +import Data.ByteString (ByteString) +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr {- $introduction @@ -92,13 +92,12 @@ newtype RNG = MkRNG { getRNGForeignPtr :: ForeignPtr BotanRNGStruct } -newRNG :: BotanRNG -> IO RNG withRNG :: RNG -> (BotanRNG -> IO a) -> IO a -- | Destroy a random number generator object immediately rngDestroy :: RNG -> IO () createRNG :: (Ptr BotanRNG -> IO CInt) -> IO RNG -(newRNG, withRNG, rngDestroy, createRNG, _) - = mkBindings MkBotanRNG runBotanRNG MkRNG getRNGForeignPtr botan_rng_destroy +(withRNG, rngDestroy, createRNG) + = mkBindings MkBotanRNG (.runBotanRNG) MkRNG (.getRNGForeignPtr) botan_rng_destroy type RNGType = ByteString @@ -128,10 +127,6 @@ :: RNGType -- ^ __rng_type__: type of the rng -> IO RNG -- ^ __rng__ rngInit = mkCreateObjectCString createRNG botan_rng_init - --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withRNGInit :: RNGType -> (RNG -> IO a) -> IO a -withRNGInit = mkWithTemp1 rngInit rngDestroy -- | Get random bytes from a random number generator rngGet diff --git a/src/Botan/Low/Remake.hs b/src/Botan/Low/Remake.hs --- a/src/Botan/Low/Remake.hs +++ b/src/Botan/Low/Remake.hs @@ -11,82 +11,33 @@ Generate low-level bindings automatically -} -module Botan.Low.Remake -( mkBindings -, mkCreateObject -, mkCreateObjects -, mkCreateObjectWith -, mkCreateObjectCString -, mkCreateObjectCString1 -, mkCreateObjectCBytes -, mkCreateObjectCBytesLen -, mkCreateObjectCBytesLen1 -, mkWithObjectAction -, mkWithObjectGetterCBytesLen -, mkWithObjectGetterCBytesLen1 -, mkWithObjectSetterCString -, mkWithObjectSetterCBytesLen -) where - -import Botan.Low.Prelude -import Botan.Low.Error - -import qualified Data.ByteString.Internal as ByteString - -import Botan.Low.Make (allocBytesQuerying) - --- ByteString Helpers - --- NOTE: Was allocBytes -createByteString :: Int -> (Ptr byte -> IO ()) -> IO ByteString -createByteString sz f = ByteString.create sz (f . castPtr) - --- NOTE: Was allocBytesWith --- createByteString' :: Int -> (Ptr byte -> IO a) -> IO (a, ByteString) - --- NOTE: Was allocBytesQuerying --- createByteStringQuerying :: (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString --- createByteStringQuerying fn = do --- alloca $ \ szPtr -> do --- -- TODO: Maybe poke szPtr 0 for extra safety in cas its not initially zero --- code <- fn nullPtr szPtr --- case code of --- InsufficientBufferSpace -> do --- sz <- fromIntegral <$> peek szPtr --- allocBytes sz $ \ outPtr -> throwBotanIfNegative_ $ fn outPtr szPtr --- _ -> do --- throwBotanError code - --- NOTE: Was allocBytesQueryingCString --- NOTE: Does not check length of taken string, vulnerable to null byte injection --- createByteStringQueryingCString :: (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString --- createByteStringQueryingCString action = do --- cstring <- allocBytesQuerying action --- return $!! ByteString.takeWhile (/= 0) cstring - --- - --- type NewObject object botan = botan -> IO object --- type WithObject object botan = (forall a . object -> (botan -> IO a) -> IO a) --- type DestroyObject object botan = object -> IO () --- type CreateObject object botan = (Ptr botan -> IO CInt) -> IO object --- type CreateObjects object botan = (Ptr botan -> Ptr CSize -> IO CInt) -> IO object - --- Example usage -{- -newtype RNG = MkRNG { getRNGForeignPtr :: ForeignPtr BotanRNGStruct } +module Botan.Low.Remake ( + mkBindings + , mkCreateObject + , mkCreateObjectWith + , mkCreateObjectCString + , mkCreateObjectCString1 + , mkCreateObjectCBytes + , mkCreateObjectCBytesLen + , mkWithObjectAction + , mkWithObjectGetterCBytesLen1 + , mkWithObjectSetterCBytesLen + ) where -newRNG :: BotanRNG -> IO RNG -withRNG :: RNG -> (BotanRNG -> IO a) -> IO a -rngDestroy :: RNG -> IO () -createRNG :: (Ptr BotanRNG -> IO CInt) -> IO RNG -(newRNG, withRNG, rngDestroy, createRNG, _) - = mkBindings MkBotanRNG runBotanRNG MkRNG getRNGForeignPtr botan_rng_destroy +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Control.Exception +import Data.ByteString (ByteString) +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import Prelude hiding (init) -rngInit :: RNGType -> IO RNG -rngInit name = asCString name $ \ namePtr -> do - createRNG $ \ outPtr -> botan_rng_init outPtr (ConstPtr namePtr) --} mkBindings :: (Storable botan) => (Ptr struct -> botan) -- mkBotan @@ -94,14 +45,12 @@ -> (ForeignPtr struct -> object) -- mkForeign -> (object -> ForeignPtr struct) -- runForeign -> FinalizerPtr struct -- destroy / finalizer - -> ( botan -> IO object -- newObject - , object -> (botan -> IO a) -> IO a -- withObject + -> ( object -> (botan -> IO a) -> IO a -- withObject , object -> IO () -- destroyObject , (Ptr botan -> IO CInt) -> IO object -- createObject - , (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object] -- createObjects ) mkBindings mkBotan runBotan mkForeign runForeign destroy = bindings where - bindings = (newObject, withObject, objectDestroy, createObject, createObjects) + bindings = (withObject, objectDestroy, createObject) newObject botan = do foreignPtr <- newForeignPtr destroy (runBotan botan) return $ mkForeign foreignPtr @@ -112,7 +61,6 @@ -- objectFinalize obj = new stable foreign ptr ... destroy -- objectDestroy obj = withObject obj destroy createObject = mkCreateObject newObject - createObjects = mkCreateObjects newObject {- Create functions @@ -129,23 +77,6 @@ out <- peek outPtr newObject out --- TODO: Rename mkCreates -mkCreateObjects - :: (Storable botan) - => (botan -> IO object) - -> (Ptr botan -> Ptr CSize -> IO CInt) - -> IO [object] -mkCreateObjects newObject inits = mask_ $ alloca $ \ szPtr -> do - code <- inits nullPtr szPtr - case code of - InsufficientBufferSpace -> do - sz <- fromIntegral <$> peek szPtr - allocaArray sz $ \ arrPtr -> do - throwBotanIfNegative_ $ inits arrPtr szPtr - outs <- peekArray sz arrPtr - forM outs newObject - _ -> throwBotanError code - mkCreateObjectWith :: ((Ptr botan -> IO CInt) -> IO object) -> (arg -> (carg -> IO object) -> IO object) @@ -164,6 +95,8 @@ -- mkCreateObjectCString createObject init cstr = withCString cstr $ \ namePtr -> do -- createObject $ \ outPtr -> init outPtr (ConstPtr namePtr) mkCreateObjectCString createObject = mkCreateObjectWith createObject withConstCString + where + withConstCString bs k = withCString bs $ \ptr -> k (ConstPtr ptr) -- TODO: Rename mkCreateCString1 mkCreateObjectCString1 @@ -195,15 +128,6 @@ mkCreateObjectCBytesLen createObject init bytes = withCBytesLen bytes $ \ (cbytes,len) -> do createObject $ \ out -> init out (ConstPtr cbytes) (fromIntegral len) -mkCreateObjectCBytesLen1 - :: ((Ptr botan -> IO CInt) -> IO object) - -> (Ptr botan -> ConstPtr Word8 -> CSize -> a -> IO CInt) - -> ByteString - -> a - -> IO object -mkCreateObjectCBytesLen1 createObject init bytes a = withCBytesLen bytes $ \ (cbytes,len) -> do - createObject $ \ out -> init out (ConstPtr cbytes) (fromIntegral len) a - {- Action -} @@ -222,20 +146,8 @@ -} -- TODO: getter parameter order may be improper - switch up if problematic -mkWithObjectGetterCBytesLen - :: (forall a . object -> (botan -> IO a) -> IO a) - -> (botan -> Ptr Word8 -> Ptr CSize -> IO CInt) - -> object - -> IO ByteString -mkWithObjectGetterCBytesLen withObject getter obj = withObject obj $ \ cobj -> do - allocBytesQuerying $ \ outPtr outLen -> getter - cobj - outPtr - outLen - --- TODO: getter parameter order may be improper - switch up if problematic mkWithObjectGetterCBytesLen1 - :: (forall a . object -> (botan -> IO a) -> IO a) + :: (forall b . object -> (botan -> IO b) -> IO b) -> (botan -> a -> Ptr Word8 -> Ptr CSize -> IO CInt) -> object -> a @@ -251,22 +163,11 @@ Setters -} --- TODO: Rename mkSetterCString -mkWithObjectSetterCString - :: (forall a . object -> (botan -> IO a) -> IO a) - -> (botan -> ConstPtr CChar -> IO BotanErrorCode) - -> object - -> ByteString - -> IO () -mkWithObjectSetterCString withObject setter obj str = withObject obj $ \ cobj -> do - withCString str $ \ cstr -> do - throwBotanIfNegative_ $ setter cobj (ConstPtr cstr) - -- Replaces mkSetBytesLen -- TODO: Rename mkSetterCBytesLen mkWithObjectSetterCBytesLen :: (forall a . object -> (botan -> IO a) -> IO a) - -> (botan -> ConstPtr Word8 -> CSize -> IO BotanErrorCode) + -> (botan -> ConstPtr Word8 -> CSize -> IO CInt) -> object -> ByteString -> IO () diff --git a/src/Botan/Low/SRP6.hs b/src/Botan/Low/SRP6.hs --- a/src/Botan/Low/SRP6.hs +++ b/src/Botan/Low/SRP6.hs @@ -8,170 +8,263 @@ Stability : experimental Portability : POSIX -The library contains an implementation of the SRP6-a password -authenticated key exchange protocol. - +This module is based on the [Secure Remote +Password](https://botan.randombit.net/handbook/api_ref/srp.html) section of the +C++ API reference. -} -module Botan.Low.SRP6 -( - --- * Secure Random Password 6a --- $introduction - --- * Usage --- $usage - - SRP6ServerSession(..) -, withSRP6ServerSession -, srp6ServerSessionInit -, srp6ServerSessionDestroy -, srp6ServerSessionStep1 -, srp6ServerSessionStep2 -, srp6GenerateVerifier -, srp6ClientAgree -, srp6GroupSize - --- * SRP6 Types - -, SRP6Verifier(..) -, SRP6BValue(..) -, SRP6AValue(..) -, SRP6SharedSecret(..) +module Botan.Low.SRP6 ( + -- * Example usage + -- $usage + -- * Password hashing + SRP6ServerSession(..) + , withSRP6ServerSession + , srp6ServerSessionInit + , srp6ServerSessionDestroy + , srp6ServerSessionStep1 + , srp6ServerSessionStep2 + , srp6GenerateVerifier + , srp6ClientAgree + , srp6GroupSize + -- * SRP6 Types + , SRP6Verifier + , SRP6BValue + , SRP6AValue + , SRP6SharedSecret + -- * SRP discrete logarithm groups + , pattern MODP_SRP_1024 + , pattern MODP_SRP_1536 + , pattern MODP_SRP_2048 + , pattern MODP_SRP_3072 + , pattern MODP_SRP_4096 + , pattern MODP_SRP_6144 + , pattern MODP_SRP_8192 + ) where --- * SRP discrete logarithm groups +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.SRP6 +import Botan.Low.Error.Internal +import Botan.Low.Hash +import Botan.Low.Internal.ByteString +import Botan.Low.PubKey +import Botan.Low.Remake +import Botan.Low.RNG +import Data.ByteString (ByteString) +import qualified Data.ByteString.Internal as BS +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable -, pattern MODP_SRP_1024 -, pattern MODP_SRP_1536 -, pattern MODP_SRP_2048 -, pattern MODP_SRP_3072 -, pattern MODP_SRP_4096 -, pattern MODP_SRP_6144 -, pattern MODP_SRP_8192 +{------------------------------------------------------------------------------- + Example usage +-------------------------------------------------------------------------------} -) where +-- NOTE: when changing this example, also change the copied example in the +-- "Test.Botan.Low.SRP6.Example" module. -import qualified Data.ByteString as ByteString +{- $usage -import Botan.Bindings.SRP6 +This is a simplified, executable example that should give you an idea of how to +use the functions in this module to run the SRP6 protocol. We will not explain +the protocol in detail here, so consult other sources if you need details about +the algorithm. The simplified example shows how a client and server run the +protocol from separate threads, keeping private values secret and communicating +public values using message passing. In practice, the client and server will +probably run on separate machines (or processes) with secure communication +channels in place, and other security measures are necessary. So, don't use this +example directly in your code if it runs in production. -import Botan.Low.Error -import Botan.Low.Hash -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake -import Botan.Low.RNG -import Botan.Low.PubKey +Let us start with some necessary imports. -{- $introduction +>>> :{ +{-# OPTIONS_GHC -threaded -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +import Botan.Low.Hash +import Botan.Low.PubKey +import Botan.Low.RNG +import Botan.Low.SRP6 +import Control.Concurrent +import Control.Concurrent.Async +import Data.ByteString hiding (group) +import Data.IORef +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe +import Text.Printf +:} -A SRP client provides what is called a SRP verifier to the server. -This verifier is based on a password, but the password cannot be -easily derived from the verifier (however brute force attacks are -possible). Later, the client and server can perform an SRP exchange, -which results in a shared secret key. This key can be used for -mutual authentication and/or encryption. +The client and server exchange a number of messages during the protocol. They +will be explained in more detail later as they become relevant for the part of +the protocol that we are discussing. The messages will be exchanged from the +client to the server using an @MVar ClientMsg@, and from the server to the +client using an @MVar ServerMsg@. -SRP works in a discrete logarithm group. Special parameter sets for -SRP6 are defined, denoted in the library as @modp\/srp\/@, for -example @modp\/srp\/2048@. +>>> :{ +type Identifier = ByteString +data ClientMsg = + Signup Identifier SRP6Verifier + | StartAuthentication Identifier + | SendClientPublicKey SRP6AValue +data ServerMsg = + SendServerPublicKey SRP6BValue +:} -Warning +SRP works in a discrete logarithm group, and it computes hashes using a hash +family. Both can be configured, and we will configure them as follows: -While knowledge of the verifier does not easily allow an attacker to -get the raw password, they could still use the verifier to impersonate -the server to the client, so verifiers should be protected as carefully -as a plaintext password would be. +>>> :{ +group :: DLGroupName +group = MODP_SRP_4096 +hash :: HashName +hash = SHA512 +:} -SRP6 may be used as part of SSL/TLS: https://www.rfc-editor.org/rfc/rfc5054 +When a client wants to sign up with the server with a combination of an +identifier and password, the client first generates a verifier using the +identifier, the password, and a locally generated salt. Then, the client sends +their identifier and verifier to the server, while it stores its own salt +locally: --} +>>> :{ +type Password = ByteString +type Salt = ByteString +clientSignup :: MVar ClientMsg -> Identifier -> Password -> IO Salt +clientSignup clientMsgVar identifier password = do + rng <- rngInit UserRNG + salt <- rngGet rng 12 + verifier <- srp6GenerateVerifier identifier password salt group hash + putMVar clientMsgVar $ Signup identifier verifier + pure salt +:} -{- $usage +The server receives the signup request, and stores the identifier with the +verifier: -On signup, the client generates a salt and verifier, and securely sends them to a server: +>>> :{ +type Users = Map Identifier SRP6Verifier +serverSignup :: MVar ClientMsg -> IORef Users -> IO () +serverSignup clientMsgVar usersRef = do + Signup identifier verifier <- takeMVar clientMsgVar + modifyIORef usersRef $ Map.insert identifier verifier +:} -> import Botan.Low.SRP6 -> import Botan.Low.Hash -> import Botan.Low.RNG -> import Botan.Low.MAC -> rng <- rngInit UserRNG -> group = MODP_SRP_4096 -> hash = SHA512 -> identifier = "alice" -> password = "Fee fi fo fum!" -> salt <- rngGet rng 12 -> verifier <- srp6GenerateVerifier identifier password salt group hash -> -- signUpUserWithServer identifier verifier salt group hash +Later, the client may request to authenticate itself to the server: -Later, on the server when the client request authentication, the server -looks up the verfier, generates a server key (a SRP6 'B' value), and sends -it back to the client: +>>> :{ +clientStartAuthentication :: MVar ClientMsg -> Identifier -> IO () +clientStartAuthentication clientMsgVar identifier = do + putMVar clientMsgVar $ StartAuthentication identifier +:} -> -- rng <- rngInit UserRNG -> session <- srp6ServerSessionInit -> -- (verifier, salt, group, hash) <- lookupUser identifier -> serverKey <- srp6ServerSessionStep1 session verifier group hash rng +The server receives the authentication request, looks up the verfier, generates +the server's public key (a SRP6 @B@ value), and sends it back to the client: -Once the client receives the server key, it generates a client key (SRP6 'A' value) -and the session key, and sends the client key to the server: +>>> :{ +serverStartAuthentication :: MVar ClientMsg -> MVar ServerMsg -> IORef Users -> IO SRP6ServerSession +serverStartAuthentication clientMsgVar serverMsg usersRef = do + StartAuthentication identifier <- takeMVar clientMsgVar + users <- readIORef usersRef + let verifier = fromJust $ Map.lookup identifier users + rng <- rngInit UserRNG + session <- srp6ServerSessionInit + serverPublicKey <- srp6ServerSessionStep1 session verifier group hash rng + putMVar serverMsg $ SendServerPublicKey serverPublicKey + pure session +:} -> -- serverKey <- didReceiveServerKey -> (clientKey, clientSessionKey) <- srp6ClientAgree identifier password group hash salt serverKey rng -> -- sendClientKey clientKey +Once the client receives the server's public key, it generates the client's +public key (an SRP6 @B@ value) and the shared secret key, and sends the client's +public key to the server: -The server then receives client key, and generates a matching session key: +>>> :{ +clientAuthentication :: MVar ClientMsg -> MVar ServerMsg -> Identifier -> Password -> Salt -> IO SRP6SharedSecret +clientAuthentication clientMsgVar serverMsgVar identifier password salt = do + SendServerPublicKey serverPublicKey <- takeMVar serverMsgVar + rng <- rngInit UserRNG + (clientPublicKey, clientSecretKey) <- + srp6ClientAgree identifier password group hash salt serverPublicKey rng + putMVar clientMsgVar $ SendClientPublicKey clientPublicKey + pure clientSecretKey +:} -> -- clientKey <- didReceiveClientKey -> serverSessionKey <- srp6ServerSessionStep2 session clientKey +The server then receives the client's public key, and generates a matching +shared secret key: -At this point, clientSessionKey and serverSessionKey should be equal, -but this should be confirmed by exchanging a hash digest to check for integrity, -using the exchange's session key, identifier, salt, and client and server keys. +>>> :{ +serverAuthentication :: MVar ClientMsg -> SRP6ServerSession -> IO SRP6SharedSecret +serverAuthentication clientMsgVar session = do + SendClientPublicKey clientPublicKey <- takeMVar clientMsgVar + serverSecretKey <- srp6ServerSessionStep2 session group clientPublicKey + pure serverSecretKey +:} -There are many ways to do this, but preferrably, an (h)mac digest should be used -to also include authentication and avoid impersonation. +At this point, the client's and servers' secret key should be equal. In +practice, the secret keys should be confirmed to match by exchanging a hash +digest of relevant protocol values, susch as the secret key, public keys, +identifier, salt, and more. Calculation of this hash digest is not part of this +example. Instead, we will return the secret keys from the client and server so +that we can compare them, which obviously breaks security, but this should be +fine for our example. -> NOTE: Both sides could calculate 'identifier <> salt <> serverKey <> clientKey' -> individually but then we need to prove that each side has calculated it without -relying on the copy received for validation, so we do this song and dance: +We bring the client-side of the algorithm together by picking an identifier and +password, and calling the client-side functions in order. -The client should first calculate and send the HMAC auth, using identifier + salt + clientKey: +>>> :{ +client :: MVar ClientMsg -> MVar ServerMsg -> IO SRP6SharedSecret +client clientMsgVar serverMsgVar = do + let identifier = "alice" + password = "Fee fi fo fum!" + salt <- clientSignup clientMsgVar identifier password + clientStartAuthentication clientMsgVar identifier + clientAuthentication clientMsgVar serverMsgVar identifier password salt +:} -> mac <- macInit (hmac SHA3) -> macSetKey mac clientSessionKey -> macUpdate mac $ identifier <> salt <> clientKey -> clientAuth <- macFinal mac -> -- sendClientAuth clientAuth +We bring the server-side of the algorithm together by initialising a session and +calling the server-side functions in order. -The server should then verify the client auth, and send its own HMAC -auth back to the client using serverKey + clientAuth: +>>> :{ +server :: MVar ClientMsg -> MVar ServerMsg -> IO SRP6SharedSecret +server clientMsgVar serverMsgVar = do + usersRef <- newIORef Map.empty + serverSignup clientMsgVar usersRef + session <- serverStartAuthentication clientMsgVar serverMsgVar usersRef + serverAuthentication clientMsgVar session +:} -> -- clientAuth <- didReceiveClientAuth -> mac <- macInit (hmac SHA3) -> macSetKey mac serverSessionKey -> macUpdate mac $ identifier <> salt <> clientKey -> verifiedClientAuth <- macFinal mac -> -- clientAuth == verifiedClientAuth -> macClear mac -> macSetKey mac serverSessionKey -> macUpdate mac $ serverKey <> clientAuth -> serverAuth <- macFinal mac -> -- sendServerAuth serverAuth +Using the @async@ package, we spin up a thread for the client and a thread for +the server. We wait for them to finish, and then compare the resulting secret +keys. -The client then receives the server HMAC auth, and validates it +>>> :{ +main :: IO () +main = do + clientMsgVar <- newEmptyMVar + serverMsgVar <- newEmptyMVar + (clientSecretKey, serverSecretKey) <- + concurrently (client clientMsgVar serverMsgVar) (server clientMsgVar serverMsgVar) + let match = clientSecretKey == serverSecretKey + if match then + print @String "client secret == server secret" + else + error $ + printf "%s /= %s" + (show clientSecretKey) + (show serverSecretKey) +:} -> -- serverAuth <- didReceiveServerAuth -> macClear mac -> macSetKey mac clientSessionKey -> macUpdate mac $ serverKey <> clientAuth -> verifiedServerAuth <- macFinal mac -> -- serverAuth == verifiedServerAuth +All that is left to do is run the program. -After this, the shared session key may be safely used. +>>> main +"client secret == server secret" -} +{------------------------------------------------------------------------------- + Password hashing +-------------------------------------------------------------------------------} -- TODO: Unify with other / move to botan type Identifier = ByteString @@ -185,150 +278,218 @@ newtype SRP6ServerSession = MkSRP6ServerSession { getSRP6ServerSessionForeignPtr :: ForeignPtr BotanSRP6ServerSessionStruct } -newSRP6ServerSession :: BotanSRP6ServerSession -> IO SRP6ServerSession withSRP6ServerSession :: SRP6ServerSession -> (BotanSRP6ServerSession -> IO a) -> IO a --- | Destroy a SRP6 server session object immediately +-- | Frees all resources of the SRP-6 server session object srp6ServerSessionDestroy :: SRP6ServerSession -> IO () createSRP6ServerSession :: (Ptr BotanSRP6ServerSession -> IO CInt) -> IO SRP6ServerSession -(newSRP6ServerSession, withSRP6ServerSession, srp6ServerSessionDestroy, createSRP6ServerSession, _) +(withSRP6ServerSession, srp6ServerSessionDestroy, createSRP6ServerSession) = mkBindings - MkBotanSRP6ServerSession runBotanSRP6ServerSession - MkSRP6ServerSession getSRP6ServerSessionForeignPtr + MkBotanSRP6ServerSession (.runBotanSRP6ServerSession) + MkSRP6ServerSession (.getSRP6ServerSessionForeignPtr) botan_srp6_server_session_destroy -- | Initialize an SRP-6 server session object -srp6ServerSessionInit - :: IO SRP6ServerSession -- ^ __srp6__: SRP-6 server session object +srp6ServerSessionInit :: + IO SRP6ServerSession -- ^ __srp6__: SRP-6 server session object srp6ServerSessionInit = createSRP6ServerSession botan_srp6_server_session_init --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withSRP6ServerSessionInit :: (SRP6ServerSession -> IO a) -> IO a -withSRP6ServerSessionInit = mkWithTemp srp6ServerSessionInit srp6ServerSessionDestroy - --- | SRP-6 Server side step 1: Generate a server B-value -srp6ServerSessionStep1 - :: SRP6ServerSession -- ^ __srp6__: SRP-6 server session object - -> SRP6Verifier -- ^ __verifier[]__: the verification value saved from client registration - -> DLGroupName -- ^ __group_id__: the SRP group id - -> HashName -- ^ __hash_id__: the SRP hash in use - -> RNG -- ^ __rng_obj__: a random number generator object - -> IO SRP6BValue -- ^ __B_pub[]__: out buffer to store the SRP-6 B value -srp6ServerSessionStep1 srp6 verifier groupId hashId rng = withSRP6ServerSession srp6 $ \ srp6Ptr -> do - asBytesLen verifier $ \ verifierPtr verifierLen -> do - asCString groupId $ \ groupIdPtr -> do - asCString hashId $ \ hashIdPtr -> do - withRNG rng $ \ botanRNG -> do - allocBytesQuerying $ \ outPtr outLen -> botan_srp6_server_session_step1 - srp6Ptr - (ConstPtr verifierPtr) - verifierLen - (ConstPtr groupIdPtr) - (ConstPtr hashIdPtr) - botanRNG - outPtr - outLen - --- | SRP-6 Server side step 2: Generate the server shared key -srp6ServerSessionStep2 - :: SRP6ServerSession -- ^ __srp6__: SRP-6 server session object - -> SRP6AValue -- ^ __A[]__: the client's value - -> IO SRP6SharedSecret -- ^ __key[]__: out buffer to store the symmetric key value -srp6ServerSessionStep2 srp6 a = withSRP6ServerSession srp6 $ \ srp6Ptr -> do - asBytesLen a $ \ aPtr aLen -> do - allocBytesQuerying $ \ outPtr outLen -> botan_srp6_server_session_step2 - srp6Ptr - (ConstPtr aPtr) - aLen - outPtr - outLen +-- | SRP-6 Server side step 1 +-- +-- NOTE: this function should be not be invoked twice on the same server +-- session. Regardless of the result of the first invocation, the second +-- invocation will result in an error. See +-- https://github.com/randombit/botan/issues/5112 for more information. If a +-- second invocation can not be prevented, try it on a newly initialised server +-- session instead. +srp6ServerSessionStep1 :: + SRP6ServerSession -- ^ __srp6__: SRP-6 server session object + -> SRP6Verifier -- ^ __verifier[]__: the verification value saved from client registration + -> DLGroupName -- ^ __group_id__: the SRP group id + -> HashName -- ^ __hash_id__: the SRP hash in use + -> RNG -- ^ __rng_obj__: a random number generator object + -> IO SRP6BValue -- ^ __B_pub[]__: out buffer to store the SRP-6 B value +srp6ServerSessionStep1 srp6 verifier groupId hashId rng = + withSRP6ServerSession srp6 $ \ srp6Ptr -> + asBytesLen verifier $ \ verifierPtr verifierLen -> + asCString groupId $ \ groupIdPtr -> + asCString hashId $ \ hashIdPtr -> + withRNG rng $ \ botanRNG -> + createWithGroupSize groupId $ \ outPtr outLen -> + throwBotanIfNegative_ $ + botan_srp6_server_session_step1 + srp6Ptr + (ConstPtr verifierPtr) + verifierLen + (ConstPtr groupIdPtr) + (ConstPtr hashIdPtr) + botanRNG + outPtr + outLen --- | SRP-6 Client side step 1: Generate a new SRP-6 verifier -srp6GenerateVerifier - :: Identifier -- ^ __identifier__: a username or other client identifier - -> Password -- ^ __password__: the secret used to authenticate user - -> Salt -- ^ __salt[]__: a randomly chosen value, at least 128 bits long - -> DLGroupName -- ^ __group_id__: specifies the shared SRP group - -> HashName -- ^ __hash_id__: specifies a secure hash function - -> IO SRP6Verifier -- ^ __verifier[]__: out buffer to store the SRP-6 verifier value -srp6GenerateVerifier identifier password salt groupId hashId = asCString identifier $ \ identifierPtr -> do - asCString password $ \ passwordPtr -> do - asBytesLen salt $ \ saltPtr saltLen -> do - asCString groupId $ \ groupIdPtr -> do - asCString hashId $ \ hashIdPtr -> do - allocBytesQuerying $ \ outPtr outLen -> botan_srp6_generate_verifier - (ConstPtr identifierPtr) - (ConstPtr passwordPtr) - (ConstPtr saltPtr) - saltLen - (ConstPtr groupIdPtr) - (ConstPtr hashIdPtr) - outPtr - outLen +-- | SRP-6 Server side step 2 +srp6ServerSessionStep2 :: + SRP6ServerSession -- ^ __srp6__: SRP-6 server session object + -> SRP6AValue -- ^ __A[]__: the client's value + -> DLGroupName -- ^ the SRP group id + -> IO SRP6SharedSecret -- ^ __key[]__: out buffer to store the symmetric key value +srp6ServerSessionStep2 srp6 groupId a = + withSRP6ServerSession srp6 $ \ srp6Ptr -> + asBytesLen a $ \ aPtr aLen -> + createWithGroupSize groupId $ \ outPtr outLen -> + throwBotanIfNegative_ $ + botan_srp6_server_session_step2 + srp6Ptr + (ConstPtr aPtr) + aLen + outPtr + outLen --- NOTE: ORDER IS DIFFERENT FROM SERVER GENERATE VERIFIER --- | SRP6a Client side step 2: Generate a client A-value and the client shared key -srp6ClientAgree - :: Identifier -- ^ __username__: the username we are attempting login for - -> Password -- ^ __password__: the password we are attempting to use - -> DLGroupName -- ^ __group_id__: specifies the shared SRP group - -> HashName -- ^ __hash_id__: specifies a secure hash function - -> Salt -- ^ __salt[]__: is the salt value sent by the server - -> SRP6BValue -- ^ __uint8_t__: B[] is the server's public value - -> RNG -- ^ __rng_obj__: is a random number generator object - -> IO (SRP6AValue, SRP6SharedSecret) -- @(A,K)@ -srp6ClientAgree identifier password groupId hashId salt b rng = do - asCString identifier $ \ identifierPtr -> do - asCString password $ \ passwordPtr -> do - asCString groupId $ \ groupIdPtr -> do - asCString hashId $ \ hashIdPtr -> do - asBytesLen salt $ \ saltPtr saltLen -> do - asBytesLen b $ \ bPtr bLen -> do - withRNG rng $ \ botanRNG -> do - alloca $ \ aSzPtr -> do - alloca $ \ kSzPtr -> do - -- Query sizes - -- TODO: Actually ensure expected error (insufficient buffer space) - -- and propagate unexpected errors - _ <- botan_srp6_client_agree - (ConstPtr identifierPtr) - (ConstPtr passwordPtr) - (ConstPtr groupIdPtr) - (ConstPtr hashIdPtr) - (ConstPtr saltPtr) - saltLen - (ConstPtr bPtr) - bLen - botanRNG - nullPtr - aSzPtr - nullPtr - kSzPtr - kSz <- fromIntegral <$> peek kSzPtr - aSz <- fromIntegral <$> peek aSzPtr - allocBytesWith kSz $ \ kPtr -> do - allocBytes aSz $ \ aPtr -> do - throwBotanIfNegative_ $ botan_srp6_client_agree - (ConstPtr identifierPtr) - (ConstPtr passwordPtr) - (ConstPtr groupIdPtr) - (ConstPtr hashIdPtr) - (ConstPtr saltPtr) - saltLen - (ConstPtr bPtr) - bLen - botanRNG - aPtr - aSzPtr - kPtr - kSzPtr +-- | Generate a new SRP-6 verifier +srp6GenerateVerifier :: + Identifier -- ^ __identifier__: a username or other client identifier + -> Password -- ^ __password__: the secret used to authenticate user + -> Salt -- ^ __salt[]__: a randomly chosen value, at least 128 bits long + -> DLGroupName -- ^ __group_id__: specifies the shared SRP group + -> HashName -- ^ __hash_id__: specifies a secure hash function + -> IO SRP6Verifier -- ^ __verifier[]__: out buffer to store the SRP-6 verifier value +srp6GenerateVerifier identifier password salt groupId hashId = + asCString identifier $ \ identifierPtr -> + asCString password $ \ passwordPtr -> + asBytesLen salt $ \ saltPtr saltLen -> + asCString groupId $ \ groupIdPtr -> + asCString hashId $ \ hashIdPtr -> + createWithGroupSize groupId $ \ outPtr outLen -> + throwBotanIfNegative_ $ + botan_srp6_generate_verifier + (ConstPtr identifierPtr) + (ConstPtr passwordPtr) + (ConstPtr saltPtr) + saltLen + (ConstPtr groupIdPtr) + (ConstPtr hashIdPtr) + outPtr + (castPtr outLen) --- NOTE: Missing FFI function: srp6_group_identifierz +-- | SRP6a Client side +srp6ClientAgree :: + -- | __username__: the username we are attempting login for + Identifier + -- | __password__: the password we are attempting to use + -> Password + -- | __group_id__: specifies the shared SRP group + -> DLGroupName + -- | __hash_id__: specifies a secure hash function + -> HashName + -- | __salt[]__: is the salt value sent by the server + -> Salt + -- | __B[]__: is the server's public value + -> SRP6BValue + -- | __rng_obj__: is a random number generator object + -> RNG + -- | A tuple of two elements (in order): + -- + -- * __A[]__: out buffer to store the SRP-6 A value + -- * __K[]__: out buffer to store the symmetric value + -> IO (SRP6AValue, SRP6SharedSecret) +srp6ClientAgree identifier password groupId hashId salt b rng = + asCString identifier $ \ identifierPtr -> + asCString password $ \ passwordPtr -> + asCString groupId $ \ groupIdPtr -> + asCString hashId $ \ hashIdPtr -> + asBytesLen salt $ \ saltPtr saltLen -> + asBytesLen b $ \ bPtr bLen -> + withRNG rng $ \ botanRNG -> + createWithGroupSize' groupId $ \ aPtr aSzPtr -> + createWithGroupSize groupId $ \ kPtr kSzPtr -> + throwBotanIfNegative_ $ + botan_srp6_client_agree + (ConstPtr identifierPtr) + (ConstPtr passwordPtr) + (ConstPtr groupIdPtr) + (ConstPtr hashIdPtr) + (ConstPtr saltPtr) + saltLen + (ConstPtr bPtr) + bLen + botanRNG + aPtr + aSzPtr + kPtr + kSzPtr -- | Return the size, in bytes, of the prime associated with group_id -srp6GroupSize - :: DLGroupName -- ^ __group_id__ - -> IO Int -- ^ __group_p_bytes__ -srp6GroupSize groupId = asCString groupId $ \ groupIdPtr -> do +-- +-- This function can be used to determine the size of output buffers for +-- generated keys in the SRP6 algorithm. Such buffers need to be allocated +-- before calling SRP6 functions. An example of such a buffer is the +-- @verifier[]@ buffer in the 'srp6GenerateVerifier' function. In @botan-low@, +-- such buffers are created internally using 'srp6GroupSize', without requiring +-- input from you (the user). +srp6GroupSize :: + DLGroupName -- ^ __group_id__ + -> IO Int -- ^ __group_p_bytes__ +srp6GroupSize groupId = + asCString groupId $ \ groupIdPtr -> alloca $ \ szPtr -> do - throwBotanIfNegative_ $ botan_srp6_group_size (ConstPtr groupIdPtr) szPtr - fromIntegral <$> peek szPtr + throwBotanIfNegative_ $ + botan_srp6_group_size (ConstPtr groupIdPtr) szPtr + fromIntegral <$> peek szPtr + +{------------------------------------------------------------------------------- + Utility +-------------------------------------------------------------------------------} + +-- | Like 'createWithSize', but we determine the maximum size of the byte string +-- based on an argument 'DLGroupName'. +createWithGroupSize :: + DLGroupName + -> (Ptr Word8 -> Ptr CSize -> IO ()) + -> IO ByteString +createWithGroupSize groupId k = do + sz <- srp6GroupSize groupId + createWithSize sz k + +-- | Given the maximum size needed and a function to make the contents of a +-- 'ByteString', 'createWithSize' makes the 'ByteString'. +-- +-- The generating function is required to write the actual final size (<= the +-- maximum size) to the 'CSize' pointer, and the resulting byte array is +-- reallocated to this size. +-- +-- NOTE: this is based on 'BS.createAndTrim'. +createWithSize :: + Int + -> (Ptr Word8 -> Ptr CSize -> IO ()) + -> IO ByteString +createWithSize sz k = + BS.createAndTrim sz $ \bytesPtr -> + alloca $ \lenPtr -> do + poke lenPtr (fromIntegral sz) + k bytesPtr lenPtr + fromIntegral <$> peek lenPtr + +-- | Like 'createWithGroupSize', but also returns an additional value created by +-- the action. +createWithGroupSize' :: + DLGroupName + -> (Ptr Word8 -> Ptr CSize -> IO a) + -> IO (ByteString, a) +createWithGroupSize' groupId k = do + sz <- srp6GroupSize groupId + createWithSize' sz k + +-- | Like 'createWithSize', but also returns an additional value created by the +-- action. +-- +-- NOTE: this is based on 'BS.createAndTrim''. +createWithSize' :: + Int + -> (Ptr Word8 -> Ptr CSize -> IO a) + -> IO (ByteString, a) +createWithSize' sz k = + BS.createAndTrim' sz $ \bytesPtr -> + alloca $ \lenPtr -> do + poke lenPtr (fromIntegral sz) + x <- k bytesPtr lenPtr + sz' <- fromIntegral <$> peek lenPtr + pure (0, sz', x) diff --git a/src/Botan/Low/TOTP.hs b/src/Botan/Low/TOTP.hs --- a/src/Botan/Low/TOTP.hs +++ b/src/Botan/Low/TOTP.hs @@ -18,48 +18,52 @@ -} -module Botan.Low.TOTP -( - --- * Time-based one time passwords --- $introduction --- * Usage --- $usage - --- * TOTP +module Botan.Low.TOTP ( - TOTP(..) -, TOTPHashName(..) -, TOTPTimestep(..) -, TOTPTimestamp(..) -, TOTPCode(..) -, withTOTP -, totpInit -, totpDestroy -, totpGenerate -, totpCheck + -- * Time-based one time passwords + -- $introduction + -- * Usage + -- $usage --- * TOTP Hashes + -- * TOTP -, pattern TOTP_SHA1 -, pattern TOTP_SHA256 -, pattern TOTP_SHA512 + TOTP(..) + , TOTPHashName + , TOTPTimestep + , TOTPTimestamp + , TOTPCode + , withTOTP + , totpInit + , totpDestroy + , totpGenerate + , totpCheck --- * Convenience + -- * TOTP Hashes -, totpHashes + , pattern TOTP_SHA1 + , pattern TOTP_SHA256 + , pattern TOTP_SHA512 -) where + -- * Convenience -import qualified Data.ByteString as ByteString + , totpHashes -import Botan.Bindings.TOTP + ) where -import Botan.Low.Error -import Botan.Low.Hash -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.Remake +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.TOTP +import Botan.Low.Error.Internal +import Botan.Low.Hash +import Botan.Low.Internal.ByteString +import Botan.Low.Remake +import Control.Monad +import Data.ByteString (ByteString) +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable -- NOTE: RFC 6238 @@ -158,14 +162,13 @@ newtype TOTP = MkTOTP { getTOTPForeignPtr :: ForeignPtr BotanTOTPStruct } -newTOTP :: BotanTOTP -> IO TOTP withTOTP :: TOTP -> (BotanTOTP -> IO a) -> IO a totpDestroy :: TOTP -> IO () createTOTP :: (Ptr BotanTOTP -> IO CInt) -> IO TOTP -(newTOTP, withTOTP, totpDestroy, createTOTP, _) +(withTOTP, totpDestroy, createTOTP) = mkBindings - MkBotanTOTP runBotanTOTP - MkTOTP getTOTPForeignPtr + MkBotanTOTP (.runBotanTOTP) + MkTOTP (.getTOTPForeignPtr) botan_totp_destroy type TOTPHashName = HashName @@ -180,6 +183,7 @@ pattern TOTP_SHA512 = SHA512 -- TODO: Do any other hashes work? +totpHashes :: [TOTPHashName] totpHashes = [ TOTP_SHA1 , TOTP_SHA256 @@ -209,10 +213,6 @@ (fromIntegral digits) (fromIntegral timestep) --- WARNING: withFooInit-style limited lifetime functions moved to high-level botan -withTOTPInit :: ByteString -> ByteString -> Int -> TOTPTimestep -> (TOTP -> IO a) -> IO a -withTOTPInit = mkWithTemp4 totpInit totpDestroy - -- | Generate a TOTP code for the provided timestamp totpGenerate :: TOTP -- ^ __totp__: the TOTP object @@ -220,16 +220,17 @@ -> IO TOTPCode -- ^ __timestamp__: the current local timestamp totpGenerate totp timestamp = withTOTP totp $ \ totpPtr -> do alloca $ \ outPtr -> do - throwBotanIfNegative $ botan_totp_generate totpPtr outPtr timestamp + void $ throwBotanIfNegative $ botan_totp_generate totpPtr outPtr timestamp peek outPtr -- | Verify a TOTP code -totpCheck - :: TOTP -- ^ __totp__: the TOTP object - -> TOTPCode -- ^ __totp_code__: the presented OTP - -> TOTPTimestamp -- ^ __timestamp__: the current local timestamp - -> Int -- ^ __acceptable_clock_drift__: specifies the acceptable amount - -- of clock drift (in terms of time steps) between the two hosts. - -> IO Bool -totpCheck totp code timestamp drift = withTOTP totp $ \ totpPtr -> do - throwBotanCatchingSuccess $ botan_totp_check totpPtr code timestamp (fromIntegral drift) +totpCheck :: + TOTP -- ^ __totp__: the TOTP object + -> TOTPCode -- ^ __totp_code__: the presented OTP + -> TOTPTimestamp -- ^ __timestamp__: the current local timestamp + -> Int -- ^ __acceptable_clock_drift__: specifies the acceptable amount + -- of clock drift (in terms of time steps) between the two hosts. + -> IO Bool +totpCheck totp code timestamp drift = + withTOTP totp $ \ totpPtr -> + throwBotanCatchingInvalidVerifier $ botan_totp_check totpPtr code timestamp (fromIntegral drift) diff --git a/src/Botan/Low/Utility.hs b/src/Botan/Low/Utility.hs --- a/src/Botan/Low/Utility.hs +++ b/src/Botan/Low/Utility.hs @@ -7,123 +7,111 @@ Maintainer : joris@well-typed.com, leo@apotheca.io Stability : experimental Portability : POSIX --} -module Botan.Low.Utility -( constantTimeCompare -, scrubMem -, HexEncodingFlags -, pattern HexUpperCase -, pattern HexLowerCase -, hexEncode -, hexDecode -, base64Encode -, base64Decode -) where +This module is based on the [Utility +Functions](https://botan.randombit.net/handbook/api_ref/ffi.html#utility-functions) +section of the C Botan FFI documentation. +-} -import Data.Bool +module Botan.Low.Utility ( + constantTimeCompare + , scrubMem + , HexEncodingFlags(..) + , hexEncode + , hexDecode + , base64Encode + , base64Decode + ) where -import qualified Data.Text as Text +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.Utility +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Data.ByteString (ByteString) +import Data.Text import qualified Data.Text.Encoding as Text - -import qualified Data.ByteString as ByteString - -import System.IO.Unsafe - -import Botan.Bindings.Utility - -import Botan.Low.Error -import Botan.Low.Prelude -import Botan.Low.Make (allocBytesQuerying, allocBytesQueryingCString) - --- NOTE: Use of Text is unique here - leave for Text for `botan` +import Data.Word +import Foreign.Ptr -- | Returns 0 if x[0..len] == y[0..len], -1 otherwise. -constantTimeCompare - :: ByteString -- ^ __x__ - -> ByteString -- ^ __y__ - -> Int -- ^ __len__ - -> IO Bool -constantTimeCompare x y len = do - asBytesLen x $ \ xPtr xlen -> do - asBytesLen y $ \ yPtr ylen -> do - result <- botan_constant_time_compare - (ConstPtr xPtr) - (ConstPtr yPtr) - xlen - case result of - 0 -> return True - _ -> return False +constantTimeCompare :: + ByteString -- ^ __x__ + -> ByteString -- ^ __y__ + -> Int -- ^ __len__ + -> IO Bool +constantTimeCompare x y len = + asBytesLen x $ \ xPtr _xlen -> + asBytesLen y $ \ yPtr _ylen -> do + result <- botan_constant_time_compare + (ConstPtr xPtr) + (ConstPtr yPtr) + (fromIntegral len) + case result of + 0 -> return True + _ -> return False -scrubMem - :: Ptr a -- ^ __mem__ - -> Int -- ^ __bytes__ - -> IO () +scrubMem :: + Ptr a -- ^ __mem__ + -> Int -- ^ __bytes__ + -> IO () scrubMem ptr sz = throwBotanIfNegative_ $ botan_scrub_mem (castPtr ptr) (fromIntegral sz) -type HexEncodingFlags = Word32 - -pattern HexUpperCase -- ^ NOTE: Not an actual flag - , HexLowerCase - :: HexEncodingFlags +data HexEncodingFlags = + HexUpperCase + | HexLowerCase -pattern HexUpperCase = BOTAN_FFI_HEX_UPPER_CASE -pattern HexLowerCase = BOTAN_FFI_HEX_LOWER_CASE +hexEncodingFlags :: HexEncodingFlags -> Word32 +hexEncodingFlags HexUpperCase = BOTAN_FFI_HEX_UPPER_CASE +hexEncodingFlags HexLowerCase = BOTAN_FFI_HEX_LOWER_CASE --- | Performs hex encoding of binary data in x of size len bytes. The output buffer out must be of at least x*2 bytes in size. If flags contains BOTAN_FFI_HEX_LOWER_CASE, hex encoding will only contain lower-case letters, upper-case letters otherwise. Returns 0 on success, 1 otherwise. --- DISCUSS: Handling of positive return code / BOTAN_FFI_INVALID_VERIFIER? --- DISCUSS: Use of Text.decodeUtf8 - bad, partial function! - but safe here? -hexEncode - :: ByteString -- ^ __x__ - -> HexEncodingFlags -- ^ __flags__ - -> IO Text -- ^ __y__ -hexEncode bytes flags = Text.decodeUtf8 <$> do - asBytesLen bytes $ \ bytesPtr bytesLen -> do - allocBytes (fromIntegral $ 2 * bytesLen) $ \ hexPtr -> do - throwBotanIfNegative_ $ botan_hex_encode - (ConstPtr bytesPtr) - bytesLen - hexPtr - flags +hexEncode :: + ByteString -- ^ __x__ + -> HexEncodingFlags -- ^ __flags__ + -> IO Text -- ^ __y__ +hexEncode bytes flags = + fmap Text.decodeUtf8 $ + asBytesLen bytes $ \ bytesPtr bytesLen -> + allocBytes (fromIntegral $ 2 * bytesLen) $ \ hexPtr -> + throwBotanIfNegative_ $ botan_hex_encode + (ConstPtr bytesPtr) + bytesLen + hexPtr + (hexEncodingFlags flags) --- | "Hex decode some data" --- DISCUSS: Return value, maybe vs exception --- DISCUSS: Botan documentation is lacking here --- WARNING: Does not actually check that len is a multiple of 2 -hexDecode - :: Text -- ^ __hex_str__ - -> IO ByteString -- ^ __out__ -hexDecode txt = do - asBytesLen (Text.encodeUtf8 txt) $ \ hexPtr hexLen -> do - allocBytesQuerying $ \ bytesPtr szPtr -> do - botan_hex_decode - (ConstPtr hexPtr) - hexLen - bytesPtr - szPtr +hexDecode :: + Text -- ^ __hex_str__ + -> IO ByteString -- ^ __out__ +hexDecode txt = + asBytesLen (Text.encodeUtf8 txt) $ \ hexPtr hexLen -> + allocBytesQuerying $ \ bytesPtr szPtr -> + botan_hex_decode + (ConstPtr hexPtr) + hexLen + bytesPtr + szPtr --- NOTE: Does not check tht base64Len == peek sizePtr -base64Encode - :: ByteString -- ^ __x__ - -> IO Text -- ^ __out__ -base64Encode bytes = Text.decodeUtf8 <$> do - asBytesLen bytes $ \ bytesPtr bytesLen -> do - allocBytesQueryingCString $ \ base64Ptr szPtr -> do - botan_base64_encode - (ConstPtr bytesPtr) - bytesLen - base64Ptr - szPtr +base64Encode :: + ByteString -- ^ __x__ + -> IO Text -- ^ __out__ +base64Encode bytes = + fmap Text.decodeUtf8 $ + asBytesLen bytes $ \ bytesPtr bytesLen -> + allocBytesQueryingCString $ \ base64Ptr szPtr -> + botan_base64_encode + (ConstPtr bytesPtr) + bytesLen + base64Ptr + szPtr --- | Ditto everything hexDecode -base64Decode - :: Text -- ^ __base64_str__ - -> IO ByteString -- ^ __out__ -base64Decode txt = do - asBytesLen (Text.encodeUtf8 txt) $ \ base64Ptr base64Len -> do - allocBytesQueryingCString $ \ bytesPtr szPtr -> do - botan_base64_decode - (ConstPtr base64Ptr) - base64Len - bytesPtr - szPtr +base64Decode :: + Text -- ^ __base64_str__ + -> IO ByteString -- ^ __out__ +base64Decode txt = + asBytesLen (Text.encodeUtf8 txt) $ \ base64Ptr base64Len -> + allocBytesQueryingCString $ \ bytesPtr szPtr -> + botan_base64_decode + (ConstPtr base64Ptr) + base64Len + bytesPtr + szPtr diff --git a/src/Botan/Low/Version.hs b/src/Botan/Low/Version.hs --- a/src/Botan/Low/Version.hs +++ b/src/Botan/Low/Version.hs @@ -7,52 +7,45 @@ Maintainer : joris@well-typed.com, leo@apotheca.io Stability : experimental Portability : POSIX --} -module Botan.Low.Version -( botanFFIAPIVersion -, botanFFISupportsAPI -, botanVersionString -, botanVersionMajor -, botanVersionMinor -, botanVersionPatch -, botanVersionDatestamp -) where - -import Data.Bool - -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Unsafe as ByteString - -import qualified Data.Text as Text -import qualified Data.Text.Foreign as Text - -import System.IO.Unsafe - -import Botan.Bindings.Version +This module is based on the +[Versioning](https://botan.randombit.net/handbook/api_ref/ffi.html#versioning) +section of the C Botan FFI documentation. +-} -import Botan.Low.Prelude -import Botan.Low.Error (throwBotanCatchingSuccess) -import GHC.Generics ((:.:)(unComp1)) +module Botan.Low.Version ( + botanFFIAPIVersion + , botanFFISupportsAPI + , botanVersionString + , botanVersionMajor + , botanVersionMinor + , botanVersionPatch + , botanVersionDatestamp + ) where --- https://botan.randombit.net/handbook/api_ref/ffi.html#versioning +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.Version +import Botan.Low.Error.Internal (throwBotanCatchingInvalidInput) +import Botan.Low.Internal.ByteString +import Data.ByteString (ByteString) --- | Returns the version of the currently supported FFI API. This is expressed in the form YYYYMMDD of the release date of this version of the API. +-- | Returns the version of the currently supported FFI API. This is expressed +-- in the form YYYYMMDD of the release date of this version of the API. botanFFIAPIVersion :: IO Int botanFFIAPIVersion = fromIntegral <$> botan_ffi_api_version --- | Returns 0 iff the FFI version specified is supported by this library. Otherwise returns -1. The expression botan_ffi_supports_api(botan_ffi_api_version()) will always evaluate to 0. A particular version of the library may also support other (older) versions of the FFI API. +-- | Returns 'True' iff the FFI version specified is supported by this library, +-- otherwise returns 'False'. +-- +-- The expression @'botanFFIAPIVersion' >>= 'botanFFISupportsAPI'@ will always +-- evaluate to 'True'. A particular version of the library may also support +-- other (older) versions of the FFI API. botanFFISupportsAPI :: Int -> IO Bool botanFFISupportsAPI version = do - supports <- botan_ffi_supports_api $ fromIntegral version - case supports of - 0 -> return True - _ -> return False --- TODO: botanFFISupportsAPI = throwBotanCatchingSuccess . botan_ffi_supports_api . fromIntegral --- AFTER renaming current throwBotanCatchingSuccess to throwBotanCatchingInvalidIdentifier + throwBotanCatchingInvalidInput $ botan_ffi_supports_api (fromIntegral version) botanVersionString :: IO ByteString -botanVersionString = botan_version_string >>= peekCString . unConstPtr +botanVersionString = botan_version_string >>= peekCString . (.unConstPtr) -- | Returns the major version of the library botanVersionMajor :: IO Int @@ -66,6 +59,7 @@ botanVersionPatch :: IO Int botanVersionPatch = fromIntegral <$> botan_version_patch --- | Returns the date this version was released as an integer YYYYMMDD, or 0 if an unreleased version +-- | Returns the date this version was released as an integer YYYYMMDD, or 0 if +-- an unreleased version botanVersionDatestamp :: IO Int botanVersionDatestamp = fromIntegral <$> botan_version_datestamp diff --git a/src/Botan/Low/View.hs b/src/Botan/Low/View.hs --- a/src/Botan/Low/View.hs +++ b/src/Botan/Low/View.hs @@ -7,31 +7,25 @@ Maintainer : joris@well-typed.com, leo@apotheca.io Stability : experimental Portability : POSIX --} -module Botan.Low.View -( - - BotanViewBinFn(..) -, BotanViewBinCallback(..) -, viewBin -, BotanViewStrFn(..) -, BotanViewStrCallback(..) -, viewStr - -)where - -import qualified Data.ByteString as ByteString - -import Data.Void - -import System.IO +This module is based on the [View +Functions](https://botan.randombit.net/handbook/api_ref/ffi.html#view-functions) +section of the C Botan FFI documentation. +-} -import Botan.Bindings.View +module Botan.Low.View ( + -- * View binary + BotanViewBinFn + , BotanViewBinCallback + , viewBin + -- * View string + , BotanViewStrFn + , BotanViewStrCallback + , viewStr + ) where -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude +import Botan.Bindings.View +import Control.Exception viewBin :: BotanViewBinFn ctx -> (BotanViewBinCallback ctx -> IO a) -> IO a viewBin f = bracket (mallocBotanViewBinCallback f) freeBotanViewBinCallback diff --git a/src/Botan/Low/X509.hs b/src/Botan/Low/X509.hs --- a/src/Botan/Low/X509.hs +++ b/src/Botan/Low/X509.hs @@ -19,82 +19,82 @@ instance in the Transport Layer Security (TLS) protocol. -} -module Botan.Low.X509 -( +module Botan.Low.X509 ( --- * X509 Certificates + -- * X509 Certificates - X509Cert(..) -, withX509Cert -, x509CertLoad -, x509CertLoadFile -, x509CertDestroy -, x509CertDup -, x509CertGetTimeStarts -, x509CertGetTimeExpires -, x509CertNotBefore -, x509CertNotAfter -, x509CertGetPubKeyFingerprint -, x509CertGetSerialNumber -, x509CertGetAuthorityKeyId -, x509CertGetSubjectKeyId -, x509CertGetPublicKeyBits -, x509CertGetPublicKey -, x509CertGetIssuerDN -, x509CertGetSubjectDN -, x509CertToString -, x509CertAllowedUsage -, x509CertHostnameMatch -, x509CertVerify -, x509CertValidationStatus + X509Cert(..) + , withX509Cert + , x509CertLoad + , x509CertLoadFile + , x509CertDestroy + , x509CertDup + , x509CertGetTimeStarts + , x509CertGetTimeExpires + , x509CertNotBefore + , x509CertNotAfter + , x509CertGetPubKeyFingerprint + , x509CertGetSerialNumber + , x509CertGetAuthorityKeyId + , x509CertGetSubjectKeyId + , x509CertGetPublicKeyBits + , x509CertGetPublicKey + , x509CertGetIssuerDN + , x509CertGetSubjectDN + , x509CertToString + , x509CertAllowedUsage + , x509CertHostnameMatch + , x509CertVerify + , x509CertValidationStatus --- * X509 Key constraints + -- * X509 Key constraints -, X509KeyConstraints(..) -, pattern NoConstraints -, pattern DigitalSignature -, pattern NonRepudiation -, pattern KeyEncipherment -, pattern DataEncipherment -, pattern KeyAgreement -, pattern KeyCertSign -, pattern CRLSign -, pattern EncipherOnly -, pattern DecipherOnly + , X509KeyConstraints + , pattern NoConstraints + , pattern DigitalSignature + , pattern NonRepudiation + , pattern KeyEncipherment + , pattern DataEncipherment + , pattern KeyAgreement + , pattern KeyCertSign + , pattern CRLSign + , pattern EncipherOnly + , pattern DecipherOnly --- * X509 Certificate revocation list + -- * X509 Certificate revocation list -, X509CRL(..) -, withX509CRL -, x509CRLLoad -, x509CRLLoadFile -, x509CRLDestroy -, x509IsRevoked -, x509CertVerifyWithCLR + , X509CRL(..) + , withX509CRL + , x509CRLLoad + , x509CRLLoadFile + , x509CRLDestroy + , x509IsRevoked + , x509CertVerifyWithCLR --- * Convenience -, DistinguishedName(..) + -- * Convenience + , DistinguishedName -) where + ) where -import qualified Data.ByteString as ByteString +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.X509 +import Botan.Low.Error.Internal +import Botan.Low.Hash (HashName) +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Botan.Low.PubKey +import Botan.Low.Remake +import Control.Monad +import Data.ByteString (ByteString, packCString) import qualified Data.ByteString.Char8 as Char8 - -import Botan.Bindings.PubKey -import Botan.Bindings.X509 - -import Botan.Low.Hash (HashName(..)) - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.Remake -import Data.Maybe (fromMaybe) -import Data.ByteString (packCString) +import Data.Word import qualified Foreign.C.String as String (withCString) -import Botan.Low.Remake (mkCreateObjectCBytesLen) -import Botan.Low.PubKey (createPubKey) +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable -- TODO: Use *.Make module to ensure consistency @@ -106,13 +106,12 @@ newtype X509Cert = MkX509Cert { getX509CertForeignPtr :: ForeignPtr BotanX509CertStruct } -newX509Cert :: BotanX509Cert -> IO X509Cert withX509Cert :: X509Cert -> (BotanX509Cert -> IO a) -> IO a -- | Destroy an x509 cert object immediately x509CertDestroy :: X509Cert -> IO () createX509Cert :: (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert -(newX509Cert, withX509Cert, x509CertDestroy, createX509Cert, _) - = mkBindings MkBotanX509Cert runBotanX509Cert MkX509Cert getX509CertForeignPtr botan_x509_cert_destroy +(withX509Cert, x509CertDestroy, createX509Cert) + = mkBindings MkBotanX509Cert (.runBotanX509Cert) MkX509Cert (.getX509CertForeignPtr) botan_x509_cert_destroy x509CertLoad :: ByteString -- ^ __cert[]__ @@ -145,10 +144,10 @@ -> IO Word64 -- ^ __time_since_epoch__ x509CertNotBefore cert = withX509Cert cert $ \ certPtr -> do alloca $ \ timePtr -> do - botan_x509_cert_not_before + void $ botan_x509_cert_not_before certPtr timePtr - fromIntegral <$> peek timePtr + peek timePtr -- TODO: mkGetIntegral x509CertNotAfter @@ -156,10 +155,10 @@ -> IO Word64 -- ^ __time_since_epoch__ x509CertNotAfter cert = withX509Cert cert $ \ certPtr -> do alloca $ \ timePtr -> do - botan_x509_cert_not_after + void $ botan_x509_cert_not_after certPtr timePtr - fromIntegral <$> peek timePtr + peek timePtr x509CertGetPubKeyFingerprint @@ -283,12 +282,13 @@ -- a negative error or INVALID_IDENTIFIER to return a bool. -- -- Note: unexplained function, best-guess implementation -x509CertAllowedUsage - :: X509Cert -- ^ __cert__ - -> X509KeyConstraints -- ^ __key_usage__ - -> IO Bool -x509CertAllowedUsage cert usage = withX509Cert cert $ \ certPtr -> do - throwBotanCatchingSuccess $ botan_x509_cert_allowed_usage certPtr usage +x509CertAllowedUsage :: + X509Cert -- ^ __cert__ + -> X509KeyConstraints -- ^ __key_usage__ + -> IO Bool +x509CertAllowedUsage cert usage = + withX509Cert cert $ \ certPtr -> + throwBotanCatchingInvalidVerifier $ botan_x509_cert_allowed_usage certPtr usage {- | Check if the certificate matches the specified hostname via alternative name or CN match. @@ -296,15 +296,16 @@ Note: unexplained function, best-guess implementation -} -x509CertHostnameMatch - :: X509Cert -- ^ __cert__ - -> ByteString -- ^ __hostname__ - -> IO Bool -x509CertHostnameMatch cert hostname = withX509Cert cert $ \ certPtr -> do - asCString hostname $ \ hostnamePtr -> do - throwBotanCatchingSuccess $ botan_x509_cert_hostname_match - certPtr - (ConstPtr hostnamePtr) +x509CertHostnameMatch :: + X509Cert -- ^ __cert__ + -> ByteString -- ^ __hostname__ + -> IO Bool +x509CertHostnameMatch cert hostname = + withX509Cert cert $ \ certPtr -> + asCString hostname $ \ hostnamePtr -> + throwBotanCatchingInvalidInput $ botan_x509_cert_hostname_match + certPtr + (ConstPtr hostnamePtr) {- | Returns 0 if the validation was successful, 1 if validation failed, @@ -314,35 +315,35 @@ Intermediates or trusted lists can be null Trusted path can be null -} -x509CertVerify - :: X509Cert -- ^ __cert__ - -> [X509Cert] -- ^ __intermediates__ - -> [X509Cert] -- ^ __trusted__ - -> Maybe FilePath -- ^ __trusted_path__ - -> Int -- ^ __required_strength__ - -> ByteString -- ^ __hostname__ - -> Word64 -- ^ __reference_time__ - -> IO (Bool, Int) -- ^ __(valid,validation_result)__ -x509CertVerify cert icerts tcerts tpath strength hostname time = do - withX509Cert cert $ \ certPtr -> do - withPtrs withX509Cert icerts $ flip withArrayLen $ \ icertsLen icertsPtr -> do - withPtrs withX509Cert tcerts $ flip withArrayLen $ \ tcertsLen tcertsPtr -> do - maybe ($ nullPtr) String.withCString tpath $ \ tpathPtr -> do - asCString hostname $ \ hostnamePtr -> do - alloca $ \ statusPtr -> do - success <- throwBotanCatchingSuccess $ botan_x509_cert_verify - statusPtr - certPtr - (ConstPtr icertsPtr) - (fromIntegral icertsLen) - (ConstPtr tcertsPtr) - (fromIntegral tcertsLen) - (ConstPtr tpathPtr) - (fromIntegral strength) - (ConstPtr hostnamePtr) - time - code <- fromIntegral <$> peek statusPtr - return (success, code) +x509CertVerify :: + X509Cert -- ^ __cert__ + -> [X509Cert] -- ^ __intermediates__ + -> [X509Cert] -- ^ __trusted__ + -> Maybe FilePath -- ^ __trusted_path__ + -> Int -- ^ __required_strength__ + -> ByteString -- ^ __hostname__ + -> Word64 -- ^ __reference_time__ + -> IO (Bool, Int) -- ^ __(valid,validation_result)__ +x509CertVerify cert icerts tcerts tpath strength hostname time = + withX509Cert cert $ \ certPtr -> + withPtrs withX509Cert icerts $ flip withArrayLen $ \ icertsLen icertsPtr -> + withPtrs withX509Cert tcerts $ flip withArrayLen $ \ tcertsLen tcertsPtr -> + maybe ($ nullPtr) String.withCString tpath $ \ tpathPtr -> + asCString hostname $ \ hostnamePtr -> + alloca $ \ statusPtr -> do + success <- throwBotanCatchingInvalidVerifier $ botan_x509_cert_verify + statusPtr + certPtr + (ConstPtr icertsPtr) + (fromIntegral icertsLen) + (ConstPtr tcertsPtr) + (fromIntegral tcertsLen) + (ConstPtr tpathPtr) + (fromIntegral strength) + (ConstPtr hostnamePtr) + time + code <- fromIntegral <$> peek statusPtr + return (success, code) -- TODO: The above works, but there's more to it -- Need to allow null pointer for empty lists too, something like: -- where @@ -356,7 +357,7 @@ status <- botan_x509_cert_validation_status (fromIntegral code) if status == ConstPtr nullPtr then return Nothing - else Just <$> packCString (unConstPtr status) + else Just <$> packCString status.unConstPtr -- /* -- * X.509 CRL @@ -366,12 +367,11 @@ newtype X509CRL = MkX509CRL { getX509CRLForeignPtr :: ForeignPtr BotanX509CRLStruct } -newX509CRL :: BotanX509CRL -> IO X509CRL withX509CRL :: X509CRL -> (BotanX509CRL -> IO a) -> IO a x509CRLDestroy :: X509CRL -> IO () createX509CRL :: (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL -(newX509CRL, withX509CRL, x509CRLDestroy, createX509CRL, _) - = mkBindings MkBotanX509CRL runBotanX509CRL MkX509CRL getX509CRLForeignPtr botan_x509_crl_destroy +(withX509CRL, x509CRLDestroy, createX509CRL) + = mkBindings MkBotanX509CRL (.runBotanX509CRL) MkX509CRL (.getX509CRLForeignPtr) botan_x509_crl_destroy x509CRLLoad :: ByteString -- ^ __crl_bits[]__ @@ -387,48 +387,49 @@ Given a CRL and a certificate, check if the certificate is revoked on that particular CRL -} -x509IsRevoked - :: X509CRL -- ^ __crl__ - -> X509Cert -- ^ __cert__ - -> IO Bool -x509IsRevoked crl cert = withX509CRL crl $ \ crlPtr -> do - withX509Cert cert $ \ certPtr -> do - throwBotanCatchingSuccess $ botan_x509_is_revoked crlPtr certPtr +x509IsRevoked :: + X509CRL -- ^ __crl__ + -> X509Cert -- ^ __cert__ + -> IO Bool +x509IsRevoked crl cert = + withX509CRL crl $ \ crlPtr -> + withX509Cert cert $ \ certPtr -> + throwBotanCatchingInvalidInput $ botan_x509_is_revoked crlPtr certPtr {- | Different flavor of `botan_x509_cert_verify`, supports revocation lists. CRLs are passed as an array, same as intermediates and trusted CAs -} -x509CertVerifyWithCLR - :: X509Cert -- ^ __cert__ - -> [X509Cert] -- ^ __intermediates__ - -> [X509Cert] -- ^ __trusted__ - -> [X509CRL] -- ^ __crls__ - -> Maybe FilePath -- ^ __trusted_path__ - -> Int -- ^ __required_strength__ - -> ByteString -- ^ __hostname__ - -> Word64 -- ^ __reference_time__ - -> IO (Bool, Int) -- ^ __(valid,validation_result)__ -x509CertVerifyWithCLR cert icerts tcerts crls tpath strength hostname time = do - withX509Cert cert $ \ certPtr -> do - withPtrs withX509Cert icerts $ flip withArrayLen $ \ icertsLen icertsPtr -> do - withPtrs withX509Cert tcerts $ flip withArrayLen $ \ tcertsLen tcertsPtr -> do - withPtrs withX509CRL crls $ flip withArrayLen $ \ crlsLen crlsPtr -> do - maybe ($ nullPtr) String.withCString tpath $ \ tpathPtr -> do - asCString hostname $ \ hostnamePtr -> do - alloca $ \ statusPtr -> do - success <- throwBotanCatchingSuccess $ botan_x509_cert_verify_with_crl - statusPtr - certPtr - (ConstPtr icertsPtr) - (fromIntegral icertsLen) - (ConstPtr tcertsPtr) - (fromIntegral tcertsLen) - (ConstPtr crlsPtr) - (fromIntegral crlsLen) - (ConstPtr tpathPtr) - (fromIntegral strength) - (ConstPtr hostnamePtr) - time - code <- fromIntegral <$> peek statusPtr - return (success, code) +x509CertVerifyWithCLR :: + X509Cert -- ^ __cert__ + -> [X509Cert] -- ^ __intermediates__ + -> [X509Cert] -- ^ __trusted__ + -> [X509CRL] -- ^ __crls__ + -> Maybe FilePath -- ^ __trusted_path__ + -> Int -- ^ __required_strength__ + -> ByteString -- ^ __hostname__ + -> Word64 -- ^ __reference_time__ + -> IO (Bool, Int) -- ^ __(valid,validation_result)__ +x509CertVerifyWithCLR cert icerts tcerts crls tpath strength hostname time = + withX509Cert cert $ \ certPtr -> + withPtrs withX509Cert icerts $ flip withArrayLen $ \ icertsLen icertsPtr -> + withPtrs withX509Cert tcerts $ flip withArrayLen $ \ tcertsLen tcertsPtr -> + withPtrs withX509CRL crls $ flip withArrayLen $ \ crlsLen crlsPtr -> + maybe ($ nullPtr) String.withCString tpath $ \ tpathPtr -> + asCString hostname $ \ hostnamePtr -> + alloca $ \ statusPtr -> do + success <- throwBotanCatchingInvalidVerifier $ botan_x509_cert_verify_with_crl + statusPtr + certPtr + (ConstPtr icertsPtr) + (fromIntegral icertsLen) + (ConstPtr tcertsPtr) + (fromIntegral tcertsLen) + (ConstPtr crlsPtr) + (fromIntegral crlsLen) + (ConstPtr tpathPtr) + (fromIntegral strength) + (ConstPtr hostnamePtr) + time + code <- fromIntegral <$> peek statusPtr + return (success, code) diff --git a/src/Botan/Low/X509/CA.hs b/src/Botan/Low/X509/CA.hs deleted file mode 100644 --- a/src/Botan/Low/X509/CA.hs +++ /dev/null @@ -1,115 +0,0 @@ -module Botan.Low.X509.CA where - -import Data.Bool - -import Botan.Low.Error -import Botan.Low.Prelude -import Botan.Low.Hash -import Botan.Low.Make -import Botan.Low.MPI -import Botan.Low.PubKey -import Botan.Low.PubKey.Sign -import Botan.Low.RNG -import Botan.Low.X509 -import Botan.Low.X509.CSR -import Botan.Low.X509.Extensions - -import Botan.Bindings.X509 -import Botan.Bindings.X509.CA -import Botan.Bindings.X509.Extensions - --- /* --- * X.509 certificate authority --- **************************/ - -newtype X509CA = MkX509CA { getX509CAForeignPtr :: ForeignPtr X509CAStruct } - -withX509CAPtr :: X509CA -> (X509CAPtr -> IO a) -> IO a -withX509CAPtr = withForeignPtr . getX509CAForeignPtr - -x509CADestroy :: X509CA -> IO () -x509CADestroy ca = finalizeForeignPtr (getX509CAForeignPtr ca) - -x509CACreate :: X509Cert -> PrivKey -> HashName -> RNG -> IO X509CA -x509CACreate cert key hash_fn rng = do - withX509Cert cert $ \ certPtr -> do - withPrivKey key $ \ keyPtr -> do - asCString hash_fn $ \ hashPtr -> do - withRNG rng $ \ botanRNG -> do - mkInit - MkX509CA - (\ caPtr -> botan_x509_ca_create - caPtr - certPtr - keyPtr - hashPtr - botanRNG - ) - botan_x509_ca_destroy - -x509CACreatePadding :: X509Cert -> PrivKey -> HashName -> X509PaddingName -> RNG -> IO X509CA -x509CACreatePadding cert key hash_fn padding_fn rng = do - withX509Cert cert $ \ certPtr -> do - withPrivKey key $ \ keyPtr -> do - asCString hash_fn $ \ hashPtr -> do - asCString padding_fn $ \ paddingPtr -> do - withRNG rng $ \ botanRNG -> do - mkInit - MkX509CA - (\ caPtr -> botan_x509_ca_create_padding - caPtr - certPtr - keyPtr - hashPtr - paddingPtr - botanRNG - ) - botan_x509_ca_destroy - -x509CASignRequest :: X509CA -> X509CSR -> RNG -> Word64 -> Word64 -> IO X509Cert -x509CASignRequest ca csr rng not_before not_after = do - withX509CAPtr ca $ \ caPtr -> do - withX509CSRPtr csr $ \ csrPtr -> do - withRNG rng $ \ botanRNG -> do - mkInit - MkX509Cert - (\ certPtr -> botan_x509_ca_sign_request certPtr caPtr csrPtr botanRNG not_before not_after) - botan_x509_cert_destroy - --- NOTE: This is a static function on X509CA, so it doesn't take an actual X509CA object -x509CAMakeCertSerial :: SignCtx -> RNG -> MP -> SignAlgoName -> PubKey -> Word64 -> Word64 -> X509SubjectDN -> X509IssuerDN -> X509Extensions -> IO X509Cert -x509CAMakeCertSerial signer rng serial signalgo pubkey not_before not_after subject_dn issuer_dn exts = do - withSignPtr signer $ \ signerPtr -> do - withRNG rng $ \ botanRNG -> do - withMP serial $ \ serialPtr -> do - asCString signalgo $ \ signalgoPtr -> do - withPubKey pubkey $ \ pubkeyPtr -> do - asBytesLen subject_dn $ \ subject_dn_ptr subject_dn_len -> do - asBytesLen issuer_dn $ \ issuer_dn_ptr issuer_dn_len -> do - withX509ExtensionsPtr exts $ \ extsPtr -> do - mkInit - MkX509Cert - (\ certPtr -> botan_x509_ca_make_cert_serial - certPtr - signerPtr - botanRNG - serialPtr - signalgoPtr - pubkeyPtr - not_before - not_after - subject_dn_ptr subject_dn_len - issuer_dn_ptr issuer_dn_len - extsPtr - ) - botan_x509_cert_destroy - -x509CAChooseExtensions :: X509CSR -> X509Cert -> HashName -> IO X509Extensions -x509CAChooseExtensions csr cert hash_fn = do - withX509CSRPtr csr $ \ csrPtr -> do - withX509Cert cert $ \ certPtr -> do - asCString hash_fn $ \ hashPtr -> do - mkInit - MkX509Extensions - (\ extsPtr -> botan_x509_ca_choose_extensions extsPtr csrPtr certPtr hashPtr) - botan_x509_exts_destroy diff --git a/src/Botan/Low/X509/CRL.hs b/src/Botan/Low/X509/CRL.hs deleted file mode 100644 --- a/src/Botan/Low/X509/CRL.hs +++ /dev/null @@ -1,151 +0,0 @@ -module Botan.Low.X509.CRL where - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.X509 -import Botan.Low.X509.Extensions - -import Botan.Bindings.X509 -import Botan.Bindings.X509.Extensions -import Botan.Bindings.X509.CRL -import Botan.Low.X509.CSR (X509IssuerDN) - --- --- CRL --- - --- TODO: Eventually move original / read-only CRL functions here too - -x509CRLGetRevoked :: X509CRL -> IO [X509CRLEntry] -x509CRLGetRevoked crl = withX509CRL crl $ \ crlPtr -> do - -- TODO: Some sort of allocArrayQuerying - undefined - -x509CRLGetIssuerDN :: X509CRL -> ByteString -> Int -> IO X509IssuerDN -x509CRLGetIssuerDN crl key index = withX509CRL crl $ \ crlPtr -> do - asBytes key $ \ keyPtr -> do - allocBytesQuerying $ \ outPtr outLen -> botan_x509_crl_get_issuer_dn - outPtr - outLen - crlPtr - keyPtr - (fromIntegral index) - -x509CRLExtensions :: X509CRL -> IO X509Extensions -x509CRLExtensions crl = withX509CRL crl $ \ crlPtr -> mkInit - MkX509Extensions - (\ ptr -> botan_x509_crl_extensions ptr crlPtr) - botan_x509_exts_destroy - -x509CRLAuthorityKeyId :: X509CRL -> IO ByteString -x509CRLAuthorityKeyId crl = withX509CRL crl $ \ crlPtr -> do - allocBytesQuerying $ \ outPtr outLen -> botan_x509_crl_authority_key_id - outPtr outLen - crlPtr - -x509CRLSerialNumber :: X509CRL -> IO Word32 -x509CRLSerialNumber crl = withX509CRL crl $ \ crlPtr -> do - alloca $ \ snPtr -> do - throwBotanIfNegative_ $ botan_x509_crl_serial_number snPtr crlPtr - peek snPtr - -x509CRLThisUpdate :: X509CRL -> IO Word64 -x509CRLThisUpdate crl = withX509CRL crl $ \ crlPtr -> do - alloca $ \ timePtr -> do - throwBotanIfNegative_ $ botan_x509_crl_this_update timePtr crlPtr - peek timePtr - -x509CRLNextUpdate :: X509CRL -> IO Word64 -x509CRLNextUpdate crl = withX509CRL crl $ \ crlPtr -> do - alloca $ \ timePtr -> do - throwBotanIfNegative_ $ botan_x509_crl_next_update timePtr crlPtr - peek timePtr - -x509CRLIssuingDistributionPoint :: X509CRL -> IO ByteString -x509CRLIssuingDistributionPoint crl = withX509CRL crl $ \ crlPtr -> do - allocBytesQuerying $ \ outPtr outLen -> botan_x509_crl_issuing_distribution_point - outPtr outLen - crlPtr - -x509CRLCreateDER :: ByteString -> IO X509CRL -x509CRLCreateDER der = do - asBytesLen der $ \ derPtr derLen -> mkInit - MkX509CRL - (\ptr -> botan_x509_crl_create_der ptr derPtr derLen) - botan_x509_crl_destroy - -x509CRLCreate :: X509IssuerDN -> Word64 -> Word64 -> [X509CRLEntry] -> IO X509CRL -x509CRLCreate der this next entries = do - -- TODO: withArray, ownership transfer - -- asBytesLen der $ \ derPtr derLen -> mkInit - -- MkX509CRL - -- (\ptr -> botan_x509_crl_create ptr derPtr derLen) - -- botan_x509_crl_destroy - undefined - -x509CRLAddEntry :: X509CRL -> X509CRLEntry -> IO () -x509CRLAddEntry crl entry = undefined - -x509CRLRevokeCert :: X509CRL -> X509Cert -> X509CRLCode -> IO () -x509CRLRevokeCert crl entry reason = undefined - --- --- CRL Entry --- - -newtype X509CRLEntry = MkX509CRLEntry { getX509CRLEntryForeignPtr :: ForeignPtr X509CRLEntryStruct } - -withX509CRLEntryPtr :: X509CRLEntry -> (X509CRLEntryPtr -> IO a) -> IO a -withX509CRLEntryPtr = withForeignPtr . getX509CRLEntryForeignPtr - -x509CRLEntryDestroy :: X509CRLEntry -> IO () -x509CRLEntryDestroy crl = finalizeForeignPtr (getX509CRLEntryForeignPtr crl) - -type X509CRLCode = Word32 - --- Must match values of CRL_Code in pkix_enums.h -pattern BOTAN_X509_CRL_CODE_UNSPECIFIED = 0 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_KEY_COMPROMISE = 1 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_CA_COMPROMISE = 2 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_AFFILIATION_CHANGED = 3 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_SUPERCEDED = 4 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_CESSATION_OF_OPERATION = 5 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_CERTIFICATE_HOLD = 6 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_REMOVE_FROM_CRL = 8 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_PRIVILEGE_WITHDRAWN = 9 :: X509CRLCode -pattern BOTAN_X509_CRL_CODE_AA_COMPROMISE = 10 :: X509CRLCode - -x509CRLEntryCreate :: X509Cert -> X509CRLCode -> IO X509CRLEntry -x509CRLEntryCreate cert crl_code = do - withX509Cert cert $ \ certPtr -> mkInit - MkX509CRLEntry - (\ptr -> botan_x509_crl_entry_create ptr certPtr crl_code) - botan_x509_crl_entry_destroy - --- -- TODO: CRL_Entry PEM / BER encode / decode (and for CRL too) - --- NOTE: Is bytestring serial number vs MP serial number elsewhere - need to consistentize -x509CRLEntryGetSerialNumber :: X509CRLEntry -> IO ByteString -x509CRLEntryGetSerialNumber entry = withX509CRLEntryPtr entry $ \ entryPtr -> do - allocBytesQuerying $ \ outPtr szPtr -> do - botan_x509_crl_entry_get_serial_number outPtr szPtr entryPtr - -x509CRLEntryGetExpireTime :: X509CRLEntry -> IO Word64 -x509CRLEntryGetExpireTime entry = withX509CRLEntryPtr entry $ \ entryPtr -> do - alloca $ \ outPtr -> do - throwBotanIfNegative_ $ botan_x509_crl_entry_get_expire_time outPtr entryPtr - peek outPtr - -x509CRLEntryGetReasonCode :: X509CRLEntry -> IO X509CRLCode -x509CRLEntryGetReasonCode entry = withX509CRLEntryPtr entry $ \ entryPtr -> do - alloca $ \ outPtr -> do - throwBotanIfNegative_ $ botan_x509_crl_entry_get_reason_code outPtr entryPtr - peek outPtr - -x509CRLEntryGetExtensions :: X509CRLEntry -> IO X509Extensions -x509CRLEntryGetExtensions entry = withX509CRLEntryPtr entry $ \ entryPtr -> do - mkInit - MkX509Extensions - (\ ptr -> botan_x509_crl_entry_get_extensions ptr entryPtr) - botan_x509_exts_destroy diff --git a/src/Botan/Low/X509/CSR.hs b/src/Botan/Low/X509/CSR.hs deleted file mode 100644 --- a/src/Botan/Low/X509/CSR.hs +++ /dev/null @@ -1,85 +0,0 @@ -module Botan.Low.X509.CSR where - -import Botan.Low.Error -import Botan.Low.Hash (HashName(..)) -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.RNG -import Botan.Low.X509 -import Botan.Low.X509.Extensions -import Botan.Low.X509.Options - -import Botan.Bindings.X509 -import Botan.Bindings.X509.CSR - --- /* --- * X.509 certificate signing request --- **************************/ - -type X509SubjectDN = ByteString -type X509IssuerDN = ByteString - --- NOTE: It is unknown which paddings are accepted (eg, compare cbc vs pk padding) -type X509PaddingName = ByteString -type X509Challenge = ByteString - -newtype X509CSR = MkX509CSR { getX509CSRForeignPtr :: ForeignPtr X509CSRStruct } - -withX509CSRPtr :: X509CSR -> (X509CSRPtr -> IO a) -> IO a -withX509CSRPtr = withForeignPtr . getX509CSRForeignPtr - -x509CSRDestroy :: X509CSR -> IO () -x509CSRDestroy csr = finalizeForeignPtr (getX509CSRForeignPtr csr) - --- NOTE: It really appears that this is the successful init pattern; --- I ought to formalize it using type-level lists or something -x509CreateCertReq :: X509CertOptions -> PrivKey -> HashName -> RNG -> IO X509CSR -x509CreateCertReq options key hash_fn rng = withX509CertOptionsPtr options $ \ optionsPtr -> do - withPrivKey key $ \ keyPtr -> do - asCString hash_fn $ \ hashPtr -> do - withRNG rng $ \ botanRNG -> do - mkInit - MkX509CSR - (\ csrPtr -> botan_x509_create_cert_req csrPtr optionsPtr keyPtr hashPtr botanRNG) - botan_x509_csr_destroy - -x509CSRCreate :: PrivKey -> X509SubjectDN -> X509Extensions -> HashName -> RNG -> X509PaddingName -> X509Challenge -> IO X509CSR -x509CSRCreate privkey subjectDN exts hash_fn rng padding_fn challenge = do - withPrivKey privkey $ \ privkeyPtr -> do - asBytesLen subjectDN $ \ subjectDNPtr subjectDNLen -> do - withX509ExtensionsPtr exts $ \ extsPtr -> do - asCString hash_fn $ \ hashPtr -> do - withRNG rng $ \ botanRNG -> do - asCString padding_fn $ \ paddingPtr -> do - asCString challenge $ \ challengePtr -> do - mkInit - MkX509CSR - (\ csrPtr -> botan_x509_csr_create - csrPtr - privkeyPtr - subjectDNPtr subjectDNLen - extsPtr - hashPtr - botanRNG - paddingPtr - challengePtr - ) - botan_x509_csr_destroy - -x509CreateSelfSignedCert :: X509CertOptions -> PrivKey -> HashName -> RNG -> IO X509Cert -x509CreateSelfSignedCert options key hash_fn rng = do - withX509CertOptionsPtr options $ \ optionsPtr -> do - withPrivKey key $ \ keyPtr -> do - asCString hash_fn $ \ hashPtr -> do - withRNG rng $ \ botanRNG -> do - mkInit - MkX509Cert - (\ certPtr -> botan_x509_create_self_signed_cert - certPtr - optionsPtr - keyPtr - hashPtr - botanRNG - ) - botan_x509_cert_destroy diff --git a/src/Botan/Low/X509/DN.hs b/src/Botan/Low/X509/DN.hs deleted file mode 100644 --- a/src/Botan/Low/X509/DN.hs +++ /dev/null @@ -1,60 +0,0 @@ -module Botan.Low.X509.DN where - -import Botan.Low.Error -import Botan.Low.Prelude -import Botan.Low.X509 - -import Botan.Bindings.X509.DN - -newtype X509DN = MkX509DN { getX509DNForeignPtr :: ForeignPtr X509DNStruct } - -withX509DNPtr :: X509DN -> (X509DNPtr -> IO a) -> IO a -withX509DNPtr = withForeignPtr . getX509DNForeignPtr - -x509DNDestroy :: X509DN -> IO () -x509DNDestroy dn = finalizeForeignPtr (getX509DNForeignPtr dn) - --- foreign import ccall unsafe botan_x509_dn_create --- :: Ptr X509DNPtr --- -> IO BotanErrorCode - --- foreign import ccall unsafe botan_x509_dn_create_from_multimap --- :: Ptr X509DNPtr --- -> Ptr Word8 -> Ptr CSize --- -> Ptr Word8 -> Ptr CSize --- -> CSize --- -> IO BotanErrorCode - --- foreign import ccall unsafe botan_x509_dn_to_string --- :: Ptr Word8 -> Ptr CSize --- -> X509DNPtr --- -> IO BotanErrorCode - --- -- NOTE: Returns a bool success code --- foreign import ccall unsafe botan_x509_dn_has_field --- :: X509DNPtr --- -> Ptr Word8 -> CSize --- -> IO BotanErrorCode - --- foreign import ccall unsafe botan_x509_dn_get_first_attribute --- :: Ptr Word8 -> Ptr CSize --- -> X509DNPtr --- -> Ptr Word8 -> CSize --- -> IO BotanErrorCode - --- foreign import ccall unsafe botan_x509_dn_get_attribute --- :: Ptr (Ptr Word8) -> Ptr CSize -> Ptr CSize --- -> X509DNPtr --- -> Ptr Word8 -> CSize --- -> IO BotanErrorCode - --- foreign import ccall unsafe botan_x509_dn_contents --- :: Ptr (Ptr Word8) -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> Ptr CSize --- -> X509DNPtr --- -> IO BotanErrorCode - --- foreign import ccall unsafe botan_x509_dn_add_attribute --- :: X509DNPtr --- -> Ptr Word8 -> CSize --- -> Ptr Word8 -> CSize --- -> IO BotanErrorCode diff --git a/src/Botan/Low/X509/Extensions.hs b/src/Botan/Low/X509/Extensions.hs deleted file mode 100644 --- a/src/Botan/Low/X509/Extensions.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Botan.Low.X509.Extensions where - -import Botan.Low.Error -import Botan.Low.Prelude -import Botan.Low.X509 - -import Botan.Bindings.X509.Extensions - -newtype X509Extensions = MkX509Extensions { getX509ExtensionsForeignPtr :: ForeignPtr X509ExtensionsStruct } - -withX509ExtensionsPtr :: X509Extensions -> (X509ExtensionsPtr -> IO a) -> IO a -withX509ExtensionsPtr = withForeignPtr . getX509ExtensionsForeignPtr - -x509ExtensionsDestroy :: X509Extensions -> IO () -x509ExtensionsDestroy exts = finalizeForeignPtr (getX509ExtensionsForeignPtr exts) - -newtype X509Extension = MkX509Extension { getX509ExtensionForeignPtr :: ForeignPtr X509ExtensionStruct } - -withX509ExtensionPtr :: X509Extension -> (X509ExtensionPtr -> IO a) -> IO a -withX509ExtensionPtr = withForeignPtr . getX509ExtensionForeignPtr - -x509ExtensionDestroy :: X509Extension -> IO () -x509ExtensionDestroy ext = finalizeForeignPtr (getX509ExtensionForeignPtr ext) - --- TODO: See C FFI for discussion on pending implementation - diff --git a/src/Botan/Low/X509/Options.hs b/src/Botan/Low/X509/Options.hs deleted file mode 100644 --- a/src/Botan/Low/X509/Options.hs +++ /dev/null @@ -1,157 +0,0 @@ -module Botan.Low.X509.Options where - -import Data.Bool - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.X509 -import Botan.Low.X509.Extensions - -import Botan.Bindings.X509.Options - --- /* --- * X.509 certificate options --- **************************/ - -newtype X509CertOptions = MkX509CertOptions { getX509CertOptionsForeignPtr :: ForeignPtr X509CertOptionsStruct } - -withX509CertOptionsPtr :: X509CertOptions -> (X509CertOptionsPtr -> IO a) -> IO a -withX509CertOptionsPtr = withForeignPtr . getX509CertOptionsForeignPtr - -x509CertOptionsDestroy :: X509CertOptions -> IO () -x509CertOptionsDestroy opts = finalizeForeignPtr (getX509CertOptionsForeignPtr opts) - -x509CertOptionsCreate :: IO X509CertOptions -x509CertOptionsCreate = mkInit MkX509CertOptions botan_x509_cert_options_create botan_x509_cert_options_destroy - -x509CertOptionsCreateCommon - :: ByteString - -> ByteString - -> ByteString - -> ByteString - -> Word32 - -> IO X509CertOptions -x509CertOptionsCreateCommon common_name country org org_unit expiration_time = do - alloca $ \ outPtr -> do - asCString common_name $ \ cnPtr -> do - asCString country $ \ countryPtr -> do - asCString org $ \ orgPtr -> do - asCString org_unit $ \ orgUnitPtr -> do - throwBotanIfNegative_ $ botan_x509_cert_options_create_common outPtr - cnPtr - countryPtr - orgPtr - orgUnitPtr - expiration_time - out <- peek outPtr - foreignPtr <- newForeignPtr botan_x509_cert_options_destroy out - return $ MkX509CertOptions foreignPtr - -x509CertOptionsSetCommonName :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetCommonName = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_common_name - -x509CertOptionsSetCountry :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetCountry = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_country - -x509CertOptionsSetOrg :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetOrg = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_organization - -x509CertOptionsSetOrgUnit :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetOrgUnit = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_org_unit - -x509CertOptionsSetMoreOrgUnits :: X509CertOptions -> [ByteString] -> IO () -x509CertOptionsSetMoreOrgUnits opts more_org_units = withX509CertOptionsPtr opts $ \ optsPtr -> do - withPtrs asCString more_org_units $ \ morePtrs -> do - allocaArray moreLen $ \ (morePtrArrayPtr :: Ptr (Ptr CChar)) -> do - pokeArray morePtrArrayPtr morePtrs - throwBotanIfNegative_ $ botan_x509_cert_options_set_more_org_units - optsPtr - morePtrArrayPtr - (fromIntegral moreLen) - where - moreLen = length more_org_units - -x509CertOptionsSetLocality :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetLocality = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_locality - -x509CertOptionsSetState :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetState = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_state - -x509CertOptionsSetSerialNumber :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetSerialNumber = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_serial_number - -x509CertOptionsSetEmail :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetEmail = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_email - -x509CertOptionsSetURI :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetURI = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_uri - -x509CertOptionsSetIP :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetIP = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_ip - -x509CertOptionsSetDNS :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetDNS = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_dns - -x509CertOptionsSetMoreDNS :: X509CertOptions -> [ByteString] -> IO () -x509CertOptionsSetMoreDNS opts more_dns = withX509CertOptionsPtr opts $ \ optsPtr -> do - withPtrs asCString more_dns $ \ morePtrs -> do - allocaArray moreLen $ \ (morePtrArrayPtr :: Ptr (Ptr CChar)) -> do - pokeArray morePtrArrayPtr morePtrs - throwBotanIfNegative_ $ botan_x509_cert_options_set_more_dns - optsPtr - morePtrArrayPtr - (fromIntegral moreLen) - where - moreLen = length more_dns - -x509CertOptionsSetXMPP :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetXMPP = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_xmpp - -x509CertOptionsSetChallenge :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetChallenge = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_challenge - -x509CertOptionsSetStart :: X509CertOptions -> Word64 -> IO () -x509CertOptionsSetStart = mkSet withX509CertOptionsPtr botan_x509_cert_options_set_start - -x509CertOptionsSetEnd :: X509CertOptions -> Word64 -> IO () -x509CertOptionsSetEnd = mkSet withX509CertOptionsPtr botan_x509_cert_options_set_end - --- // TODO: Convenience functions for set_start_duration, set_expires - -x509CertOptionsSetIsCA :: X509CertOptions -> Bool -> IO () -x509CertOptionsSetIsCA = mkSetOn withX509CertOptionsPtr (CBool . bool 0 1) botan_x509_cert_options_set_is_ca - -x509CertOptionsSetPathLimit :: X509CertOptions -> Int -> IO () -x509CertOptionsSetPathLimit = mkSetCSize withX509CertOptionsPtr botan_x509_cert_options_set_path_limit - -x509CertOptionsSetPaddingScheme :: X509CertOptions -> ByteString -> IO () -x509CertOptionsSetPaddingScheme = mkSetCString withX509CertOptionsPtr botan_x509_cert_options_set_padding_scheme - --- NOTE: Should probably be Word rather than Int -x509CertOptionsSetKeyConstraints :: X509CertOptions -> Int -> IO () -x509CertOptionsSetKeyConstraints = mkSetOn withX509CertOptionsPtr fromIntegral botan_x509_cert_options_set_key_constraints - -x509CertOptionsSetExConstraints :: X509CertOptions -> [ByteString] -> IO () -x509CertOptionsSetExConstraints opts exConstraints = withX509CertOptionsPtr opts $ \ optsPtr -> do - withPtrs asCString exConstraints $ \ exPtrs -> do - allocaArray exLen $ \ (exPtrArrayPtr :: Ptr (Ptr CChar)) -> do - pokeArray exPtrArrayPtr exPtrs - throwBotanIfNegative_ $ botan_x509_cert_options_set_ex_constraints - optsPtr - exPtrArrayPtr - (fromIntegral exLen) - where - exLen = length exConstraints - -x509CertOptionsSetExtensions :: X509CertOptions -> X509Extensions -> IO () -x509CertOptionsSetExtensions opts extensions = withX509CertOptionsPtr opts $ \ optsPtr -> do - withX509ExtensionsPtr extensions $ \ extensionPtr -> do - throwBotanIfNegative_ $ botan_x509_cert_options_set_extensions - optsPtr - extensionPtr - --- TODO: botan_x509_cert_options getters - --- TODO: botan_x509_cert_options functions (above is just members) --- There's only a few though so its easy diff --git a/src/Botan/Low/X509/Path.hs b/src/Botan/Low/X509/Path.hs deleted file mode 100644 --- a/src/Botan/Low/X509/Path.hs +++ /dev/null @@ -1,141 +0,0 @@ -module Botan.Low.X509.Path where - -import Foreign.Marshal.Utils - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.X509 -import Botan.Low.X509.Store - -import Botan.Bindings.X509 -import Botan.Bindings.X509.Path - -newtype X509PathRestrictions = MkX509PathRestrictions { getX509PathRestrictionsForeignPtr :: ForeignPtr X509PathRestrictionsStruct } - -withX509PathRestrictionsPtr :: X509PathRestrictions -> (X509PathRestrictionsPtr -> IO a) -> IO a -withX509PathRestrictionsPtr = withForeignPtr . getX509PathRestrictionsForeignPtr - -x509PathRestrictionsDestroy :: X509PathRestrictions -> IO () -x509PathRestrictionsDestroy restrictions = finalizeForeignPtr (getX509PathRestrictionsForeignPtr restrictions) - -x509PathRestrictionsCreate :: Bool -> Int -> Bool -> Word64 -> X509CertStore -> IO X509PathRestrictions -x509PathRestrictionsCreate require_rev minimum_key_strength ocsp_all_intermediates max_ocsp_age trusted_ocsp_responders = do - withX509CertStorePtr trusted_ocsp_responders $ \ trustedStorePtr -> do - mkInit - MkX509PathRestrictions - (\ pvPtr -> botan_x509_path_restrictions_create - pvPtr - (fromBool require_rev) - (fromIntegral minimum_key_strength) - (fromBool ocsp_all_intermediates) - max_ocsp_age - trustedStorePtr - ) - botan_x509_path_restrictions_destroy - --- TODO: x509PathRestrictionsCreateTrustedHashes - -newtype X509PathValidation = MkX509PathValidation { getX509PathValidationForeignPtr :: ForeignPtr X509PathValidationStruct } - -withX509PathValidationPtr :: X509PathValidation -> (X509PathValidationPtr -> IO a) -> IO a -withX509PathValidationPtr = withForeignPtr . getX509PathValidationForeignPtr - -x509PathValidationDestroy :: X509PathValidation -> IO () -x509PathValidationDestroy validation = finalizeForeignPtr (getX509PathValidationForeignPtr validation) - --- NOTE: OCSPResponse not yet implemented -x509PathValidate :: X509Cert -> X509PathRestrictions -> X509CertStore -> ByteString -> Word32 -> Word64 -> Word64 -> Ptr () -> IO X509PathValidation -x509PathValidate cert restrictions store hostname usage validationTime ocspTimeout ocspResponse = do - withX509Cert cert $ \ certPtr -> do - withX509PathRestrictionsPtr restrictions $ \ restrictionsPtr -> do - withX509CertStorePtr store $ \ storePtr -> do - asCString hostname $ \ hostnamePtr -> do - mkInit - MkX509PathValidation - (\ pvPtr -> botan_x509_path_validate - pvPtr - certPtr - restrictionsPtr - storePtr - hostnamePtr - (fromIntegral usage) - validationTime - ocspTimeout - ocspResponse - ) - botan_x509_path_validation_destroy - -x509PathValidationSuccessfulValidation :: X509PathValidation -> IO Bool -x509PathValidationSuccessfulValidation pv = withX509PathValidationPtr pv $ \ pvPtr -> do - throwBotanCatchingSuccess $ botan_x509_path_validation_successful_validation pvPtr - -x509PathValidationResultString :: X509PathValidation -> IO ByteString -x509PathValidationResultString pv = withX509PathValidationPtr pv $ \ pvPtr -> do - allocBytesQueryingCString $ \ resultPtr resultLen -> do - botan_x509_path_validation_result_string resultPtr resultLen pvPtr - -x509PathValidationTrustRoot :: X509PathValidation -> IO X509Cert -x509PathValidationTrustRoot pv = withX509PathValidationPtr pv $ \ pvPtr -> do - mkInit - MkX509Cert - (\ certPtr -> botan_x509_path_validation_trust_root certPtr pvPtr) - botan_x509_cert_destroy - --- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit -x509PathValidationCertPath :: X509PathValidation -> IO [X509Cert] -x509PathValidationCertPath pv = withX509PathValidationPtr pv $ \ pvPtr -> do - let fn arrPtr szPtr = botan_x509_path_validation_cert_path arrPtr szPtr pvPtr - alloca $ \ szPtr -> do - code <- fn nullPtr szPtr - case code of - InsufficientBufferSpace -> do - sz <- fromIntegral <$> peek szPtr - allocaArray sz $ \ arrPtr -> do - throwBotanIfNegative_ $ fn arrPtr szPtr - certPtrs <- peekArray sz arrPtr - -- NOTE: Cannot use mkInit because that performs an alloca and a peek, - -- whereas we have already performed that work here - forM certPtrs $ \ certPtr -> do - foreignPtr <- newForeignPtr botan_x509_cert_destroy certPtr - return $ MkX509Cert foreignPtr - _ -> throwBotanError code - -type X509PathValidationStatusCode = Int - -x509PathValidationStatusCode :: X509PathValidation -> IO X509PathValidationStatusCode -x509PathValidationStatusCode pv = withX509PathValidationPtr pv $ \ pvPtr -> do - alloca $ \ statusCodePtr -> do - throwBotanIfNegative_ $ botan_x509_path_validation_status_code statusCodePtr pvPtr - fromIntegral <$> peek statusCodePtr - --- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit -x509PathValidationAllStatusCodes :: X509PathValidation -> IO [X509PathValidationStatusCode] -x509PathValidationAllStatusCodes pv = withX509PathValidationPtr pv $ \ pvPtr -> do - let fn arrPtr szPtr = botan_x509_path_validation_all_status_codes arrPtr szPtr pvPtr - alloca $ \ szPtr -> do - code <- fn nullPtr szPtr - case code of - InsufficientBufferSpace -> do - sz <- fromIntegral <$> peek szPtr - allocaArray sz $ \ arrPtr -> do - throwBotanIfNegative_ $ fn arrPtr szPtr - fmap fromIntegral <$> peekArray sz arrPtr - _ -> throwBotanError code - --- NOTE: Array of strings - extra tricky, not finished yet, will be reused --- NOTE: Similar to x509DNGetAttribute / x509DNGetContents -x509PathValidationTrustedHashes :: X509PathValidation -> IO [ByteString] -x509PathValidationTrustedHashes pv = withX509PathValidationPtr pv $ \ pvPtr -> do - let fn arrPtr sizesPtr szPtr = botan_x509_path_validation_trusted_hashes arrPtr sizesPtr szPtr pvPtr - alloca $ \ szPtr -> do - code <- fn nullPtr nullPtr szPtr - case code of - InsufficientBufferSpace -> do - sz <- fromIntegral <$> peek szPtr - allocaArray sz $ \ sizesPtr -> do - code' <- fn nullPtr sizesPtr szPtr - case code' of - -- TODO: Actually fill out array of strings - _ -> undefined - _ -> throwBotanError code diff --git a/src/Botan/Low/X509/Store.hs b/src/Botan/Low/X509/Store.hs deleted file mode 100644 --- a/src/Botan/Low/X509/Store.hs +++ /dev/null @@ -1,326 +0,0 @@ -module Botan.Low.X509.Store where - -import Data.Bool -import Foreign.Marshal.Utils - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude -import Botan.Low.PubKey -import Botan.Low.RNG -import Botan.Low.X509 - -import Botan.Bindings.PubKey -import Botan.Bindings.X509 -import Botan.Bindings.X509.Store - -newtype X509CertStore = MkX509CertStore { getX509CertStoreForeignPtr :: ForeignPtr X509CertStoreStruct } - -withX509CertStorePtr :: X509CertStore -> (X509CertStorePtr -> IO a) -> IO a -withX509CertStorePtr = withForeignPtr . getX509CertStoreForeignPtr - -x509CertStoreDestroy :: X509CertStore -> IO () -x509CertStoreDestroy ca = finalizeForeignPtr (getX509CertStoreForeignPtr ca) - --- NOTE: mkInit cannot handle Maybes (checking for nullPtr), need a mkInitMaybe or to use maybePeek -x509CertStoreFindCert :: X509CertStore -> ByteString -> ByteString -> IO (Maybe X509Cert) -x509CertStoreFindCert store subject_dn key_id = withX509CertStorePtr store $ \ store_ptr -> do - asBytesLen subject_dn $ \ subject_dn_ptr subject_dn_len -> do - asBytesLen key_id $ \ key_id_ptr key_id_len -> do - alloca $ \ outPtr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_find_cert - outPtr - store_ptr - subject_dn_ptr - subject_dn_len - key_id_ptr - key_id_len - out <- peek outPtr - if out == nullPtr - then return Nothing - else do - foreignPtr <- newForeignPtr botan_x509_cert_destroy out - return $ Just $ MkX509Cert foreignPtr - --- NOTE: Untested --- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit -x509CertStoreFindAllCerts :: X509CertStore -> ByteString -> ByteString -> IO [X509Cert] -x509CertStoreFindAllCerts store subject_dn key_id = withX509CertStorePtr store $ \ store_ptr -> do - asBytesLen subject_dn $ \ subject_dn_ptr subject_dn_len -> do - asBytesLen key_id $ \ key_id_ptr key_id_len -> do - let fn arrPtr szPtr = botan_x509_cert_store_find_all_certs arrPtr szPtr store_ptr subject_dn_ptr subject_dn_len key_id_ptr key_id_len - alloca $ \ szPtr -> do - code <- fn nullPtr szPtr - case code of - InsufficientBufferSpace -> do - sz <- fromIntegral <$> peek szPtr - allocaArray sz $ \ arrPtr -> do - throwBotanIfNegative_ $ fn arrPtr szPtr - certPtrs <- peekArray sz arrPtr - -- NOTE: Cannot use mkInit because that performs an alloca and a peek, - -- whereas we have already performed that work here - forM certPtrs $ \ certPtr -> do - foreignPtr <- newForeignPtr botan_x509_cert_destroy certPtr - return $ MkX509Cert foreignPtr - _ -> throwBotanError code - --- TODO: Use mkInitMaybe -x509CertStoreFindCertByPubkeySHA1 :: X509CertStore -> ByteString -> IO (Maybe X509Cert) -x509CertStoreFindCertByPubkeySHA1 store digest = withX509CertStorePtr store $ \ store_ptr -> do - asBytesLen digest $ \ digest_ptr _ -> do - alloca $ \ outPtr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_find_cert_by_pubkey_sha1 - outPtr - store_ptr - digest_ptr - out <- peek outPtr - if out == nullPtr - then return Nothing - else do - foreignPtr <- newForeignPtr botan_x509_cert_destroy out - return $ Just $ MkX509Cert foreignPtr - --- TODO: Use mkInitMaybe -x509CertStoreFindCertByRawSubjectDNSHA256 :: X509CertStore -> ByteString -> IO (Maybe X509Cert) -x509CertStoreFindCertByRawSubjectDNSHA256 store digest = withX509CertStorePtr store $ \ store_ptr -> do - asBytesLen digest $ \ digest_ptr _ -> do - alloca $ \ outPtr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_find_cert_by_raw_subject_dn_sha256 - outPtr - store_ptr - digest_ptr - out <- peek outPtr - if out == nullPtr - then return Nothing - else do - foreignPtr <- newForeignPtr botan_x509_cert_destroy out - return $ Just $ MkX509Cert foreignPtr - --- TODO: Use mkInitMaybe -x509CertStoreFindCRLFor :: X509CertStore -> X509Cert -> IO (Maybe X509CRL) -x509CertStoreFindCRLFor store cert = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - alloca $ \ outPtr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_find_crl_for - outPtr - store_ptr - cert_ptr - out <- peek outPtr - if out == nullPtr - then return Nothing - else do - foreignPtr <- newForeignPtr botan_x509_crl_destroy out - return $ Just $ MkX509CRL foreignPtr - -x509CertStoreCertificateKnown :: X509CertStore -> X509Cert -> IO Bool -x509CertStoreCertificateKnown store cert = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - throwBotanCatchingSuccess $ botan_x509_cert_store_certificate_known store_ptr cert_ptr - --- {- --- In-memory cert store --- -} - --- TODO: Get rid of bytestring paths -x509CertStoreInMemoryLoadDir :: ByteString -> IO X509CertStore -x509CertStoreInMemoryLoadDir path = asCString path $ \ path_ptr -> mkInit - MkX509CertStore - (\ ptr -> botan_x509_cert_store_in_memory_load_dir - ptr - path_ptr - ) - botan_x509_cert_store_destroy - -x509CertStoreInMemoryLoadCert :: X509Cert -> IO X509CertStore -x509CertStoreInMemoryLoadCert cert = withX509Cert cert $ \ cert_ptr -> mkInit - MkX509CertStore - (\ ptr -> botan_x509_cert_store_in_memory_load_cert - ptr - cert_ptr - ) - botan_x509_cert_store_destroy - -x509CertStoreInMemoryCreate :: IO X509CertStore -x509CertStoreInMemoryCreate = mkInit - MkX509CertStore - botan_x509_cert_store_in_memory_create - botan_x509_cert_store_destroy - -x509CertStoreInMemoryAddCertificate :: X509CertStore -> X509Cert -> IO () -x509CertStoreInMemoryAddCertificate store cert = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_in_memory_add_certificate - store_ptr - cert_ptr - -x509CertStoreInMemoryAddCRL :: X509CertStore -> X509CRL -> IO () -x509CertStoreInMemoryAddCRL store crl = withX509CertStorePtr store $ \ store_ptr -> do - withX509CRL crl $ \ crl_ptr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_in_memory_add_crl - store_ptr - crl_ptr - --- {- --- Flatfile cert store --- -} - -x509CertStoreFlatfileCreate :: ByteString -> Bool -> IO X509CertStore -x509CertStoreFlatfileCreate path ignore_non_ca = asCString path $ \ path_ptr -> mkInit - MkX509CertStore - (\ ptr -> botan_x509_cert_store_flatfile_create - ptr - path_ptr - (fromBool ignore_non_ca) - ) - botan_x509_cert_store_destroy - -{- -SQL cert store --} - -x509CertStoreSQLInsertCert :: X509CertStore -> X509Cert -> IO Bool -x509CertStoreSQLInsertCert store cert = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - throwBotanCatchingSuccess $ botan_x509_cert_store_sql_insert_cert - store_ptr - cert_ptr - -x509CertStoreSQLRemoveCert :: X509CertStore -> X509Cert -> IO Bool -x509CertStoreSQLRemoveCert store cert = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - throwBotanCatchingSuccess $ botan_x509_cert_store_sql_remove_cert - store_ptr - cert_ptr - --- TODO: Use mkInitMaybe -x509CertStoreSQLFindKey :: X509CertStore -> X509Cert -> IO (Maybe PrivKey) -x509CertStoreSQLFindKey store cert = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - alloca $ \ outPtr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_sql_find_key - outPtr - store_ptr - cert_ptr - out <- peek outPtr - if out == nullPtr - then return Nothing - else do - foreignPtr <- newForeignPtr botan_privkey_destroy out - return $ Just $ MkPrivKey foreignPtr - --- NOTE: See notes about returning arrays of things, improper return pointer type --- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit -x509CertStoreSQLFindCertsForKey :: X509CertStore -> PrivKey -> IO [X509Cert] -x509CertStoreSQLFindCertsForKey store privkey = withX509CertStorePtr store $ \ store_ptr -> do - withPrivKey privkey $ \ privkey_ptr -> do - let fn arrPtr szPtr = botan_x509_cert_store_sql_find_certs_for_key arrPtr szPtr store_ptr privkey_ptr - alloca $ \ szPtr -> do - code <- fn nullPtr szPtr - case code of - InsufficientBufferSpace -> do - sz <- fromIntegral <$> peek szPtr - allocaArray sz $ \ arrPtr -> do - throwBotanIfNegative_ $ fn arrPtr szPtr - certPtrs <- peekArray sz arrPtr - -- NOTE: Cannot use mkInit because that performs an alloca and a peek, - -- whereas we have already performed that work here - forM certPtrs $ \ certPtr -> do - foreignPtr <- newForeignPtr botan_x509_cert_destroy certPtr - return $ MkX509Cert foreignPtr - _ -> throwBotanError code - -x509CertStoreSQLInsertKey :: X509CertStore -> X509Cert -> PrivKey -> IO Bool -x509CertStoreSQLInsertKey store cert privkey = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - withPrivKey privkey $ \ privkey_ptr -> do - throwBotanCatchingSuccess $ botan_x509_cert_store_sql_insert_key - store_ptr - cert_ptr - privkey_ptr - -x509CertStoreSQLRemoveKey :: X509CertStore -> PrivKey -> IO () -x509CertStoreSQLRemoveKey store privkey = withX509CertStorePtr store $ \ store_ptr -> do - withPrivKey privkey $ \ privkey_ptr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_sql_remove_key - store_ptr - privkey_ptr - -x509CertStoreSQLRevokeCert :: X509CertStore -> X509Cert -> Word32 -> Word64 -> IO () -x509CertStoreSQLRevokeCert store cert crl_code time = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_sql_revoke_cert - store_ptr - cert_ptr - crl_code - time - -x509CertStoreSQLAffirmCert :: X509CertStore -> X509Cert -> IO () -x509CertStoreSQLAffirmCert store cert = withX509CertStorePtr store $ \ store_ptr -> do - withX509Cert cert $ \ cert_ptr -> do - throwBotanIfNegative_ $ botan_x509_cert_store_sql_affirm_cert - store_ptr - cert_ptr - --- -- NOTE: See notes about returning arrays of things, improper return pointer type --- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit -x509CertStoreSQLGenerateCRLs :: X509CertStore -> IO [X509CRL] -x509CertStoreSQLGenerateCRLs store = withX509CertStorePtr store $ \ store_ptr -> do - let fn arrPtr szPtr = botan_x509_cert_store_sql_generate_crls arrPtr szPtr store_ptr - alloca $ \ szPtr -> do - code <- fn nullPtr szPtr - case code of - InsufficientBufferSpace -> do - sz <- fromIntegral <$> peek szPtr - allocaArray sz $ \ arrPtr -> do - throwBotanIfNegative_ $ fn arrPtr szPtr - crlPtrs <- peekArray sz arrPtr - -- NOTE: Cannot use mkInit because that performs an alloca and a peek, - -- whereas we have already performed that work here - forM crlPtrs $ \ crlPtr -> do - foreignPtr <- newForeignPtr botan_x509_crl_destroy crlPtr - return $ MkX509CRL foreignPtr - _ -> throwBotanError code - -{- -SQLite3 cert store -NOTE: Not confirmed to be implemented correctly C++-side --} - -x509CertStoreSqlite3Create :: ByteString -> ByteString -> RNG -> ByteString -> IO X509CertStore -x509CertStoreSqlite3Create db_path passwd rng table_prefix = asCString db_path $ \ db_path_ptr -> do - asCString passwd $ \ passwd_ptr -> do - withRNG rng $ \ botanRNG -> do - asCString table_prefix $ \ table_prefix_ptr -> mkInit - MkX509CertStore - (\ ptr -> botan_x509_cert_store_sqlite3_create - ptr - db_path_ptr - passwd_ptr botanRNG - table_prefix_ptr - ) - botan_x509_cert_store_destroy - -{- -System cert store --} - -x509CertStoreSystemCreate :: IO X509CertStore -x509CertStoreSystemCreate = mkInit MkX509CertStore botan_x509_cert_store_system_create botan_x509_cert_store_destroy - -{- -MacOS cert store -NOTE: OS-specific, covered by System certificate store type? --} - --- foreign import ccall unsafe botan_x509_cert_store_macos_create --- :: Ptr X509CertStorePtr --- -> IO BotanErrorCode - -{- -Windows cert store -NOTE: OS-specific, covered by System certificate store type? --} - --- foreign import ccall unsafe botan_x509_cert_store_windows_create --- :: Ptr X509CertStorePtr --- -> IO BotanErrorCode diff --git a/src/Botan/Low/ZFEC.hs b/src/Botan/Low/ZFEC.hs --- a/src/Botan/Low/ZFEC.hs +++ b/src/Botan/Low/ZFEC.hs @@ -14,33 +14,35 @@ -} -module Botan.Low.ZFEC -( - --- * Forward Error Correction --- $introduction --- * Usage --- $usage +{-# LANGUAGE OverloadedStrings #-} --- * ZFEC - ZFECShare(..) -, zfecEncode -, zfecDecode +module Botan.Low.ZFEC ( -) where + -- * Forward Error Correction + -- $introduction + -- * Usage + -- $usage -import Control.Concurrent + -- * ZFEC + ZFECShare + , zfecEncode + , zfecDecode -import Data.Foldable + ) where +import Botan.Bindings.ConstPtr (ConstPtr (..)) +import Botan.Bindings.ZFEC +import Botan.Low.Error.Internal +import Botan.Low.Internal.ByteString +import Botan.Low.Make +import Control.DeepSeq +import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Unsafe as ByteString - -import Botan.Bindings.ZFEC - -import Botan.Low.Error -import Botan.Low.Make -import Botan.Low.Prelude +import Data.Word +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr {- $introduction diff --git a/test/Botan/Low/BcryptSpec.hs b/test/Botan/Low/BcryptSpec.hs deleted file mode 100644 --- a/test/Botan/Low/BcryptSpec.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.RNG -import Botan.Low.Bcrypt - -password :: ByteString -password = "Fee fi fo fum!" - -factor = 12 - -main :: IO () -main = hspec $ do - describe "bcryptGenerate" $ do - it "generates a bcrypt hash" $ do - rng <- rngInit "user-threadsafe" - _ <- bcryptGenerate password rng factor - pass - describe "bcryptIsValid" $ do - it "validates a bcrypt hash" $ do - rng <- rngInit "user-threadsafe" - h <- bcryptGenerate password rng factor - valid <- bcryptIsValid password h - valid `shouldBe` True diff --git a/test/Botan/Low/BlockCipherSpec.hs b/test/Botan/Low/BlockCipherSpec.hs deleted file mode 100644 --- a/test/Botan/Low/BlockCipherSpec.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Main where - -import Test.Prelude - -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.ByteString as ByteString - -import Botan.Low.BlockCipher -import Botan.Low.RNG - -message = "Fee fi fo fum! I smell the blood of an Englishman!" - -main :: IO () -main = hspec $ testSuite allBlockCiphers chars $ \ bc -> do - it "can initialize a block cipher context" $ do - ctx <- blockCipherInit bc - pass - it "has a name" $ do - ctx <- blockCipherInit bc - name <- blockCipherName ctx - -- name `shouldBe` bc -- Name expands to include default parameters - need to record - pass - it "has a key spec" $ do - ctx <- blockCipherInit bc - (_,_,_) <- blockCipherGetKeyspec ctx - pass - it "has a block size" $ do - ctx <- blockCipherInit bc - _ <- blockCipherBlockSize ctx - pass - it "can set the key" $ do - ctx <- blockCipherInit bc - (_,mx,_) <- blockCipherGetKeyspec ctx - k <- systemRNGGet mx - blockCipherSetKey ctx k - pass - it "can encipher a message" $ do - ctx <- blockCipherInit bc - (_,mx,_) <- blockCipherGetKeyspec ctx - k <- systemRNGGet mx - blockCipherSetKey ctx k - bsz <- blockCipherBlockSize ctx - msg <- systemRNGGet $ bsz * 10 - encmsg <- blockCipherEncryptBlocks ctx msg - pass - -- NOTE: It does not actually throw an error - this is slightly concerning. - -- it "can only encipher messages that are a multiple of the block size" $ do - -- ctx <- blockCipherInitName bc - -- bsz <- blockCipherBlockSize ctx - -- if bsz == 1 - -- then pass - -- else do - -- (_,mx,_) <- blockCipherGetKeyspec ctx - -- k <- systemRNGGetIO mx - -- blockCipherSetKey ctx k - -- msg <- systemRNGGetIO $ bsz + 1 - -- blockCipherEncryptBlocks ctx msg `shouldThrow` anyBotanException - it "can decipher an enciphered message" $ do - ctx <- blockCipherInit bc - (_,mx,_) <- blockCipherGetKeyspec ctx - k <- systemRNGGet mx - blockCipherSetKey ctx k - bsz <- blockCipherBlockSize ctx - msg <- systemRNGGet $ bsz * 10 - encmsg <- blockCipherEncryptBlocks ctx msg - decmsg <- blockCipherDecryptBlocks ctx encmsg - decmsg `shouldBe` msg - pass diff --git a/test/Botan/Low/CipherSpec.hs b/test/Botan/Low/CipherSpec.hs deleted file mode 100644 --- a/test/Botan/Low/CipherSpec.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} - -module Main where - -import Test.Prelude - -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Char8 as Char8 - -import Botan.Bindings.Cipher -import Botan.Low.BlockCipher -import Botan.Low.Cipher -import Botan.Low.RNG - -showBytes :: (Show a) => a -> ByteString -showBytes = Char8.pack . show - -main :: IO () -main = hspec $ testSuite (cipherModes ++ aeads) chars $ \ cipher -> do - it "can initialize a cipher encryption context" $ do - ctx <- cipherInit cipher Encrypt - pass - it "can initialize a cipher decryption context" $ do - ctx <- cipherInit cipher Decrypt - pass - it "has a name" $ do - ctx <- cipherInit cipher Encrypt - name <- cipherName ctx - -- name `shouldBe` bc -- Name expands to include default parameters - need to record - pass - it "has a key spec" $ do - ctx <- cipherInit cipher Encrypt - (_,_,_) <- cipherGetKeyspec ctx - pass - it "can set the key" $ do - ctx <- cipherInit cipher Encrypt - (_,mx,_) <- cipherGetKeyspec ctx - k <- systemRNGGet mx - cipherSetKey ctx k - pass - it "has a valid default nonce length" $ do - ctx <- cipherInit cipher Encrypt - nlen <- cipherGetDefaultNonceLength ctx - pass - it "can validate nonce length" $ do - ctx <- cipherInit cipher Encrypt - nlen <- cipherGetDefaultNonceLength ctx - defaultIsValid <- cipherValidNonceLength ctx nlen - defaultIsValid `shouldBe` True - -- NOTE: Some ciphers accept nonces of any length, eg SIV - -- Others allow any length > 0, eg GCM - -- Some have ranges - -- Some have just 'if (length == 0) return false;' eg OCB - -- Search C++ source for 'valid_nonce_length' to find them all - -- zeroIsValid <- cipherValidNonceLength ctx 0 - -- zeroIsValid `shouldBe` False - -- absurdlyLargeIsValid <- cipherValidNonceLength ctx maxBound - -- absurdlyLargeIsValid `shouldBe` False - pass - it "can calculate output length" $ do - ctx <- cipherInit cipher Encrypt - olen <- cipherOutputLength ctx 1024 - pass - -- NOTE: This check should be ae / aead only - it "has a tag length" $ do - ctx <- cipherInit cipher Encrypt - _ <- cipherGetTagLength ctx - pass - it "has an update graularity" $ do - ctx <- cipherInit cipher Encrypt - _ <- cipherGetUpdateGranularity ctx - pass - it "has an ideal update granularity" $ do - ctx <- cipherInit cipher Encrypt - _ <- cipherGetIdealUpdateGranularity ctx - pass - if cipher `elem` aeads - then it "can set the associated data" $ do - ctx <- cipherInit cipher Encrypt - -- NOTE: Undocumented: A cipher must set the key before setting AD - (_,mx,_) <- cipherGetKeyspec ctx - k <- systemRNGGet mx - cipherSetKey ctx k - -- END NOTE - ad <- systemRNGGet 64 - cipherSetAssociatedData ctx ad - pass - else pass - it "can reset all message state" $ do - ctx <- cipherInit cipher Encrypt - cipherReset ctx - pass - it "can clear all internal state" $ do - ctx <- cipherInit cipher Encrypt - cipherClear ctx - pass - it "can start processing a message" $ do - ctx <- cipherInit cipher Encrypt - (_,mx,_) <- cipherGetKeyspec ctx - k <- systemRNGGet mx - cipherSetKey ctx k - if cipher `elem` aeads - then do - ad <- systemRNGGet 64 - cipherSetAssociatedData ctx ad - else pass - n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx - cipherStart ctx n - pass - -- TODO: More extensive testing in Botan; these are just binding sanity checks - it "can one-shot / offline encipher a message" $ do - ctx <- cipherInit cipher Encrypt - (_,mx,_) <- cipherGetKeyspec ctx - k <- systemRNGGet mx - cipherSetKey ctx k - if cipher `elem` aeads - then do - ad <- systemRNGGet 64 - cipherSetAssociatedData ctx ad - else pass - n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx - cipherStart ctx n - g <- cipherGetIdealUpdateGranularity ctx - msg <- systemRNGGet g - encmsg <- cipherEncrypt ctx msg - pass - it "can one-shot / offline decipher a message" $ do - -- Same as prior test - ctx <- cipherInit cipher Encrypt - (_,mx,_) <- cipherGetKeyspec ctx - k <- systemRNGGet mx - cipherSetKey ctx k - ad <- systemRNGGet 64 - if cipher `elem` aeads - then do - cipherSetAssociatedData ctx ad - else pass - n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx - cipherStart ctx n - g <- cipherGetIdealUpdateGranularity ctx - msg <- systemRNGGet g - encmsg <- cipherEncrypt ctx msg - -- Start actual test - dctx <- cipherInit cipher Decrypt - cipherSetKey dctx k - if cipher `elem` aeads - then do - cipherSetAssociatedData dctx ad - else pass - cipherStart dctx n - decmsg <- cipherDecrypt dctx encmsg - msg `shouldBe` decmsg - pass - it "can incrementally / online encipher a message" $ do - -- Same as prior test - ctx <- cipherInit cipher Encrypt - (_,mx,_) <- cipherGetKeyspec ctx - k <- systemRNGGet mx - cipherSetKey ctx k - ad <- systemRNGGet 64 - if cipher `elem` aeads - then do - cipherSetAssociatedData ctx ad - else pass - n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx - cipherStart ctx n - g <- cipherGetIdealUpdateGranularity ctx - msg <- systemRNGGet (8 * g) - encmsg <- cipherEncryptOnline ctx msg - pass - -- NOTE: Fails for SIV, CCM because they are offline-only algorithms - -- This is expected, but not reflected in the tests yet - it "can incrementally / online decipher a message" $ do - ctx <- cipherInit cipher Encrypt - (_,mx,_) <- cipherGetKeyspec ctx - k <- systemRNGGet mx - cipherSetKey ctx k - ad <- systemRNGGet 64 - if cipher `elem` aeads - then do - cipherSetAssociatedData ctx ad - else pass - n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx - cipherStart ctx n - g <- cipherGetIdealUpdateGranularity ctx - msg <- systemRNGGet (8 * g) - encmsg <- cipherEncryptOnline ctx msg - -- Start actual test - dctx <- cipherInit cipher Decrypt - cipherSetKey dctx k - if cipher `elem` aeads - then do - cipherSetAssociatedData dctx ad - else pass - cipherStart dctx n - decmsg <- cipherDecryptOnline dctx encmsg - msg `shouldBe` decmsg - pass - -- NOTE: Fails for SIV, CCM because they are offline-only algorithms - -- This is expected, but not reflected in the tests yet - it "has parity between online and offline" $ do - onlinectx <- cipherInit cipher Encrypt - offlinectx <- cipherInit cipher Encrypt - (_,mx,_) <- cipherGetKeyspec onlinectx - k <- systemRNGGet mx - cipherSetKey onlinectx k - cipherSetKey offlinectx k - ad <- systemRNGGet 64 - when (cipher `elem` aeads) $ do - cipherSetAssociatedData onlinectx ad - cipherSetAssociatedData offlinectx ad - n <- systemRNGGet =<< cipherGetDefaultNonceLength onlinectx - cipherStart onlinectx n - cipherStart offlinectx n - g <- cipherGetIdealUpdateGranularity onlinectx - msg <- systemRNGGet (8 * g) - putStrLn " Testing online encryption:" - onlinemsg <- cipherEncryptOnline onlinectx msg - putStrLn " Testing offline encryption:" - offlinemsg <- cipherEncrypt offlinectx msg - putStrLn " Result:" - onlinemsg `shouldBe` offlinemsg - pass diff --git a/test/Botan/Low/FPESpec.hs b/test/Botan/Low/FPESpec.hs deleted file mode 100644 --- a/test/Botan/Low/FPESpec.hs +++ /dev/null @@ -1,97 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.FPE -import Botan.Bindings.FPE -import Botan.Low.MPI -import Botan.Low.RNG - -import Botan.Low.Error - --- NOTE: FPE operations encrypt/decrypt integers less than n -nStr :: ByteString -nStr = "1000000000000" - -key :: ByteString -key = "0000DEADBEEF0000" - -rounds :: Int -rounds = 3 - -newRng :: IO RNG -newRng = rngInit "system" - -newX :: MP -> IO MP -newX n = do - x <- mpInit - z <- mpInit - mpSetFromInt z 0 - -- n <- mpInit - -- mpSetFromStr n nStr - rng <- newRng - mpRandRange x rng z n - return x - -newFE1Ctx :: IO (MP, FPE) -newFE1Ctx = do - n <- mpInit - mpSetFromStr n nStr - ctx <- fpeInitFE1 n key rounds BOTAN_FPE_FLAG_NONE - return (n,ctx) - -newFE1CtxCompatMode :: IO (MP, FPE) -newFE1CtxCompatMode = do - n <- mpInit - mpSetFromStr n nStr - ctx <- fpeInitFE1 n key rounds BOTAN_FPE_FLAG_FE1_COMPAT_MODE - return (n,ctx) - -main :: IO () -main = hspec $ do - describe "fpeInitFE1" $ do - it "initializes an FE1 FPE context" $ do - newFE1Ctx - pass - it "initializes an FE1 FPE context in compat mode" $ (do - newFE1CtxCompatMode - pass - ) -- `shouldThrow` anyBotanException - describe "fpeEncrypt" $ do - it "performs format-preserving encryption" $ do - (n,ctx) <- newFE1Ctx - x <- newX n - y <- mpCopy x - fpeEncrypt ctx y "" - isSame <- mpEqual x y - isSame `shouldBe` False - pass - it "performs format-preserving encryption in compat mode" $ do - (n,ctx) <- newFE1CtxCompatMode - x <- newX n - y <- mpCopy x - fpeEncrypt ctx y "" - isSame <- mpEqual x y - isSame `shouldBe` False - pass - describe "fpeDecrypt" $ do - it "performs format-preserving decryption" $ do - (n,ctx) <- newFE1Ctx - x <- newX n - y <- mpCopy x - fpeEncrypt ctx y "" - z <- mpCopy y - fpeDecrypt ctx z "" - isSame <- mpEqual x z - isSame `shouldBe` True - pass - it "performs format-preserving decryption in compat mode" $ do - (n,ctx) <- newFE1CtxCompatMode - x <- newX n - y <- mpCopy x - fpeEncrypt ctx y "" - z <- mpCopy y - fpeDecrypt ctx z "" - isSame <- mpEqual x z - isSame `shouldBe` True - pass diff --git a/test/Botan/Low/HOTPSpec.hs b/test/Botan/Low/HOTPSpec.hs deleted file mode 100644 --- a/test/Botan/Low/HOTPSpec.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Main where - -import Test.Prelude -import Botan.Low.Hash (HashName(..)) - -import Botan.Low.HOTP - -key :: ByteString -key = "Fee fi fo fum" - -counter :: HOTPCounter -counter = 12345 - -main :: IO () -main = hspec $ testSuite hotpHashes chars $ \ h -> do - it "hotpInit" $ do - ctx <- hotpInit key h 6 - pass - it "hotpGenerate" $ do - ctx <- hotpInit key h 6 - code <- hotpGenerate ctx counter - pass - it "hotpCheck" $ do - ctx <- hotpInit key h 6 - code <- hotpGenerate ctx counter - (success,next) <- hotpCheck ctx code counter 0 - success `shouldBe` True diff --git a/test/Botan/Low/HashSpec.hs b/test/Botan/Low/HashSpec.hs deleted file mode 100644 --- a/test/Botan/Low/HashSpec.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Main where - -import Test.Prelude - -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.ByteString as ByteString - -import Botan.Bindings.Hash -import Botan.Low.Hash - -message = "Fee fi fo fum! I smell the blood of an Englishman!" - -main :: IO () -main = hspec $ testSuite allHashes chars $ \ h -> do - it "can initialize a hash context" $ do - ctx <- hashInit h - pass - it "has a name" $ do - ctx <- hashInit h - name <- hashName ctx - pass - it "has an output length" $ do - ctx <- hashInit h - olen <- hashOutputLength ctx - pass - it "can copy the internal state" $ do - ctx <- hashInit h - -- TODO: Populate with state and actually prove - ctx' <- hashCopyState ctx - pass - it "can clear all internal state" $ do - ctx <- hashInit h - -- TODO: Populate with state and actually prove - hashClear ctx - pass - it "can update the internal state with a single message block" $ do - ctx <- hashInit h - hashUpdate ctx message - pass - it "can update the internal state with multiple message blocks" $ do - ctx <- hashInit h - forM_ (splitBlocks 4 message) $ hashUpdate ctx - pass - it "can finalize a digest" $ do - ctx <- hashInit h - hashUpdate ctx message - d <- hashFinal ctx - pass diff --git a/test/Botan/Low/KDFSpec.hs b/test/Botan/Low/KDFSpec.hs deleted file mode 100644 --- a/test/Botan/Low/KDFSpec.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Main where - -import Test.Prelude - -import qualified Data.ByteString as ByteString - --- import Botan.Low.Hash -import Botan.Low.KDF - --- NOTE: Many of these tests fail because different kdfs / macs / hashes have different requirements --- such as input or output lengths. --- Failing tests: --- - Checksums: Adler32, CRC24, CRC32, BadParameterException for almost everything --- - Probably because they are not cryptographic hashes --- - All fail for HKDF, SP800-108-*(HMAC(hash)), SP800-56A(hash), SP800-56A(HMAC(hash)), SP800-56C(hash), SP800-56C(HMAC(hash)) --- - CRC24 fails for KDF1, probably because we asked for 4 bits --- - HKDF-Extract - BadParameterException for unknown reasons --- - X9.42-PRF: About half fail with NotImplementedException --- - SP800-108-*: Requires HMAC wrapping, may support other MACs? --- - SP800-56A / SP800-56C: Allow HMAC wrapping, may support other MACs? --- Many do accept HMAC(hash) as an argument instead of just hash --- It is not yet known which if any MACs work aside from HMAC (eg whether anything with CMAC, GMAC does) due to non-exhaustive --- enumeration of MACs in their own tests. --- SP800 KDFs fail with InvalidKeyLengthException for X9.19-MAC, Poly1305, SipHash(2,4) --- except for SP800-56A which fails with NotImplementedException --- TODO: Exhaustive algorithm testing (see Botan.KDF notes) - --- NOTE: Some kdfs (HKDF-Extract) do not support label input arguments -main :: IO () -main = hspec $ testSuite kdfs chars $ \ algo -> do - describe "kdf" $ do - it "can derive a key" $ do - key <- kdf algo 3 "secret" "salt" "" -- "label" - pass diff --git a/test/Botan/Low/KeyWrapSpec.hs b/test/Botan/Low/KeyWrapSpec.hs deleted file mode 100644 --- a/test/Botan/Low/KeyWrapSpec.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.BlockCipher - -import Botan.Low.RNG - -import Botan.Low.KeyWrap - -kwKey :: ByteString -kwKey = "This key *must* be a multiple of 8 bytes" - -kwpKey :: ByteString -kwpKey = "Fee fi fo fum! I smell the blood of an Englishman!" - -main :: IO () -main = hspec $ testSuite blockCipher128s chars $ \ algo -> do - it "nistKeyWrapEncode" $ do - (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo - kek <- systemRNGGet keklen - wrappedKey <- nistKeyWrapEncode algo 0 kwKey kek - pass - it "nistKeyWrapDecode" $ do - (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo - kek <- systemRNGGet keklen - wrappedKey <- nistKeyWrapEncode algo 0 kwKey kek - unwrappedKey <- nistKeyWrapDecode algo 0 wrappedKey kek - unwrappedKey `shouldBe` kwKey - pass - it "nistKeyWrapEncode padded" $ do - (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo - kek <- systemRNGGet keklen - wrappedKey <- nistKeyWrapEncode algo 1 kwpKey kek - pass - it "nistKeyWrapDecode padded" $ do - (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo - kek <- systemRNGGet keklen - wrappedKey <- nistKeyWrapEncode algo 1 kwpKey kek - unwrappedKey <- nistKeyWrapDecode algo 1 wrappedKey kek - unwrappedKey `shouldBe` kwpKey - pass diff --git a/test/Botan/Low/MACSpec.hs b/test/Botan/Low/MACSpec.hs deleted file mode 100644 --- a/test/Botan/Low/MACSpec.hs +++ /dev/null @@ -1,132 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Bindings.MAC -import Botan.Low.MAC - -import Botan.Low.RNG - --- NOTE: Full testing of all algorithms will require botan ADT types instead --- of names, to be able to query for acceptable key and nonce parameters - --- nonceMACs :: [(MACName, Maybe Int)] --- nonceMACs = concat --- [ [ "CMAC(" <> bc <> ")" | bc <- allBlockCiphers ] --- , [ "GMAC(" <> bc <> ")" | bc <- allBlockCiphers ] --- , [ "CBC-MAC(" <> bc <> ")" | bc <- allBlockCiphers ] --- ] - --- macs :: [(MACName, Maybe Int)] --- macs = concat --- [ nonceMACs --- , [ "HMAC(" <> h <> ")" | h <- hashes ] --- , [ "Poly1305", "SipHash(2,4)", "X9.19-MAC" ] --- ] - -macs :: [MACName] -macs = fmap fst macsAndNonceSzs - -macsAndNonceSzs :: [(MACName, Int)] -macsAndNonceSzs = - [ ("CMAC(AES-256)", 0) - , ("GMAC(AES-256)", 16) - -- , ("CBC-MAC(AES-256)", 16) -- Not supported - , ("HMAC(SHA-3)", 0) - , ("Poly1305", 0) - , ("SipHash(2,4)", 0) - , ("X9.19-MAC", 0) - ] - -message :: ByteString -message = "Fee fi fo fum! I smell the blood of an Englishman!" - -main :: IO () -main = hspec $ testSuite macsAndNonceSzs (chars . fst) $ \ (h,nonceSz) -> do - it "can initialize a mac context" $ do - ctx <- macInit h - pass - it "has a name" $ do - ctx <- macInit h - name <- macName ctx - pass - it "has an output length" $ do - ctx <- macInit h - olen <- macOutputLength ctx - pass - -- it "can copy the internal state" $ do - -- ctx <- macInit h - -- -- TODO: Populate with state and actually prove - -- ctx' <- macCopyState ctx - -- pass - it "has a key spec" $ do - ctx <- macInit h - (_,_,_) <- macGetKeyspec ctx - pass - it "can set the key" $ do - ctx <- macInit h - (_,mx,_) <- macGetKeyspec ctx - k <- systemRNGGet mx - macSetKey ctx k - pass - -- it "has a nonce spec" $ do - it "can set the nonce" $ do - if nonceSz > 0 - then do - ctx <- macInit h - (_,mx,_) <- macGetKeyspec ctx - k <- systemRNGGet mx - macSetKey ctx k - n <- systemRNGGet nonceSz - macSetNonce ctx n - else pass - it "can clear all internal state" $ do - ctx <- macInit h - (_,mx,_) <- macGetKeyspec ctx - k <- systemRNGGet mx - macSetKey ctx k - if nonceSz > 0 - then do - n <- systemRNGGet nonceSz - macSetNonce ctx n - else pass - -- TODO: Populate with state and actually prove - macClear ctx - pass - it "can update the internal state with a single message block" $ do - ctx <- macInit h - (_,mx,_) <- macGetKeyspec ctx - k <- systemRNGGet mx - macSetKey ctx k - if nonceSz > 0 - then do - n <- systemRNGGet nonceSz - macSetNonce ctx n - else pass - macUpdate ctx message - pass - it "can update the internal state with multiple message blocks" $ do - ctx <- macInit h - (_,mx,_) <- macGetKeyspec ctx - k <- systemRNGGet mx - macSetKey ctx k - if nonceSz > 0 - then do - n <- systemRNGGet nonceSz - macSetNonce ctx n - else pass - forM_ (splitBlocks 4 message) $ macUpdate ctx - pass - it "can finalize a digest" $ do - ctx <- macInit h - (_,mx,_) <- macGetKeyspec ctx - k <- systemRNGGet mx - macSetKey ctx k - if nonceSz > 0 - then do - n <- systemRNGGet nonceSz - macSetNonce ctx n - else pass - macUpdate ctx message - d <- macFinal ctx - pass diff --git a/test/Botan/Low/MPISpec.hs b/test/Botan/Low/MPISpec.hs deleted file mode 100644 --- a/test/Botan/Low/MPISpec.hs +++ /dev/null @@ -1,382 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG - --- NOTE: These unit tests are mostly checking that the functions are bound correctly. --- These are kind of crappy and repetative, but that also exposes what needs to be done --- in the higher libraries to make things ergonomic. - -main :: IO () -main = hspec $ do - it "can initialize a mutable MPI reference" $ do - mp <- mpInit - pass - it "can set the value from an int" $ do - mp <- mpInit - mpSetFromInt mp 512 - pass - it "can set the value from another reference" $ do - mp <- mpInit - mpSetFromInt mp 512 - mp' <- mpInit - mpSetFromMP mp' mp - isEqual <- mpEqual mp mp' - isEqual `shouldBe` True - pass - it "can be converted to a hex string" $ do - mp <- mpInit - mpSetFromInt mp 512 - hex <- mpToHex mp - hex `shouldBe` "0x0200" - hex' <- mpToStr mp 16 - hex' `shouldBe` "0x0200" - pass - it "can be converted to a decimal string" $ do - mp <- mpInit - mpSetFromInt mp 512 - dec <- mpToStr mp 10 - dec `shouldBe` "512" - pass - it "can be cleared to zero" $ do - mp <- mpInit - mpSetFromInt mp 512 - mpClear mp - zero <- mpInit - mpSetFromInt zero 0 - isClear <- mpEqual mp zero - isClear `shouldBe` True - pass - it "can copy the value to a new reference" $ do - mp <- mpInit - mpSetFromInt mp 512 - mp' <- mpCopy mp - isEqual <- mpEqual mp mp' - isEqual `shouldBe` True - pass - it "can set the value from a decimal string" $ do - mp <- mpInit - mpSetFromStr mp "512" - mp' <- mpInit - mpSetFromInt mp' 512 - isEqualStr <- mpEqual mp mp' - isEqualStr `shouldBe` True - mpSetFromRadixStr mp "512" 10 - isEqualRadixStr <- mpEqual mp mp' - isEqualRadixStr `shouldBe` True - pass - it "can set the value from a hex string" $ do - mp <- mpInit - mpSetFromStr mp "0x0200" - mp' <- mpInit - mpSetFromInt mp' 512 - isEqualStr <- mpEqual mp mp' - isEqualStr `shouldBe` True - mpSetFromRadixStr mp "0200" 16 -- NOTE: Lack of "0x" prefix - isEqualRadixStr <- mpEqual mp mp' - isEqualRadixStr `shouldBe` True - pass - it "has a number of bits" $ do - mp <- mpInit - mpSetFromStr mp "512" - n <- mpNumBits mp - n `shouldBe` 10 - pass - it "has a number of bytes" $ do - mp <- mpInit - mpSetFromStr mp "512" - n <- mpNumBytes mp - n `shouldBe` 2 - pass - it "can be converted to a bytestring" $ do - mp <- mpInit - mpSetFromInt mp 512 - bin <- mpToBin mp - bin `shouldBe` "\STX\NUL" -- NOTE: 0b 0000 0010 0000 0000 - pass - it "can set the value from a bytestring" $ do - mp <- mpInit - mpFromBin mp "\STX\NUL" - mp' <- mpInit - mpSetFromInt mp' 512 - isEqual <- mpEqual mp mp' - isEqual `shouldBe` True - pass - it "can be converted to a 32-bit word" $ do - mp <- mpInit - mpSetFromInt mp 512 - w <- mpToWord32 mp - w `shouldBe` 512 - pass - -- NOTE: Returns whether x >= 0, not x > 0 because 0 is treated as positive. - it "can check if a value is positive" $ do - n <- mpInit - mpSetFromInt n (-512) - nIsPositive <- mpIsPositive n - nIsPositive `shouldBe` False - z <- mpInit - mpSetFromInt z 0 - zIsPositive <- mpIsPositive z - zIsPositive `shouldBe` True - p <- mpInit - mpSetFromInt p 512 - pIsPositive <- mpIsPositive p - pIsPositive `shouldBe` True - pass - it "can check if a value is negative" $ do - n <- mpInit - mpSetFromInt n (-512) - nIsPositive <- mpIsNegative n - nIsPositive `shouldBe` True - z <- mpInit - mpSetFromInt z 0 - zIsPositive <- mpIsNegative z - zIsPositive `shouldBe` False - p <- mpInit - mpSetFromInt p 512 - pIsPositive <- mpIsNegative p - pIsPositive `shouldBe` False - pass - it "can flip the sign of a value" $ do - p <- mpInit - mpSetFromInt p 512 - n <- mpInit - mpSetFromInt n (-512) - mpFlipSign p - isEqual <- mpEqual p n - pass - it "can check whether a value is zero" $ do - mp <- mpInit - mpSetFromInt mp 512 - isZeroA <- mpIsZero mp - isZeroA `shouldBe` False - mpSetFromInt mp 0 - isZeroB <- mpIsZero mp - isZeroB `shouldBe` True - mpSetFromInt mp (-512) - isZeroC <- mpIsZero mp - isZeroC `shouldBe` False - pass - it "can add a 32-bit word to the value and store the result" $ do - mp <- mpInit - mpSetFromInt mp 512 - mp' <- mpInit - mpAddWord32 mp' mp 512 - result <- mpToWord32 mp' - result `shouldBe` 1024 - pass - it "can subtract a 32-bit word from the value and store the result" $ do - mp <- mpInit - mpSetFromInt mp 512 - mp' <- mpInit - mpSubWord32 mp' mp 512 - result <- mpToWord32 mp' - result `shouldBe` 0 - pass - it "can add one value to another and store the result" $ do - a <- mpInit - mpSetFromInt a 512 - b <- mpInit - mpSetFromInt b 512 - c <- mpInit - mpAdd c a b - result <- mpToWord32 c - result `shouldBe` 1024 - pass - it "can subtract one value from another and store the result" $ do - a <- mpInit - mpSetFromInt a 512 - b <- mpInit - mpSetFromInt b 512 - c <- mpInit - mpSub c a b - result <- mpToWord32 c - result `shouldBe` 0 - pass - it "can multiply one value by another and store the result" $ do - a <- mpInit - mpSetFromInt a 512 - b <- mpInit - mpSetFromInt b 512 - c <- mpInit - mpMul c a b - result <- mpToWord32 c - result `shouldBe` 262144 - pass - it "can divide one value by another and store the result" $ do - a <- mpInit - mpSetFromInt a 512 - b <- mpInit - mpSetFromInt b 512 - q <- mpInit - r <- mpInit - mpDiv q r a b - quotient <- mpToWord32 q - quotient `shouldBe` 1 - remainder <- mpToWord32 r - remainder `shouldBe` 0 - pass - it "can perform multiplication and modulus at the same time and store the result" $ do - r <- mpInit - x <- mpInit - mpSetFromInt x 2 - y <- mpInit - mpSetFromInt y 4 - mod <- mpInit - mpSetFromInt mod 7 - mpModMul r x y mod - result <- mpToWord32 r - result `shouldBe` 1 - pass - it "can check whether two values are equal" $ do - a <- mpInit - mpSetFromInt a 512 - b <- mpInit - mpSetFromInt b 512 - c <- mpInit - mpSetFromInt c 256 - abEqual <- mpEqual a b - abEqual `shouldBe` True - bcEqual <- mpEqual b c - bcEqual `shouldBe` False - pass - it "can compare two values for order" $ do - n <- mpInit - mpSetFromInt n (-1) - z <- mpInit - mpSetFromInt z 0 - p <- mpInit - mpSetFromInt p 1 - nz <- mpCmp n z - nz `shouldBe` -1 - zp <- mpCmp z p - zp `shouldBe` -1 - np <- mpCmp n p - np `shouldBe` -1 - nn <- mpCmp n n - nn `shouldBe` 0 - zz <- mpCmp z z - zz `shouldBe` 0 - pp <- mpCmp p p - pp `shouldBe` 0 - pz <- mpCmp p z - pz `shouldBe` 1 - zn <- mpCmp z n - zn `shouldBe` 1 - pn <- mpCmp p n - pn `shouldBe` 1 - pass - it "can swap the values of two references" $ do - a <- mpInit - mpSetFromInt a 512 - b <- mpInit - mpSetFromInt b 256 - mpSwap a b - a' <- mpToWord32 a - a' `shouldBe` 256 - b' <- mpToWord32 b - b' `shouldBe` 512 - pass - it "can perform exponentiation and modulus at the same time and store the result" $ do - r <- mpInit - x <- mpInit - mpSetFromInt x 2 - y <- mpInit - mpSetFromInt y 4 - mod <- mpInit - mpSetFromInt mod 7 - mpPowMod r x y mod - result <- mpToWord32 r - result `shouldBe` 2 - pass - it "can perform a left shift and store the result" $ do - mp <- mpInit - result <- mpInit - mpSetFromInt mp 512 - mpLeftShift result mp 3 - r <- mpToWord32 result - r `shouldBe` 4096 - pass - it "can perform a right shift and store the result" $ do - mp <- mpInit - result <- mpInit - mpSetFromInt mp 512 - mpRightShift result mp 3 - r <- mpToWord32 result - r `shouldBe` 64 - pass - it "can compute the modular inverse" $ do - result <- mpInit - x <- mpInit - mpSetFromInt x 29 - mod <- mpInit - mpSetFromInt mod 65535 - -- x needs to be smaller than mod - mpModInverse result x mod - r <- mpToWord32 result - r `shouldBe` 13559 - pass - it "can generate a number of random bits" $ do - mp <- mpInit - rng <- rngInit "system" - mpRandBits mp rng 9 - r <- mpToWord32 mp - 0 <= r && r < 512 `shouldBe` True - pass - it "can generate a random value within a range [lower,upper)" $ do - result <- mpInit - rng <- rngInit "system" - lower <- mpInit - mpSetFromInt lower 4 - upper <- mpInit - mpSetFromInt upper 8 - mpRandRange result rng lower upper - isGTELower <- (<= 0) <$> mpCmp lower result - isGTELower `shouldBe` True - isLTUpper <- (== -1) <$> mpCmp result upper - isLTUpper `shouldBe` True - pass - it "can calculate the greatest common divisor of a value" $ do - r <- mpInit - x <- mpInit - mpSetFromInt x 35 - y <- mpInit - mpSetFromInt y 21 - mpGCD r x y - result <- mpToWord32 r - result `shouldBe` 7 - pass - it "can probabilistically calculate whether a value is prime" $ do - mp <- mpInit - rng <- rngInit "system" - mpSetFromInt mp 131 - isPrime131 <- mpIsPrime mp rng 100 - isPrime131 `shouldBe` True - mpSetFromInt mp 133 - isPrime133 <- mpIsPrime mp rng 100 - isPrime133 `shouldBe` False - pass - it "can get the value of a single bit" $ do - mp <- mpInit - mpSetFromInt mp 512 - f <- mpGetBit mp 8 - f `shouldBe` False - t <- mpGetBit mp 9 - t `shouldBe` True - pass - it "can set the value of a single bit (set it to 1)" $ do - mp <- mpInit - mpSetFromInt mp 512 - mpSetBit mp 8 - result <- mpToWord32 mp - result `shouldBe` 768 - pass - it "can clear the value of a single bit (set it to 0)" $ do - mp <- mpInit - mpSetFromInt mp 768 - mpClearBit mp 8 - result <- mpToWord32 mp - result `shouldBe` 512 - pass diff --git a/test/Botan/Low/PubKey/DHSpec.hs b/test/Botan/Low/PubKey/DHSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/DHSpec.hs +++ /dev/null @@ -1,69 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.DH - --- TODO: Consolidate -dlGroups :: [ByteString] -dlGroups = - [ "ffdhe/ietf/2048" - , "ffdhe/ietf/3072" - , "ffdhe/ietf/4096" - , "ffdhe/ietf/6144" - , "ffdhe/ietf/8192" - , "modp/ietf/1024" - , "modp/ietf/1536" - , "modp/ietf/2048" - , "modp/ietf/3072" - , "modp/ietf/4096" - , "modp/ietf/6144" - , "modp/ietf/8192" - , "modp/srp/1024" - , "modp/srp/1536" - , "modp/srp/2048" - , "modp/srp/3072" - , "modp/srp/4096" - , "modp/srp/6144" - , "modp/srp/8192" - , "dsa/jce/1024" - , "dsa/botan/2048" - , "dsa/botan/3072" - ] - --- TODO: Consolidate -privKeyField :: PrivKey -> ByteString -> IO MP -privKeyField privKey field = do - mp <- mpInit - privKeyGetField mp privKey field - return mp - --- TODO: Consolidate -pubKeyField :: PubKey -> ByteString -> IO MP -pubKeyField pubKey field = do - mp <- mpInit - pubKeyGetField mp pubKey field - return mp - -main :: IO () -main = hspec $ testSuite dlGroups chars $ \ dlGroup -> do - it "privKeyLoadDH" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "DH" dlGroup rng - p <- privKeyField privKey "p" - g <- privKeyField privKey "g" - x <- privKeyField privKey "x" - loadedKey <- privKeyLoadDH p g x - pass - it "pubKeyLoadDH" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "DH" dlGroup rng - pubKey <- privKeyExportPubKey privKey - p <- pubKeyField pubKey "p" - g <- pubKeyField pubKey "g" - y <- pubKeyField pubKey "y" - loadedKey <- pubKeyLoadDH p g y - pass diff --git a/test/Botan/Low/PubKey/DSASpec.hs b/test/Botan/Low/PubKey/DSASpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/DSASpec.hs +++ /dev/null @@ -1,76 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.DSA - --- TODO: Consolidate -dlGroups :: [ByteString] -dlGroups = - [ "ffdhe/ietf/2048" - , "ffdhe/ietf/3072" - , "ffdhe/ietf/4096" - , "ffdhe/ietf/6144" - , "ffdhe/ietf/8192" - , "modp/ietf/1024" - , "modp/ietf/1536" - , "modp/ietf/2048" - , "modp/ietf/3072" - , "modp/ietf/4096" - , "modp/ietf/6144" - , "modp/ietf/8192" - , "modp/srp/1024" - , "modp/srp/1536" - , "modp/srp/2048" - , "modp/srp/3072" - , "modp/srp/4096" - , "modp/srp/6144" - , "modp/srp/8192" - , "dsa/jce/1024" - , "dsa/botan/2048" - , "dsa/botan/3072" - ] - --- TODO: Consolidate -privKeyField :: PrivKey -> ByteString -> IO MP -privKeyField privKey field = do - mp <- mpInit - privKeyGetField mp privKey field - return mp - --- TODO: Consolidate -pubKeyField :: PubKey -> ByteString -> IO MP -pubKeyField pubKey field = do - mp <- mpInit - pubKeyGetField mp pubKey field - return mp - --- NOTE: Fields are --- DLGroup PubKey: p, q, g, y --- DLGroup PrivKey: p, q, g, x, y - --- NOTE: Fails on pubKeyLoadDSA for srp curves (but not privKeyLoadDSA?) -main :: IO () -main = hspec $ testSuite dlGroups chars $ \ dlGroup -> do - it "privKeyLoadDSA" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "DH" dlGroup rng - p <- privKeyField privKey "p" - q <- privKeyField privKey "q" - g <- privKeyField privKey "g" - x <- privKeyField privKey "x" - loadedKey <- privKeyLoadDSA p q g x - pass - it "pubKeyLoadDSA" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "DH" dlGroup rng - pubKey <- privKeyExportPubKey privKey - p <- pubKeyField pubKey "p" - q <- pubKeyField pubKey "q" - g <- pubKeyField pubKey "g" - y <- pubKeyField pubKey "y" - loadedKey <- pubKeyLoadDSA p q g y - pass diff --git a/test/Botan/Low/PubKey/DecryptSpec.hs b/test/Botan/Low/PubKey/DecryptSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/DecryptSpec.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.PubKey -import Botan.Low.PubKey.Encrypt -import Botan.Low.PubKey.Decrypt -import Botan.Low.RNG - -pks = - [ ("RSA", "2048", "PKCS1v15") - , ("SM2", "sm2p256v1", "SHA-256") -- NOTE: Decrypt fails with InsufficientBufferSpace - , ("ElGamal", "modp/ietf/1024", "PKCS1v15") - ] - -pkTestName :: (ByteString, ByteString, ByteString) -> String -pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding - -main :: IO () -main = hspec $ testSuite pks pkTestName $ \ (pk, param, padding) -> do - it "decryptCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ctx <- decryptCreate privKey padding - pass - it "decryptOutputLength" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ctx <- decryptCreate privKey padding - _ <- decryptOutputLength ctx 128 - pass - it "decrypt" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ectx <- encryptCreate pubKey padding - dctx <- decryptCreate privKey padding - encrypted <- encrypt ectx rng "Fee fi fo fum!" - decrypted <- decrypt dctx encrypted - decrypted `shouldBe` "Fee fi fo fum!" - pass diff --git a/test/Botan/Low/PubKey/ECDHSpec.hs b/test/Botan/Low/PubKey/ECDHSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/ECDHSpec.hs +++ /dev/null @@ -1,78 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.ECDH - --- TODO: Consolidate -ecGroups :: [ByteString] -ecGroups = - [ "secp160k1" - , "secp160r1" - , "secp160r2" - , "secp192k1" - , "secp192r1" - , "secp224k1" - , "secp224r1" - , "secp256k1" - , "secp256r1" - , "secp384r1" - , "secp521r1" - , "brainpool160r1" - , "brainpool192r1" - , "brainpool224r1" - , "brainpool256r1" - , "brainpool320r1" - , "brainpool384r1" - , "brainpool512r1" - , "x962_p192v2" - , "x962_p192v3" - , "x962_p239v1" - , "x962_p239v2" - , "x962_p239v3" - , "gost_256A" - , "gost_512A" - , "frp256v1" - , "sm2p256v1" - ] - --- TODO: Consolidate -privKeyField :: PrivKey -> ByteString -> IO MP -privKeyField privKey field = do - mp <- mpInit - privKeyGetField mp privKey field - return mp - --- TODO: Consolidate -pubKeyField :: PubKey -> ByteString -> IO MP -pubKeyField pubKey field = do - mp <- mpInit - pubKeyGetField mp pubKey field - return mp - -main :: IO () -main = hspec $ testSuite ecGroups chars $ \ ecGroup -> do - it "privKeyLoadECDH" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "ECDH" ecGroup rng - x <- privKeyField privKey "x" - loadedPrivKey <- privKeyLoadECDH x ecGroup - -- Inscrutible >_> but shows key equality - -- pubKeyBytes <- privKeyExportPubKey privKey >>= \ pubKey -> pubKeyExport pubKey PubKeyExportPEM - -- loadedPubKeyBytes <- privKeyExportPubKey loadedPrivKey >>= \ loadedPubKey -> pubKeyExport loadedPubKey PubKeyExportPEM - -- pubKeyBytes `shouldBe` loadedPubKeyBytes - pass - it "pubKeyLoadECDH" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "ECDH" ecGroup rng - pubKey <- privKeyExportPubKey privKey - public_x <- pubKeyField pubKey "public_x" - public_y <- pubKeyField pubKey "public_y" - loadedPubKey <- pubKeyLoadECDH public_x public_y ecGroup - -- pubKeyBytes <- pubKeyExport pubKey PubKeyExportPEM - -- loadedPubKeyBytes <- pubKeyExport loadedPubKey PubKeyExportPEM - -- pubKeyBytes `shouldBe` loadedPubKeyBytes - pass diff --git a/test/Botan/Low/PubKey/ECDSASpec.hs b/test/Botan/Low/PubKey/ECDSASpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/ECDSASpec.hs +++ /dev/null @@ -1,72 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.ECDSA - --- TODO: Consolidate -ecGroups :: [ByteString] -ecGroups = - [ "secp160k1" - , "secp160r1" - , "secp160r2" - , "secp192k1" - , "secp192r1" - , "secp224k1" - , "secp224r1" - , "secp256k1" - , "secp256r1" - , "secp384r1" - , "secp521r1" - , "brainpool160r1" - , "brainpool192r1" - , "brainpool224r1" - , "brainpool256r1" - , "brainpool320r1" - , "brainpool384r1" - , "brainpool512r1" - , "x962_p192v2" - , "x962_p192v3" - , "x962_p239v1" - , "x962_p239v2" - , "x962_p239v3" - , "gost_256A" - , "gost_512A" - , "frp256v1" - , "sm2p256v1" - ] - --- TODO: Consolidate -privKeyField :: PrivKey -> ByteString -> IO MP -privKeyField privKey field = do - mp <- mpInit - privKeyGetField mp privKey field - return mp - --- TODO: Consolidate -pubKeyField :: PubKey -> ByteString -> IO MP -pubKeyField pubKey field = do - mp <- mpInit - pubKeyGetField mp pubKey field - return mp - --- TODO: Don't assume just "ECDSA", other elliptic curve DSA might be valid here -main :: IO () -main = hspec $ testSuite ecGroups chars $ \ ecGroup -> do - it "privKeyLoadECDSA" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "ECDSA" ecGroup rng - x <- privKeyField privKey "x" - loadedPrivKey <- privKeyLoadECDSA x ecGroup - pass - it "pubKeyLoadECDSA" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "ECDSA" ecGroup rng - pubKey <- privKeyExportPubKey privKey - public_x <- pubKeyField pubKey "public_x" - public_y <- pubKeyField pubKey "public_y" - loadedPubKey <- pubKeyLoadECDSA public_x public_y ecGroup - pass diff --git a/test/Botan/Low/PubKey/Ed25519Spec.hs b/test/Botan/Low/PubKey/Ed25519Spec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/Ed25519Spec.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.Ed25519 - -main :: IO () -main = hspec $ do - it "privKeyEd25519GetPrivKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Ed25519" "" rng - exportedPrivKey <- privKeyEd25519GetPrivKey privKey - pass - it "pubKeyEd25519GetPubKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Ed25519" "" rng - pubKey <- privKeyExportPubKey privKey - exportedPubKey <- pubKeyEd25519GetPubKey pubKey - pass - it "privKeyLoadEd25519" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Ed25519" "" rng - exportedPrivKey <- privKeyEd25519GetPrivKey privKey - loadedPrivKey <- privKeyLoadEd25519 exportedPrivKey - pass - it "pubKeyLoadEd25519" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Ed25519" "" rng - pubKey <- privKeyExportPubKey privKey - exportedPubKey <- pubKeyEd25519GetPubKey pubKey - loadedPubKey <- pubKeyLoadEd25519 exportedPubKey - pass diff --git a/test/Botan/Low/PubKey/ElGamalSpec.hs b/test/Botan/Low/PubKey/ElGamalSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/ElGamalSpec.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.ElGamal - --- TODO: Consolidate -dlGroups :: [ByteString] -dlGroups = - [ "ffdhe/ietf/2048" - , "ffdhe/ietf/3072" - , "ffdhe/ietf/4096" - , "ffdhe/ietf/6144" - , "ffdhe/ietf/8192" - , "modp/ietf/1024" - , "modp/ietf/1536" - , "modp/ietf/2048" - , "modp/ietf/3072" - , "modp/ietf/4096" - , "modp/ietf/6144" - , "modp/ietf/8192" - , "modp/srp/1024" - , "modp/srp/1536" - , "modp/srp/2048" - , "modp/srp/3072" - , "modp/srp/4096" - , "modp/srp/6144" - , "modp/srp/8192" - , "dsa/jce/1024" - , "dsa/botan/2048" - , "dsa/botan/3072" - ] - --- TODO: Consolidate -privKeyField :: PrivKey -> ByteString -> IO MP -privKeyField privKey field = do - mp <- mpInit - privKeyGetField mp privKey field - return mp - --- TODO: Consolidate -pubKeyField :: PubKey -> ByteString -> IO MP -pubKeyField pubKey field = do - mp <- mpInit - pubKeyGetField mp pubKey field - return mp - -main :: IO () -main = hspec $ testSuite dlGroups chars $ \ dlGroup -> do - it "privKeyLoadELGamal" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "DH" dlGroup rng - p <- privKeyField privKey "p" - q <- privKeyField privKey "q" - g <- privKeyField privKey "g" - x <- privKeyField privKey "x" - loadedKey <- privKeyLoadElGamal p g x - pass - it "pubKeyLoadELGamal" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "DH" dlGroup rng - pubKey <- privKeyExportPubKey privKey - p <- privKeyField privKey "p" - q <- privKeyField privKey "q" - g <- privKeyField privKey "g" - y <- privKeyField privKey "y" - loadedKey <- pubKeyLoadElGamal p g y - pass diff --git a/test/Botan/Low/PubKey/EncryptSpec.hs b/test/Botan/Low/PubKey/EncryptSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/EncryptSpec.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.PubKey -import Botan.Low.PubKey.Encrypt -import Botan.Low.RNG - --- NOTE: SM2 encrypt fails with InsufficientBufferSpace unless sm2p256v1 is used as the --- curve when creating the key (but creating the key and the encryption context do not fail) - -pks = - [ ("RSA", "2048", "PKCS1v15") - , ("SM2", "sm2p256v1", "SHA-256") -- NOTE: SM2 takes a hash rather than a padding - , ("ElGamal", "modp/ietf/1024", "PKCS1v15") - ] - -pkTestName :: (ByteString, ByteString, ByteString) -> String -pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding - -main :: IO () -main = hspec $ testSuite pks pkTestName $ \ (pk, param, padding) -> do - it "encryptCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ctx <- encryptCreate pubKey padding - pass - it "encryptOutputLength" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ctx <- encryptCreate pubKey padding - _ <- encryptOutputLength ctx 128 - pass - it "encrypt" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ctx <- encryptCreate pubKey padding - _ <- encrypt ctx rng "Fee fi fo fum!" - pass diff --git a/test/Botan/Low/PubKey/KeyAgreementSpec.hs b/test/Botan/Low/PubKey/KeyAgreementSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/KeyAgreementSpec.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.PubKey -import Botan.Low.PubKey.KeyAgreement -import Botan.Low.RNG - --- TODO: More thorough test with different KDFs and curves / groups -pks :: [(ByteString, ByteString)] -pks = - [ ("DH", "modp/ietf/1024") - , ("ECDH", "secp256r1") - , ("Curve25519", "") - ] - -pkTestName :: (ByteString, ByteString) -> String -pkTestName (pk, param) = chars $ pk <> " " <> param - -main :: IO () -main = hspec $ testSuite pks pkTestName $ \ (pk, param) -> do - it "keyAgreementCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - ka <- keyAgreementCreate privKey "HKDF(SHA-256)" - pass - it "keyAgreementExportPublic" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - ka <- keyAgreementCreate privKey "HKDF(SHA-256)" - pubKey <- keyAgreementExportPublic privKey - pass - it "keyAgreementSize" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - ka <- keyAgreementCreate privKey "HKDF(SHA-256)" - kaSz <- keyAgreementSize ka - pass - it "keyAgreement" $ do - rng <- rngInit "system" - privKeyA <- privKeyCreate pk param rng - pubKeyA <- keyAgreementExportPublic privKeyA - privKeyB <- privKeyCreate pk param rng - pubKeyB <- keyAgreementExportPublic privKeyB - kaA <- keyAgreementCreate privKeyA "HKDF(SHA-256)" - kaB <- keyAgreementCreate privKeyB "HKDF(SHA-256)" - sharedKeyA <- keyAgreement kaA pubKeyB "salt" - sharedKeyB <- keyAgreement kaB pubKeyA "salt" - sharedKeyA `shouldBe` sharedKeyB - pass diff --git a/test/Botan/Low/PubKey/KeyEncapsulationSpec.hs b/test/Botan/Low/PubKey/KeyEncapsulationSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/KeyEncapsulationSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.PubKey -import Botan.Low.PubKey.KeyEncapsulation -import Botan.Low.RNG - -pks = - [ ( "RSA", "2048", "HKDF(SHA-256)") - , ( "Kyber", "", "HKDF(SHA-256)") - , ( "McEliece", "", "HKDF(SHA-256)") - ] - -pkTestName :: (ByteString, ByteString, ByteString) -> String -pkTestName (pk, param, kdf) = chars $ pk <> " " <> param <> " " <> kdf - -main :: IO () -main = hspec $ testSuite pks pkTestName $ \ (pk, param, kdf) -> do - it "kemEncryptCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" - pass - it "kemEncryptSharedKeyLength" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" - sharedKeyLength <- kemEncryptSharedKeyLength kem 256 - pass - it "kemEncryptEncapsulatedKeyLength" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" - encapsulatedKeyLength <- kemEncryptEncapsulatedKeyLength kem - pass - it "kemEncryptCreateSharedKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" - (sharedKey, encapsulatedKey) <- kemEncryptCreateSharedKey kem rng "salt" 256 - pass - it "kemDecryptCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - kem <- kemDecryptCreate privKey "HKDF(SHA-256)" - pass - it "kemDecryptSharedKeyLength" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - kem <- kemDecryptCreate privKey "HKDF(SHA-256)" - sharedKeyLen <- kemDecryptSharedKeyLength kem 256 - pass - it "kemDecryptSharedKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - encryptCtx <- kemEncryptCreate pubKey "HKDF(SHA-256)" - (sharedKey, encapsulatedKey) <- kemEncryptCreateSharedKey encryptCtx rng "salt" 256 - decryptCtx <- kemDecryptCreate privKey "HKDF(SHA-256)" - decryptedSharedKey <- kemDecryptSharedKey decryptCtx "salt" encapsulatedKey 256 - sharedKey `shouldBe` decryptedSharedKey - pass diff --git a/test/Botan/Low/PubKey/RSASpec.hs b/test/Botan/Low/PubKey/RSASpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/RSASpec.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.RSA - -rsaSizes = [ "2048" ] - --- TODO: Consolidate -privKeyField :: PrivKey -> ByteString -> IO MP -privKeyField privKey field = do - mp <- mpInit - privKeyGetField mp privKey field - return mp - --- TODO: Consolidate -pubKeyField :: PubKey -> ByteString -> IO MP -pubKeyField pubKey field = do - mp <- mpInit - pubKeyGetField mp pubKey field - return mp - -main :: IO () -main = hspec $ testSuite rsaSizes chars $ \ rsaSize -> do - it "privKeyLoadRSA" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "RSA" rsaSize rng - p <- privKeyField privKey "p" - q <- privKeyField privKey "q" - e <- privKeyField privKey "e" - loadedKey <- privKeyLoadRSA p q e - pass - it "pubKeyLoadRSA" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "RSA" rsaSize rng - pubKey <- privKeyExportPubKey privKey - n <- pubKeyField pubKey "n" - e <- pubKeyField pubKey "e" - loadedKey <- pubKeyLoadRSA n e - pass diff --git a/test/Botan/Low/PubKey/SM2Spec.hs b/test/Botan/Low/PubKey/SM2Spec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/SM2Spec.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.SM2 - --- TODO: Consolidate -ecGroups :: [ByteString] -ecGroups = - [ "secp160k1" - , "secp160r1" - , "secp160r2" - , "secp192k1" - , "secp192r1" - , "secp224k1" - , "secp224r1" - , "secp256k1" - , "secp256r1" - , "secp384r1" - , "secp521r1" - , "brainpool160r1" - , "brainpool192r1" - , "brainpool224r1" - , "brainpool256r1" - , "brainpool320r1" - , "brainpool384r1" - , "brainpool512r1" - , "x962_p192v2" - , "x962_p192v3" - , "x962_p239v1" - , "x962_p239v2" - , "x962_p239v3" - , "gost_256A" - , "gost_512A" - , "frp256v1" - , "sm2p256v1" - ] - --- TODO: Consolidate -privKeyField :: PrivKey -> ByteString -> IO MP -privKeyField privKey field = do - mp <- mpInit - privKeyGetField mp privKey field - return mp - --- TODO: Consolidate -pubKeyField :: PubKey -> ByteString -> IO MP -pubKeyField pubKey field = do - mp <- mpInit - pubKeyGetField mp pubKey field - return mp - -main :: IO () -main = hspec $ testSuite ecGroups chars $ \ ecGroup -> do - it "privKeyLoadSM2" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "SM2" ecGroup rng - x <- privKeyField privKey "x" - loadedPrivKey <- privKeyLoadSM2 x ecGroup - pass - it "pubKeyLoadSM2" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "SM2" ecGroup rng - pubKey <- privKeyExportPubKey privKey - public_x <- pubKeyField pubKey "public_x" - public_y <- pubKeyField pubKey "public_y" - loadedPubKey <- pubKeyLoadSM2 public_x public_y ecGroup - pass diff --git a/test/Botan/Low/PubKey/SignSpec.hs b/test/Botan/Low/PubKey/SignSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/SignSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.PubKey -import Botan.Low.PubKey.Sign -import Botan.Low.RNG - -ecGroup :: ByteString -ecGroup = "secp256r1" - -dlGroup :: ByteString -dlGroup = "modp/ietf/1024" - -sha = "SHA-256" - --- TODO: More exhaustive testing in botan --- pks :: [(PKName, PKParams, Padding)] -pks :: [(ByteString, ByteString, ByteString)] -pks = - [ ("RSA", "2048", "EMSA4(SHA-256)") -- NOTE: It is not yet known if any of the others suppport EMSA - , ("SM2", "sm2p256v1", "foo,SHA-256") - , ("DSA", dlGroup, sha) - , ("ECDSA", ecGroup, sha) - , ("ECKCDSA", ecGroup, sha) - , ("ECGDSA", ecGroup, sha) - , ("GOST-34.10", ecGroup, sha) - , ("Ed25519", "", "") - , ("XMSS", "XMSS-SHAKE_10_256", "") - -- TODO: Dilithium-x-y - , ("Dilithium", "", "") - -- TODO: SPHINCS+ - ] - -pkTestName :: (ByteString, ByteString, ByteString) -> String -pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding - --- NOTE: Some algorithms do not support DER format encoding. -main :: IO () -main = hspec $ testSuite pks pkTestName $ \ (pk, param, algo) -> do - it "signCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - ctx <- signCreate privKey algo StandardFormatSignature - -- ctxDER <- signCreate privKey algo DERFormatSignature - pass - it "signOutputLength" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - ctx <- signCreate privKey algo StandardFormatSignature - sigLen <- signOutputLength ctx - -- ctxDER <- signCreate privKey algo DERFormatSignature - -- _ <- signOutputLength ctxDER - pass - it "signUpdate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - ctx <- signCreate privKey algo StandardFormatSignature - signUpdate ctx "Fee fi fo fum!" - pass - it "signFinish" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - ctx <- signCreate privKey algo StandardFormatSignature - signUpdate ctx "Fee fi fo fum!" - sig <- signFinish ctx rng - pass diff --git a/test/Botan/Low/PubKey/VerifySpec.hs b/test/Botan/Low/PubKey/VerifySpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/VerifySpec.hs +++ /dev/null @@ -1,79 +0,0 @@ -module Main where - -import Test.Prelude - -import qualified Data.ByteString as ByteString - -import Botan.Low.PubKey -import Botan.Low.PubKey.Sign -import Botan.Low.PubKey.Verify -import Botan.Low.RNG - --- TODO: Consolidate test values with SignSpec - -ecGroup :: ByteString -ecGroup = "secp256r1" - -dlGroup :: ByteString -dlGroup = "modp/ietf/1024" - -sha = "SHA-256" - -pks :: [(ByteString, ByteString, ByteString)] -pks = - [ ("RSA", "2048", "EMSA4(SHA-256)") - , ("SM2", "sm2p256v1", "foo,SHA-256") - , ("DSA", dlGroup, sha) - , ("ECDSA", ecGroup, sha) - , ("ECKCDSA", ecGroup, sha) - , ("ECGDSA", ecGroup, sha) - , ("GOST-34.10", ecGroup, sha) - , ("Ed25519", "", "") - , ("XMSS", "XMSS-SHAKE_10_256", "") - -- TODO: Dilithium-x-y - , ("Dilithium", "", "") - -- TODO: SPHINCS+ - ] - -pkTestName :: (ByteString, ByteString, ByteString) -> String -pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding - --- SEE: signFinish for more details --- NOTE: Verified signatures pass for all algorithms in standard format --- Fails for only 4 in DER format via BadParameterException, but for important algs: --- RSA, Ed25519, XMSS, Dilithium --- The context and signatures are created without throwing any errors, --- compared to earlier which failed to even create a context, but --- it is possible that I need to figure out correct parameters and I doubt --- it is coincidence that the EMSA4 / empty params are the ones that are failing. --- Yet, it works for standard format. - -main :: IO () -main = hspec $ testSuite pks pkTestName $ \ (pk, param, algo) -> do - it "verifyCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ctx <- verifyCreate pubKey algo StandardFormatSignature - pass - it "verifyUpdate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - ctx <- verifyCreate pubKey algo StandardFormatSignature - verifyUpdate ctx "Fee fi fo fum!" - pass - it "verifyFinish" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - signCtx <- signCreate privKey algo StandardFormatSignature - signUpdate signCtx "Fee fi fo fum!" - sig <- signFinish signCtx rng - -- print $ "Siglen is: " <> show (ByteString.length sig) - print sig - pubKey <- privKeyExportPubKey privKey - verifyCtx <- verifyCreate pubKey algo StandardFormatSignature - verifyUpdate verifyCtx "Fee fi fo fum!" - verified <- verifyFinish verifyCtx sig - verified `shouldBe` True - pass diff --git a/test/Botan/Low/PubKey/X25519Spec.hs b/test/Botan/Low/PubKey/X25519Spec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKey/X25519Spec.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.PubKey.X25519 - -main :: IO () -main = hspec $ do - it "privKeyX25519GetPrivKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Curve25519" "" rng - exportedPrivKey <- privKeyX25519GetPrivKey privKey - pass - it "pubKeyX25519GetPubKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Curve25519" "" rng - pubKey <- privKeyExportPubKey privKey - exportedPubKey <- pubKeyX25519GetPubKey pubKey - pass - it "privKeyLoadX25519" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Curve25519" "" rng - exportedPrivKey <- privKeyX25519GetPrivKey privKey - loadedPrivKey <- privKeyLoadX25519 exportedPrivKey - pass - it "pubKeyLoadX25519" $ do - rng <- rngInit "system" - privKey <- privKeyCreate "Curve25519" "" rng - pubKey <- privKeyExportPubKey privKey - exportedPubKey <- pubKeyX25519GetPubKey pubKey - loadedPubKey <- pubKeyLoadX25519 exportedPubKey - pass diff --git a/test/Botan/Low/PubKeySpec.hs b/test/Botan/Low/PubKeySpec.hs deleted file mode 100644 --- a/test/Botan/Low/PubKeySpec.hs +++ /dev/null @@ -1,188 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.MPI -import Botan.Low.RNG -import Botan.Low.PubKey - -ecGroup :: ByteString -ecGroup = "secp256r1" - -dlGroup :: ByteString -dlGroup = "modp/ietf/1024" - --- TODO: More exhaustive testing in botan --- pks :: [(PKName, PKParams)] -pks :: [(ByteString, ByteString)] -pks = - [ ("RSA", "2048") - , ("SM2", ecGroup) - , ("ElGamal", dlGroup) - , ("DSA", dlGroup) - , ("ECDSA", ecGroup) - , ("ECKCDSA", ecGroup) - , ("ECGDSA", ecGroup) - , ("GOST-34.10", ecGroup) - , ("Ed25519", "") - , ("XMSS", "XMSS-SHAKE_10_256") -- NOTE: XMSS is noticeably slower than other keys and - -- the _16 and _20 variants are exponentially slower - , ("DH", dlGroup) - , ("ECDH", ecGroup) - , ("Curve25519", "") - -- TODO: Dilithium-x-y - , ("Dilithium", "") - -- TODO: Kyber-x-y - , ("Kyber", "") - -- TODO: SPHINCS+ - -- https://github.com/randombit/botan/blob/a303f4af1504e7ac349dd798190924ea08ead9b7/src/lib/pubkey/sphincsplus/sphincsplus_common/sp_parameters.cpp#L155 - -- , ("SPHINCS+", "sha2-128s-r3.1") -- Not working - , ("McEliece", "") - ] - -pkTestName :: (ByteString, ByteString) -> String -pkTestName (pk, param) = chars $ pk <> " " <> param - --- NOTE: Known fields are: n, e, p, q, g, a, b --- ECGroup PrivKey: x plus all in PubKey --- EGGroup PubKey: public_x, public_y, base_x, base_y, p, a, b, cofactor, order --- DLGroup PubKey: p, q, g, y (not all groups have all four) --- DLGroup PrivKey: p, q, g, x, y --- RSA PubKey: p, q, d, c, d1, d2 --- RSA PrivKey: n, e, d, p, q, d1, d2, c - -ecGroupPrivFields = [ "x" , "public_x", "public_y", "base_x", "base_y", "p", "a", "b", "cofactor", "order" ] -ecGroupPubFields = [ "public_x", "public_y", "base_x", "base_y", "p", "a", "b", "cofactor", "order" ] - -dlGroupPrivFields = [ "p", "q", "g", "x", "y" ] -dlGroupPubFields = [ "p", "q", "g", "y" ] - -privKeyFields "RSA" = [ "p", "q", "d", "n", "e"] -- TODO: Check -privKeyFields "SM2" = ecGroupPrivFields -privKeyFields "ElGamal" = dlGroupPrivFields -privKeyFields "DSA" = dlGroupPrivFields -privKeyFields "ECDSA" = ecGroupPrivFields -privKeyFields "ECKCDSA" = ecGroupPrivFields -privKeyFields "ECGDSA" = ecGroupPrivFields -privKeyFields "GOST-34.10" = ecGroupPrivFields -privKeyFields "Ed25519" = [] -- TODO -privKeyFields "XMSS" = [] -- TODO -privKeyFields "DH" = dlGroupPrivFields -privKeyFields "ECDH" = ecGroupPrivFields -privKeyFields "Curve25519" = [] -- TODO -privKeyFields "Dilithium" = [] -- TODO -privKeyFields "Kyber" = [] -- TODO -privKeyFields "McEliece" = [] -- TODO - -pubKeyFields "RSA" = [ "n", "e" ] -pubKeyFields "SM2" = ecGroupPubFields -pubKeyFields "ElGamal" = dlGroupPubFields -pubKeyFields "DSA" = dlGroupPubFields -pubKeyFields "ECDSA" = ecGroupPubFields -pubKeyFields "ECKCDSA" = ecGroupPubFields -pubKeyFields "ECGDSA" = ecGroupPubFields -pubKeyFields "GOST-34.10" = ecGroupPubFields -pubKeyFields "Ed25519" = [] -- TODO -pubKeyFields "XMSS" = [] -- TODO -pubKeyFields "DH" = dlGroupPubFields -pubKeyFields "ECDH" = ecGroupPubFields -pubKeyFields "Curve25519" = [] -- TODO -pubKeyFields "Dilithium" = [] -- TODO -pubKeyFields "Kyber" = [] -- TODO -pubKeyFields "McEliece" = [] -- TODO - --- NOTE: These tests are going to be very slow if we create new keys every time -main :: IO () -main = hspec $ testSuite pks pkTestName $ \ (pk, param) -> do - it "privKeyCreate" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pass - it "privKeyCheckKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - privKeyCheckKey privKey rng CheckKeyNormalTests - -- privKeyCheckKey privKey rng CheckKeyExpensiveTests - pass - it "privKeyExport" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - privKeyDER <- privKeyExport privKey PrivKeyExportDER - privKeyPEM <- privKeyExport privKey PrivKeyExportPEM - pass - it "privKeyLoad" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - privKeyDER <- privKeyExport privKey PrivKeyExportDER - privKeyPEM <- privKeyExport privKey PrivKeyExportPEM - privKeyLoad privKeyDER "" - privKeyLoad privKeyPEM "" - pass - it "privKeyAlgoName" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - privKeyAlgoName privKey - pass - it "privKeyExportPubKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - pass - it "pubKeyCheckKey" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - pubKeyCheckKey pubKey rng CheckKeyNormalTests - -- pubKeyCheckKey pubKey rng CheckKeyExpensiveTests - pass - it "pubKeyExport" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - pubKeyDER <- pubKeyExport pubKey PrivKeyExportDER - pubKeyPEM <- pubKeyExport pubKey PrivKeyExportPEM - pass - it "pubKeyLoad" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - pubKeyDER <- pubKeyExport pubKey PrivKeyExportDER - pubKeyPEM <- pubKeyExport pubKey PrivKeyExportPEM - pubKeyLoad pubKeyDER - pubKeyLoad pubKeyPEM - pass - it "pubKeyAlgoName" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - pubKeyAlgoName pubKey - pass - it "pubKeyEstimatedStrength" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - pubKeyEstimatedStrength pubKey - pass - it "pubKeyFingerprint" $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - pubKeyFingerprint pubKey "SHA-256" - pass - describe "privKeyGetField" $ do - forM_ (privKeyFields pk) $ \ field -> do - it (chars field) $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - mp <- mpInit - privKeyGetField mp privKey field - pass - describe "pubKeyGetField" $ do - forM_ (pubKeyFields pk) $ \ field -> do - it (chars field) $ do - rng <- rngInit "system" - privKey <- privKeyCreate pk param rng - pubKey <- privKeyExportPubKey privKey - mp <- mpInit - pubKeyGetField mp pubKey field - pass diff --git a/test/Botan/Low/PwdHashSpec.hs b/test/Botan/Low/PwdHashSpec.hs deleted file mode 100644 --- a/test/Botan/Low/PwdHashSpec.hs +++ /dev/null @@ -1,61 +0,0 @@ -module Main where - -import Data.ByteString (isPrefixOf) - -import Botan.Low.Hash -import Botan.Low.MAC -import Botan.Low.PwdHash - -import Test.Prelude - --- NOTE: Needs more exhaustive tests, and to validate parameter order for --- Scrypt and the Argons. We've got tests that pass, but that doesn't --- mean that they're being used properly. Need to investigate C++ source. - --- NOTE: Values generated by "pwdhashTimed pbkdf 200 64 passphrase salt" -pbkdfs :: [(PBKDFName, Int, Int, Int)] -pbkdfs = - [ ("PBKDF2(HMAC(SHA-512))",138000,0,0) - -- NOTE: These results indicate that the parameter result order is inconsistent - -- for pwdhashTimed compared to pwdhash - -- Eg, Scrypt should be n, r, p but n=8192 is clearly last - -- Same for the argons - -- This causes both tests to fail (original generated values) - -- , ("Scrypt",1,81,8192) - -- , ("Argon2d",1,1,262144) - -- , ("Argon2i",1,1,262144) - -- , ("Argon2id",1,1,262144) - -- Note that this still causes four pwdhashTimed tests to still fail because - -- the pwdhashTimed function itself needs to be fixed for these algorithms - -- Fixed values, assuming only x/z are flipped a la (x,y,z) -> (z,y,x) - -- But - , ("Scrypt",8192,81,1) - , ("Argon2d",262144,1,1) - , ("Argon2i",262144,1,1) - , ("Argon2id",262144,1,1) - , ("Bcrypt-PBKDF",26,0,0) - , ("OpenPGP-S2K(SHA-512)",65011712,0,0) - ] - -passphrase :: ByteString -passphrase = "Fee fi fo fum!" - -salt :: ByteString -salt = "salt" - -main :: IO () -main = hspec $ testSuite pbkdfs (\(n,_,_,_) -> chars n) $ \ (pbkdf, i, j, k) -> do - it "pwdhash" $ do - _ <- pwdhash pbkdf i j k 64 passphrase salt - pass - it "pwdhashTimed" $ do - timed@(i',j',k',pwd) <- pwdhashTimed pbkdf 200 64 passphrase salt - -- NOTE: Fails parity for Scrypt and the Argons due to parameter order - -- pwd' <- pwdhash pbkdf i' j' k' 64 passphrase salt - --NOTE: Scrypt still fails parity and flipping j and k doesn't matter. - pwd' <- case pbkdf of - "Scrypt" -> pwdhash pbkdf j' k' i' 64 passphrase salt - _ | "Argon" `isPrefixOf` pbkdf -> pwdhash pbkdf k' j' i' 64 passphrase salt - _ -> pwdhash pbkdf i' j' k' 64 passphrase salt - pwd `shouldBe` pwd' - pass diff --git a/test/Botan/Low/RNGSpec.hs b/test/Botan/Low/RNGSpec.hs deleted file mode 100644 --- a/test/Botan/Low/RNGSpec.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Main where - -import Test.Prelude - -import qualified Data.ByteString as ByteString - -import Botan.Low.RNG - -rngs :: [RNGType] -rngs = - [ SystemRNG - , UserRNG - , UserThreadsafeRNG - , RDRandRNG -- NOTES: Not available on all processors - ] - -main :: IO () -main = hspec $ do - it "systemRNGGet" $ do - bs <- systemRNGGet 8 - ByteString.length bs `shouldBe` 8 - testSuite rngs chars $ \ rng -> do - it "rngInit" $ do - ctx <- rngInit rng - pass - it "rngGet" $ do - ctx <- rngInit rng - bs <- rngGet ctx 8 - pass - it "rngReseed" $ do - ctx <- rngInit rng - rngReseed ctx 64 - pass - it "rngReseedFromRNGCtx" $ do - ctx <- rngInit rng - source <- rngInit rng - rngReseedFromRNG ctx source 64 - pass - it "rngAddEntropy" $ do - ctx <- rngInit rng - rngAddEntropy ctx "Fee fi fo fum!" - pass diff --git a/test/Botan/Low/SRP6Spec.hs b/test/Botan/Low/SRP6Spec.hs deleted file mode 100644 --- a/test/Botan/Low/SRP6Spec.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE CPP #-} - -#if defined(MIN_VERSION_GLASGOW_HASKELL) -#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) -{-# OPTIONS_GHC -Wwarn=x-partial #-} -#endif -#endif - -module Main where - -import Test.Prelude - -import Botan.Low.SRP6 -import Botan.Low.RNG -import Botan.Low.PubKey -import Botan.Low.Hash - -username :: ByteString -username = "username" - -password :: ByteString -password = "password" - -salt :: ByteString -salt = "salt" - --- NOTE: Consolidate with DLGroup -groupIds :: [DLGroupName] -groupIds = - [ "ffdhe/ietf/2048" - , "ffdhe/ietf/3072" - , "ffdhe/ietf/4096" - , "ffdhe/ietf/6144" - , "ffdhe/ietf/8192" - , "modp/ietf/1024" - , "modp/ietf/1536" - , "modp/ietf/2048" - , "modp/ietf/3072" - , "modp/ietf/4096" - , "modp/ietf/6144" - , "modp/ietf/8192" - , "modp/srp/1024" - , "modp/srp/1536" - , "modp/srp/2048" - , "modp/srp/3072" - , "modp/srp/4096" - , "modp/srp/6144" - , "modp/srp/8192" - , "dsa/jce/1024" - , "dsa/botan/2048" - , "dsa/botan/3072" - ] - -groupId :: DLGroupName -groupId = head groupIds - --- TODO: Test which hashes work -hashId :: HashName -hashId = "SHA-256" - -main :: IO () -main = hspec $ testSuite groupIds chars $ \ groupId -> do - it "can negotiate a shared secret" $ do - rng <- rngInit "system" - verifier <- srp6GenerateVerifier username password salt groupId hashId - ctx <- srp6ServerSessionInit - b <- srp6ServerSessionStep1 ctx verifier groupId hashId rng - (a,sharedSecret) <- srp6ClientAgree username password groupId hashId salt b rng - sharedSecret' <- srp6ServerSessionStep2 ctx a - sharedSecret `shouldBe` sharedSecret' - pass diff --git a/test/Botan/Low/TOTPSpec.hs b/test/Botan/Low/TOTPSpec.hs deleted file mode 100644 --- a/test/Botan/Low/TOTPSpec.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Main where - -import Test.Prelude -import Botan.Low.Hash (HashName(..)) - -import Botan.Low.TOTP - -key :: ByteString -key = "Fee fi fo fum" - -timestep :: TOTPTimestep -timestep = 60 - -timestamp :: TOTPTimestamp -timestamp = 1698109812 - --- TODO: More thorough testing -main :: IO () -main = hspec $ testSuite totpHashes chars $ \ h -> do - it "totpInit" $ do - ctx <- totpInit key h 6 timestep - pass - it "totpGenerate" $ do - ctx <- totpInit key h 6 timestep - code <- totpGenerate ctx timestamp - pass - it "totpCheck" $ do - ctx <- totpInit key h 6 timestep - code <- totpGenerate ctx timestamp - success <- totpCheck ctx code timestamp 0 - success `shouldBe` True diff --git a/test/Botan/Low/UtilitySpec.hs b/test/Botan/Low/UtilitySpec.hs deleted file mode 100644 --- a/test/Botan/Low/UtilitySpec.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.Utility - -import qualified Data.ByteString as ByteString - -message = "Fee fi fo fum!" - -hexMessage = "46656520666920666F2066756D21" - -base64Message = "RmVlIGZpIGZvIGZ1bSE=" - --- hexUpperMessage - -main :: IO () -main = hspec $ do - it "constantTimeCompare" $ do - equal <- constantTimeCompare "compare me" "compare me" (ByteString.length "compare me") - equal `shouldBe` True - pass - -- TODO: - -- it "scrubMem" $ do - -- pass - it "hexEncode" $ do - hex <- hexEncode message HexUpperCase - hex `shouldBe` hexMessage - pass - it "hexDecode" $ do - msg <- hexDecode hexMessage - msg `shouldBe` message - pass - it "base64Encode" $ do - base64 <- base64Encode message - base64 `shouldBe` base64Message - pass - it "base64Decode" $ do - msg <- base64Decode base64Message - msg `shouldBe` message - pass diff --git a/test/Botan/Low/X509Spec.hs b/test/Botan/Low/X509Spec.hs deleted file mode 100644 --- a/test/Botan/Low/X509Spec.hs +++ /dev/null @@ -1,171 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.X509 - -import Paths_botan_low - --- NOTE: Taken from https://fm4dd.com/openssl/certexamples.shtm -testCert :: ByteString -testCert = "-----BEGIN CERTIFICATE-----\ -\MIID2jCCA0MCAg39MA0GCSqGSIb3DQEBBQUAMIGbMQswCQYDVQQGEwJKUDEOMAwG\ -\A1UECBMFVG9reW8xEDAOBgNVBAcTB0NodW8ta3UxETAPBgNVBAoTCEZyYW5rNERE\ -\MRgwFgYDVQQLEw9XZWJDZXJ0IFN1cHBvcnQxGDAWBgNVBAMTD0ZyYW5rNEREIFdl\ -\YiBDQTEjMCEGCSqGSIb3DQEJARYUc3VwcG9ydEBmcmFuazRkZC5jb20wHhcNMTIw\ -\ODIyMDUyODAwWhcNMTcwODIxMDUyODAwWjBKMQswCQYDVQQGEwJKUDEOMAwGA1UE\ -\CAwFVG9reW8xETAPBgNVBAoMCEZyYW5rNEREMRgwFgYDVQQDDA93d3cuZXhhbXBs\ -\ZS5jb20wggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCwvWITOLeyTbS1\ -\Q/UacqeILIK16UHLvSymIlbbiT7mpD4SMwB343xpIlXN64fC0Y1ylT6LLeX4St7A\ -\cJrGIV3AMmJcsDsNzgo577LqtNvnOkLH0GojisFEKQiREX6gOgq9tWSqwaENccTE\ -\sAXuV6AQ1ST+G16s00iN92hjX9V/V66snRwTsJ/p4WRpLSdAj4272hiM19qIg9zr\ -\h92e2rQy7E/UShW4gpOrhg2f6fcCBm+aXIga+qxaSLchcDUvPXrpIxTd/OWQ23Qh\ -\vIEzkGbPlBA8J7Nw9KCyaxbYMBFb1i0lBjwKLjmcoihiI7PVthAOu/B71D2hKcFj\ -\Kpfv4D1Uam/0VumKwhwuhZVNjLq1BR1FKRJ1CioLG4wCTr0LVgtvvUyhFrS+3PdU\ -\R0T5HlAQWPMyQDHgCpbOHW0wc0hbuNeO/lS82LjieGNFxKmMBFF9lsN2zsA6Qw32\ -\Xkb2/EFltXCtpuOwVztdk4MDrnaDXy9zMZuqFHpv5lWTbDVwDdyEQNclYlbAEbDe\ -\vEQo/rAOZFl94Mu63rAgLiPeZN4IdS/48or5KaQaCOe0DuAb4GWNIQ42cYQ5TsEH\ -\Wt+FIOAMSpf9hNPjDeu1uff40DOtsiyGeX9NViqKtttaHpvd7rb2zsasbcAGUl+f\ -\NQJj4qImPSB9ThqZqPTukEcM/NtbeQIDAQABMA0GCSqGSIb3DQEBBQUAA4GBAIAi\ -\gU3My8kYYniDuKEXSJmbVB+K1upHxWDA8R6KMZGXfbe5BRd8s40cY6JBYL52Tgqd\ -\l8z5Ek8dC4NNpfpcZc/teT1WqiO2wnpGHjgMDuDL1mxCZNL422jHpiPWkWp3AuDI\ -\c7tL1QjbfAUHAQYwmHkWgPP+T2wAv0pOt36GgMCM\ -\-----END CERTIFICATE-----\ -\" - --- NOTE: Taken from https://fm4dd.com/openssl/certexamples.shtm -testCertFile :: FilePath -testCertFile = "test-data/4096b-rsa-example-cert.pem" - -{- -Version: 1 -Subject: C="JP",X520.State="Tokyo",O="Frank4DD",CN="www.example.com" -Issuer: C="JP",X520.State="Tokyo",X520.Locality="Chuo-ku",O="Frank4DD",OU="WebCert Support",CN="Frank4DD Web CA",PKCS9.EmailAddress="support@frank4dd.com" -Issued: 2012/08/22 05:28:00 UTC -Expires: 2017/08/21 05:28:00 UTC -Constraints: - None -Signature algorithm: RSA/EMSA3(SHA-1) -Serial number: 0DFD -Public Key [RSA-4096] - ------BEGIN PUBLIC KEY----- -MIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAsL1iEzi3sk20tUP1GnKn -iCyCtelBy70spiJW24k+5qQ+EjMAd+N8aSJVzeuHwtGNcpU+iy3l+ErewHCaxiFd -wDJiXLA7Dc4KOe+y6rTb5zpCx9BqI4rBRCkIkRF+oDoKvbVkqsGhDXHExLAF7leg -ENUk/hterNNIjfdoY1/Vf1eurJ0cE7Cf6eFkaS0nQI+Nu9oYjNfaiIPc64fdntq0 -MuxP1EoVuIKTq4YNn+n3AgZvmlyIGvqsWki3IXA1Lz166SMU3fzlkNt0IbyBM5Bm -z5QQPCezcPSgsmsW2DARW9YtJQY8Ci45nKIoYiOz1bYQDrvwe9Q9oSnBYyqX7+A9 -VGpv9FbpisIcLoWVTYy6tQUdRSkSdQoqCxuMAk69C1YLb71MoRa0vtz3VEdE+R5Q -EFjzMkAx4AqWzh1tMHNIW7jXjv5UvNi44nhjRcSpjARRfZbDds7AOkMN9l5G9vxB -ZbVwrabjsFc7XZODA652g18vczGbqhR6b+ZVk2w1cA3chEDXJWJWwBGw3rxEKP6w -DmRZfeDLut6wIC4j3mTeCHUv+PKK+SmkGgjntA7gG+BljSEONnGEOU7BB1rfhSDg -DEqX/YTT4w3rtbn3+NAzrbIshnl/TVYqirbbWh6b3e629s7GrG3ABlJfnzUCY+Ki -Jj0gfU4amaj07pBHDPzbW3kCAwEAAQ== ------END PUBLIC KEY----- - --} - -testCertHostname :: ByteString -testCertHostname = "www.example.com" - -testCertValidTimestamp = 1420092000 - -main :: IO () -main = hspec $ do - it "x509CertLoad" $ do - cert <- x509CertLoad testCert - pass - it "x509CertLoadFile" $ do - cert <- x509CertLoadFile =<< getDataFileName testCertFile - pass - it "x509CertDup" $ do - cert <- x509CertLoad testCert - dup <- x509CertDup cert - -- TODO: parity check, eg: x509CertGetPublicKey cert == x509CertGetPublicKey dup - pass - it "x509CertGetTimeStarts" $ do - cert <- x509CertLoad testCert - ts <- x509CertGetTimeStarts cert - pass - it "x509CertGetTimeExpires" $ do - cert <- x509CertLoad testCert - te <- x509CertGetTimeExpires cert - pass - it "x509CertNotBefore" $ do - cert <- x509CertLoad testCert - nb <- x509CertNotBefore cert - pass - it "x509CertNotAfter" $ do - cert <- x509CertLoad testCert - na <- x509CertNotAfter cert - pass - it "x509CertGetPubKeyFingerprint" $ do - cert <- x509CertLoad testCert - fp <- x509CertGetPubKeyFingerprint cert "SHA-256" -- TODO: HashName - pass - it "x509CertGetSerialNumber" $ do - cert <- x509CertLoad testCert - sn <- x509CertGetSerialNumber cert - pass - it "x509CertGetAuthorityKeyId" $ do - cert <- x509CertLoad testCert - akid <- x509CertGetAuthorityKeyId cert - pass - it "x509CertGetSubjectKeyId" $ do - cert <- x509CertLoad testCert - sid <- x509CertGetSubjectKeyId cert - pass - it "x509CertGetPublicKeyBits" $ do - cert <- x509CertLoad testCert - pkbits <- x509CertGetPublicKeyBits cert - pass - it "x509CertGetPublicKey" $ do - cert <- x509CertLoad testCert - pk <- x509CertGetPublicKey cert - pass - it "x509CertGetIssuerDN" $ do - cert <- x509CertLoad testCert - _ <- x509CertGetIssuerDN cert "CN" 0 -- TODO: Distinguished names, etc - pass - it "x509CertGetSubjectDN" $ do - cert <- x509CertLoad testCert - _ <- x509CertGetSubjectDN cert "CN" 0 -- TODO: Distinguished names, etc - pass - it "x509CertToString" $ do - cert <- x509CertLoad testCert - pass - it "x509CertAllowedUsage" $ do - cert <- x509CertLoad testCert - allowed <- x509CertAllowedUsage cert NoConstraints - pass - it "x509CertHostnameMatch" $ do - cert <- x509CertLoad testCert - matched <- x509CertHostnameMatch cert testCertHostname - pass - it "x509CertVerify" $ do - cert <- x509CertLoad testCert - (success, status) <- x509CertVerify cert [] [] Nothing 0 testCertHostname testCertValidTimestamp - pass - it "x509CertValidationStatus" $ do - cert <- x509CertLoad testCert - _ <- x509CertValidationStatus 0 - pending - -- NOTE: May need to generate a proper test cert with CA and CRL - it "x509CRLLoad" $ do - cert <- x509CertLoad testCert - -- x509CRLLoad cert - pending - it "x509CRLLoadFile" $ do - cert <- x509CertLoad testCert - -- x509CRLLoadFile cert - pending - it "x509IsRevoked" $ do - cert <- x509CertLoad testCert - -- x509IsRevoked cert - pending - it "x509CertVerifyWithCLR" $ do - cert <- x509CertLoad testCert - -- x509CertVerifyWithCLR cert - pending - diff --git a/test/Botan/Low/ZFECSpec.hs b/test/Botan/Low/ZFECSpec.hs deleted file mode 100644 --- a/test/Botan/Low/ZFECSpec.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Main where - -import Test.Prelude - -import Botan.Low.ZFEC - -k :: Int -k = 5 - -n :: Int -n = 7 - -message :: ByteString -message = "Fee fi fo fum! I smell the blood of an Englishman!" - -main :: IO () -main = hspec $ do - describe "zfecEncode" $ do - it "encodes a message into shares" $ do - shares <- zfecEncode k n message - length shares `shouldBe` n - describe "zfecDecode" $ do - it "recovers a message from enough shares" $ do - shares <- zfecEncode k n message - someShares <- take k <$> generate (shuffle shares) - recoveredMessage <- zfecDecode k n someShares - recoveredMessage `shouldBe` message diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,117 @@ +module Main (main) where + +import qualified Test.Botan.Low.Bcrypt +import qualified Test.Botan.Low.BlockCipher +import qualified Test.Botan.Low.Cipher +import qualified Test.Botan.Low.FPE +import qualified Test.Botan.Low.Hash +import qualified Test.Botan.Low.HOTP +import qualified Test.Botan.Low.KDF +import qualified Test.Botan.Low.KeyWrap +import qualified Test.Botan.Low.MAC +import qualified Test.Botan.Low.MPI +import qualified Test.Botan.Low.PubKey +import qualified Test.Botan.Low.PubKey.Decrypt +import qualified Test.Botan.Low.PubKey.DH +import qualified Test.Botan.Low.PubKey.DSA +import qualified Test.Botan.Low.PubKey.ECDH +import qualified Test.Botan.Low.PubKey.ECDSA +import qualified Test.Botan.Low.PubKey.Ed25519 +import qualified Test.Botan.Low.PubKey.ElGamal +import qualified Test.Botan.Low.PubKey.Encrypt +import qualified Test.Botan.Low.PubKey.KeyAgreement +import qualified Test.Botan.Low.PubKey.KeyEncapsulation +import qualified Test.Botan.Low.PubKey.RSA +import qualified Test.Botan.Low.PubKey.Sign +import qualified Test.Botan.Low.PubKey.SM2 +import qualified Test.Botan.Low.PubKey.Verify +import qualified Test.Botan.Low.PubKey.X25519 +import qualified Test.Botan.Low.PwdHash +import qualified Test.Botan.Low.RNG +import qualified Test.Botan.Low.SRP6 +import qualified Test.Botan.Low.SRP6.Example +import qualified Test.Botan.Low.TOTP +import qualified Test.Botan.Low.Utility +import qualified Test.Botan.Low.Version +import qualified Test.Botan.Low.X509 +import qualified Test.Botan.Low.ZFEC +import Test.Tasty +import Test.Tasty.HUnit + +main :: IO () +main = tests >>= defaultMain + +tests :: IO TestTree +tests = do + bcryptTests <- Test.Botan.Low.Bcrypt.tests + blockCipherTests <- Test.Botan.Low.BlockCipher.tests + cipherTests <- Test.Botan.Low.Cipher.tests + fpeTests <- Test.Botan.Low.FPE.tests + hashTests <- Test.Botan.Low.Hash.tests + hotpTests <- Test.Botan.Low.HOTP.tests + kdfTests <- Test.Botan.Low.KDF.tests + keyWrapTests <- Test.Botan.Low.KeyWrap.tests + macTests <- Test.Botan.Low.MAC.tests + mpiTests <- Test.Botan.Low.MPI.tests + pubKeyTests <- Test.Botan.Low.PubKey.tests + pubKeyDecryptTests <- Test.Botan.Low.PubKey.Decrypt.tests + pubKeyDhTests <- Test.Botan.Low.PubKey.DH.tests + pubKeyDsaTests <- Test.Botan.Low.PubKey.DSA.tests + pubKeyEcdhTests <- Test.Botan.Low.PubKey.ECDH.tests + pubKeyEcdsaTests <- Test.Botan.Low.PubKey.ECDSA.tests + pubKeyEd25519Tests <- Test.Botan.Low.PubKey.Ed25519.tests + pubKeyElGamalTests <- Test.Botan.Low.PubKey.ElGamal.tests + pubKeyEncryptTests <- Test.Botan.Low.PubKey.Encrypt.tests + pubKeyKeyAgreementTests <- Test.Botan.Low.PubKey.KeyAgreement.tests + pubKeyKeyEncapsulationTests <- Test.Botan.Low.PubKey.KeyEncapsulation.tests + pubKeyRsaTests <- Test.Botan.Low.PubKey.RSA.tests + pubKeySignTests <- Test.Botan.Low.PubKey.Sign.tests + pubKeySm2Tests <- Test.Botan.Low.PubKey.SM2.tests + pubKeyVerifyTests <- Test.Botan.Low.PubKey.Verify.tests + pubKeyX25519Tests <- Test.Botan.Low.PubKey.X25519.tests + pwdHashTests <- Test.Botan.Low.PwdHash.tests + rngTests <- Test.Botan.Low.RNG.tests + srp6Tests <- Test.Botan.Low.SRP6.tests + totpTests <- Test.Botan.Low.TOTP.tests + utilityTests <- Test.Botan.Low.Utility.tests + x509Tests <- Test.Botan.Low.X509.tests + zfecTests <- Test.Botan.Low.ZFEC.tests + pure $ testGroup "botan-low" [ + bcryptTests + , blockCipherTests + , cipherTests + , fpeTests + , hashTests + , hotpTests + , kdfTests + , keyWrapTests + , macTests + , mpiTests + , pubKeyTests + , pubKeyDecryptTests + , pubKeyDhTests + , pubKeyDsaTests + , pubKeyEcdhTests + , pubKeyEcdsaTests + , pubKeyEd25519Tests + , pubKeyElGamalTests + , pubKeyEncryptTests + , pubKeyKeyAgreementTests + , pubKeyKeyEncapsulationTests + , pubKeyRsaTests + , pubKeySignTests + , pubKeySm2Tests + , pubKeyVerifyTests + , pubKeyX25519Tests + , pwdHashTests + , rngTests + , srp6Tests + , testGroup "Test.Botan.Low.SRP6.Example" [ + testCase "example" Test.Botan.Low.SRP6.Example.main + ] + , totpTests + , utilityTests + , Test.Botan.Low.Version.tests + , x509Tests + , zfecTests + ] diff --git a/test/Test/Botan/Low/Bcrypt.hs b/test/Test/Botan/Low/Bcrypt.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/Bcrypt.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.Bcrypt (tests) where + +import Botan.Low.Bcrypt +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_bcrypt" spec_bcrypt + pure $ testGroup "Test.Botan.Low.Bcrypt" [ + specs + ] + +password :: ByteString +password = "Fee fi fo fum!" + +factor :: BcryptWorkFactor +factor = 12 + +spec_bcrypt :: Spec +spec_bcrypt = do + describe "bcryptGenerate" $ do + it "generates a bcrypt hash" $ do + rng <- rngInit "user-threadsafe" + _ <- bcryptGenerate password rng factor + pass + describe "bcryptIsValid" $ do + it "validates a bcrypt hash" $ do + rng <- rngInit "user-threadsafe" + h <- bcryptGenerate password rng factor + valid <- bcryptIsValid password h + valid `shouldBe` True diff --git a/test/Test/Botan/Low/BlockCipher.hs b/test/Test/Botan/Low/BlockCipher.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/BlockCipher.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.BlockCipher ( + tests + ) where + +import Botan.Low.BlockCipher +import Botan.Low.Hash +import Botan.Low.RNG +import qualified Data.ByteString as BS +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_blockCipher" spec_blockCipher + pure $ testGroup "Test.Botan.Low.BlockCipher" [ + specs + ] + +{------------------------------------------------------------------------------- + Specs +-------------------------------------------------------------------------------} + +spec_blockCipher :: Spec +spec_blockCipher = testSuite allTestBlockCiphers chars $ \ bc -> do + it "can initialize a block cipher context" $ do + _ctx <- blockCipherInit bc + pass + it "has a name" $ do + ctx <- blockCipherInit bc + _name <- blockCipherName ctx + -- name `shouldBe` bc -- Name expands to include default parameters - need to record + pass + it "has a key spec" $ do + ctx <- blockCipherInit bc + (_,_,_) <- blockCipherGetKeyspec ctx + pass + it "has a block size" $ do + ctx <- blockCipherInit bc + _ <- blockCipherBlockSize ctx + pass + it "can set the key" $ do + ctx <- blockCipherInit bc + (_,mx,_) <- blockCipherGetKeyspec ctx + k <- systemRNGGet mx + blockCipherSetKey ctx k + pass + it "can encipher a message" $ do + ctx <- blockCipherInit bc + (_,mx,_) <- blockCipherGetKeyspec ctx + k <- systemRNGGet mx + blockCipherSetKey ctx k + bsz <- blockCipherBlockSize ctx + msg <- systemRNGGet $ bsz * 10 + _encmsg <- blockCipherEncryptBlocks ctx msg + pass + it "can only encipher a message that is a multiple of the block size" $ do + ctx <- blockCipherInit bc + (_,mx,_) <- blockCipherGetKeyspec ctx + k <- systemRNGGet mx + blockCipherSetKey ctx k + bsz <- blockCipherBlockSize ctx + msg <- systemRNGGet $ bsz * 10 + let msgCorrupted = msg <> BS.pack [17] + blockCipherEncryptBlocks ctx msgCorrupted + `shouldThrow` anyErrorCall + it "can decipher an enciphered message" $ do + ctx <- blockCipherInit bc + (_,mx,_) <- blockCipherGetKeyspec ctx + k <- systemRNGGet mx + blockCipherSetKey ctx k + bsz <- blockCipherBlockSize ctx + msg <- systemRNGGet $ bsz * 10 + encmsg <- blockCipherEncryptBlocks ctx msg + decmsg <- blockCipherDecryptBlocks ctx encmsg + decmsg `shouldBe` msg + pass + it "can only decipher an enciphered message that is a multiple of the block size" $ do + ctx <- blockCipherInit bc + (_,mx,_) <- blockCipherGetKeyspec ctx + k <- systemRNGGet mx + blockCipherSetKey ctx k + bsz <- blockCipherBlockSize ctx + msg <- systemRNGGet $ bsz * 10 + encmsg <- blockCipherEncryptBlocks ctx msg + let encmsgCorrupted = BS.take (BS.length encmsg - 1) encmsg + blockCipherDecryptBlocks ctx encmsgCorrupted + `shouldThrow` anyErrorCall + +allTestBlockCiphers :: [BlockCipherName] +allTestBlockCiphers = fmap adjust allBlockCiphers + where + adjust Cascade = cascade Serpent AES256 + adjust Lion = lion SHA1 "RC4" (Just 64) + adjust name = name diff --git a/test/Test/Botan/Low/Cipher.hs b/test/Test/Botan/Low/Cipher.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/Cipher.hs @@ -0,0 +1,244 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deprecations #-} + +module Test.Botan.Low.Cipher (tests) where + +import Botan.Bindings.Version (botan_version_major, + botan_version_minor) +import Botan.Low.Cipher +import Botan.Low.RNG +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import System.IO.Unsafe (unsafePerformIO) +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_cipher" spec_cipher + pure $ testGroup "Test.Botan.Low.Cipher" [ + specs + ] + +testModes :: [ByteString] +testModes = filter p (cipherModes ++ aeads) + where + p s + -- TODO: also test "Lion" and "Cascade" + | "Lion" `BS.isPrefixOf` s || "Cascade" `BS.isPrefixOf` s + = False + -- SIV and CCM have bugs on versions earlier than 3.5 + | unsafePerformIO botan_version_major == 3 + , unsafePerformIO botan_version_minor <= 4 + , "SIV" `BS.isSuffixOf` s || "CCM" `BS.isSuffixOf` s + = False + | otherwise + = True + +spec_cipher :: Spec +spec_cipher = testSuite testModes chars $ \ cipher -> do + it "can initialize a cipher encryption context" $ do + _ctx <- cipherInit cipher CipherEncrypt + pass + it "can initialize a cipher decryption context" $ do + _ctx <- cipherInit cipher CipherDecrypt + pass + it "has a name" $ do + ctx <- cipherInit cipher CipherEncrypt + _name <- cipherName ctx + -- name `shouldBe` bc -- Name expands to include default parameters - need to record + pass + it "has a key spec" $ do + ctx <- cipherInit cipher CipherEncrypt + (_,_,_) <- cipherGetKeyspec ctx + pass + it "can set the key" $ do + ctx <- cipherInit cipher CipherEncrypt + (_,mx,_) <- cipherGetKeyspec ctx + k <- systemRNGGet mx + cipherSetKey ctx k + pass + it "has a valid default nonce length" $ do + ctx <- cipherInit cipher CipherEncrypt + _nlen <- cipherGetDefaultNonceLength ctx + pass + it "can validate nonce length" $ do + ctx <- cipherInit cipher CipherEncrypt + nlen <- cipherGetDefaultNonceLength ctx + defaultIsValid <- cipherValidNonceLength ctx nlen + defaultIsValid `shouldBe` True + -- NOTE: Some ciphers accept nonces of any length, eg SIV + -- Others allow any length > 0, eg GCM + -- Some have ranges + -- Some have just 'if (length == 0) return false;' eg OCB + -- Search C++ source for 'valid_nonce_length' to find them all + -- zeroIsValid <- cipherValidNonceLength ctx 0 + -- zeroIsValid `shouldBe` False + -- absurdlyLargeIsValid <- cipherValidNonceLength ctx maxBound + -- absurdlyLargeIsValid `shouldBe` False + pass + it "can calculate output length" $ do + ctx <- cipherInit cipher CipherEncrypt + _olen <- cipherOutputLength ctx 1024 + pass + -- NOTE: This check should be ae / aead only + it "has a tag length" $ do + ctx <- cipherInit cipher CipherEncrypt + _ <- cipherGetTagLength ctx + pass + it "has an update graularity" $ do + ctx <- cipherInit cipher CipherEncrypt + _ <- cipherGetUpdateGranularity ctx + pass + it "has an ideal update granularity" $ do + ctx <- cipherInit cipher CipherEncrypt + _ <- cipherGetIdealUpdateGranularity ctx + pass + if cipher `elem` aeads + then it "can set the associated data" $ do + ctx <- cipherInit cipher CipherEncrypt + -- NOTE: Undocumented: A cipher must set the key before setting AD + (_,mx,_) <- cipherGetKeyspec ctx + k <- systemRNGGet mx + cipherSetKey ctx k + -- END NOTE + ad <- systemRNGGet 64 + cipherSetAssociatedData ctx ad + pass + else pass + it "can reset all message state" $ do + ctx <- cipherInit cipher CipherEncrypt + cipherReset ctx + pass + it "can clear all internal state" $ do + ctx <- cipherInit cipher CipherEncrypt + cipherClear ctx + pass + it "can start processing a message" $ do + ctx <- cipherInit cipher CipherEncrypt + (_,mx,_) <- cipherGetKeyspec ctx + k <- systemRNGGet mx + cipherSetKey ctx k + if cipher `elem` aeads + then do + ad <- systemRNGGet 64 + cipherSetAssociatedData ctx ad + else pass + n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx + cipherStart ctx n + pass + -- TODO: More extensive testing in Botan; these are just binding sanity checks + it "can one-shot / offline encipher a message" $ do + ctx <- cipherInit cipher CipherEncrypt + (_,mx,_) <- cipherGetKeyspec ctx + k <- systemRNGGet mx + cipherSetKey ctx k + if cipher `elem` aeads + then do + ad <- systemRNGGet 64 + cipherSetAssociatedData ctx ad + else pass + n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx + cipherStart ctx n + g <- cipherGetIdealUpdateGranularity ctx + msg <- systemRNGGet g + _encmsg <- cipherEncrypt ctx msg + pass + it "can one-shot / offline decipher a message" $ do + -- Same as prior test + ctx <- cipherInit cipher CipherEncrypt + (_,mx,_) <- cipherGetKeyspec ctx + k <- systemRNGGet mx + cipherSetKey ctx k + ad <- systemRNGGet 64 + if cipher `elem` aeads + then do + cipherSetAssociatedData ctx ad + else pass + n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx + cipherStart ctx n + g <- cipherGetIdealUpdateGranularity ctx + msg <- systemRNGGet g + encmsg <- cipherEncrypt ctx msg + -- Start actual test + dctx <- cipherInit cipher CipherDecrypt + cipherSetKey dctx k + if cipher `elem` aeads + then do + cipherSetAssociatedData dctx ad + else pass + cipherStart dctx n + decmsg <- cipherDecrypt dctx encmsg + msg `shouldBe` decmsg + pass + it "can incrementally / online encipher a message" $ do + -- Same as prior test + ctx <- cipherInit cipher CipherEncrypt + (_,mx,_) <- cipherGetKeyspec ctx + k <- systemRNGGet mx + cipherSetKey ctx k + ad <- systemRNGGet 64 + if cipher `elem` aeads + then do + cipherSetAssociatedData ctx ad + else pass + n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx + cipherStart ctx n + g <- cipherGetIdealUpdateGranularity ctx + msg <- systemRNGGet (8 * g) + _encmsg <- cipherEncryptOnline ctx msg + pass + -- NOTE: Fails for SIV, CCM because they are offline-only algorithms + -- This is expected, but not reflected in the tests yet + it "can incrementally / online decipher a message" $ do + ctx <- cipherInit cipher CipherEncrypt + (_,mx,_) <- cipherGetKeyspec ctx + k <- systemRNGGet mx + cipherSetKey ctx k + ad <- systemRNGGet 64 + if cipher `elem` aeads + then do + cipherSetAssociatedData ctx ad + else pass + n <- systemRNGGet =<< cipherGetDefaultNonceLength ctx + cipherStart ctx n + g <- cipherGetIdealUpdateGranularity ctx + msg <- systemRNGGet (8 * g) + encmsg <- cipherEncryptOnline ctx msg + -- Start actual test + dctx <- cipherInit cipher CipherDecrypt + cipherSetKey dctx k + if cipher `elem` aeads + then do + cipherSetAssociatedData dctx ad + else pass + cipherStart dctx n + decmsg <- cipherDecryptOnline dctx encmsg + msg `shouldBe` decmsg + pass + -- NOTE: Fails for SIV, CCM because they are offline-only algorithms + -- This is expected, but not reflected in the tests yet + it "has parity between online and offline" $ do + onlinectx <- cipherInit cipher CipherEncrypt + offlinectx <- cipherInit cipher CipherEncrypt + (_,mx,_) <- cipherGetKeyspec onlinectx + k <- systemRNGGet mx + cipherSetKey onlinectx k + cipherSetKey offlinectx k + ad <- systemRNGGet 64 + when (cipher `elem` aeads) $ do + cipherSetAssociatedData onlinectx ad + cipherSetAssociatedData offlinectx ad + n <- systemRNGGet =<< cipherGetDefaultNonceLength onlinectx + cipherStart onlinectx n + cipherStart offlinectx n + g <- cipherGetIdealUpdateGranularity onlinectx + msg <- systemRNGGet (8 * g) + onlinemsg <- cipherEncryptOnline onlinectx msg + offlinemsg <- cipherEncrypt offlinectx msg + onlinemsg `shouldBe` offlinemsg + pass diff --git a/test/Test/Botan/Low/FPE.hs b/test/Test/Botan/Low/FPE.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/FPE.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.FPE (tests) where + +import Botan.Low.FPE +import Botan.Low.MPI +import Botan.Low.RNG +import Control.Monad +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_fpe" spec_fpe + pure $ testGroup "Test.Botan.Low.FPE" [ + specs + ] + +-- NOTE: FPE operations encrypt/decrypt integers less than n +nStr :: ByteString +nStr = "1000000000000" + +key :: ByteString +key = "0000DEADBEEF0000" + +rounds :: Int +rounds = 3 + +newRng :: IO RNG +newRng = rngInit "system" + +newX :: MP -> IO MP +newX n = do + x <- mpInit + z <- mpInit + mpSetFromInt z 0 + -- n <- mpInit + -- mpSetFromStr n nStr + rng <- newRng + mpRandRange x rng z n + return x + +newFE1Ctx :: IO (MP, FPE) +newFE1Ctx = do + n <- mpInit + mpSetFromStr n nStr + ctx <- fpeInitFE1 n key rounds FPENone + return (n,ctx) + +newFE1CtxCompatMode :: IO (MP, FPE) +newFE1CtxCompatMode = do + n <- mpInit + mpSetFromStr n nStr + ctx <- fpeInitFE1 n key rounds FPEFE1CompatMode + return (n,ctx) + +spec_fpe :: Spec +spec_fpe = do + describe "fpeInitFE1" $ do + it "initializes an FE1 FPE context" $ do + void newFE1Ctx + pass + it "initializes an FE1 FPE context in compat mode" $ (do + void newFE1CtxCompatMode + pass + ) -- `shouldThrow` anyBotanException + describe "fpeEncrypt" $ do + it "performs format-preserving encryption" $ do + (n,ctx) <- newFE1Ctx + x <- newX n + y <- mpCopy x + fpeEncrypt ctx y "" + isSame <- mpEqual x y + isSame `shouldBe` False + pass + it "performs format-preserving encryption in compat mode" $ do + (n,ctx) <- newFE1CtxCompatMode + x <- newX n + y <- mpCopy x + fpeEncrypt ctx y "" + isSame <- mpEqual x y + isSame `shouldBe` False + pass + describe "fpeDecrypt" $ do + it "performs format-preserving decryption" $ do + (n,ctx) <- newFE1Ctx + x <- newX n + y <- mpCopy x + fpeEncrypt ctx y "" + z <- mpCopy y + fpeDecrypt ctx z "" + isSame <- mpEqual x z + isSame `shouldBe` True + pass + it "performs format-preserving decryption in compat mode" $ do + (n,ctx) <- newFE1CtxCompatMode + x <- newX n + y <- mpCopy x + fpeEncrypt ctx y "" + z <- mpCopy y + fpeDecrypt ctx z "" + isSame <- mpEqual x z + isSame `shouldBe` True + pass diff --git a/test/Test/Botan/Low/HOTP.hs b/test/Test/Botan/Low/HOTP.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/HOTP.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.HOTP (tests) where + +import Botan.Low.HOTP +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_HOTP" spec_HOTP + pure $ testGroup "Test.Botan.Low.HOTP" [ + specs + ] + +key :: ByteString +key = "Fee fi fo fum" + +counter :: HOTPCounter +counter = 12345 + +spec_HOTP :: Spec +spec_HOTP = testSuite hotpHashes chars $ \ h -> do + it "hotpInit" $ do + _ctx <- hotpInit key h 6 + pass + it "hotpGenerate" $ do + ctx <- hotpInit key h 6 + _code <- hotpGenerate ctx counter + pass + it "hotpCheck" $ do + ctx <- hotpInit key h 6 + code <- hotpGenerate ctx counter + (success,_next) <- hotpCheck ctx code counter 0 + success `shouldBe` True diff --git a/test/Test/Botan/Low/Hash.hs b/test/Test/Botan/Low/Hash.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/Hash.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.Hash (tests) where + +import Botan.Low.Hash +import Control.Monad +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_hash" spec_hash + pure $ testGroup "Test.Botan.Low.Hash" [ + specs + ] + +message :: ByteString +message = "Fee fi fo fum! I smell the blood of an Englishman!" + +spec_hash :: Spec +spec_hash = testSuite allHashes chars $ \ h -> do + it "can initialize a hash context" $ do + _ctx <- hashInit h + pass + it "has a name" $ do + ctx <- hashInit h + _name <- hashName ctx + pass + it "has an output length" $ do + ctx <- hashInit h + _olen <- hashOutputLength ctx + pass + it "can copy the internal state" $ do + ctx <- hashInit h + -- TODO: Populate with state and actually prove + _ctx' <- hashCopyState ctx + pass + it "can clear all internal state" $ do + ctx <- hashInit h + -- TODO: Populate with state and actually prove + hashClear ctx + pass + it "can update the internal state with a single message block" $ do + ctx <- hashInit h + hashUpdate ctx message + pass + it "can update the internal state with multiple message blocks" $ do + ctx <- hashInit h + forM_ (splitBlocks 4 message) $ hashUpdate ctx + pass + it "can finalize a digest" $ do + ctx <- hashInit h + hashUpdate ctx message + _d <- hashFinal ctx + pass diff --git a/test/Test/Botan/Low/KDF.hs b/test/Test/Botan/Low/KDF.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/KDF.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.KDF (tests) where + +import Botan.Low.KDF +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_kdf" spec_kdf + pure $ testGroup "Test.Botan.Low.KDF" [ + specs + ] + + +-- NOTE: Many of these tests fail because different kdfs / macs / hashes have different requirements +-- such as input or output lengths. +-- Failing tests: +-- - Checksums: Adler32, CRC24, CRC32, BadParameterException for almost everything +-- - Probably because they are not cryptographic hashes +-- - All fail for HKDF, SP800-108-*(HMAC(hash)), SP800-56A(hash), SP800-56A(HMAC(hash)), SP800-56C(hash), SP800-56C(HMAC(hash)) +-- - CRC24 fails for KDF1, probably because we asked for 4 bits +-- - HKDF-Extract - BadParameterException for unknown reasons +-- - X9.42-PRF: About half fail with NotImplementedException +-- - SP800-108-*: Requires HMAC wrapping, may support other MACs? +-- - SP800-56A / SP800-56C: Allow HMAC wrapping, may support other MACs? +-- Many do accept HMAC(hash) as an argument instead of just hash +-- It is not yet known which if any MACs work aside from HMAC (eg whether anything with CMAC, GMAC does) due to non-exhaustive +-- enumeration of MACs in their own tests. +-- SP800 KDFs fail with InvalidKeyLengthException for X9.19-MAC, Poly1305, SipHash(2,4) +-- except for SP800-56A which fails with NotImplementedException +-- TODO: Exhaustive algorithm testing (see Botan.KDF notes) + +-- NOTE: Some kdfs (HKDF-Extract) do not support label input arguments +spec_kdf :: Spec +spec_kdf = testSuite kdfs chars $ \ algo -> do + describe "kdf" $ do + it "can derive a key" $ do + _key <- kdf algo 3 "secret" "salt" "" -- "label" + pass diff --git a/test/Test/Botan/Low/KeyWrap.hs b/test/Test/Botan/Low/KeyWrap.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/KeyWrap.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.KeyWrap (tests) where + +import Botan.Low.BlockCipher +import Botan.Low.KeyWrap +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_keywrap" spec_keywrap + pure $ testGroup "Test.Botan.Low.KeyWrap" [ + specs + ] +kwKey :: ByteString +kwKey = "This key *must* be a multiple of 8 bytes" + +kwpKey :: ByteString +kwpKey = "Fee fi fo fum! I smell the blood of an Englishman!" + +spec_keywrap :: Spec +spec_keywrap = testSuite blockCipher128s chars $ \ algo -> do + it "nistKeyWrapEncode" $ do + (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo + kek <- systemRNGGet keklen + _wrappedKey <- nistKeyWrapEncode algo 0 kwKey kek + pass + it "nistKeyWrapDecode" $ do + (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo + kek <- systemRNGGet keklen + wrappedKey <- nistKeyWrapEncode algo 0 kwKey kek + unwrappedKey <- nistKeyWrapDecode algo 0 wrappedKey kek + unwrappedKey `shouldBe` kwKey + pass + it "nistKeyWrapEncode padded" $ do + (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo + kek <- systemRNGGet keklen + _wrappedKey <- nistKeyWrapEncode algo 1 kwpKey kek + pass + it "nistKeyWrapDecode padded" $ do + (_,keklen,_) <- blockCipherGetKeyspec =<< blockCipherInit algo + kek <- systemRNGGet keklen + wrappedKey <- nistKeyWrapEncode algo 1 kwpKey kek + unwrappedKey <- nistKeyWrapDecode algo 1 wrappedKey kek + unwrappedKey `shouldBe` kwpKey + pass diff --git a/test/Test/Botan/Low/MAC.hs b/test/Test/Botan/Low/MAC.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/MAC.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.MAC (tests) where + +import Botan.Low.MAC +import Botan.Low.RNG +import Control.Monad +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_mac" spec_mac + pure $ testGroup "Test.Botan.Low.MAC" [ + specs + ] + +-- NOTE: Full testing of all algorithms will require botan ADT types instead +-- of names, to be able to query for acceptable key and nonce parameters + +-- nonceMACs :: [(MACName, Maybe Int)] +-- nonceMACs = concat +-- [ [ "CMAC(" <> bc <> ")" | bc <- allBlockCiphers ] +-- , [ "GMAC(" <> bc <> ")" | bc <- allBlockCiphers ] +-- , [ "CBC-MAC(" <> bc <> ")" | bc <- allBlockCiphers ] +-- ] + +-- macs :: [(MACName, Maybe Int)] +-- macs = concat +-- [ nonceMACs +-- , [ "HMAC(" <> h <> ")" | h <- hashes ] +-- , [ "Poly1305", "SipHash(2,4)", "X9.19-MAC" ] +-- ] + +macsAndNonceSzs :: [(MACName, Int)] +macsAndNonceSzs = + [ ("CMAC(AES-256)", 0) + , ("GMAC(AES-256)", 16) + -- , ("CBC-MAC(AES-256)", 16) -- Not supported + , ("HMAC(SHA-3)", 0) + , ("Poly1305", 0) + , ("SipHash(2,4)", 0) + , ("X9.19-MAC", 0) + ] + +message :: ByteString +message = "Fee fi fo fum! I smell the blood of an Englishman!" + +spec_mac :: Spec +spec_mac = testSuite macsAndNonceSzs (chars . fst) $ \ (h,nonceSz) -> do + it "can initialize a mac context" $ do + _ctx <- macInit h + pass + it "has a name" $ do + ctx <- macInit h + _name <- macName ctx + pass + it "has an output length" $ do + ctx <- macInit h + _olen <- macOutputLength ctx + pass + -- it "can copy the internal state" $ do + -- ctx <- macInit h + -- -- TODO: Populate with state and actually prove + -- ctx' <- macCopyState ctx + -- pass + it "has a key spec" $ do + ctx <- macInit h + (_,_,_) <- macGetKeyspec ctx + pass + it "can set the key" $ do + ctx <- macInit h + (_,mx,_) <- macGetKeyspec ctx + k <- systemRNGGet mx + macSetKey ctx k + pass + -- it "has a nonce spec" $ do + it "can set the nonce" $ do + if nonceSz > 0 + then do + ctx <- macInit h + (_,mx,_) <- macGetKeyspec ctx + k <- systemRNGGet mx + macSetKey ctx k + n <- systemRNGGet nonceSz + macSetNonce ctx n + else pass + it "can clear all internal state" $ do + ctx <- macInit h + (_,mx,_) <- macGetKeyspec ctx + k <- systemRNGGet mx + macSetKey ctx k + if nonceSz > 0 + then do + n <- systemRNGGet nonceSz + macSetNonce ctx n + else pass + -- TODO: Populate with state and actually prove + macClear ctx + pass + it "can update the internal state with a single message block" $ do + ctx <- macInit h + (_,mx,_) <- macGetKeyspec ctx + k <- systemRNGGet mx + macSetKey ctx k + if nonceSz > 0 + then do + n <- systemRNGGet nonceSz + macSetNonce ctx n + else pass + macUpdate ctx message + pass + it "can update the internal state with multiple message blocks" $ do + ctx <- macInit h + (_,mx,_) <- macGetKeyspec ctx + k <- systemRNGGet mx + macSetKey ctx k + if nonceSz > 0 + then do + n <- systemRNGGet nonceSz + macSetNonce ctx n + else pass + forM_ (splitBlocks 4 message) $ macUpdate ctx + pass + it "can finalize a digest" $ do + ctx <- macInit h + (_,mx,_) <- macGetKeyspec ctx + k <- systemRNGGet mx + macSetKey ctx k + if nonceSz > 0 + then do + n <- systemRNGGet nonceSz + macSetNonce ctx n + else pass + macUpdate ctx message + _d <- macFinal ctx + pass diff --git a/test/Test/Botan/Low/MPI.hs b/test/Test/Botan/Low/MPI.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/MPI.hs @@ -0,0 +1,394 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.MPI (tests) where + +import Botan.Low.MPI +import Botan.Low.RNG +import Prelude hiding (mod) +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_mpi" spec_mpi + pure $ testGroup "Test.Botan.Low.MPI" [ + specs + ] + +-- NOTE: These unit tests are mostly checking that the functions are bound correctly. +-- These are kind of crappy and repetative, but that also exposes what needs to be done +-- in the higher libraries to make things ergonomic. + +spec_mpi :: Spec +spec_mpi = do + it "can initialize a mutable MPI reference" $ do + _mp <- mpInit + pass + it "can set the value from an int" $ do + mp <- mpInit + mpSetFromInt mp 512 + pass + it "can set the value from another reference" $ do + mp <- mpInit + mpSetFromInt mp 512 + mp' <- mpInit + mpSetFromMP mp' mp + isEqual <- mpEqual mp mp' + isEqual `shouldBe` True + pass + it "can be converted to a hex string" $ do + mp <- mpInit + mpSetFromInt mp 512 + hex <- mpToHex mp + hex `shouldBe` "0x0200" + hex' <- mpToStr mp 16 + hex' `shouldBe` "0x0200" + pass + it "can be converted to a decimal string" $ do + mp <- mpInit + mpSetFromInt mp 512 + dec <- mpToStr mp 10 + dec `shouldBe` "512" + pass + it "can be cleared to zero" $ do + mp <- mpInit + mpSetFromInt mp 512 + mpClear mp + zero <- mpInit + mpSetFromInt zero 0 + isClear <- mpEqual mp zero + isClear `shouldBe` True + pass + it "can copy the value to a new reference" $ do + mp <- mpInit + mpSetFromInt mp 512 + mp' <- mpCopy mp + isEqual <- mpEqual mp mp' + isEqual `shouldBe` True + pass + it "can set the value from a decimal string" $ do + mp <- mpInit + mpSetFromStr mp "512" + mp' <- mpInit + mpSetFromInt mp' 512 + isEqualStr <- mpEqual mp mp' + isEqualStr `shouldBe` True + mpSetFromRadixStr mp "512" 10 + isEqualRadixStr <- mpEqual mp mp' + isEqualRadixStr `shouldBe` True + pass + it "can set the value from a hex string" $ do + mp <- mpInit + mpSetFromStr mp "0x0200" + mp' <- mpInit + mpSetFromInt mp' 512 + isEqualStr <- mpEqual mp mp' + isEqualStr `shouldBe` True + mpSetFromRadixStr mp "0200" 16 -- NOTE: Lack of "0x" prefix + isEqualRadixStr <- mpEqual mp mp' + isEqualRadixStr `shouldBe` True + pass + it "has a number of bits" $ do + mp <- mpInit + mpSetFromStr mp "512" + n <- mpNumBits mp + n `shouldBe` 10 + pass + it "has a number of bytes" $ do + mp <- mpInit + mpSetFromStr mp "512" + n <- mpNumBytes mp + n `shouldBe` 2 + pass + it "can be converted to a bytestring" $ do + mp <- mpInit + mpSetFromInt mp 512 + bin <- mpToBin mp + bin `shouldBe` "\STX\NUL" -- NOTE: 0b 0000 0010 0000 0000 + pass + it "can set the value from a bytestring" $ do + mp <- mpInit + mpFromBin mp "\STX\NUL" + mp' <- mpInit + mpSetFromInt mp' 512 + isEqual <- mpEqual mp mp' + isEqual `shouldBe` True + pass + it "can be converted to a 32-bit word" $ do + mp <- mpInit + mpSetFromInt mp 512 + w <- mpToWord32 mp + w `shouldBe` 512 + pass + -- NOTE: Returns whether x >= 0, not x > 0 because 0 is treated as positive. + it "can check if a value is positive" $ do + n <- mpInit + mpSetFromInt n (-512) + nIsPositive <- mpIsPositive n + nIsPositive `shouldBe` False + z <- mpInit + mpSetFromInt z 0 + zIsPositive <- mpIsPositive z + zIsPositive `shouldBe` True + p <- mpInit + mpSetFromInt p 512 + pIsPositive <- mpIsPositive p + pIsPositive `shouldBe` True + pass + it "can check if a value is negative" $ do + n <- mpInit + mpSetFromInt n (-512) + nIsPositive <- mpIsNegative n + nIsPositive `shouldBe` True + z <- mpInit + mpSetFromInt z 0 + zIsPositive <- mpIsNegative z + zIsPositive `shouldBe` False + p <- mpInit + mpSetFromInt p 512 + pIsPositive <- mpIsNegative p + pIsPositive `shouldBe` False + pass + it "can flip the sign of a value" $ do + p <- mpInit + mpSetFromInt p 512 + n <- mpInit + mpSetFromInt n (-512) + mpFlipSign p + _isEqual <- mpEqual p n + pass + it "can check whether a value is zero" $ do + mp <- mpInit + mpSetFromInt mp 512 + isZeroA <- mpIsZero mp + isZeroA `shouldBe` False + mpSetFromInt mp 0 + isZeroB <- mpIsZero mp + isZeroB `shouldBe` True + mpSetFromInt mp (-512) + isZeroC <- mpIsZero mp + isZeroC `shouldBe` False + pass + it "can add a 32-bit word to the value and store the result" $ do + mp <- mpInit + mpSetFromInt mp 512 + mp' <- mpInit + mpAddWord32 mp' mp 512 + result <- mpToWord32 mp' + result `shouldBe` 1024 + pass + it "can subtract a 32-bit word from the value and store the result" $ do + mp <- mpInit + mpSetFromInt mp 512 + mp' <- mpInit + mpSubWord32 mp' mp 512 + result <- mpToWord32 mp' + result `shouldBe` 0 + pass + it "can add one value to another and store the result" $ do + a <- mpInit + mpSetFromInt a 512 + b <- mpInit + mpSetFromInt b 512 + c <- mpInit + mpAdd c a b + result <- mpToWord32 c + result `shouldBe` 1024 + pass + it "can subtract one value from another and store the result" $ do + a <- mpInit + mpSetFromInt a 512 + b <- mpInit + mpSetFromInt b 512 + c <- mpInit + mpSub c a b + result <- mpToWord32 c + result `shouldBe` 0 + pass + it "can multiply one value by another and store the result" $ do + a <- mpInit + mpSetFromInt a 512 + b <- mpInit + mpSetFromInt b 512 + c <- mpInit + mpMul c a b + result <- mpToWord32 c + result `shouldBe` 262144 + pass + it "can divide one value by another and store the result" $ do + a <- mpInit + mpSetFromInt a 512 + b <- mpInit + mpSetFromInt b 512 + q <- mpInit + r <- mpInit + mpDiv q r a b + quotient <- mpToWord32 q + quotient `shouldBe` 1 + remainder <- mpToWord32 r + remainder `shouldBe` 0 + pass + it "can perform multiplication and modulus at the same time and store the result" $ do + r <- mpInit + x <- mpInit + mpSetFromInt x 2 + y <- mpInit + mpSetFromInt y 4 + mod <- mpInit + mpSetFromInt mod 7 + mpModMul r x y mod + result <- mpToWord32 r + result `shouldBe` 1 + pass + it "can check whether two values are equal" $ do + a <- mpInit + mpSetFromInt a 512 + b <- mpInit + mpSetFromInt b 512 + c <- mpInit + mpSetFromInt c 256 + abEqual <- mpEqual a b + abEqual `shouldBe` True + bcEqual <- mpEqual b c + bcEqual `shouldBe` False + pass + it "can compare two values for order" $ do + n <- mpInit + mpSetFromInt n (-1) + z <- mpInit + mpSetFromInt z 0 + p <- mpInit + mpSetFromInt p 1 + nz <- mpCmp n z + nz `shouldBe` -1 + zp <- mpCmp z p + zp `shouldBe` -1 + np <- mpCmp n p + np `shouldBe` -1 + nn <- mpCmp n n + nn `shouldBe` 0 + zz <- mpCmp z z + zz `shouldBe` 0 + pp <- mpCmp p p + pp `shouldBe` 0 + pz <- mpCmp p z + pz `shouldBe` 1 + zn <- mpCmp z n + zn `shouldBe` 1 + pn <- mpCmp p n + pn `shouldBe` 1 + pass + it "can swap the values of two references" $ do + a <- mpInit + mpSetFromInt a 512 + b <- mpInit + mpSetFromInt b 256 + mpSwap a b + a' <- mpToWord32 a + a' `shouldBe` 256 + b' <- mpToWord32 b + b' `shouldBe` 512 + pass + it "can perform exponentiation and modulus at the same time and store the result" $ do + r <- mpInit + x <- mpInit + mpSetFromInt x 2 + y <- mpInit + mpSetFromInt y 4 + mod <- mpInit + mpSetFromInt mod 7 + mpPowMod r x y mod + result <- mpToWord32 r + result `shouldBe` 2 + pass + it "can perform a left shift and store the result" $ do + mp <- mpInit + result <- mpInit + mpSetFromInt mp 512 + mpLeftShift result mp 3 + r <- mpToWord32 result + r `shouldBe` 4096 + pass + it "can perform a right shift and store the result" $ do + mp <- mpInit + result <- mpInit + mpSetFromInt mp 512 + mpRightShift result mp 3 + r <- mpToWord32 result + r `shouldBe` 64 + pass + it "can compute the modular inverse" $ do + result <- mpInit + x <- mpInit + mpSetFromInt x 29 + mod <- mpInit + mpSetFromInt mod 65535 + -- x needs to be smaller than mod + mpModInverse result x mod + r <- mpToWord32 result + r `shouldBe` 13559 + pass + it "can generate a number of random bits" $ do + mp <- mpInit + rng <- rngInit "system" + mpRandBits mp rng 9 + r <- mpToWord32 mp + 0 <= r && r < 512 `shouldBe` True + pass + it "can generate a random value within a range [lower,upper)" $ do + result <- mpInit + rng <- rngInit "system" + lower <- mpInit + mpSetFromInt lower 4 + upper <- mpInit + mpSetFromInt upper 8 + mpRandRange result rng lower upper + isGTELower <- (<= 0) <$> mpCmp lower result + isGTELower `shouldBe` True + isLTUpper <- (== -1) <$> mpCmp result upper + isLTUpper `shouldBe` True + pass + it "can calculate the greatest common divisor of a value" $ do + r <- mpInit + x <- mpInit + mpSetFromInt x 35 + y <- mpInit + mpSetFromInt y 21 + mpGCD r x y + result <- mpToWord32 r + result `shouldBe` 7 + pass + it "can probabilistically calculate whether a value is prime" $ do + mp <- mpInit + rng <- rngInit "system" + mpSetFromInt mp 131 + isPrime131 <- mpIsPrime mp rng 100 + isPrime131 `shouldBe` True + mpSetFromInt mp 133 + isPrime133 <- mpIsPrime mp rng 100 + isPrime133 `shouldBe` False + pass + it "can get the value of a single bit" $ do + mp <- mpInit + mpSetFromInt mp 512 + f <- mpGetBit mp 8 + f `shouldBe` False + t <- mpGetBit mp 9 + t `shouldBe` True + pass + it "can set the value of a single bit (set it to 1)" $ do + mp <- mpInit + mpSetFromInt mp 512 + mpSetBit mp 8 + result <- mpToWord32 mp + result `shouldBe` 768 + pass + it "can clear the value of a single bit (set it to 0)" $ do + mp <- mpInit + mpSetFromInt mp 768 + mpClearBit mp 8 + result <- mpToWord32 mp + result `shouldBe` 512 + pass diff --git a/test/Test/Botan/Low/PubKey.hs b/test/Test/Botan/Low/PubKey.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.RNG +import Control.Monad +import Data.ByteString +import Data.String +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_pubKey" spec_pubKey + pure $ testGroup "Test.Botan.Low.PubKey" [ + specs + ] + +ecGroup :: ByteString +ecGroup = "secp256r1" + +dlGroup :: ByteString +dlGroup = "modp/ietf/1024" + +-- TODO: More exhaustive testing in botan +-- pks :: [(PKName, PKParams)] +pks :: [(ByteString, ByteString)] +pks = + [ ("RSA", "2048") + , ("SM2", ecGroup) + , ("ElGamal", dlGroup) + , ("DSA", dlGroup) + , ("ECDSA", ecGroup) + , ("ECKCDSA", ecGroup) + , ("ECGDSA", ecGroup) + , ("GOST-34.10", ecGroup) + , ("Ed25519", "") + , ("XMSS", "XMSS-SHAKE_10_256") -- NOTE: XMSS is noticeably slower than other keys and + -- the _16 and _20 variants are exponentially slower + , ("DH", dlGroup) + , ("ECDH", ecGroup) + , ("Curve25519", "") + -- TODO: Dilithium-x-y + , ("Dilithium", "") + -- TODO: Kyber-x-y + , ("Kyber", "") + -- TODO: SPHINCS+ + -- https://github.com/randombit/botan/blob/a303f4af1504e7ac349dd798190924ea08ead9b7/src/lib/pubkey/sphincsplus/sphincsplus_common/sp_parameters.cpp#L155 + -- , ("SPHINCS+", "sha2-128s-r3.1") -- Not working + , ("McEliece", "") + ] + +pkTestName :: (ByteString, ByteString) -> String +pkTestName (pk, param) = chars $ pk <> " " <> param + +-- NOTE: Known fields are: n, e, p, q, g, a, b +-- ECGroup PrivKey: x plus all in PubKey +-- EGGroup PubKey: public_x, public_y, base_x, base_y, p, a, b, cofactor, order +-- DLGroup PubKey: p, q, g, y (not all groups have all four) +-- DLGroup PrivKey: p, q, g, x, y +-- RSA PubKey: p, q, d, c, d1, d2 +-- RSA PrivKey: n, e, d, p, q, d1, d2, c + +ecGroupPrivFields :: [ByteString] +ecGroupPrivFields = [ "x" , "public_x", "public_y", "base_x", "base_y", "p", "a", "b", "cofactor", "order" ] +ecGroupPubFields :: [ByteString] +ecGroupPubFields = [ "public_x", "public_y", "base_x", "base_y", "p", "a", "b", "cofactor", "order" ] + +dlGroupPrivFields :: [ByteString] +dlGroupPrivFields = [ "p", "q", "g", "x", "y" ] +dlGroupPubFields :: [ByteString] +dlGroupPubFields = [ "p", "q", "g", "y" ] + +privKeyFields :: (Eq a, IsString a) => a -> [ByteString] +privKeyFields "RSA" = [ "p", "q", "d", "n", "e"] -- TODO: Check +privKeyFields "SM2" = ecGroupPrivFields +privKeyFields "ElGamal" = dlGroupPrivFields +privKeyFields "DSA" = dlGroupPrivFields +privKeyFields "ECDSA" = ecGroupPrivFields +privKeyFields "ECKCDSA" = ecGroupPrivFields +privKeyFields "ECGDSA" = ecGroupPrivFields +privKeyFields "GOST-34.10" = ecGroupPrivFields +privKeyFields "Ed25519" = [] -- TODO +privKeyFields "XMSS" = [] -- TODO +privKeyFields "DH" = dlGroupPrivFields +privKeyFields "ECDH" = ecGroupPrivFields +privKeyFields "Curve25519" = [] -- TODO +privKeyFields "Dilithium" = [] -- TODO +privKeyFields "Kyber" = [] -- TODO +privKeyFields "McEliece" = [] -- TODO +privKeyFields _ = error "privKeyFields" + +pubKeyFields :: (Eq a, IsString a) => a -> [ByteString] +pubKeyFields "RSA" = [ "n", "e" ] +pubKeyFields "SM2" = ecGroupPubFields +pubKeyFields "ElGamal" = dlGroupPubFields +pubKeyFields "DSA" = dlGroupPubFields +pubKeyFields "ECDSA" = ecGroupPubFields +pubKeyFields "ECKCDSA" = ecGroupPubFields +pubKeyFields "ECGDSA" = ecGroupPubFields +pubKeyFields "GOST-34.10" = ecGroupPubFields +pubKeyFields "Ed25519" = [] -- TODO +pubKeyFields "XMSS" = [] -- TODO +pubKeyFields "DH" = dlGroupPubFields +pubKeyFields "ECDH" = ecGroupPubFields +pubKeyFields "Curve25519" = [] -- TODO +pubKeyFields "Dilithium" = [] -- TODO +pubKeyFields "Kyber" = [] -- TODO +pubKeyFields "McEliece" = [] -- TODO +pubKeyFields _ = error "pubKeyFields" + +-- NOTE: These tests are going to be very slow if we create new keys every time +spec_pubKey :: Spec +spec_pubKey = testSuite pks pkTestName $ \ (pk, param) -> do + it "privKeyCreate" $ do + rng <- rngInit "system" + _privKey <- privKeyCreate pk param rng + pass + it "privKeyCheckKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + privKeyCheckKey privKey rng CheckKeyNormalTests + -- privKeyCheckKey privKey rng CheckKeyExpensiveTests + pass + it "privKeyExport" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _privKeyDER <- privKeyExport privKey PrivKeyExportDER + _privKeyPEM <- privKeyExport privKey PrivKeyExportPEM + pass + it "privKeyLoad" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + privKeyDER <- privKeyExport privKey PrivKeyExportDER + privKeyPEM <- privKeyExport privKey PrivKeyExportPEM + void $ privKeyLoad privKeyDER "" + void $ privKeyLoad privKeyPEM "" + pass + it "privKeyAlgoName" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + void $ privKeyAlgoName privKey + pass + it "privKeyExportPubKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _pubKey <- privKeyExportPubKey privKey + pass + it "pubKeyCheckKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + void $ pubKeyCheckKey pubKey rng CheckKeyNormalTests + -- pubKeyCheckKey pubKey rng CheckKeyExpensiveTests + pass + it "pubKeyExport" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + _pubKeyDER <- pubKeyExport pubKey PrivKeyExportDER + _pubKeyPEM <- pubKeyExport pubKey PrivKeyExportPEM + pass + it "pubKeyLoad" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + pubKeyDER <- pubKeyExport pubKey PrivKeyExportDER + pubKeyPEM <- pubKeyExport pubKey PrivKeyExportPEM + void $ pubKeyLoad pubKeyDER + void $ pubKeyLoad pubKeyPEM + pass + it "pubKeyAlgoName" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + void $ pubKeyAlgoName pubKey + pass + it "pubKeyEstimatedStrength" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + void $ pubKeyEstimatedStrength pubKey + pass + it "pubKeyFingerprint" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + void $ pubKeyFingerprint pubKey "SHA-256" + pass + describe "privKeyGetField" $ do + forM_ (privKeyFields pk) $ \ field -> do + it (chars field) $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + mp <- mpInit + privKeyGetField mp privKey field + pass + describe "pubKeyGetField" $ do + forM_ (pubKeyFields pk) $ \ field -> do + it (chars field) $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + mp <- mpInit + pubKeyGetField mp pubKey field + pass diff --git a/test/Test/Botan/Low/PubKey/DH.hs b/test/Test/Botan/Low/PubKey/DH.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/DH.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.DH (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.PubKey.DH +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_dh" spec_dh + pure $ testGroup "Test.Botan.Low.PubKey.DH" [ + specs + ] + +-- TODO: Consolidate +dlGroups :: [ByteString] +dlGroups = + [ "ffdhe/ietf/2048" + , "ffdhe/ietf/3072" + , "ffdhe/ietf/4096" + , "ffdhe/ietf/6144" + , "ffdhe/ietf/8192" + , "modp/ietf/1024" + , "modp/ietf/1536" + , "modp/ietf/2048" + , "modp/ietf/3072" + , "modp/ietf/4096" + , "modp/ietf/6144" + , "modp/ietf/8192" + , "modp/srp/1024" + , "modp/srp/1536" + , "modp/srp/2048" + , "modp/srp/3072" + , "modp/srp/4096" + , "modp/srp/6144" + , "modp/srp/8192" + , "dsa/jce/1024" + , "dsa/botan/2048" + , "dsa/botan/3072" + ] + +-- TODO: Consolidate +privKeyField :: PrivKey -> ByteString -> IO MP +privKeyField privKey field = do + mp <- mpInit + privKeyGetField mp privKey field + return mp + +-- TODO: Consolidate +pubKeyField :: PubKey -> ByteString -> IO MP +pubKeyField pubKey field = do + mp <- mpInit + pubKeyGetField mp pubKey field + return mp + +spec_dh :: Spec +spec_dh = testSuite dlGroups chars $ \ dlGroup -> do + it "privKeyLoadDH" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "DH" dlGroup rng + p <- privKeyField privKey "p" + g <- privKeyField privKey "g" + x <- privKeyField privKey "x" + _loadedKey <- privKeyLoadDH p g x + pass + it "pubKeyLoadDH" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "DH" dlGroup rng + pubKey <- privKeyExportPubKey privKey + p <- pubKeyField pubKey "p" + g <- pubKeyField pubKey "g" + y <- pubKeyField pubKey "y" + _loadedKey <- pubKeyLoadDH p g y + pass diff --git a/test/Test/Botan/Low/PubKey/DSA.hs b/test/Test/Botan/Low/PubKey/DSA.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/DSA.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.DSA (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.PubKey.DSA +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_dsa" spec_dsa + pure $ testGroup "Test.Botan.Low.PubKey.DSA" [ + specs + ] + +-- TODO: Consolidate +dlGroups :: [ByteString] +dlGroups = + [ "dsa/jce/1024" + , "dsa/botan/2048" + , "dsa/botan/3072" + ] + +-- TODO: Consolidate +privKeyField :: PrivKey -> ByteString -> IO MP +privKeyField privKey field = do + mp <- mpInit + privKeyGetField mp privKey field + return mp + +-- TODO: Consolidate +pubKeyField :: PubKey -> ByteString -> IO MP +pubKeyField pubKey field = do + mp <- mpInit + pubKeyGetField mp pubKey field + return mp + +-- NOTE: Fields are +-- DLGroup PubKey: p, q, g, y +-- DLGroup PrivKey: p, q, g, x, y + +-- NOTE: Fails on pubKeyLoadDSA for srp curves (but not privKeyLoadDSA?) +spec_dsa :: Spec +spec_dsa = testSuite dlGroups chars $ \ dlGroup -> do + it "privKeyLoadDSA" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "DSA" dlGroup rng + p <- privKeyField privKey "p" + q <- privKeyField privKey "q" + g <- privKeyField privKey "g" + x <- privKeyField privKey "x" + _loadedKey <- privKeyLoadDSA p q g x + pass + it "pubKeyLoadDSA" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "DSA" dlGroup rng + pubKey <- privKeyExportPubKey privKey + p <- pubKeyField pubKey "p" + q <- pubKeyField pubKey "q" + g <- pubKeyField pubKey "g" + y <- pubKeyField pubKey "y" + _loadedKey <- pubKeyLoadDSA p q g y + pass diff --git a/test/Test/Botan/Low/PubKey/Decrypt.hs b/test/Test/Botan/Low/PubKey/Decrypt.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/Decrypt.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.Decrypt (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.Decrypt +import Botan.Low.PubKey.Encrypt +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_decrypt" spec_decrypt + pure $ testGroup "Test.Botan.Low.PubKey.Decrypt" [ + specs + ] + +pks :: [(ByteString, ByteString, ByteString)] +pks = + [ ("RSA", "2048", "PKCS1v15") + , ("SM2", "sm2p256v1", "SHA-256") -- NOTE: SM2 takes a hash rather than a padding + , ("ElGamal", "modp/ietf/1024", "PKCS1v15") + ] + +pkTestName :: (ByteString, ByteString, ByteString) -> String +pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding + +spec_decrypt :: Spec +spec_decrypt = testSuite pks pkTestName $ \ (pk, param, padding) -> do + it "decryptCreate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _pubKey <- privKeyExportPubKey privKey + _ctx <- decryptCreate privKey padding + pass + it "decryptOutputLength" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _pubKey <- privKeyExportPubKey privKey + ctx <- decryptCreate privKey padding + _ <- decryptOutputLength ctx 128 + pass + it "decrypt" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + ectx <- encryptCreate pubKey padding + dctx <- decryptCreate privKey padding + encrypted <- encrypt ectx rng "Fee fi fo fum!" + decrypted <- decrypt dctx encrypted + decrypted `shouldBe` "Fee fi fo fum!" + pass diff --git a/test/Test/Botan/Low/PubKey/ECDH.hs b/test/Test/Botan/Low/PubKey/ECDH.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/ECDH.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.ECDH (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.PubKey.ECDH +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_ecdh" spec_ecdh + pure $ testGroup "Test.Botan.Low.PubKey.ECDH" [ + specs + ] + +-- TODO: Consolidate +ecGroups :: [ByteString] +ecGroups = + [ "secp160k1" + , "secp160r1" + , "secp160r2" + , "secp192k1" + , "secp192r1" + , "secp224k1" + , "secp224r1" + , "secp256k1" + , "secp256r1" + , "secp384r1" + , "secp521r1" + , "brainpool160r1" + , "brainpool192r1" + , "brainpool224r1" + , "brainpool256r1" + , "brainpool320r1" + , "brainpool384r1" + , "brainpool512r1" + , "x962_p192v2" + , "x962_p192v3" + , "x962_p239v1" + , "x962_p239v2" + , "x962_p239v3" + , "gost_256A" + , "gost_512A" + , "frp256v1" + , "sm2p256v1" + ] + +-- TODO: Consolidate +privKeyField :: PrivKey -> ByteString -> IO MP +privKeyField privKey field = do + mp <- mpInit + privKeyGetField mp privKey field + return mp + +-- TODO: Consolidate +pubKeyField :: PubKey -> ByteString -> IO MP +pubKeyField pubKey field = do + mp <- mpInit + pubKeyGetField mp pubKey field + return mp + +spec_ecdh :: Spec +spec_ecdh = testSuite ecGroups chars $ \ ecGroup -> do + it "privKeyLoadECDH" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "ECDH" ecGroup rng + x <- privKeyField privKey "x" + _loadedPrivKey <- privKeyLoadECDH x ecGroup + -- Inscrutible >_> but shows key equality + -- pubKeyBytes <- privKeyExportPubKey privKey >>= \ pubKey -> pubKeyExport pubKey PubKeyExportPEM + -- loadedPubKeyBytes <- privKeyExportPubKey loadedPrivKey >>= \ loadedPubKey -> pubKeyExport loadedPubKey PubKeyExportPEM + -- pubKeyBytes `shouldBe` loadedPubKeyBytes + pass + it "pubKeyLoadECDH" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "ECDH" ecGroup rng + pubKey <- privKeyExportPubKey privKey + public_x <- pubKeyField pubKey "public_x" + public_y <- pubKeyField pubKey "public_y" + _loadedPubKey <- pubKeyLoadECDH public_x public_y ecGroup + -- pubKeyBytes <- pubKeyExport pubKey PubKeyExportPEM + -- loadedPubKeyBytes <- pubKeyExport loadedPubKey PubKeyExportPEM + -- pubKeyBytes `shouldBe` loadedPubKeyBytes + pass diff --git a/test/Test/Botan/Low/PubKey/ECDSA.hs b/test/Test/Botan/Low/PubKey/ECDSA.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/ECDSA.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.ECDSA (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.PubKey.ECDSA +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_ecdsa" spec_ecdsa + pure $ testGroup "Test.Botan.Low.PubKey.ECDSA" [ + specs + ] + +-- TODO: Consolidate +ecGroups :: [ByteString] +ecGroups = + [ "secp160k1" + , "secp160r1" + , "secp160r2" + , "secp192k1" + , "secp192r1" + , "secp224k1" + , "secp224r1" + , "secp256k1" + , "secp256r1" + , "secp384r1" + , "secp521r1" + , "brainpool160r1" + , "brainpool192r1" + , "brainpool224r1" + , "brainpool256r1" + , "brainpool320r1" + , "brainpool384r1" + , "brainpool512r1" + , "x962_p192v2" + , "x962_p192v3" + , "x962_p239v1" + , "x962_p239v2" + , "x962_p239v3" + , "gost_256A" + , "gost_512A" + , "frp256v1" + , "sm2p256v1" + ] + +-- TODO: Consolidate +privKeyField :: PrivKey -> ByteString -> IO MP +privKeyField privKey field = do + mp <- mpInit + privKeyGetField mp privKey field + return mp + +-- TODO: Consolidate +pubKeyField :: PubKey -> ByteString -> IO MP +pubKeyField pubKey field = do + mp <- mpInit + pubKeyGetField mp pubKey field + return mp + +-- TODO: Don't assume just "ECDSA", other elliptic curve DSA might be valid here +spec_ecdsa :: Spec +spec_ecdsa = testSuite ecGroups chars $ \ ecGroup -> do + it "privKeyLoadECDSA" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "ECDSA" ecGroup rng + x <- privKeyField privKey "x" + _loadedPrivKey <- privKeyLoadECDSA x ecGroup + pass + it "pubKeyLoadECDSA" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "ECDSA" ecGroup rng + pubKey <- privKeyExportPubKey privKey + public_x <- pubKeyField pubKey "public_x" + public_y <- pubKeyField pubKey "public_y" + _loadedPubKey <- pubKeyLoadECDSA public_x public_y ecGroup + pass diff --git a/test/Test/Botan/Low/PubKey/Ed25519.hs b/test/Test/Botan/Low/PubKey/Ed25519.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/Ed25519.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.Ed25519 (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.Ed25519 +import Botan.Low.RNG +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_ed25519" spec_ed25519 + pure $ testGroup "Test.Botan.Low.PubKey.Ed25519" [ + specs + ] + +spec_ed25519 :: Spec +spec_ed25519 = do + it "privKeyEd25519GetPrivKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Ed25519" "" rng + _exportedPrivKey <- privKeyEd25519GetPrivKey privKey + pass + it "pubKeyEd25519GetPubKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Ed25519" "" rng + pubKey <- privKeyExportPubKey privKey + _exportedPubKey <- pubKeyEd25519GetPubKey pubKey + pass + it "privKeyLoadEd25519" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Ed25519" "" rng + exportedPrivKey <- privKeyEd25519GetPrivKey privKey + _loadedPrivKey <- privKeyLoadEd25519 exportedPrivKey + pass + it "pubKeyLoadEd25519" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Ed25519" "" rng + pubKey <- privKeyExportPubKey privKey + exportedPubKey <- pubKeyEd25519GetPubKey pubKey + _loadedPubKey <- pubKeyLoadEd25519 exportedPubKey + pass diff --git a/test/Test/Botan/Low/PubKey/ElGamal.hs b/test/Test/Botan/Low/PubKey/ElGamal.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/ElGamal.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.ElGamal (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.PubKey.ElGamal +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_elGamal" spec_elGamal + pure $ testGroup "Test.Botan.Low.PubKey.ElGamal" [ + specs + ] + + +-- TODO: Consolidate +dlGroups :: [ByteString] +dlGroups = + [ "ffdhe/ietf/2048" + , "ffdhe/ietf/3072" + , "ffdhe/ietf/4096" + , "ffdhe/ietf/6144" + , "ffdhe/ietf/8192" + , "modp/ietf/1024" + , "modp/ietf/1536" + , "modp/ietf/2048" + , "modp/ietf/3072" + , "modp/ietf/4096" + , "modp/ietf/6144" + , "modp/ietf/8192" + , "modp/srp/1024" + , "modp/srp/1536" + , "modp/srp/2048" + , "modp/srp/3072" + , "modp/srp/4096" + , "modp/srp/6144" + , "modp/srp/8192" + , "dsa/jce/1024" + , "dsa/botan/2048" + , "dsa/botan/3072" + ] + +-- TODO: Consolidate +privKeyField :: PrivKey -> ByteString -> IO MP +privKeyField privKey field = do + mp <- mpInit + privKeyGetField mp privKey field + return mp + +spec_elGamal :: Spec +spec_elGamal = testSuite dlGroups chars $ \ dlGroup -> do + it "privKeyLoadELGamal" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "DH" dlGroup rng + p <- privKeyField privKey "p" + _q <- privKeyField privKey "q" + g <- privKeyField privKey "g" + x <- privKeyField privKey "x" + _loadedKey <- privKeyLoadElGamal p g x + pass + it "pubKeyLoadELGamal" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "DH" dlGroup rng + _pubKey <- privKeyExportPubKey privKey + p <- privKeyField privKey "p" + _q <- privKeyField privKey "q" + g <- privKeyField privKey "g" + y <- privKeyField privKey "y" + _loadedKey <- pubKeyLoadElGamal p g y + pass diff --git a/test/Test/Botan/Low/PubKey/Encrypt.hs b/test/Test/Botan/Low/PubKey/Encrypt.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/Encrypt.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.Encrypt (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.Encrypt +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_encrypt" spec_encrypt + pure $ testGroup "Test.Botan.Low.PubKey.Encrypt" [ + specs + ] + +pks :: [(ByteString, ByteString, ByteString)] +pks = + [ ("RSA", "2048", "PKCS1v15") + , ("SM2", "sm2p256v1", "SHA-256") -- NOTE: SM2 takes a hash rather than a padding + , ("ElGamal", "modp/ietf/1024", "PKCS1v15") + ] + +pkTestName :: (ByteString, ByteString, ByteString) -> String +pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding + +spec_encrypt :: Spec +spec_encrypt = testSuite pks pkTestName $ \ (pk, param, padding) -> do + it "encryptCreate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + _ctx <- encryptCreate pubKey padding + pass + it "encryptOutputLength" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + ctx <- encryptCreate pubKey padding + _ <- encryptOutputLength ctx 128 + pass + it "encrypt" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + ctx <- encryptCreate pubKey padding + _ <- encrypt ctx rng "Fee fi fo fum!" + pass diff --git a/test/Test/Botan/Low/PubKey/KeyAgreement.hs b/test/Test/Botan/Low/PubKey/KeyAgreement.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/KeyAgreement.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.KeyAgreement (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.KeyAgreement +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_keyAgreement" spec_keyAgreement + pure $ testGroup "Test.Botan.Low.PubKey.KeyAgreement" [ + specs + ] + +-- TODO: More thorough test with different KDFs and curves / groups +pks :: [(ByteString, ByteString)] +pks = + [ ("DH", "modp/ietf/1024") + , ("ECDH", "secp256r1") + , ("Curve25519", "") + ] + +pkTestName :: (ByteString, ByteString) -> String +pkTestName (pk, param) = chars $ pk <> " " <> param + +spec_keyAgreement :: Spec +spec_keyAgreement = testSuite pks pkTestName $ \ (pk, param) -> do + it "keyAgreementCreate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _ka <- keyAgreementCreate privKey "HKDF(SHA-256)" + pass + it "keyAgreementExportPublic" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _ka <- keyAgreementCreate privKey "HKDF(SHA-256)" + _pubKey <- keyAgreementExportPublic privKey + pass + it "keyAgreementSize" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + ka <- keyAgreementCreate privKey "HKDF(SHA-256)" + _kaSz <- keyAgreementSize ka + pass + it "keyAgreement" $ do + rng <- rngInit "system" + privKeyA <- privKeyCreate pk param rng + pubKeyA <- keyAgreementExportPublic privKeyA + privKeyB <- privKeyCreate pk param rng + pubKeyB <- keyAgreementExportPublic privKeyB + kaA <- keyAgreementCreate privKeyA "HKDF(SHA-256)" + kaB <- keyAgreementCreate privKeyB "HKDF(SHA-256)" + sharedKeyA <- keyAgreement kaA pubKeyB "salt" + sharedKeyB <- keyAgreement kaB pubKeyA "salt" + sharedKeyA `shouldBe` sharedKeyB + pass diff --git a/test/Test/Botan/Low/PubKey/KeyEncapsulation.hs b/test/Test/Botan/Low/PubKey/KeyEncapsulation.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/KeyEncapsulation.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.KeyEncapsulation (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.KeyEncapsulation +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_keyEncapsulation" spec_keyEncapsulation + pure $ testGroup "Test.Botan.Low.PubKey.KeyEncapsulation" [ + specs + ] + + +pks :: [(ByteString, ByteString, ByteString)] +pks = + [ ( "RSA", "2048", "HKDF(SHA-256)") + , ( "Kyber", "", "HKDF(SHA-256)") + , ( "McEliece", "", "HKDF(SHA-256)") + ] + +pkTestName :: (ByteString, ByteString, ByteString) -> String +pkTestName (pk, param, kdf) = chars $ pk <> " " <> param <> " " <> kdf + +spec_keyEncapsulation :: Spec +spec_keyEncapsulation = testSuite pks pkTestName $ \ (pk, param, _kdf) -> do + it "kemEncryptCreate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + _kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" + pass + it "kemEncryptSharedKeyLength" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" + _sharedKeyLength <- kemEncryptSharedKeyLength kem 256 + pass + it "kemEncryptEncapsulatedKeyLength" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" + _encapsulatedKeyLength <- kemEncryptEncapsulatedKeyLength kem + pass + it "kemEncryptCreateSharedKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + kem <- kemEncryptCreate pubKey "HKDF(SHA-256)" + (_sharedKey, _encapsulatedKey) <- kemEncryptCreateSharedKey kem rng "salt" 256 + pass + it "kemDecryptCreate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _kem <- kemDecryptCreate privKey "HKDF(SHA-256)" + pass + it "kemDecryptSharedKeyLength" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + kem <- kemDecryptCreate privKey "HKDF(SHA-256)" + _sharedKeyLen <- kemDecryptSharedKeyLength kem 256 + pass + it "kemDecryptSharedKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + encryptCtx <- kemEncryptCreate pubKey "HKDF(SHA-256)" + (sharedKey, encapsulatedKey) <- kemEncryptCreateSharedKey encryptCtx rng "salt" 256 + decryptCtx <- kemDecryptCreate privKey "HKDF(SHA-256)" + decryptedSharedKey <- kemDecryptSharedKey decryptCtx "salt" encapsulatedKey 256 + sharedKey `shouldBe` decryptedSharedKey + pass diff --git a/test/Test/Botan/Low/PubKey/RSA.hs b/test/Test/Botan/Low/PubKey/RSA.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/RSA.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.RSA (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.PubKey.RSA +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_rsa" spec_rsa + pure $ testGroup "Test.Botan.Low.PubKey.RSA" [ + specs + ] + +rsaSizes :: [ByteString] +rsaSizes = [ "2048" ] + +-- TODO: Consolidate +privKeyField :: PrivKey -> ByteString -> IO MP +privKeyField privKey field = do + mp <- mpInit + privKeyGetField mp privKey field + return mp + +-- TODO: Consolidate +pubKeyField :: PubKey -> ByteString -> IO MP +pubKeyField pubKey field = do + mp <- mpInit + pubKeyGetField mp pubKey field + return mp + +spec_rsa :: Spec +spec_rsa = testSuite rsaSizes chars $ \ rsaSize -> do + it "privKeyLoadRSA" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "RSA" rsaSize rng + p <- privKeyField privKey "p" + q <- privKeyField privKey "q" + e <- privKeyField privKey "e" + _loadedKey <- privKeyLoadRSA p q e + pass + it "pubKeyLoadRSA" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "RSA" rsaSize rng + pubKey <- privKeyExportPubKey privKey + n <- pubKeyField pubKey "n" + e <- pubKeyField pubKey "e" + _loadedKey <- pubKeyLoadRSA n e + pass diff --git a/test/Test/Botan/Low/PubKey/SM2.hs b/test/Test/Botan/Low/PubKey/SM2.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/SM2.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.SM2 (tests) where + +import Botan.Low.MPI +import Botan.Low.PubKey +import Botan.Low.PubKey.SM2 +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_sm2" spec_sm2 + pure $ testGroup "Test.Botan.Low.PubKey.SM2" [ + specs + ] + +-- TODO: Consolidate +ecGroups :: [ByteString] +ecGroups = + [ "secp160k1" + , "secp160r1" + , "secp160r2" + , "secp192k1" + , "secp192r1" + , "secp224k1" + , "secp224r1" + , "secp256k1" + , "secp256r1" + , "secp384r1" + , "secp521r1" + , "brainpool160r1" + , "brainpool192r1" + , "brainpool224r1" + , "brainpool256r1" + , "brainpool320r1" + , "brainpool384r1" + , "brainpool512r1" + , "x962_p192v2" + , "x962_p192v3" + , "x962_p239v1" + , "x962_p239v2" + , "x962_p239v3" + , "gost_256A" + , "gost_512A" + , "frp256v1" + , "sm2p256v1" + ] + +-- TODO: Consolidate +privKeyField :: PrivKey -> ByteString -> IO MP +privKeyField privKey field = do + mp <- mpInit + privKeyGetField mp privKey field + return mp + +-- TODO: Consolidate +pubKeyField :: PubKey -> ByteString -> IO MP +pubKeyField pubKey field = do + mp <- mpInit + pubKeyGetField mp pubKey field + return mp + +spec_sm2 :: Spec +spec_sm2 = testSuite ecGroups chars $ \ ecGroup -> do + it "privKeyLoadSM2" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "SM2" ecGroup rng + x <- privKeyField privKey "x" + _loadedPrivKey <- privKeyLoadSM2 x ecGroup + pass + it "pubKeyLoadSM2" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "SM2" ecGroup rng + pubKey <- privKeyExportPubKey privKey + public_x <- pubKeyField pubKey "public_x" + public_y <- pubKeyField pubKey "public_y" + _loadedPubKey <- pubKeyLoadSM2 public_x public_y ecGroup + pass diff --git a/test/Test/Botan/Low/PubKey/Sign.hs b/test/Test/Botan/Low/PubKey/Sign.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/Sign.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.Sign (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.Sign +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_sign" spec_sign + pure $ testGroup "Test.Botan.Low.PubKey.Sign" [ + specs + ] + +ecGroup :: ByteString +ecGroup = "secp256r1" + +dlGroup :: ByteString +dlGroup = "modp/ietf/1024" + +sha :: ByteString +sha = "SHA-256" + +-- TODO: More exhaustive testing in botan +-- pks :: [(PKName, PKParams, Padding)] +pks :: [(ByteString, ByteString, ByteString)] +pks = + [ ("RSA", "2048", "EMSA4(SHA-256)") -- NOTE: It is not yet known if any of the others suppport EMSA + , ("SM2", "sm2p256v1", "foo,SHA-256") + , ("DSA", dlGroup, sha) + , ("ECDSA", ecGroup, sha) + , ("ECKCDSA", ecGroup, sha) + , ("ECGDSA", ecGroup, sha) + , ("GOST-34.10", ecGroup, sha) + , ("Ed25519", "", "") + , ("XMSS", "XMSS-SHAKE_10_256", "") + -- TODO: Dilithium-x-y + , ("Dilithium", "", "") + -- TODO: SPHINCS+ + ] + +pkTestName :: (ByteString, ByteString, ByteString) -> String +pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding + +-- NOTE: Some algorithms do not support DER format encoding. +spec_sign :: Spec +spec_sign = testSuite pks pkTestName $ \ (pk, param, algo) -> do + it "signCreate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + _ctx <- signCreate privKey algo StandardFormatSignature + -- ctxDER <- signCreate privKey algo DERFormatSignature + pass + it "signOutputLength" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + ctx <- signCreate privKey algo StandardFormatSignature + _sigLen <- signOutputLength ctx + -- ctxDER <- signCreate privKey algo DERFormatSignature + -- _ <- signOutputLength ctxDER + pass + it "signUpdate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + ctx <- signCreate privKey algo StandardFormatSignature + signUpdate ctx "Fee fi fo fum!" + pass + it "signFinish" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + ctx <- signCreate privKey algo StandardFormatSignature + signUpdate ctx "Fee fi fo fum!" + _sig <- signFinish ctx rng + pass diff --git a/test/Test/Botan/Low/PubKey/Verify.hs b/test/Test/Botan/Low/PubKey/Verify.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/Verify.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.Verify (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.Sign +import Botan.Low.PubKey.Verify +import Botan.Low.RNG +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_verify" spec_verify + pure $ testGroup "Test.Botan.Low.PubKey.Verify" [ + specs + ] + +-- TODO: Consolidate test values with SignSpec + +ecGroup :: ByteString +ecGroup = "secp256r1" + +dlGroup :: ByteString +dlGroup = "modp/ietf/1024" + +sha :: ByteString +sha = "SHA-256" + +pks :: [(ByteString, ByteString, ByteString)] +pks = + [ ("RSA", "2048", "EMSA4(SHA-256)") + , ("SM2", "sm2p256v1", "foo,SHA-256") + , ("DSA", dlGroup, sha) + , ("ECDSA", ecGroup, sha) + , ("ECKCDSA", ecGroup, sha) + , ("ECGDSA", ecGroup, sha) + , ("GOST-34.10", ecGroup, sha) + , ("Ed25519", "", "") + , ("XMSS", "XMSS-SHAKE_10_256", "") + -- TODO: Dilithium-x-y + , ("Dilithium", "", "") + -- TODO: SPHINCS+ + ] + +pkTestName :: (ByteString, ByteString, ByteString) -> String +pkTestName (pk, param, padding) = chars $ pk <> " " <> param <> " " <> padding + +-- SEE: signFinish for more details +-- NOTE: Verified signatures pass for all algorithms in standard format +-- Fails for only 4 in DER format via BadParameterException, but for important algs: +-- RSA, Ed25519, XMSS, Dilithium +-- The context and signatures are created without throwing any errors, +-- compared to earlier which failed to even create a context, but +-- it is possible that I need to figure out correct parameters and I doubt +-- it is coincidence that the EMSA4 / empty params are the ones that are failing. +-- Yet, it works for standard format. + +spec_verify :: Spec +spec_verify = testSuite pks pkTestName $ \ (pk, param, algo) -> do + it "verifyCreate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + _ctx <- verifyCreate pubKey algo StandardFormatSignature + pass + it "verifyUpdate" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + pubKey <- privKeyExportPubKey privKey + ctx <- verifyCreate pubKey algo StandardFormatSignature + verifyUpdate ctx "Fee fi fo fum!" + pass + it "verifyFinish" $ do + rng <- rngInit "system" + privKey <- privKeyCreate pk param rng + signCtx <- signCreate privKey algo StandardFormatSignature + signUpdate signCtx "Fee fi fo fum!" + sig <- signFinish signCtx rng + -- print $ "Siglen is: " <> show (ByteString.length sig) + print sig + pubKey <- privKeyExportPubKey privKey + verifyCtx <- verifyCreate pubKey algo StandardFormatSignature + verifyUpdate verifyCtx "Fee fi fo fum!" + verified <- verifyFinish verifyCtx sig + verified `shouldBe` True + pass diff --git a/test/Test/Botan/Low/PubKey/X25519.hs b/test/Test/Botan/Low/PubKey/X25519.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PubKey/X25519.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PubKey.X25519 (tests) where + +import Botan.Low.PubKey +import Botan.Low.PubKey.X25519 +import Botan.Low.RNG +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_x25519" spec_x25519 + pure $ testGroup "Test.Botan.Low.PubKey.X25519" [ + specs + ] + +spec_x25519 :: Spec +spec_x25519 = do + it "privKeyX25519GetPrivKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Curve25519" "" rng + _exportedPrivKey <- privKeyX25519GetPrivKey privKey + pass + it "pubKeyX25519GetPubKey" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Curve25519" "" rng + pubKey <- privKeyExportPubKey privKey + _exportedPubKey <- pubKeyX25519GetPubKey pubKey + pass + it "privKeyLoadX25519" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Curve25519" "" rng + exportedPrivKey <- privKeyX25519GetPrivKey privKey + _loadedPrivKey <- privKeyLoadX25519 exportedPrivKey + pass + it "pubKeyLoadX25519" $ do + rng <- rngInit "system" + privKey <- privKeyCreate "Curve25519" "" rng + pubKey <- privKeyExportPubKey privKey + exportedPubKey <- pubKeyX25519GetPubKey pubKey + _loadedPubKey <- pubKeyLoadX25519 exportedPubKey + pass diff --git a/test/Test/Botan/Low/PwdHash.hs b/test/Test/Botan/Low/PwdHash.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/PwdHash.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PwdHash ( + tests + -- * Test parameters + , generateTestParams + ) where + +import Botan.Low.Error +import Botan.Low.Hash +import Botan.Low.MAC +import Botan.Low.PwdHash +import Control.Exception +import Control.Monad +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Tasty.HUnit +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_pwdhash" spec_pwdhash + pure $ testGroup "Test.Botan.Low.PwdHash" [ + testCase "test_pwdhash_badSchemeName" $ + test_pwdhash_badSchemeName False + , testCase "test_pwdhashTimed_badSchemeName" $ + test_pwdhash_badSchemeName True + , specs + ] + +{------------------------------------------------------------------------------- + Test parameters +-------------------------------------------------------------------------------} + +data TestParams = TestParams { + testPbkdfName :: PBKDFName + , testIterationsParam :: Int + , testParallelismParam :: Int + , testMemoryParam :: Int + } + deriving stock (Show, Eq) + +-- | Parameters for testing +-- +-- These are generated using 'generateTestParams'. +testParams :: [TestParams] +testParams = + [ TestParams "PBKDF2(SHA-256)" 436000 0 0 + , TestParams "PBKDF2(SHA-512)" 258000 0 0 + , TestParams "Scrypt" 8 1 65536 + , TestParams "Argon2d" 1 1 262144 + , TestParams "Argon2i" 1 1 262144 + , TestParams "Argon2id" 1 1 262144 + , TestParams "Bcrypt-PBKDF" 92 0 0 + , TestParams "OpenPGP-S2K(SHA-384)" 65011712 0 0 + ] + +-- | Schemes for testing +testPbkdfs :: [PBKDFName] +testPbkdfs = [ + -- PBKDF2 + pbkdf2 SHA256 + , pbkdf2 SHA512 + -- Scrypt + , Scrypt + -- Argon + , Argon2d + , Argon2i + , Argon2id + -- Bcrypt + , Bcrypt_PBKDF + -- OpenPGP S2K + , openPGP_S2K SHA384 + ] + +-- | Generate test parameters using 'tuneParams' on schemes listed in +-- 'testPbkdfs'. +-- +-- NOTE: the test parameters can change per invocation, but theys should be +-- roughly similar. +generateTestParams :: IO [TestParams] +generateTestParams = forM testPbkdfs tuneParams + +-- | Tune parameters for a given scheme +tuneParams :: PBKDFName -> IO TestParams +tuneParams name = do + (iterations, parallelism, memory, _) <- pwdhashTimed name 200 64 passphrase salt + pure $ TestParams name iterations parallelism memory + +passphrase :: ByteString +passphrase = "Fee fi fo fum!" + +salt :: ByteString +salt = "salt" + +{------------------------------------------------------------------------------- + Tests +-------------------------------------------------------------------------------} + +-- | Test that using 'pwdhash' or 'pwdhashTimed' with bad scheme names results +-- in errors. +test_pwdhash_badSchemeName :: Bool -> Assertion +test_pwdhash_badSchemeName useTimed = do + -- PBKDF2 + go PBKDF2 >>= \case + Left BadParameterException{} -> pure () + Right{} -> assertFailure "got success, but expected BadParameterException" + go (pbkdf2 HMAC) >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (pbkdf2 $ hmac "2") >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (pbkdf2 $ hmac "SHA-256") >>= \case + Left SomeException{} -> assertFailure "got SomeException, but expected success" + Right{} -> pure () + go (pbkdf2 $ gmac "SHA-256") >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (pbkdf2 "SHA-256") >>= \case + Left SomeException{} -> assertFailure "got SomeException, but expected success" + Right{} -> pure () + + -- OpenPGP S2K + go OpenPGP_S2K >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (openPGP_S2K "2") >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (openPGP_S2K "SHA-384") >>= \case + Left SomeException{} -> assertFailure "got SomeException, but expected success" + Right{} -> pure () + where + go schemeName + | useTimed = try $ + void $ pwdhashTimed schemeName 200 64 passphrase salt + | otherwise = try $ + void $ pwdhash schemeName 1 0 0 64 passphrase salt + +{------------------------------------------------------------------------------- + Specs +-------------------------------------------------------------------------------} + +-- | Run 'pwdhash' and 'pwdhashTimed', and check that their outputs match. +spec_pwdhash :: Spec +spec_pwdhash = + testSuite testParams (\(TestParams n _ _ _) -> chars n) $ + \params@(TestParams pbkdf _ _ _) -> do + it "pwdhash" $ do + _ <- pwdhashCorrected params + pass + it "pwdhashTimed" $ do + _timed@(iterations', parallelism', memory', pwd) <- pwdhashTimed pbkdf 200 64 passphrase salt + pwd' <- pwdhashCorrected (TestParams pbkdf iterations' parallelism' memory') + pwd `shouldBe` pwd' + pass + where + -- For @Argon2@ and @Scrypt@ algorithms, 'botan_pwdhash_timed' returns + -- parameters in a different order than what 'botan_pwdhash' takes in. + pwdhashCorrected :: TestParams -> IO ByteString + pwdhashCorrected (TestParams pbkdf iterations parallelism memory) = + case pbkdf of + "Scrypt" -> pwdhash pbkdf memory iterations parallelism 64 passphrase salt + _ | "Argon" `isPrefixOf` pbkdf -> pwdhash pbkdf memory iterations parallelism 64 passphrase salt + _ -> pwdhash pbkdf iterations parallelism memory 64 passphrase salt diff --git a/test/Test/Botan/Low/RNG.hs b/test/Test/Botan/Low/RNG.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/RNG.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.RNG (tests) where + +import Botan.Low.RNG +import Data.ByteString as BS +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_rng" spec_rng + pure $ testGroup "Test.Botan.Low.RNG" [ + specs +#ifdef darwin_HOST_OS + -- TODO: temporarily disabled because the test suite fails. See issue + -- #33. + | False +#endif + ] + +rngs :: [RNGType] +rngs = + [ SystemRNG + , UserRNG + , UserThreadsafeRNG + , RDRandRNG -- NOTES: Not available on all processors + ] + +spec_rng :: Spec +spec_rng = do + it "systemRNGGet" $ do + bs <- systemRNGGet 8 + BS.length bs `shouldBe` 8 + testSuite rngs chars $ \ rng -> do + it "rngInit" $ do + _ctx <- rngInit rng + pass + it "rngGet" $ do + ctx <- rngInit rng + _bs <- rngGet ctx 8 + pass + it "rngReseed" $ do + ctx <- rngInit rng + rngReseed ctx 64 + pass + it "rngReseedFromRNGCtx" $ do + ctx <- rngInit rng + source <- rngInit rng + rngReseedFromRNG ctx source 64 + pass + it "rngAddEntropy" $ do + ctx <- rngInit rng + rngAddEntropy ctx "Fee fi fo fum!" + pass diff --git a/test/Test/Botan/Low/SRP6.hs b/test/Test/Botan/Low/SRP6.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/SRP6.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.SRP6 ( + tests + ) where + +import Botan.Low.Hash +import Botan.Low.PubKey +import Botan.Low.RNG +import Botan.Low.SRP6 +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_srp6" spec_srp6 + pure $ testGroup "Test.Botan.Low.SRP6" [ + specs + ] + +username :: ByteString +username = "username" + +password :: ByteString +password = "password" + +salt :: ByteString +salt = "saltsaltsaltsalt" + +-- NOTE: Consolidate with DLGroup +groupIds :: [DLGroupName] +groupIds = + [ "ffdhe/ietf/2048" + , "ffdhe/ietf/3072" + , "ffdhe/ietf/4096" + , "ffdhe/ietf/6144" + , "ffdhe/ietf/8192" + , "modp/ietf/1024" + , "modp/ietf/1536" + , "modp/ietf/2048" + , "modp/ietf/3072" + , "modp/ietf/4096" + , "modp/ietf/6144" + , "modp/ietf/8192" + , "modp/srp/1024" + , "modp/srp/1536" + , "modp/srp/2048" + , "modp/srp/3072" + , "modp/srp/4096" + , "modp/srp/6144" + , "modp/srp/8192" + , "dsa/jce/1024" + , "dsa/botan/2048" + , "dsa/botan/3072" + ] + +-- TODO: Test which hashes work +hashId :: HashName +hashId = "SHA-256" + +spec_srp6 :: Spec +spec_srp6 = testSuite groupIds chars $ \ groupId -> do + it "can negotiate a shared secret" $ do + rng <- rngInit "system" + verifier <- srp6GenerateVerifier username password salt groupId hashId + ctx <- srp6ServerSessionInit + b <- srp6ServerSessionStep1 ctx verifier groupId hashId rng + (a,sharedSecret) <- srp6ClientAgree username password groupId hashId salt b rng + sharedSecret' <- srp6ServerSessionStep2 ctx groupId a + sharedSecret `shouldBe` sharedSecret' + pass diff --git a/test/Test/Botan/Low/SRP6/Example.hs b/test/Test/Botan/Low/SRP6/Example.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/SRP6/Example.hs @@ -0,0 +1,202 @@ +{-# OPTIONS_GHC -threaded -Wall #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | The executable example described int the Haddock documentation of +-- "Botan.Low.SRP6" module. +-- +-- NOTE: when changing this example, also change the Haddock documentation in +-- the "Botan.Low.SRP6" module. +module Test.Botan.Low.SRP6.Example (main) where + +{- +This is a simplified, executable example that should give you an idea of how to +use the functions in this module to run the SRP6 protocol. We will not explain +the protocol in detail here, so consult other sources if you need details about +the algorithm. The simplified example shows how a client and server run the +protocol from separate threads, keeping private values secret and communicating +public values using message passing. In practice, the client and server will +probably run on separate machines (or processes) with secure communication +channels in place, and other security measures are necessary. So, don't use this +example directly in your code if it runs in production. +-} + +{- +Let us start with some necessary imports. +-} + +import Botan.Low.Hash +import Botan.Low.PubKey +import Botan.Low.RNG +import Botan.Low.SRP6 +import Control.Concurrent +import Control.Concurrent.Async +import Data.ByteString hiding (group) +import Data.IORef +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe +import Text.Printf + +{- +The client and server exchange a number of messages during the protocol. They +will be explained in more detail later as they become relevant for the part of +the protocol that we are discussing. The messages will be exchanged from the +client to the server using an @MVar ClientMsg@, and from the server to the +client using an @MVar ServerMsg@. +-} + +type Identifier = ByteString +data ClientMsg = + Signup Identifier SRP6Verifier + | StartAuthentication Identifier + | SendClientPublicKey SRP6AValue +data ServerMsg = + SendServerPublicKey SRP6BValue + +{- +SRP works in a discrete logarithm group, and it computes hashes using a hash +family. Both can be configured, and we will configure them as follows: +-} + +group :: DLGroupName +group = MODP_SRP_4096 +hash :: HashName +hash = SHA512 + +{- +When a client wants to sign up with the server with a combination of an +identifier and password, the client first generates a verifier using the +identifier, the password, and a locally generated salt. Then, the client sends +their identifier and verifier to the server, while it stores its own salt +locally: +-} + +type Password = ByteString +type Salt = ByteString +clientSignup :: MVar ClientMsg -> Identifier -> Password -> IO Salt +clientSignup clientMsgVar identifier password = do + rng <- rngInit UserRNG + salt <- rngGet rng 12 + verifier <- srp6GenerateVerifier identifier password salt group hash + putMVar clientMsgVar $ Signup identifier verifier + pure salt + +{- +The server receives the signup request, and stores the identifier with the +verifier: +-} + +type Users = Map Identifier SRP6Verifier +serverSignup :: MVar ClientMsg -> IORef Users -> IO () +serverSignup clientMsgVar usersRef = do + Signup identifier verifier <- takeMVar clientMsgVar + modifyIORef usersRef $ Map.insert identifier verifier + +{- +Later, the client may request to authenticate itself to the server: +-} + +clientStartAuthentication :: MVar ClientMsg -> Identifier -> IO () +clientStartAuthentication clientMsgVar identifier = do + putMVar clientMsgVar $ StartAuthentication identifier + +{- +The server receives the authentication request, looks up the verfier, generates +the server's public key (a SRP6 @B@ value), and sends it back to the client: +-} + +serverStartAuthentication :: MVar ClientMsg -> MVar ServerMsg -> IORef Users -> IO SRP6ServerSession +serverStartAuthentication clientMsgVar serverMsg usersRef = do + StartAuthentication identifier <- takeMVar clientMsgVar + users <- readIORef usersRef + let verifier = fromJust $ Map.lookup identifier users + rng <- rngInit UserRNG + session <- srp6ServerSessionInit + serverPublicKey <- srp6ServerSessionStep1 session verifier group hash rng + putMVar serverMsg $ SendServerPublicKey serverPublicKey + pure session + +{- +Once the client receives the server's public key, it generates the client's +public key (an SRP6 @B@ value) and the shared secret key, and sends the client's +public key to the server: +-} + +clientAuthentication :: MVar ClientMsg -> MVar ServerMsg -> Identifier -> Password -> Salt -> IO SRP6SharedSecret +clientAuthentication clientMsgVar serverMsgVar identifier password salt = do + SendServerPublicKey serverPublicKey <- takeMVar serverMsgVar + rng <- rngInit UserRNG + (clientPublicKey, clientSecretKey) <- + srp6ClientAgree identifier password group hash salt serverPublicKey rng + putMVar clientMsgVar $ SendClientPublicKey clientPublicKey + pure clientSecretKey + +{- +The server then receives the client's public key, and generates a matching +shared secret key: +-} + +serverAuthentication :: MVar ClientMsg -> SRP6ServerSession -> IO SRP6SharedSecret +serverAuthentication clientMsgVar session = do + SendClientPublicKey clientPublicKey <- takeMVar clientMsgVar + serverSecretKey <- srp6ServerSessionStep2 session group clientPublicKey + pure serverSecretKey + +{- +At this point, the client's and servers' secret key should be equal. In +practice, the secret keys should be confirmed to match by exchanging a hash +digest of relevant protocol values, susch as the secret key, public keys, +identifier, salt, and more. Calculation of this hash digest is not part of this +example. Instead, we will return the secret keys from the client and server so +that we can compare them, which obviously breaks security, but this should be +fine for our example. + +We bring the client-side of the algorithm together by picking an identifier and +password, and calling the client-side functions in order. +-} + +client :: MVar ClientMsg -> MVar ServerMsg -> IO SRP6SharedSecret +client clientMsgVar serverMsgVar = do + let identifier = "alice" + password = "Fee fi fo fum!" + salt <- clientSignup clientMsgVar identifier password + clientStartAuthentication clientMsgVar identifier + clientAuthentication clientMsgVar serverMsgVar identifier password salt + +{- +We bring the server-side of the algorithm together by initialising a session and +calling the server-side functions in order. +-} + +server :: MVar ClientMsg -> MVar ServerMsg -> IO SRP6SharedSecret +server clientMsgVar serverMsgVar = do + usersRef <- newIORef Map.empty + serverSignup clientMsgVar usersRef + session <- serverStartAuthentication clientMsgVar serverMsgVar usersRef + serverAuthentication clientMsgVar session + +{- +Using the @async@ package, we spin up a thread for the client and a thread for +the server. We wait for them to finish, and then compare the resulting secret +keys. +-} + +main :: IO () +main = do + clientMsgVar <- newEmptyMVar + serverMsgVar <- newEmptyMVar + (clientSecretKey, serverSecretKey) <- + concurrently (client clientMsgVar serverMsgVar) (server clientMsgVar serverMsgVar) + let match = clientSecretKey == serverSecretKey + if match then + print @String "client secret == server secret" + else + error $ + printf "%s /= %s" + (show clientSecretKey) + (show serverSecretKey) + +{- +All that is left to do is run the program. +-} + diff --git a/test/Test/Botan/Low/TOTP.hs b/test/Test/Botan/Low/TOTP.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/TOTP.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.TOTP (tests) where + +import Botan.Low.TOTP +import Data.ByteString +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.ByteString +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_totp" spec_totp + pure $ testGroup "Test.Botan.Low.TOTP" [ + specs + ] + +key :: ByteString +key = "Fee fi fo fum" + +timestep :: TOTPTimestep +timestep = 60 + +timestamp :: TOTPTimestamp +timestamp = 1698109812 + +-- TODO: More thorough testing +spec_totp :: Spec +spec_totp = testSuite totpHashes chars $ \ h -> do + it "totpInit" $ do + _ctx <- totpInit key h 6 timestep + pass + it "totpGenerate" $ do + ctx <- totpInit key h 6 timestep + _code <- totpGenerate ctx timestamp + pass + it "totpCheck" $ do + ctx <- totpInit key h 6 timestep + code <- totpGenerate ctx timestamp + success <- totpCheck ctx code timestamp 0 + success `shouldBe` True diff --git a/test/Test/Botan/Low/Utility.hs b/test/Test/Botan/Low/Utility.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/Utility.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.Utility (tests) where + +import Botan.Low.Utility +import Data.ByteString as BS +import Data.Text +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_utility" spec_utility + pure $ testGroup "Test.Botan.Low.Utility" [ + specs + ] + +message :: ByteString +message = "Fee fi fo fum!" + +hexMessage :: Text +hexMessage = "46656520666920666F2066756D21" + +base64Message :: Text +base64Message = "RmVlIGZpIGZvIGZ1bSE=" + +-- hexUpperMessage + +spec_utility :: Spec +spec_utility = do + it "constantTimeCompare" $ do + equal <- constantTimeCompare "compare me" "compare me" (BS.length "compare me") + equal `shouldBe` True + pass + -- TODO: + -- it "scrubMem" $ do + -- pass + it "hexEncode" $ do + hex <- hexEncode message HexUpperCase + hex `shouldBe` hexMessage + pass + it "hexDecode" $ do + msg <- hexDecode hexMessage + msg `shouldBe` message + pass + it "base64Encode" $ do + base64 <- base64Encode message + base64 `shouldBe` base64Message + pass + it "base64Decode" $ do + msg <- base64Decode base64Message + msg `shouldBe` message + pass diff --git a/test/Test/Botan/Low/Version.hs b/test/Test/Botan/Low/Version.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/Version.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.Version (tests) where + +import Botan.Low.Version +import Test.Tasty +import Test.Tasty.QuickCheck + +tests :: TestTree +tests = testGroup "Test.Botan.Low.Version" [ + testProperty "prop_ffiSupportsItsOwnVersion" prop_ffiSupportsItsOwnVersion + ] + +prop_ffiSupportsItsOwnVersion :: Property +prop_ffiSupportsItsOwnVersion = once $ ioProperty $ do + version <- botanFFIAPIVersion + supports <- botanFFISupportsAPI version + pure $ + counterexample ("version: " <> show version) + supports diff --git a/test/Test/Botan/Low/X509.hs b/test/Test/Botan/Low/X509.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/X509.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.X509 (tests) where + +import Botan.Low.X509 +import Data.ByteString +import Data.Word +import Paths_botan_low +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Util.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_x509" spec_x509 + -- TODO: implement pending tests + pure $ localOption TreatPendingAsSuccess + $ testGroup "Test.Botan.Low.X509" [ + specs + ] + +-- NOTE: Taken from https://fm4dd.com/openssl/certexamples.shtm +testCert :: ByteString +testCert = "-----BEGIN CERTIFICATE-----\ +\MIID2jCCA0MCAg39MA0GCSqGSIb3DQEBBQUAMIGbMQswCQYDVQQGEwJKUDEOMAwG\ +\A1UECBMFVG9reW8xEDAOBgNVBAcTB0NodW8ta3UxETAPBgNVBAoTCEZyYW5rNERE\ +\MRgwFgYDVQQLEw9XZWJDZXJ0IFN1cHBvcnQxGDAWBgNVBAMTD0ZyYW5rNEREIFdl\ +\YiBDQTEjMCEGCSqGSIb3DQEJARYUc3VwcG9ydEBmcmFuazRkZC5jb20wHhcNMTIw\ +\ODIyMDUyODAwWhcNMTcwODIxMDUyODAwWjBKMQswCQYDVQQGEwJKUDEOMAwGA1UE\ +\CAwFVG9reW8xETAPBgNVBAoMCEZyYW5rNEREMRgwFgYDVQQDDA93d3cuZXhhbXBs\ +\ZS5jb20wggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCwvWITOLeyTbS1\ +\Q/UacqeILIK16UHLvSymIlbbiT7mpD4SMwB343xpIlXN64fC0Y1ylT6LLeX4St7A\ +\cJrGIV3AMmJcsDsNzgo577LqtNvnOkLH0GojisFEKQiREX6gOgq9tWSqwaENccTE\ +\sAXuV6AQ1ST+G16s00iN92hjX9V/V66snRwTsJ/p4WRpLSdAj4272hiM19qIg9zr\ +\h92e2rQy7E/UShW4gpOrhg2f6fcCBm+aXIga+qxaSLchcDUvPXrpIxTd/OWQ23Qh\ +\vIEzkGbPlBA8J7Nw9KCyaxbYMBFb1i0lBjwKLjmcoihiI7PVthAOu/B71D2hKcFj\ +\Kpfv4D1Uam/0VumKwhwuhZVNjLq1BR1FKRJ1CioLG4wCTr0LVgtvvUyhFrS+3PdU\ +\R0T5HlAQWPMyQDHgCpbOHW0wc0hbuNeO/lS82LjieGNFxKmMBFF9lsN2zsA6Qw32\ +\Xkb2/EFltXCtpuOwVztdk4MDrnaDXy9zMZuqFHpv5lWTbDVwDdyEQNclYlbAEbDe\ +\vEQo/rAOZFl94Mu63rAgLiPeZN4IdS/48or5KaQaCOe0DuAb4GWNIQ42cYQ5TsEH\ +\Wt+FIOAMSpf9hNPjDeu1uff40DOtsiyGeX9NViqKtttaHpvd7rb2zsasbcAGUl+f\ +\NQJj4qImPSB9ThqZqPTukEcM/NtbeQIDAQABMA0GCSqGSIb3DQEBBQUAA4GBAIAi\ +\gU3My8kYYniDuKEXSJmbVB+K1upHxWDA8R6KMZGXfbe5BRd8s40cY6JBYL52Tgqd\ +\l8z5Ek8dC4NNpfpcZc/teT1WqiO2wnpGHjgMDuDL1mxCZNL422jHpiPWkWp3AuDI\ +\c7tL1QjbfAUHAQYwmHkWgPP+T2wAv0pOt36GgMCM\ +\-----END CERTIFICATE-----\ +\" + +-- NOTE: Taken from https://fm4dd.com/openssl/certexamples.shtm +testCertFile :: FilePath +testCertFile = "test-data/4096b-rsa-example-cert.pem" + +{- +Version: 1 +Subject: C="JP",X520.State="Tokyo",O="Frank4DD",CN="www.example.com" +Issuer: C="JP",X520.State="Tokyo",X520.Locality="Chuo-ku",O="Frank4DD",OU="WebCert Support",CN="Frank4DD Web CA",PKCS9.EmailAddress="support@frank4dd.com" +Issued: 2012/08/22 05:28:00 UTC +Expires: 2017/08/21 05:28:00 UTC +Constraints: + None +Signature algorithm: RSA/EMSA3(SHA-1) +Serial number: 0DFD +Public Key [RSA-4096] + +-----BEGIN PUBLIC KEY----- +MIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAsL1iEzi3sk20tUP1GnKn +iCyCtelBy70spiJW24k+5qQ+EjMAd+N8aSJVzeuHwtGNcpU+iy3l+ErewHCaxiFd +wDJiXLA7Dc4KOe+y6rTb5zpCx9BqI4rBRCkIkRF+oDoKvbVkqsGhDXHExLAF7leg +ENUk/hterNNIjfdoY1/Vf1eurJ0cE7Cf6eFkaS0nQI+Nu9oYjNfaiIPc64fdntq0 +MuxP1EoVuIKTq4YNn+n3AgZvmlyIGvqsWki3IXA1Lz166SMU3fzlkNt0IbyBM5Bm +z5QQPCezcPSgsmsW2DARW9YtJQY8Ci45nKIoYiOz1bYQDrvwe9Q9oSnBYyqX7+A9 +VGpv9FbpisIcLoWVTYy6tQUdRSkSdQoqCxuMAk69C1YLb71MoRa0vtz3VEdE+R5Q +EFjzMkAx4AqWzh1tMHNIW7jXjv5UvNi44nhjRcSpjARRfZbDds7AOkMN9l5G9vxB +ZbVwrabjsFc7XZODA652g18vczGbqhR6b+ZVk2w1cA3chEDXJWJWwBGw3rxEKP6w +DmRZfeDLut6wIC4j3mTeCHUv+PKK+SmkGgjntA7gG+BljSEONnGEOU7BB1rfhSDg +DEqX/YTT4w3rtbn3+NAzrbIshnl/TVYqirbbWh6b3e629s7GrG3ABlJfnzUCY+Ki +Jj0gfU4amaj07pBHDPzbW3kCAwEAAQ== +-----END PUBLIC KEY----- + +-} + +testCertHostname :: ByteString +testCertHostname = "www.example.com" + +testCertValidTimestamp :: Word64 +testCertValidTimestamp = 1420092000 + +spec_x509 :: Spec +spec_x509 = do + it "x509CertLoad" $ do + _cert <- x509CertLoad testCert + pass + it "x509CertLoadFile" $ do + _cert <- x509CertLoadFile =<< getDataFileName testCertFile + pass + it "x509CertDup" $ do + cert <- x509CertLoad testCert + _dup <- x509CertDup cert + -- TODO: parity check, eg: x509CertGetPublicKey cert == x509CertGetPublicKey dup + pass + it "x509CertGetTimeStarts" $ do + cert <- x509CertLoad testCert + _ts <- x509CertGetTimeStarts cert + pass + it "x509CertGetTimeExpires" $ do + cert <- x509CertLoad testCert + _te <- x509CertGetTimeExpires cert + pass + it "x509CertNotBefore" $ do + cert <- x509CertLoad testCert + _nb <- x509CertNotBefore cert + pass + it "x509CertNotAfter" $ do + cert <- x509CertLoad testCert + _na <- x509CertNotAfter cert + pass + it "x509CertGetPubKeyFingerprint" $ do + cert <- x509CertLoad testCert + _fp <- x509CertGetPubKeyFingerprint cert "SHA-256" -- TODO: HashName + pass + it "x509CertGetSerialNumber" $ do + cert <- x509CertLoad testCert + _sn <- x509CertGetSerialNumber cert + pass + it "x509CertGetAuthorityKeyId" $ do + cert <- x509CertLoad testCert + _akid <- x509CertGetAuthorityKeyId cert + pass + it "x509CertGetSubjectKeyId" $ do + cert <- x509CertLoad testCert + _sid <- x509CertGetSubjectKeyId cert + pass + it "x509CertGetPublicKeyBits" $ do + cert <- x509CertLoad testCert + _pkbits <- x509CertGetPublicKeyBits cert + pass + it "x509CertGetPublicKey" $ do + cert <- x509CertLoad testCert + _pk <- x509CertGetPublicKey cert + pass + it "x509CertGetIssuerDN" $ do + cert <- x509CertLoad testCert + _ <- x509CertGetIssuerDN cert "CN" 0 -- TODO: Distinguished names, etc + pass + it "x509CertGetSubjectDN" $ do + cert <- x509CertLoad testCert + _ <- x509CertGetSubjectDN cert "CN" 0 -- TODO: Distinguished names, etc + pass + it "x509CertToString" $ do + _cert <- x509CertLoad testCert + pass + it "x509CertAllowedUsage" $ do + cert <- x509CertLoad testCert + _allowed <- x509CertAllowedUsage cert NoConstraints + pass + it "x509CertHostnameMatch" $ do + cert <- x509CertLoad testCert + _matched <- x509CertHostnameMatch cert testCertHostname + pass + it "x509CertVerify" $ do + cert <- x509CertLoad testCert + (_success, _status) <- x509CertVerify cert [] [] Nothing 0 testCertHostname testCertValidTimestamp + pass + it "x509CertValidationStatus" $ do + _cert <- x509CertLoad testCert + _ <- x509CertValidationStatus 0 + pending + -- NOTE: May need to generate a proper test cert with CA and CRL + it "x509CRLLoad" $ do + _cert <- x509CertLoad testCert + -- x509CRLLoad cert + pending + it "x509CRLLoadFile" $ do + _cert <- x509CertLoad testCert + -- x509CRLLoadFile cert + pending + it "x509IsRevoked" $ do + _cert <- x509CertLoad testCert + -- x509IsRevoked cert + pending + it "x509CertVerifyWithCLR" $ do + _cert <- x509CertLoad testCert + -- x509CertVerifyWithCLR cert + pending + diff --git a/test/Test/Botan/Low/ZFEC.hs b/test/Test/Botan/Low/ZFEC.hs new file mode 100644 --- /dev/null +++ b/test/Test/Botan/Low/ZFEC.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.ZFEC (tests) where + +import Botan.Low.ZFEC +import Data.ByteString (ByteString) +import Test.Hspec +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.Hspec + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_zfec" spec_zfec + pure $ testGroup "Test.Botan.Low.ZFEC" [ + specs + ] +k :: Int +k = 5 + +n :: Int +n = 7 + +message :: ByteString +message = "Fee fi fo fum! I smell the blood of an Englishman!" + +spec_zfec :: Spec +spec_zfec = do + describe "zfecEncode" $ do + it "encodes a message into shares" $ do + shares <- zfecEncode k n message + length shares `shouldBe` n + describe "zfecDecode" $ do + it "recovers a message from enough shares" $ do + shares <- zfecEncode k n message + someShares <- take k <$> generate (shuffle shares) + recoveredMessage <- zfecDecode k n someShares + recoveredMessage `shouldBe` message diff --git a/test/Test/Prelude.hs b/test/Test/Prelude.hs deleted file mode 100644 --- a/test/Test/Prelude.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Test.Prelude -( module Prelude -, module Test.Hspec -, module Test.QuickCheck -, module Control.Monad -, module Data.ByteString -, chars -, splitBlocks -, testSuite -, ftestSuite -, pass -, anyBotanException -) where - -import Prelude - -import Test.Hspec -import Test.QuickCheck - -import Control.Monad - -import Data.ByteString (ByteString) -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Char8 as Char8 - -import Botan.Low.Error - -chars :: ByteString -> [Char] -chars = Char8.unpack - -splitBlocks :: Int -> ByteString -> [ByteString] -splitBlocks blockSize = go where - go bytes = case ByteString.splitAt blockSize bytes of - (block,"") -> [block] - (block,rest) -> block : go rest - -testSuite :: [t] -> (t -> String) -> (t -> SpecWith a) -> SpecWith a -testSuite tests testName runTest = forM_ tests $ \ test -> describe (testName test) (runTest test) - -ftestSuite :: [t] -> (t -> String) -> (t -> SpecWith a) -> SpecWith a -ftestSuite tests testName runTest = focus (testSuite tests testName runTest) - --- An alternative to void? --- _ <- performSomeAction --- pass -pass :: (Monad m) => m () -pass = return () - -anyBotanException :: Selector SomeBotanException -anyBotanException = const True diff --git a/test/Test/Util/ByteString.hs b/test/Test/Util/ByteString.hs new file mode 100644 --- /dev/null +++ b/test/Test/Util/ByteString.hs @@ -0,0 +1,19 @@ +module Test.Util.ByteString ( + chars + , splitBlocks + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC + +chars :: ByteString -> [Char] +chars = BSC.unpack + +splitBlocks :: Int -> ByteString -> [ByteString] +splitBlocks blockSize = go + where + go bytes = case BS.splitAt blockSize bytes of + (block,rest) + | BS.null rest -> [block] + | otherwise -> block : go rest diff --git a/test/Test/Util/Hspec.hs b/test/Test/Util/Hspec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Util/Hspec.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Util.Hspec ( + testSuite + , pass + ) where + +import Control.Monad +import Test.Hspec + +testSuite :: [t] -> (t -> String) -> (t -> SpecWith a) -> SpecWith a +testSuite tests testName runTest = forM_ tests $ \ test -> describe (testName test) (runTest test) + +-- An alternative to void? +-- _ <- performSomeAction +-- pass +pass :: (Monad m) => m () +pass = return ()