packages feed

botan-low (empty) → 0.0.1.0

raw patch · 87 files changed

+12596/−0 lines, 87 filesdep +QuickCheckdep +basedep +botan-bindingsbinary-added

Dependencies added: QuickCheck, base, botan-bindings, botan-low, bytestring, crypton, deepseq, hspec, tasty-bench, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog++## 0.0.1 - 2024/02/05++Initial release.
+ README.md view
@@ -0,0 +1,7 @@+# Welcome to botan-low++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.++For more information, see the [README on Github](https://github.com/apotheca/botan)
+ bench/Bcrypt.hs view
@@ -0,0 +1,70 @@+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++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+            ]+        , bgroup "Botan"+            [ bench "password"  $ nfIO $ botanHash password+            , bench "plaintext" $ nfIO $ botanHash plaintext+            , bench "longtext" $ nfIO $ botanHash longtext+            ]+        ]+    ]+
+ botan-low.cabal view
@@ -0,0 +1,849 @@+cabal-version:  3.0+name:           botan-low+version:        0.0.1.0+license:        BSD-3-Clause+author:         Leo D.+maintainer:     leo@apotheca.io+build-type:     Simple+category:       Cryptography+synopsis:       Low-level Botan bindings+description:++    Welcome to botan-low++    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.++    For more information, see the [README on Github](https://github.com/apotheca/botan)++-- NOTE: Use data-files instead, if this is inappropriate+-- NOTE: This causes a soft error:+--      Ignoring trailing fields after sections: "extra-source-files"+-- unless placed here above source-repository and flag.+-- We can still use `extra-source-files` under `if flag(XFFI)` later without+-- causing problems+extra-source-files:+    test-data/*.der+    test-data/*.pem++extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/apotheca/botan.git++flag XFFI+    description: Enable experimental / upstream ffi support+    manual: True+    default: False++library+    hs-source-dirs:   src+    default-language: Haskell2010+    default-extensions:+        ExistentialQuantification+        NoImplicitPrelude+        OverloadedStrings+        PatternSynonyms+        RankNTypes+        ScopedTypeVariables+        TupleSections+        TypeApplications+    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.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.ECDH+        Botan.Low.PubKey.ECDSA+        Botan.Low.PubKey.Ed25519+        Botan.Low.PubKey.ElGamal+        Botan.Low.PubKey.Encrypt+        Botan.Low.PubKey.KeyAgreement+        Botan.Low.PubKey.KeyEncapsulation+        Botan.Low.PubKey.RSA+        Botan.Low.PubKey.Sign+        Botan.Low.PubKey.SM2+        Botan.Low.PubKey.Verify+        Botan.Low.PubKey.X25519+        Botan.Low.PwdHash+        Botan.Low.RNG+        Botan.Low.SRP6+        Botan.Low.TOTP+        Botan.Low.Utility+        Botan.Low.Version+        Botan.Low.View+        Botan.Low.X509+        Botan.Low.ZFEC+    other-modules:+        Botan.Low.Prelude+        Botan.Low.Make+        Botan.Low.Remake+        Paths_botan_low+    autogen-modules:+        Paths_botan_low+    build-depends:+        base            >= 4 && < 5,+        botan-bindings  == 0.0.1.0,+        bytestring      >= 0.11 && < 0.13,+        deepseq         >= 1.4  && < 1.6,+        text            >= 1.2  && < 1.3 || >= 2.0 && < 2.2+    -- cc-options:     -Wall+    -- ghc-options:    -Wall -funbox-strict-fields    +    if flag(XFFI)+        exposed-modules:+            Botan.Low.X509.CA+            Botan.Low.X509.CSR+            Botan.Low.X509.CRL+            Botan.Low.X509.DN+            Botan.Low.X509.Extensions+            -- Botan.Low.X509.OCSP+            Botan.Low.X509.Options+            Botan.Low.X509.Path+            Botan.Low.X509.Store+        cpp-options: -DXFFI ++-- test-suite botan-low-tests+--     type:             exitcode-stdio-1.0+--     main-is:          Spec.hs+--     hs-source-dirs:   test/+--     build-depends:+--         base,+--         botan-bindings,+--         botan-low,+--         bytestring,+--         directory,+--         hspec,+--         QuickCheck,+--         text+--     other-modules:+--         -- Botan.Low.BcryptSpec+--         Botan.Low.BlockCipherSpec+--         Botan.Low.CipherSpec+--         Botan.Low.FPESpec+--         Botan.Low.HashSpec+--         Botan.Low.HOTPSpec+--         Botan.Low.KDFSpec+--         Botan.Low.KeyWrapSpec+--         Botan.Low.MACSpec+--         Botan.Low.MPISpec+--         -- Botan.Low.PBKDFSpec+--         Botan.Low.PubKeySpec+--         Botan.Low.PubKey.DecryptSpec+--         Botan.Low.PubKey.DHSpec+--         Botan.Low.PubKey.DSASpec+--         Botan.Low.PubKey.ECDHSpec+--         Botan.Low.PubKey.ECDSASpec+--         Botan.Low.PubKey.Ed25519Spec+--         Botan.Low.PubKey.ElGamalSpec+--         Botan.Low.PubKey.EncryptSpec+--         Botan.Low.PubKey.KeyAgreementSpec+--         Botan.Low.PubKey.KeyEncapsulationSpec+--         Botan.Low.PubKey.RSASpec+--         Botan.Low.PubKey.SignSpec+--         Botan.Low.PubKey.SM2Spec+--         Botan.Low.PubKey.VerifySpec+--         Botan.Low.PubKey.X25519Spec+--         Botan.Low.PwdHashSpec+--         Botan.Low.RNGSpec+--         -- Botan.Low.ScryptSpec+--         Botan.Low.SRP6Spec+--         Botan.Low.TOTPSpec+--         Botan.Low.UtilitySpec+--         Botan.Low.X509Spec+--         Botan.Low.ZFECSpec+--         Test.Prelude+--         Paths_botan_low+--     --   ghc-options: +--     default-language: Haskell2010+--     default-extensions:+--         NoImplicitPrelude+--         OverloadedStrings+--     -- NOTE: hspec-discover fails to respect the XFFI flag, and it tries+--     --  to begin loading modules that should not be built. Eg:+--     --      Could not find module ‘Botan.Low.X509.Store’+--     -- if flag(XFFI)+--     --     other-modules:+--     --         Botan.Low.X509.CASpec+--     --         Botan.Low.X509.CSRSpec+--     --         Botan.Low.X509.CRLSpec+--     --         Botan.Low.X509.DNSpec+--     --         Botan.Low.X509.ExtensionsSpec+--     --         -- Botan.Low.X509.OCSPSpec+--     --         Botan.Low.X509.OptionsSpec+--     --         Botan.Low.X509.PathSpec+--     --         Botan.Low.X509.StoreSpec+--     --     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:+        Test.Prelude+        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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++test-suite botan-low-cipher-tests+    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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++test-suite botan-low-pubkey-decrypt-tests+    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:+        Test.Prelude+        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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++test-suite botan-low-pubkey-dsa-tests+    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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++test-suite botan-low-pubkey-encrypt-tests+    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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++-- TODO: Pubkey folder tests++test-suite botan-low-pwdhash-tests+    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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++test-suite botan-low-rng-tests+    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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++test-suite botan-low-srp6-tests+    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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        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:+        Test.Prelude+        Paths_botan_low+    default-language: Haskell2010+    default-extensions:+        NoImplicitPrelude+        OverloadedStrings++test-suite botan-low-zfec-tests+    type:             exitcode-stdio-1.0+    main-is:          Botan/Low/ZFECSpec.hs+    hs-source-dirs:   test/+    build-depends:+        base,+        botan-bindings,+        botan-low,+        bytestring,+        hspec,+        QuickCheck+    other-modules:+        Test.Prelude+        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"+    if impl(ghc >= 8.6)+        ghc-options: -fproc-alignment=64
+ src/Botan/Low/Bcrypt.hs view
@@ -0,0 +1,159 @@+{-|+Module      : Botan.Low.Bcrypt+Description : Bcrypt password hashing+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Generate and validate Bcrypt password hashes+-}++module Botan.Low.Bcrypt+(++-- * Bcrypt+-- $introduction++-- * Usage+-- $usage++-- * Generate a bcrypt digest+  bcryptGenerate++-- * Validate a bcrypt digest+, bcryptIsValid++-- * Work factor+, BcryptWorkFactor(..)+, pattern BcryptFast+, pattern BcryptGood+, pattern BcryptStrong+, BcryptPassword(..)+, BcryptDigest(..)++) where++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++{- $introduction++`bcrypt` is a password-hashing algorithm designed to protect your passwords+against hackers using an expensive key setup phase. Instead of storing a user's+password in plaintext in the database, the server may instead generate a salted+bcrypt digest upon signup, and verify it upon login. ++The `bcrypt` implementation provided by `botan` generates a random salt for you+automatically. A work factor of 12 or greater is recommended.++-}++{- $usage++To generate a bcrypt digest:++> import Botan.Low.RNG+> import Botan.Low.Bcrypt+> +> -- The user has sent us a username and password in order to sign up +> onUserSignup :: ByteString -> ByteString -> IO ()+> onUserSignup username password = do+>     rng <- rngInit "user"+>     digest <- bcryptGenerate password rng 12+>     createAndStoreNewUser username digest++To validate a bcrypt digest:++> import Botan.Low.RNG+> import Botan.Low.Bcrypt+> +> -- The user has sent us a username and password in order to log in+> onUserLogin :: ByteString -> ByteString -> IO Bool+> onUserLogin username password = do+>     rng <- rngInit "user"+>     digestMaybe <- getStoredUserDigest username+>     case digestMaybe of+>         Nothing     -> return False+>         Just digest -> bcryptIsValid password digest++-}++-- | A work factor to slow down guessing attacks.+type BcryptWorkFactor = Int++pattern BcryptFast+    ,   BcryptGood+    ,   BcryptStrong+    ::  BcryptWorkFactor++-- | Should not cause noticable CPU usage+pattern BcryptFast    = BOTAN_BCRYPT_WORK_FACTOR_FAST++-- | May cause noticable CPU usage+pattern BcryptGood    = BOTAN_BCRYPT_WORK_FACTOR_GOOD++-- | May block for several seconds+pattern BcryptStrong  = BOTAN_BCRYPT_WORK_FACTOR_STRONG++-- | A bcrypt password.+type BcryptPassword = ByteString++-- | A bcrypt-hashed password digest.+type BcryptDigest = ByteString++{- |+Create a password hash using Bcrypt++> rng <- rngInit "user"+> digest <- bcryptGenerate password rng 12++Output is formatted bcrypt $2a$...+-}+bcryptGenerate+    :: BcryptPassword   -- ^ __password__: The password+    -> RNG              -- ^ __rng__: A random number generator+    -> BcryptWorkFactor -- ^ __work_factor__: How much work to do to slow down guessing attacks. A value of 12 to 16 is probably fine.+    -> IO BcryptDigest+bcryptGenerate password rng factor = asCString password $ \ passwordPtr -> do+   withRNG rng $ \ botanRNG -> do+        alloca $ \ szPtr -> do+            -- NOTE: bcrypt max pass size should be < 72 in general, we'll+            -- do 80 for safety+            poke szPtr 80+            allocaBytes 80 $ \ outPtr -> do+                throwBotanIfNegative_ $ botan_bcrypt_generate+                    outPtr+                    szPtr+                    (ConstPtr passwordPtr)+                    botanRNG+                    (fromIntegral factor)+                    0   -- "@param flags should be 0 in current API revision, all other uses are reserved"+                ByteString.packCString (castPtr outPtr)++{- |+Check a previously created password hash++> valid <- bcryptIsValid password digest+> if valid ...++Returns True iff this password/hash combination is valid,+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)
+ src/Botan/Low/BlockCipher.hs view
@@ -0,0 +1,337 @@+{-|+Module      : Botan.Low.BlockCipher+Description : Raw Block Cipher (PRP) interface+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+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.+-}++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++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.BlockCipher++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.Remake++{- $introduction++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.++-}++{- $usage++Unless you need a specific block cipher, it is strongly recommended that you use the `AES256` algorithm.++> import Botan.Low.BlockCipher+> blockCipher <- blockCipherInit AES256++To use a block cipher, we first need to generate (if we haven't already) 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++After the key is generated, we must set it as the block cipher key:++> blockCipherSetKey blockCipher key++To encrypt a message, it must be a multiple of the block size.++> blockSize <- blockCipherBlockSize blockCipher+> -- AES256 block size is always 16 bytes+> message = "0000DEADBEEF0000" :: ByteString+> ciphertext <- blockCipherEncryptBlocks blockCipher message++To decrypt a message, simply reverse the process:++> plaintext <- blockCipherDecryptBlocks blockCipher ciphertext+> message == plaintext -- True++-}++-- | 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, _)+    = mkBindings+        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++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++blockCipher128s =+    [ AES128+    , AES192+    , AES256+    , ARIA128+    , ARIA192+    , ARIA256+    , Camellia128+    , Camellia192+    , Camellia256+    , Noekeon+    , SEED+    , SM4+    , Serpent+    , 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 =+    [ Blowfish+    , CAST128+    , DES+    , TripleDES+    , GOST_28147_89+    , IDEA+    , 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+{-# WARNING blockCipherEncryptBlocks "The plaintext length should be a multiple of the block size." #-}++{- |+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+{-# WARNING blockCipherDecryptBlocks "The ciphertext length should be a multiple of the block size." #-}++{- |+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
+ src/Botan/Low/Cipher.hs view
@@ -0,0 +1,617 @@+{-|+Module      : Botan.Low.Cipher+Description : Symmetric cipher modes+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++A block cipher by itself, is only able to securely encrypt a single+data block. To be able to securely encrypt data of arbitrary length,+a mode of operation applies the block cipher’s single block operation+repeatedly to encrypt an entire message.+-}++module Botan.Low.Cipher+(+ +-- * Cipher+-- $introduction++-- * Usage+-- $usage++  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++-- * Cipher modes+, CipherMode(..)+, cbcMode+, cfbMode+, cfbModeWith+, xtsMode++-- ** CBC padding+, CBCPaddingName(..)+, pattern PKCS7+, pattern OneAndZeros+, pattern X9_23+, pattern ESP+, pattern CTS+, pattern NoPadding++-- * AEAD+, AEADName(..)+, pattern ChaCha20Poly1305+, chaCha20Poly1305++-- * AEAD modes+, AEADMode(..)+, gcmMode+, gcmModeWith+, ocbMode+, ocbModeWith+, eaxMode+, eaxModeWith+, sivMode+, ccmMode+, ccmModeWith++-- * Convenience+, cipherEncryptOnline+, cipherDecryptOnline+, cipherModes+, cbcPaddings+, aeads+, allCiphers++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.Cipher++import Botan.Low.BlockCipher+import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.Remake++import Botan.Low.RNG++{- $introduction++A `cipher` mode is a cryptographic algorithm suitable for encrypting and+decrypting large quantities of arbitrarily-sized data. An `aead` is a cipher+mode that also used to provide authentication of the ciphertext, potentially+with plaintext `associated data`.++-}++{- $usage++Unless you need a specific `cipher` or `aead`, it is strongly recommended that you use the `cbcMode AES256 PKCS7` and `gcmMode AES256` (or `ChaCha20Poly1305`) algorithms respectively.++> import Botan.Low.Cipher+> encrypter <- cipherInit ChaCha20Poly1305 Encrypt++To use a cipher, we first need to generate (if we haven't already) a secret key.++> import Botan.Low.RNG+> rng <- rngInit "user"+> -- We will use the maximum key size; ChaCha20Poly1305 keys are always 32 bytes+> (_,keySize,_) <- cipherGetKeyspec encrypter+> -- Block cipher keys are randomly generated+> key <- rngGet rng keySize++After the key is generated, we must set it as the cipher key:++> cipherSetKey encrypter key++If the cipher is an `aead`, we may also set the `associated data`:++> cipherSetAssociatedData encrypter "Fee fi fo fum!"++To ensure that the key is not leaked, we should generate a new nonce for every encryption. The range of allowed nonce sizes depends on the specific algorithm.++> import Botan.Low.RNG+> -- The default ChaCha20Poly1305 nonce is always 12 bytes.+> nonceSize <- cipherGetDefaultNonceLength encrypter+> nonce <- rngGet rng nonceSize++To encrypt a message, it must be a multiple of the block size. If the cipher was an aead, the authentication tag will automatically be included in the ciphertext++> -- Rarely, some cipher modes require that the message size be aligned to the block size+> -- Consult algorithm-specific documentation if this occurs. +> message = "I smell the blood of an Englishman!"+> cipherStart encrypter nonce+> ciphertext <- cipherEncrypt encrypter message++To decrypt a message, we run the same process with a decrypter, using the same `key` and `nonce` to decode the `ciphertext`:++> decrypter <- cipherInit ChaCha20Poly1305 Decrypt+> cipherSetKey decrypter key+> cipherSetAssociatedData decrypter "Fee fi fo fum!"+> cipherStart decrypter nonce+> plaintext <- cipherDecrypt decrypter ciphertext+> message == plaintext -- True++You can completely clear a cipher's state, leaving it ready for reuse:++> cipherClear encrypter+> -- You'll have to set the key, nonce, (and ad, if aead) again.+> cipherSetKey encrypter anotherKey+> cipherStart encrypter anotherNonce+> cipherSetAssociatedData encrypter anotherAD+> -- Process another message+> anotherCiphertext <- cipherEncrypt encrypter anotherMessage++If you are encrypting or decrypting multiple messages with the same key, you can reset the cipher instead of clearing it, leaving the key set:++> cipherClear encrypter+> -- This is equivalent to calling cipherClear followed by cipherSetKey with the original key.+> -- You'll have to set the nonce  (and ad, if aead) again, but not the key.+> cipherStart encrypter anotherNonce+> cipherSetAssociatedData encrypter anotherAD+> -- Process another message with the same key+> anotherCiphertext <- cipherEncrypt encrypter anotherMessage++-}++-- NOTE: This is *symmetric* ciphers  For the 'raw' interface to ECB mode block ciphers, see BlockCipher.hs++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, _)+    = mkBindings+        MkBotanCipher runBotanCipher+        MkCipher getCipherForeignPtr+        botan_cipher_destroy++type CipherInitFlags = Word32+type CipherUpdateFlags = Int+type CipherNonce = ByteString+type CipherKey = ByteString++type CipherName = ByteString++type CipherMode = ByteString++type CBCPaddingName = ByteString++pattern PKCS7+    ,   OneAndZeros+    ,   X9_23+    ,   ESP+    ,   CTS+    ,   NoPadding+    ::  CBCPaddingName++pattern PKCS7       = BOTAN_CBC_PADDING_PKCS7+pattern OneAndZeros = BOTAN_CBC_PADDING_ONE_AND_ZEROS+pattern X9_23       = BOTAN_CBC_PADDING_X9_23+pattern ESP         = BOTAN_CBC_PADDING_ESP+pattern CTS         = BOTAN_CBC_PADDING_CTS+pattern NoPadding   = BOTAN_CBC_PADDING_NO_PADDING++cbcMode :: BlockCipherName -> CBCPaddingName -> CipherName +cbcMode bc padding = bc // BOTAN_CIPHER_MODE_CBC // padding++cfbMode :: BlockCipherName -> CipherName +cfbMode bc = bc // BOTAN_CIPHER_MODE_CFB++cfbModeWith :: BlockCipherName -> Int -> CipherName +cfbModeWith bc feedbackSz = cfbMode bc /$ showBytes feedbackSz++xtsMode :: BlockCipherName -> CipherName+xtsMode bc = bc // BOTAN_CIPHER_MODE_XTS++type AEADName = CipherName++pattern ChaCha20Poly1305 :: CipherName+pattern ChaCha20Poly1305 = BOTAN_AEAD_CHACHA20POLY1305++chaCha20Poly1305 :: AEADName+chaCha20Poly1305 = BOTAN_AEAD_CHACHA20POLY1305++type AEADMode = ByteString++gcmMode :: BlockCipher128Name -> AEADName+gcmMode bc = bc // BOTAN_AEAD_MODE_GCM++gcmModeWith :: BlockCipher128Name -> Int -> AEADName+gcmModeWith bc tagSz = gcmMode bc /$ showBytes tagSz++ocbMode :: BlockCipher128Name -> AEADName+ocbMode bc = bc // BOTAN_AEAD_MODE_OCB++ocbModeWith :: BlockCipher128Name -> Int -> AEADName+ocbModeWith bc tagSz = ocbMode bc /$ showBytes tagSz++eaxMode :: BlockCipherName -> AEADName+eaxMode bc = bc // BOTAN_AEAD_MODE_EAX++eaxModeWith :: BlockCipherName -> Int -> AEADName+eaxModeWith bc tagSz = eaxMode bc /$ showBytes tagSz++sivMode :: BlockCipher128Name -> AEADName+sivMode bc = bc // BOTAN_AEAD_MODE_SIV++ccmMode :: BlockCipher128Name -> AEADName+ccmMode bc = bc // BOTAN_AEAD_MODE_CCM++ccmModeWith :: BlockCipher128Name -> Int -> Int -> AEADName+ccmModeWith bc tagSz l = ccmMode bc /$ showBytes tagSz <> "," <> showBytes l++cbcPaddings =+    [ PKCS7+    , OneAndZeros+    , X9_23+    , ESP+    , CTS+    , NoPadding+    ]++cipherModes = concat+    [ [ cbcMode bc pd | bc <- allBlockCiphers, pd <- cbcPaddings ]+    , [ cfbMode bc    | bc <- allBlockCiphers ]+    , [ xtsMode bc    | bc <- allBlockCiphers ]+    ]++aeads = concat+    [ [ chaCha20Poly1305 ]+    , [ gcmMode bc | bc <- blockCipher128s ]+    , [ ocbMode bc | bc <- blockCipher128s ]+    , [ eaxMode bc | bc <- blockCiphers ] -- WARNING: Why just blockCiphers, why not allBlockCiphers?+    , [ sivMode bc | bc <- blockCipher128s ]+    , [ ccmMode bc | bc <- blockCipher128s ]+    ]++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++pattern MaskDirection = BOTAN_CIPHER_INIT_FLAG_MASK_DIRECTION+pattern Encrypt = BOTAN_CIPHER_INIT_FLAG_ENCRYPT+pattern Decrypt = BOTAN_CIPHER_INIT_FLAG_DECRYPT++pattern CipherUpdate+    ,   CipherFinal+    ::  CipherUpdateFlags++pattern CipherUpdate    = BOTAN_CIPHER_UPDATE_FLAG_NONE+pattern 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++-- |Return the name of the cipher object+cipherName+    :: Cipher           -- ^ __cipher__+    -> IO CipherName    -- ^ __name__+cipherName = mkGetCString withCipher botan_cipher_name++-- |Return the output length of this cipher, for a particular input length.+--+--  WARNING: This function is of limited use. From the C++ docs:+--   /**+--   * Returns the size of the output if this transform is used to process a+--   * message with input_length bytes. In most cases the answer is precise.+--   * If it is not possible to precise (namely for CBC decryption) instead an+--   * upper bound is returned.+--   */+--  We need to explicitly calculate padding + tag length+cipherOutputLength+    :: Cipher   -- ^ __cipher__+    -> Int      -- ^ __in_len__+    -> IO Int   -- ^ __out_len__+cipherOutputLength = mkGetSize_csize withCipher botan_cipher_output_length++-- NOTE: Unique function form?+-- |Return if the specified nonce length is valid for this cipher+-- NOTE: This just always seems to return 'True', even for -1 and maxBound+cipherValidNonceLength+    :: Cipher   -- ^ __cipher__+    -> Int      -- ^ __nl__+    -> IO Bool+cipherValidNonceLength = mkGetBoolCode_csize withCipher botan_cipher_valid_nonce_length++-- |Get the tag length of the cipher (0 for non-AEAD modes)+cipherGetTagLength+    :: Cipher   -- ^ __cipher__+    -> IO Int   -- ^ __tag_size__+cipherGetTagLength = mkGetSize withCipher botan_cipher_get_tag_length++-- |Get the default nonce length of this cipher+cipherGetDefaultNonceLength+    :: Cipher   -- ^ __cipher__+    -> IO Int   -- ^ __nl__+cipherGetDefaultNonceLength = mkGetSize withCipher botan_cipher_get_default_nonce_length++-- |Return the update granularity of the cipher; botan_cipher_update must be+--  called with blocks of this size, except for the final.+cipherGetUpdateGranularity+    :: Cipher   -- ^ __cipher__+    -> IO Int   -- ^ __ug__+cipherGetUpdateGranularity = mkGetSize withCipher botan_cipher_get_update_granularity++-- |Return the ideal update granularity of the cipher. This is some multiple of the+--  update granularity, reflecting possibilities for optimization.+--+-- Some ciphers (ChaChaPoly, EAX) may consume less input than the reported ideal granularity+cipherGetIdealUpdateGranularity+    :: Cipher   -- ^ __cipher__+    -> IO Int   -- ^ __ug__+cipherGetIdealUpdateGranularity = mkGetSize withCipher botan_cipher_get_ideal_update_granularity++-- |Get information about the key lengths.+cipherQueryKeylen+    :: Cipher       -- ^ __cipher__+    -> IO (Int,Int) -- ^ __(min,max)__+cipherQueryKeylen = mkGetSizes2 withCipher botan_cipher_query_keylen+{-# DEPRECATED cipherQueryKeylen "Prefer cipherGetKeyspec." #-}++-- |Get information about the supported key lengths.+cipherGetKeyspec+    :: Cipher           -- ^ __cipher__+    -> IO (Int,Int,Int) -- ^ __(min,max,mod)__+cipherGetKeyspec = mkGetSizes3 withCipher botan_cipher_get_keyspec++-- |Set the key for this cipher object+cipherSetKey+    :: Cipher       -- ^ __cipher__+    -> ByteString   -- ^ __key__+    -> IO ()+cipherSetKey = mkWithObjectSetterCBytesLen withCipher botan_cipher_set_key++-- |Reset the message specific state for this cipher.+--  Without resetting the keys, this resets the nonce, and any state+--  associated with any message bits that have been processed so far.+--  +--  It is conceptually equivalent to calling botan_cipher_clear followed+--  by botan_cipher_set_key with the original key.+cipherReset+    :: Cipher   -- ^ __cipher__+    -> IO ()+cipherReset = mkAction withCipher botan_cipher_reset++-- |Set the associated data. Will fail if cipher is not an AEAD+cipherSetAssociatedData+    :: Cipher       -- ^ __cipher__+    -> ByteString   -- ^ __ad__+    -> IO ()+cipherSetAssociatedData = mkWithObjectSetterCBytesLen withCipher botan_cipher_set_associated_data++-- |Begin processing a new message using the provided nonce+cipherStart+    :: Cipher       -- ^ __cipher__+    -> ByteString   -- ^ __nonce__+    -> IO ()+cipherStart = mkWithObjectSetterCBytesLen withCipher botan_cipher_start++-- |"Encrypt some data"+--+--  This function is ill-documented.+--+--  See the source for authoritative details:+--  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)++{- |+Encrypt and finalize a complete piece of data.++This is not a canonical Botan C/C++ function.+-}+cipherEncrypt :: Cipher -> ByteString -> IO ByteString+cipherEncrypt = cipherEncryptOffline++{- |+Encrypt and finalize a complete piece of data.++This is not a canonical Botan C/C++ function.+-}+cipherDecrypt :: Cipher -> ByteString -> IO ByteString+cipherDecrypt = cipherDecryptOffline++-- |Reset the key, nonce, AD and all other state on this cipher object+cipherClear :: Cipher -> IO ()+cipherClear = mkAction withCipher botan_cipher_clear++{-+Non-standard functions+-}++-- NOTE: out + ug + tag is safe overestimate for encryption+-- NOTE: out + ug - tag may not be a safe overestimate for decryption+{-# DEPRECATED cipherEstimateOutputLength "This will be moved from botan-low to botan" #-}+cipherEstimateOutputLength :: Cipher -> CipherInitFlags -> Int -> IO Int+cipherEstimateOutputLength ctx flags input = do+    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+        then return (o + u + t)+        else return (o + u - t) -- TODO: Maybe just 'o'... ++-- NOTE: Offset must be a valid length of the input so far processed+-- NOTE: If (estimated) outputLength input + offset == outputLength (input + offset) then+--  we can just use cipherEstimateOutputLength instead of this+--  However, this may not be completely true due to block alignment requirements+--  For the moment this function exists for clarity.+{-# DEPRECATED cipherEstimateFinalOutputLength "Moving from botan-low to botan" #-}+cipherEstimateFinalOutputLength :: Cipher -> CipherInitFlags -> Int -> Int -> IO Int+cipherEstimateFinalOutputLength ctx flags offset input = do+    len <- cipherEstimateOutputLength ctx flags (offset + input)+    return $ len - offset++-- A better version of cipherUpdate+-- NOTE: It returns (processed,remaining) compared to (consumed,processed)+--  so the processed ciphertext has moved from snd to fst+-- TODO: Use Builder to do this+--  https://hackage.haskell.org/package/bytestring-0.12.0.2/docs/Data-ByteString-Builder.html+-- NOTE: There still is (an efficiency) use for a version that reports only consumed length+--  and defers the computation of the 'remaining' bytestring+{-# DEPRECATED cipherProcess "Moving from botan-low to botan" #-}+cipherProcess :: Cipher -> CipherUpdateFlags -> Int -> ByteString -> IO (ByteString,ByteString)+cipherProcess ctx flags outputSz input = do+    (consumed,processed) <- cipherUpdate ctx flags outputSz input+    -- NOTE: The safety of this function is suspect - may require deepseq+    let remaining = ByteString.drop consumed input+        in processed `seq` remaining `seq` return (processed,remaining)++{-# DEPRECATED cipherProcessOffline "Moving from botan-low to botan" #-}+cipherProcessOffline :: Cipher -> CipherInitFlags -> ByteString -> IO ByteString+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++{-# 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++{-# 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++{-+Experiments with online processing+-}++-- cipherEncryptOnline :: Cipher -> ByteString -> IO ByteString+-- cipherEncryptOnline ctx msg = do+--     u <- cipherGetUpdateGranularity ctx+--     t <- cipherGetTagLength ctx+--     g <- cipherGetIdealUpdateGranularity ctx+--     ByteString.concat <$> go 0 u t g msg+--     where+--         go i u t g bs = case ByteString.splitAt g bs of+--             (block,"")      -> do+--                 o <- cipherOutputLength ctx (i + ByteString.length block)  -- NOTE: Flawed but usable+--                 (_,encblock) <- cipherUpdate ctx BOTAN_CIPHER_UPDATE_FLAG_FINAL (o + u + t - i) block+--                 return [encblock]+--             (block,rest)    -> do+--                 (_,encblock) <- cipherUpdate ctx BOTAN_CIPHER_UPDATE_FLAG_NONE g block+--                 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+{-# DEPRECATED cipherEncryptOnline "Moving from botan-low to botan" #-}+cipherEncryptOnline :: Cipher -> ByteString -> IO ByteString+cipherEncryptOnline ctx msg = do+    g <- cipherGetIdealUpdateGranularity ctx+    ByteString.concat <$> go 0 g msg+    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+                return [processed]+            (block,rest)    -> do+                (processed,remaining) <- cipherProcess ctx BOTAN_CIPHER_UPDATE_FLAG_NONE 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+                -- (consumed,processed) <- cipherUpdate ctx BOTAN_CIPHER_UPDATE_FLAG_NONE g block+                -- (processed :) <$> go (i + g) g (ByteString.drop consumed bs)++-- TODO: Consolidate online encipher / decipher+{-# DEPRECATED cipherDecryptOnline "Moving from botan-low to botan" #-}+cipherDecryptOnline :: Cipher -> ByteString -> IO ByteString+cipherDecryptOnline ctx msg = do+    g <- cipherGetIdealUpdateGranularity ctx+    t <- cipherGetTagLength ctx+    ByteString.concat <$> go 0 g t msg+    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+                return [processed]+            (block,rest)    -> do+                (processed,remaining) <- cipherProcess ctx BOTAN_CIPHER_UPDATE_FLAG_NONE g block+                (processed :) <$> go (i + g) g t (remaining <> rest)
+ src/Botan/Low/Error.hs view
@@ -0,0 +1,406 @@+{-|+Module      : Botan.Low.Error+Description : Error codes and exception handling+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : 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+-}++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++handleBotan :: (SomeBotanException -> IO a) -> IO a -> IO a+handleBotan = flip catch
+ src/Botan/Low/FPE.hs view
@@ -0,0 +1,160 @@+{-|+Module      : Botan.Low.FPE+Description : Format Preserving Encryption+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Format preserving encryption (FPE) refers to a set of techniques+for encrypting data such that the ciphertext has the same format+as the plaintext. For instance, you can use FPE to encrypt credit+card numbers with valid checksums such that the ciphertext is also+an credit card number with a valid checksum, or similarly for bank+account numbers, US Social Security numbers, or even more general+mappings like English words onto other English words.++The scheme currently implemented in botan is called FE1, and described+in the paper Format Preserving Encryption by Mihir Bellare, Thomas+Ristenpart, Phillip Rogaway, and Till Stegers. FPE is an area of+ongoing standardization and it is likely that other schemes will be+included in the future.++To encrypt an arbitrary value using FE1, you need to use a ranking+method. Basically, the idea is to assign an integer to every value+you might encrypt. For instance, a 16 digit credit card number consists+of a 15 digit code plus a 1 digit checksum. So to encrypt a credit card+number, you first remove the checksum, encrypt the 15 digit value modulo+1015, and then calculate what the checksum is for the new (ciphertext)+number. Or, if you were encrypting words in a dictionary, you could rank+the words by their lexicographical order, and choose the modulus to be+the number of words in the dictionary.+-}++module Botan.Low.FPE+(++  FPE(..)+, FPEFlags(..)+, pattern FPENone+, pattern FPEFE1CompatMode+, withFPE+, fpeInitFE1+, fpeDestroy+, fpeEncrypt+, fpeDecrypt++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.FPE++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.Remake++-- 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.+--  I did find these functions in the actual header, and have implemented them as to my best guess+--  It is untested, pending an understanding of what the expected parameters are.+-- I think the FPE FFI is using the "original interface to FE1, first added in 1.9.17",+-- because they do not take a mac algo parameter, and may be hardcoded to "HMAC(SHA-256)"+--  SEE: https://botan.randombit.net/handbook/api_ref/fpe.html++-- NOTE: Source indicates that the FPE1 mac_algo is using the default "HMAC(SHA-256)", and+--  that the option is not exposed to FFI.++-- /**+-- * Format Preserving Encryption+-- */++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, _)+    = mkBindings+        MkBotanFPE runBotanFPE+        MkFPE getFPEForeignPtr+        botan_fpe_destroy++type FPEFlags = Word32++pattern FPENone+    ,   FPEFE1CompatMode+    ::  FPEFlags+pattern FPENone          = BOTAN_FPE_FLAG_NONE+pattern FPEFE1CompatMode = BOTAN_FPE_FLAG_FE1_COMPAT_MODE++-- | Initialize a FE1 FPE context+fpeInitFE1+    :: MP           -- ^ __n__+    -> ByteString   -- ^ __key[]__+    -> Int          -- ^ __rounds__+    -> FPEFlags     -- ^ __flags__+    -> IO FPE       -- ^ __fpe__+fpeInitFE1 n key rounds flags = withMP n $ \ nPtr -> do+    asBytesLen key $ \ keyPtr keyLen -> do+        createFPE $ \ out -> botan_fpe_fe1_init+            out+            nPtr+            (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++-- -- NOTE: Referentially transparent, move to botan+-- fpeEncrypt :: FPE -> MP -> ByteString -> IO MP+-- fpeEncrypt fpe mp tweak = do+--     mp' <- mpCopy mp+--     fpeEncrypt fpe mp' tweak+--     return mp ++-- | Encrypt the 'x' value in-place+--+-- NOTE: Mutates the MP+fpeEncrypt+    :: FPE          -- ^ __fpe__+    -> MP           -- ^ __x__+    -> ByteString   -- ^ __tweak[]__+    -> IO ()+fpeEncrypt fpe mp tweak = do+    withFPE fpe $ \ fpePtr -> do+        withMP mp $ \ mpPtr -> do+            asBytesLen tweak $ \ tweakPtr tweakLen -> do+                throwBotanIfNegative_ $ botan_fpe_encrypt fpePtr mpPtr (ConstPtr tweakPtr) tweakLen++-- -- NOTE: Referentially transparent, move to botan+-- fpeDecrypt :: FPE -> MP -> ByteString -> IO MP+-- fpeDecrypt fpe mp tweak = do+--     mp' <- mpCopy mp+--     fpeDecrypt fpe mp' tweak+--     return mp ++-- | Decrypt the 'x' value in-place+--+-- NOTE: Mutates the MP+fpeDecrypt+    :: FPE          -- ^ __fpe__+    -> MP           -- ^ __x__+    -> ByteString   -- ^ __tweak[]__+    -> IO ()+fpeDecrypt fpe mp tweak = do+    withFPE fpe $ \ fpePtr -> do+        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
+ src/Botan/Low/HOTP.hs view
@@ -0,0 +1,241 @@+{-|+Module      : Botan.Low.HOTP+Description : Hash-based one-time passwords+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++One time password schemes are a user authentication method that+relies on a fixed secret key which is used to derive a sequence+of short passwords, each of which is accepted only once. Commonly+this is used to implement two-factor authentication (2FA), where+the user authenticates using both a conventional password (or a+public key signature) and an OTP generated by a small device such+as a mobile phone.+-}++module Botan.Low.HOTP+(++-- * Hash-based One Time Password+-- $introduction+-- * Usage+-- $usage++-- * HOTP++  HOTP(..)+, HOTPHashName(..)+, HOTPCounter(..)+, HOTPCode(..)+, withHOTP+, hotpInit+, hotpDestroy+, hotpGenerate+, hotpCheck++-- * HOTP Hashes++, pattern HOTP_SHA1+, pattern HOTP_SHA256+, pattern HOTP_SHA512++-- * Convenience++, hotpHashes++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.HOTP+import Botan.Low.Hash++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.Remake++-- NOTE: RFC 4226+-- NOTE: I think this *only* takes SHA-2, specificaly "SHA-256" and "SHA-512",+--  and probably because the RFC specifically uses it?++{- $introduction++Botan implements the HOTP and TOTP schemes from RFC 4226 and 6238.++Since the range of possible OTPs is quite small, applications must+rate limit OTP authentication attempts to some small number per +second. Otherwise an attacker could quickly try all 1000000 6-digit+OTPs in a brief amount of time.++HOTP generates OTPs that are a short numeric sequence, between 6+and 8 digits (most applications use 6 digits), created using the+HMAC of a 64-bit counter value. If the counter ever repeats the+OTP will also repeat, thus both parties must assure the counter+only increments and is never repeated or decremented. Thus both+client and server must keep track of the next counter expected.++Anyone with access to the client-specific secret key can authenticate+as that client, so it should be treated with the same security+consideration as would be given to any other symmetric key or+plaintext password.++-}++{- $usage++> WARNING: Guarding against concurrent access to the stored counter is+> beyond the scope of this tutorial.++To use HOTP for MFA / 2FA, the client authenticator must generate a+client-specific shared secret and counter value, and securely communicate+them to the server authenticator.++The secret key may be any bytestring value with more than 160 bits, such as+a Bcrypt digest or SRP6 shared key. The counter value is not required to be+a secret; it may start at 0 for simplicity, or it may start at a value that+was selected at random.++> import Botan.Low.HOTP+> import Botan.Low.RNG+> import Botan.Low.MPI+> import Data.Bits+> sharedSecret <- systemRNGGet 16+> -- TODO: Use random:System.Random.Stateful.Uniform instead of MPI in `botan`+> (hi :: Word32) <- mpInit >>= \ w -> mpRandBits w rng 32 >> mpToWord32 w+> (lo :: Word32) <- mpInit >>= \ w -> mpRandBits w rng 32 >> mpToWord32 w+> (counter :: Word64) = shiftL (fromIntegral hi) 32 `xor` fromIntegral lo ++The client and server authenticators are now in a shared state, and any login+attempts from a new device may be authenticated using HOTP as MFA.++A client has requested a new connection, and HOTP is being used as MFA/2FA to+authenticate their request. The server authenticator receives the client connection+request and initializes a HOTP session using the stored client-specific shared+secret, and then sends an authentication request to the client authenticator:++> -- (serverSharedSecret, serverCounter) <- lookupServerSharedSecretAndCounter+> serverSession <- hotpInit serverSharedSecret HOTP_SHA512 8+> -- sendMFAAuthenticationRequest++The client authenticator receives the authentication request, generates a+client-side code, increments their counter, and displays the HOTP code to+the user:++> -- (clientSharedSecret, clientCounter) <- lookupClientSharedSecretAndCounter+> clientSession <- hotpInit clientSharedSecret HOTP_SHA512 8+> clientCode <- hotpGenerate clientSession clientCounter+> -- incrementAndPersistClientCounter+> -- displayClientCode clientCode++> NOTE: The client authenticator is responsible for incrementing and persisting+> their own counter manually.++The client then sends the client code to the server authenticator using the+unauthenticated / requested connection:++> -- clientCode <- readClientCode+> -- sendMFAAuthenticationResponse clientCode++The server authenticator receives the authentication response, and performs+a check of the key, with a resync range of R in case the client has generated+a few codes without logging in successfully:++> -- serverClientCode <- didreceiveMFAAuthenticationResponse+> (isValid,nextCounter) <- hotpCheck serverSession serverClientCode serverCounter 10+> persistClientCounter nextCounter++> NOTE: The server authentication check returns an incremented and resynced+> counter which must be persisted manually. If the authentication check fails,+> the counter value is return unchanged.++If the code is valid, then the signin may be completed on the new connection+as normal.++The server should discontinue the session and refuse any new connections+to the account after T unsuccessful authentication attempts, where T < R.+The user should then be notified.++-}++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, _)+    = mkBindings+        MkBotanHOTP runBotanHOTP+        MkHOTP getHOTPForeignPtr+        botan_hotp_destroy++type HOTPHashName = HashName++pattern HOTP_SHA1 +    ,   HOTP_SHA256+    ,   HOTP_SHA512+    ::  HOTPHashName++pattern HOTP_SHA1   = SHA1+pattern HOTP_SHA256 = SHA256+pattern HOTP_SHA512 = SHA512++-- TODO: Do any other hashes work?+hotpHashes =+    [ HOTP_SHA1+    , HOTP_SHA256+    , HOTP_SHA512+    ]++type HOTPCounter = Word64+type HOTPCode = Word32++-- NOTE: Digits should be 6-8+hotpInit+    :: ByteString   -- ^ __key[]__+    -> HashName     -- ^ __hash_algo__+    -> Int          -- ^ __digits__+    -> IO HOTP      -- ^ __hotp__+hotpInit key algo digits = asBytesLen key $ \ keyPtr keyLen -> do+    asCString algo $ \ algoPtr -> do+        createHOTP $ \ out -> botan_hotp_init +            out+            (ConstPtr keyPtr)+            keyLen+            (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__+    -> HOTPCounter  -- ^ __hotp_counter__+    -> IO HOTPCode  -- ^ __hotp_code__+hotpGenerate hotp counter = withHOTP hotp $ \ hotpPtr -> do+    alloca $ \ outPtr -> do+        throwBotanIfNegative $ botan_hotp_generate hotpPtr outPtr counter+        peek outPtr++-- NOTE:+--      "Returns a pair of (is_valid,next_counter_to_use). If the OTP is+--      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+    alloca $ \ outPtr -> do+        valid <- throwBotanCatchingSuccess $ botan_hotp_check hotpPtr outPtr code counter (fromIntegral resync)+        nextCounter <- peek outPtr+        return (valid, nextCounter)
+ src/Botan/Low/Hash.hs view
@@ -0,0 +1,375 @@+{-|+Module      : Botan.Low.Hash+Description : Hash Functions and Checksums+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Hash functions are one-way functions, which map data of arbitrary size+to a fixed output length. Most of the hash functions in Botan are designed+to be cryptographically secure, which means that it is computationally+infeasible to create a collision (finding two inputs with the same hash)+or preimages (given a hash output, generating an arbitrary input with the+same hash). But note that not all such hash functions meet their goals,+in particular MD4 and MD5 are trivially broken. However they are still+included due to their wide adoption in various protocols.++Using a hash function is typically split into three stages: initialization,+update, and finalization (often referred to as a IUF interface). The+initialization stage is implicit: after creating a hash function object,+it is ready to process data. Then update is called one or more times.+Calling update several times is equivalent to calling it once with all of+the arguments concatenated. After completing a hash computation (eg using+hashFinal), the internal state is reset to begin hashing a new message.+-}++module Botan.Low.Hash+( +    +-- * Hashing+-- $introduction++-- * Usage+-- $usage+ +  Hash(..)+, HashName(..)+, HashDigest(..)+, withHash+, hashInit+, hashDestroy+, hashName+, hashBlockSize+, hashOutputLength+, hashCopyState+, hashUpdate+, hashFinal+, hashUpdateFinalize+, hashUpdateFinalizeClear+, hashClear++-- * Hash algorithms++, 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++-- * Convenience++, cryptohashes+, checksums+, allHashes++) where++import qualified Data.ByteString as ByteString++import System.IO.Unsafe++import Botan.Bindings.Hash++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.Remake++{- $introduction++A `hash` is deterministic, one-way function suitable for producing a+deterministic, fixed-size digest from an arbitrarily-sized message, which is+used to verify the integrity of the data.++-}++{- $usage++Unless you need a specific `hash`, it is strongly recommended that you use the `SHA3` algorithm.++> import Botan.Low.Hash+> hash <- hashInit SHA3+> message = "Fee fi fo fum!"+> hashUpdate hash message+> digest <- hashFinal hash++You can verify a digest by hashing the message a second time, and comparing the two:++> rehash <- hashInit SHA3+> hashUpdate rehash message+> redigest <- hashFinal rehash+> digest == redigest -- True++You can clear a hash's state, leaving it ready for reuse:++> hashClear hash+> -- Process another message+> hashUpdate hash anotherMessage+> anotherDigest <- hashFinal hash++-}++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, _)+    = mkBindings+        MkBotanHash runBotanHash+        MkHash getHashForeignPtr+        botan_hash_destroy++type HashName = ByteString++pattern BLAKE2b+    ,   Keccak1600+    ,   GOST_34_11+    ,   MD4+    ,   MD5+    ,   RIPEMD160+    ,   SHA1+    ,   SHA224+    ,   SHA256+    ,   SHA384+    ,   SHA512+    ,   SHA512_256+    ,   SHA3+    ,   SHAKE128+    ,   SHAKE256+    ,   SM3+    ,   Skein512+    ,   Streebog256+    ,   Streebog512+    ,   Whirlpool+    ,   Parallel+    ,   Comb4P+    ,   Adler32+    ,   CRC24+    ,   CRC32+    :: HashName++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 sz | sz <= 512 = BLAKE2b /$ showBytes sz+blake2b _ = error "Invalid BLAKE2b variant"+pattern Keccak1600     = BOTAN_HASH_KECCAK_1600+-- TODO: function or pattern+keccak1600 n | n `elem` [224, 256, 384, 512] = Keccak1600 /$ showBytes n+keccak1600 _ = error "Invalid Keccak-1600 variant"+-- pattern Keccak1600_224 = "Keccak-1600(224)"+-- pattern Keccak1600_256 = "Keccak-1600(256)"+-- pattern Keccak1600_384 = "Keccak-1600(384)"+-- pattern Keccak1600_512 = "Keccak-1600(512)"+pattern GOST_34_11  = BOTAN_HASH_GOST_34_11+pattern MD4         = BOTAN_HASH_MD4+pattern MD5         = BOTAN_HASH_MD5+pattern RIPEMD160   = BOTAN_HASH_RIPEMD_160+pattern SHA1        = BOTAN_HASH_SHA1+pattern SHA224      = BOTAN_HASH_SHA_224+pattern SHA256      = BOTAN_HASH_SHA_256+pattern SHA384      = BOTAN_HASH_SHA_384+pattern SHA512      = BOTAN_HASH_SHA_512+pattern SHA512_256  = BOTAN_HASH_SHA_512_256+pattern SHA3        = BOTAN_HASH_SHA_3+-- TODO: function or pattern+sha3 n | n `elem` [224, 256, 384, 512] = SHA3 /$ showBytes n+sha3 _ = error "Invalid SHA-3 variant"+-- pattern SHA3_224 = "SHA-3(224)"+-- pattern SHA3_256 = "SHA-3(256)"+-- pattern SHA3_384 = "SHA-3(384)"+-- pattern SHA3_512 = "SHA-3(512)"+pattern SHAKE128       = BOTAN_HASH_SHAKE_128+-- TODO: function+shake128 sz = SHAKE128 /$ showBytes sz+pattern SHAKE256       = BOTAN_HASH_SHAKE_256+-- TODO: function+shake256 sz = SHAKE256 /$ showBytes sz+pattern SM3             = BOTAN_HASH_SM3+pattern Skein512       = BOTAN_HASH_SKEIN_512+-- TODO: function+skein512 sz salt = Skein512 /$ showBytes sz <> "," <> salt+pattern Streebog256    = BOTAN_HASH_STREEBOG_256+pattern Streebog512    = BOTAN_HASH_STREEBOG_512+pattern Whirlpool       = BOTAN_HASH_WHIRLPOOL+pattern Parallel        = BOTAN_HASH_STRAT_PARALLEL+-- TODO: function+-- parallel a b =  Parallel /$ a <> "," <> b+-- TODO: function+-- comb4P a b =  Comb4P /$ a <> "," <> b+pattern Comb4P          = BOTAN_HASH_STRAT_COMB4P+pattern Adler32         = BOTAN_CHECKSUM_ADLER32+pattern CRC24           = BOTAN_CHECKSUM_CRC24+pattern CRC32           = BOTAN_CHECKSUM_CRC32++cryptohashes :: [HashName]+cryptohashes = +    [ BLAKE2b+    -- , "BLAKE2b(128)"+    -- , "BLAKE2b(256)"+    -- , "BLAKE2b(512)"+    , GOST_34_11+    , Keccak1600+    -- , "Keccak-1600(224)"+    -- , "Keccak-1600(256)"+    -- , "Keccak-1600(384)"+    -- , "Keccak-1600(512)"+    , MD4+    , MD5+    , RIPEMD160+    , SHA1+    , SHA224+    , SHA256+    , SHA384+    , SHA512+    , SHA512_256+    , SHA3+    -- , "SHA-3(224)"+    -- , "SHA-3(256)"+    -- , "SHA-3(384)"+    -- , "SHA-3(512)"+    -- NOTE: SHAKE-128 has no default value, a parameter *MUST* be supplied+    , shake128 128+    -- , "SHAKE-128(128)"+    -- , "SHAKE-128(256)"+    -- , "SHAKE-128(512)"+    -- NOTE: SHAKE-256 has no default value, a parameter *MUST* be supplied+    , shake256 128+    -- , "SHAKE-256(128)"+    -- , "SHAKE-256(256)"+    -- , "SHAKE-256(512)"+    , SM3+    , Skein512+    -- , "Skein-512(128)"+    -- , "Skein-512(256)"+    -- , "Skein-512(512)"+    , Streebog256+    , Streebog512+    , Whirlpool+    ]++-- TODO:+-- hashStrategies :: [HashName]+-- hashStrategies = undefined++checksums = +    [ Adler32+    , CRC24+    , CRC32+    ]++allHashes = cryptohashes ++ checksums++type HashDigest = ByteString++hashInit+    :: HashName -- ^ __hash_name__: name of the hash function, e.g., "SHA-384"+    -> 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+hashName = mkGetCString withHash botan_hash_name++-- NOTE: This does the correct thing - see C++ docs:+--  Return a newly allocated HashFunction object of the same type as this one,+--  whose internal state matches the current state of this.++hashCopyState+    :: Hash     -- ^ __source__: source hash object+    -> IO Hash  -- ^ __dest__: destination hash object+hashCopyState source = withHash source $ \ sourcePtr -> do+    createHash $ \ dest -> botan_hash_copy_state dest sourcePtr++hashClear+    :: Hash -- ^ __hash__: hash object+    -> IO ()+hashClear =  mkAction withHash botan_hash_clear++hashBlockSize+    :: Hash     -- ^ __hash__: hash object+    -> IO Int   -- ^ __block_size__: output buffer to hold the hash function block size+hashBlockSize = mkGetSize withHash botan_hash_block_size++hashOutputLength+    :: Hash     -- ^ __hash__: hash object+    -> IO Int   -- ^ __block_size__: output buffer to hold the hash function output length+hashOutputLength = mkGetSize withHash botan_hash_output_length++hashUpdate+    :: Hash         -- ^ __hash__: hash object+    -> ByteString   -- ^ __in__: input buffer+    -> IO ()+hashUpdate = mkWithObjectSetterCBytesLen withHash botan_hash_update++hashFinal+    :: Hash             -- ^ __hash__: hash object+    -> IO HashDigest    -- ^ __out[]__: output buffer+hashFinal hash = withHash hash $ \ hashPtr -> do+    sz <- hashOutputLength hash+    allocBytes sz $ \ digestPtr -> do+        throwBotanIfNegative_ $ botan_hash_final hashPtr digestPtr++-- TODO:+-- pkcsHashId+--     :: ByteString       -- ^ __hash_name__+--     -> IO ByteString    -- ^ __pkcs_id[]__+-- pkcsHashId = undefined+++-- Convenience++hashUpdateFinalize :: Hash -> ByteString -> IO HashDigest+hashUpdateFinalize ctx bytes = do+    hashUpdate ctx bytes+    hashFinal ctx++hashUpdateFinalizeClear :: Hash -> ByteString -> IO HashDigest+hashUpdateFinalizeClear ctx bytes = do+    dg <- hashUpdateFinalize ctx bytes+    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
+ src/Botan/Low/KDF.hs view
@@ -0,0 +1,166 @@+{-|+Module      : Botan.Low.KDF+Description : Key Derivation Functions (KDF)+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Key derivation functions are used to turn some amount of shared+secret material into uniform random keys suitable for use with+symmetric algorithms. An example of an input which is useful for+a KDF is a shared secret created using Diffie-Hellman key agreement.++Typically a KDF is also used with a salt and a label. The salt should+be some random information which is available to all of the parties+that would need to use the KDF; this could be performed by setting+the salt to some kind of session identifier, or by having one of the+parties generate a random salt and including it in a message.++The label is used to bind the KDF output to some specific context. For+instance if you were using the KDF to derive a specific key referred to+as the “message key” in the protocol description, you might use a label+of “FooProtocol v2 MessageKey”. This labeling ensures that if you+accidentally use the same input key and salt in some other context, you+still use different keys in the two contexts.+-}++module Botan.Low.KDF+(++-- * Key derivation function++  KDFName(..)+, kdf++-- * KDF algorithms++, 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++-- * Convenience++, kdfs++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.KDF++import Botan.Low.Hash+import Botan.Low.MAC+import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude++type KDFName = ByteString++pattern HKDF+    ,   HKDF_Extract+    ,   HKDF_Expand+    ,   KDF2+    ,   KDF1_18033+    ,   KDF1+    ,   TLS_12_PRF+    ,   X9_42_PRF+    ,   SP800_108_Counter+    ,   SP800_108_Feedback+    ,   SP800_108_Pipeline+    ,   SP800_56A+    ,   SP800_56C+    :: KDFName++pattern HKDF                = BOTAN_KDF_HKDF+pattern HKDF_Extract        = BOTAN_KDF_HKDF_EXTRACT+pattern HKDF_Expand         = BOTAN_KDF_HKDF_EXPAND+pattern KDF2                = BOTAN_KDF_KDF2+pattern KDF1_18033          = BOTAN_KDF_KDF1_18033+pattern KDF1                = BOTAN_KDF_KDF1+pattern TLS_12_PRF          = BOTAN_KDF_TLS_12_PRF+pattern X9_42_PRF           = BOTAN_KDF_X9_42_PRF+pattern SP800_108_Counter   = BOTAN_KDF_SP800_108_COUNTER+pattern SP800_108_Feedback  = BOTAN_KDF_SP800_108_FEEDBACK+pattern SP800_108_Pipeline  = BOTAN_KDF_SP800_108_PIPELINE+pattern SP800_56A           = BOTAN_KDF_SP800_56A+pattern SP800_56C           = BOTAN_KDF_SP800_56C++hkdf :: HashName -> KDFName+hkdf h = HKDF /$ h+hkdf_extract h = HKDF_Extract /$ h+hkdf_expand h = HKDF_Expand /$ h+kdf2 h = KDF2 /$ h+kdf1_18033 h = KDF1_18033 /$ h+kdf1 h = KDF1 /$ h+tls_12_prf h = TLS_12_PRF /$ h+x9_42_prf h = X9_42_PRF /$ h+sp800_108_counter h = SP800_108_Counter /$ HMAC /$ h+sp800_108_feedback h = SP800_108_Feedback /$ HMAC /$ h+sp800_108_pipeline h = SP800_108_Pipeline /$ HMAC /$ h+sp800_56A h = SP800_56A /$ HMAC /$ h+sp800_56C h = SP800_56C /$ HMAC /$ h++kdfs = concat+    [ [ hkdf h | h <- cryptohashes ]+    , [ hkdf_extract h | h <- cryptohashes ]+    , [ hkdf_expand h | h <- cryptohashes ]+    , [ kdf2 h | h <- allHashes ]+    , [ kdf1_18033 h | h <- allHashes ]+    , [ kdf1 h | h <- allHashes ]+    , [ tls_12_prf h | h <- cryptohashes ]+    , [ x9_42_prf SHA1 ]+    , [ sp800_108_counter h | h <- cryptohashes ]+    , [ sp800_108_feedback h | h <- cryptohashes ]+    , [ sp800_108_pipeline h | h <- cryptohashes ]+    , [ sp800_56A h | h <- cryptohashes ]+    , [ sp800_56C h | h <- cryptohashes ]+    ]++-- SEE: Algos here: https://botan.randombit.net/doxygen/classBotan_1_1KDF.html+kdf+    :: KDFName          -- ^ __kdf_algo__: KDF algorithm, e.g., "SP800-56C"+    -> Int              -- ^ __out_len__: the desired output length in bytes+    -> ByteString       -- ^ __secret[]__: the secret input+    -> ByteString       -- ^ __salt[]__: a diversifier+    -> ByteString       -- ^ __label[]__: purpose for the derived keying material+    -> IO ByteString    -- ^ __out[]__: buffer holding the derived key+kdf algo outLen secret salt label = allocBytes outLen $ \ outPtr -> do+    asCString algo $ \ algoPtr -> do+        asBytesLen secret $ \ secretPtr secretLen -> do+            asBytesLen salt $ \ saltPtr saltLen -> do+                asBytesLen label $ \ labelPtr labelLen -> do+                    throwBotanIfNegative_ $ botan_kdf+                        (ConstPtr algoPtr)+                        outPtr+                        (fromIntegral outLen)+                        (ConstPtr secretPtr)+                        secretLen+                        (ConstPtr saltPtr)+                        saltLen+                        (ConstPtr labelPtr)+                        labelLen
+ src/Botan/Low/KeyWrap.hs view
@@ -0,0 +1,77 @@+{-|+Module      : Botan.Low.KeyWrap+Description : Bcrypt password hashing+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++NIST specifies two mechanisms for wrapping (encrypting) symmetric keys+using another key. The first (and older, more widely supported) method+requires the input be a multiple of 8 bytes long. The other allows any+length input, though only up to 2**32 bytes.++These algorithms are described in NIST SP 800-38F, and RFCs 3394 and 5649.++These functions take an arbitrary 128-bit block cipher. NIST only allows+these functions with AES, but any 128-bit cipher will do and some other+implementations (such as in OpenSSL) do also allow other ciphers.++Use AES for best interop.+-}++module Botan.Low.KeyWrap+(++  nistKeyWrapEncode+, nistKeyWrapDecode++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.KeyWrap++import Botan.Low.BlockCipher+import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude++nistKeyWrapEncode+    :: BlockCipherName  -- ^ __cipher_algo__+    -> Int              -- ^ __padded__+    -> ByteString       -- ^ __key[]__+    -> ByteString       -- ^ __kek[]__+    -> IO ByteString    -- ^ __wrapped_key[]__+nistKeyWrapEncode algo padded key kek = asCString algo $ \ algoPtr -> do+    asBytesLen key $ \ keyPtr keyLen -> do+        asBytesLen kek $ \ kekPtr kekLen -> do+            allocBytesQuerying $ \ wrappedKeyPtr wrappedKeyLen -> botan_nist_kw_enc+                (ConstPtr algoPtr)+                (fromIntegral padded)+                (ConstPtr keyPtr)+                keyLen+                (ConstPtr kekPtr)+                kekLen+                wrappedKeyPtr+                wrappedKeyLen++nistKeyWrapDecode+    :: BlockCipherName  -- ^ __cipher_algo__+    -> Int              -- ^ __padded__+    -> ByteString       -- ^ __wrapped_key[]__+    -> ByteString       -- ^ __kek[]__+    -> IO ByteString    -- ^ __key[]__+nistKeyWrapDecode algo padded wrappedKey kek = asCString algo $ \ algoPtr -> do+    asBytesLen wrappedKey $ \ wrappedKeyPtr wrappedKeyLen -> do+        asBytesLen kek $ \ kekPtr kekLen -> do+            allocBytesQuerying $ \ keyPtr keyLen -> botan_nist_kw_dec+                (ConstPtr algoPtr)+                (fromIntegral padded)+                (ConstPtr wrappedKeyPtr)+                wrappedKeyLen+                (ConstPtr kekPtr)+                kekLen+                keyPtr+                keyLen
+ src/Botan/Low/MAC.hs view
@@ -0,0 +1,307 @@+{-|+Module      : Botan.Low.MAC+Description : Message Authentication Codes (MAC)+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++A Message Authentication Code algorithm computes a tag over a+message utilizing a shared secret key. Thus a valid tag confirms+the authenticity and integrity of the message. Only entities in+possession of the shared secret key are able to verify the tag.++Note++When combining a MAC with unauthenticated encryption mode, prefer+to first encrypt the message and then MAC the ciphertext. The+alternative is to MAC the plaintext, which depending on exact usage+can suffer serious security issues. For a detailed discussion of+this issue see the paper “The Order of Encryption and Authentication+for Protecting Communications” by Hugo Krawczyk++The Botan MAC computation is split into five stages.++- Instantiate the MAC algorithm.++- Set the secret key.++- Process IV.++- Process data.++- Finalize the MAC computation.+-}++module Botan.Low.MAC+(++-- * Message authentication codes+-- $introduction++-- * Usage+-- $usage++  MAC(..)+, MACName(..)+, MACKey(..)+, MACNonce(..)+, MACDigest(..)+, withMAC+, macInit+, macDestroy+, macName+, macOutputLength+, macGetKeyspec+, macSetKey+, macSetNonce+, macUpdate+, macFinal+, macClear++-- * MAC algorithms++, pattern CMAC+, cmac+, pattern GMAC+, gmac+, pattern HMAC+, hmac+, pattern Poly1305+, pattern SipHash+, sipHash+, pattern X9_19_MAC++-- * Convenience++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.MAC++import Botan.Low.BlockCipher+import Botan.Low.Error+import Botan.Low.Hash+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.Remake++{- $introduction++A `mac` (or message authentication code) is a cryptographic algorithm that uses+a secret key to produce a fixed-size digest from an arbitrarily-sized message,+which is then used to verify the integrity and authenticity of the data.++-}++{- $usage++Unless you need a specific `mac`, it is strongly recommended that you use the+`hmac SHA3` algorithm.++> import Botan.Low.MAC+> import Botan.Low.Hash+> mac <- macInit (hmac SHA3)++To use a MAC, we first need to generate (if we haven't already) a secret key.++> import Botan.Low.RNG+> rng <- rngInit "user"+> -- HMAC allows for an arbitrary key size, but we can check the key spec.+> (keyMin,keyMax,keyMod) <- macGetKeyspec mac+> -- MAC are randomly generated; 32 bytes is acceptable+> key <- rngGet rng 32++After the key is generated, we must set it as the mac key:++> macSetKey mac key++Then, we may produce an authentication code from a message using the secret key:++> macUpdate mac "Fee fi fo fum!"+> auth <- macFinal mac++To verify an message authentication code, we can reproduce it using the secret+key and message, and then check for equality:++> verify <- macInit (hmac SHA3)+> macSetKey verify key+> macUpdate verify "Fee fi fo fum!"+> verifyAuth <- macFinal verify+> auth == verifyAuth -- True++You can completely clear a mac's state, leaving it ready for reuse:++> macClear mac+> -- You'll have to set the key again+> macSetKey mac anotherKey+> -- Process another message+> macUpdate mac anotherMessage+> anotherAuth <- macFinal mac++Some algorithms (GMAC, Poly1305) have additional requirements for use. Avoid if+possible, and consult algorithm-specific documentation for GMAC and Poly1305.+If you must use GMAC, a nonce needs to be set:++> mac <- macInit (gmac AES256)+> k <- systemRNGGet 32+> n <- systemRNGGet 32    -- Here+> macSetKey mac k+> macSetNonce mac n       -- Here+> macUpdate mac "Fee fi fo fum!"+> auth <- macFinal mac++-}++-- /*+-- * Message Authentication type+-- */++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, _)+    = mkBindings+        MkBotanMAC runBotanMAC+        MkMAC getMACForeignPtr+        botan_mac_destroy++type MACName = ByteString++pattern CMAC+    ,   GMAC+    -- ,   CBC_MAC+    ,   HMAC+    -- ,   KMAC_128+    -- ,   KMAC_256+    ,   Poly1305+    ,   SipHash+    ,   X9_19_MAC+    :: MACName++pattern CMAC      = BOTAN_MAC_CMAC+pattern GMAC      = BOTAN_MAC_GMAC+-- pattern CBC_MAC   = BOTAN_MAC_CBC_MAC+pattern HMAC      = BOTAN_MAC_HMAC+-- pattern KMAC_128  = BOTAN_MAC_KMAC_128+-- pattern KMAC_256  = BOTAN_MAC_KMAC_256+pattern Poly1305  = BOTAN_MAC_Poly1305+pattern SipHash   = BOTAN_MAC_SipHash+pattern X9_19_MAC = BOTAN_MAC_X9_19_MAC++cmac :: BlockCipherName -> MACName+cmac bc = CMAC /$ bc++gmac :: BlockCipherName -> MACName+gmac bc = GMAC /$ bc++-- cbc_mac :: BlockCipherName -> MACName+-- cbc_mac bc = CBC_MAC /$ bc++hmac :: BlockCipherName -> MACName+hmac h = HMAC /$ h++-- kmac_128 :: BlockCipherName -> MACName+-- kmac_128 = ...++-- kmac_256 :: BlockCipherName -> MACName+-- kmac_256 = ...++sipHash :: Int -> Int -> MACName+sipHash ir fr = SipHash /$ showBytes ir <> "," <> showBytes fr+++type MACKey = ByteString+type MACNonce = ByteString++-- TODO: Rename MACTag?+type MACDigest = ByteString++-- | Initialize a message authentication code object+macInit+    :: 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+    :: MAC      -- ^ __mac__: mac object+    -> IO Int   -- ^ __output_length__: output buffer to hold the MAC output length+macOutputLength = mkGetSize withMAC botan_mac_output_length++-- | Sets the key on the MAC+macSetKey+    :: MAC          -- ^ __mac__: mac object+    -> ByteString   -- ^ __key__: buffer holding the key+    -> IO ()+macSetKey = mkWithObjectSetterCBytesLen withMAC botan_mac_set_key++-- NOTE: Not all MACs require a nonce+--  Eg, GMAC requires a nonce+--  Other MACs do not require a nonce, and will cause a BadParameterException (-32)+-- | Sets the nonce on the MAC+macSetNonce+    :: MAC          -- ^ __mac__: mac object+    -> ByteString   -- ^ __nonce__: buffer holding the nonce+    -> IO ()+macSetNonce = mkWithObjectSetterCBytesLen withMAC botan_mac_set_nonce++-- | Send more input to the message authentication code+macUpdate+    :: MAC          -- ^ __mac__: mac object+    -> ByteString   -- ^ __buf__: input buffer+    -> IO ()+macUpdate = mkWithObjectSetterCBytesLen withMAC botan_mac_update++-- TODO: Digest type+{- |+Finalizes the MAC computation and writes the output to+out[0:botan_mac_output_length()] then reinitializes for computing+another MAC as if botan_mac_clear had been called.+-}+macFinal+    :: MAC          -- ^ __mac__: mac object+    -> IO MACDigest -- ^ __out[]__: output buffer+macFinal mac = withMAC mac $ \ macPtr -> do+    -- sz <- alloca $ \ szPtr -> do+    --     throwBotanIfNegative_ $ botan_mac_output_length macPtr szPtr+    --     fromIntegral <$> peek szPtr+    sz <- macOutputLength mac+    allocBytes sz $ \ bytesPtr -> do+        throwBotanIfNegative_ $ botan_mac_final macPtr bytesPtr++{- |+Reinitializes the state of the MAC computation. A MAC can+be computed (with update/final) immediately.+-}+macClear+    :: MAC -- @mac@: mac object+    -> IO ()+macClear = mkAction withMAC botan_mac_clear++-- | Get the name of this MAC+macName+    :: MAC              -- ^ __mac__: the object to read+    -> IO ByteString    -- ^ __name__: output buffer+macName = mkGetCString withMAC botan_mac_name++-- | Get the key length limits of this auth code+macGetKeyspec+    :: MAC              -- ^ __mac__: the object to read+    -> IO (Int,Int,Int) -- ^ __(min,max,mod)__: minimum maximum and modulo keylength of MAC+macGetKeyspec = mkGetSizes3 withMAC botan_mac_get_keyspec++-- TODO: MAC does not have a nonce size query, and it relies on per-algorithm knowledgre+-- Luckily only 1 MAC actually requires a nonce (GMAC), so this isn't really an issue+--  macGetNoncespec :: MAC -> IO (Int,Int,Int)+-- Or+-- macGetDefaultNonceLength :: MAC -> IO Int
+ src/Botan/Low/MPI.hs view
@@ -0,0 +1,307 @@+{-|+Module      : Botan.Low.MPI+Description : Multiple Precision Integers+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++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  ++) where++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++-- Yes, the module is named MPI, but the type is MP.+-- I'm probably renaming the module / type to `Botan.Integer` for ergonomics,+--  like I did with `Botan.RNG`.++-- NOTE: Operations have a different format here, compared to other botan objects.+--  Botan.Make does not apply very well.+--  MPI are rarely mutated, and usually take a destination argument instead.+--  As such, there are some mk- functions specific to MPI, and this module+--  will be greatly improved by idiomatic bindings wrappers++-- NOTE: This whole module is not idiomatic - some methods mutate, some have a destination argument+--  It will need furter wrapping.++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, _)+    = mkBindings+        MkBotanMP runBotanMP+        MkMP getMPForeignPtr+        botan_mp_destroy++mpInit :: IO MP+-- mpInit = mkInit MkMP botan_mp_init botan_mp_destroy+mpInit = createMP botan_mp_init++-- NOTE: The actual botan_mp_to_hex is misleading+--  The actual buffer size is 2 + (num_bytes * 2) + 1 bytes in length+--  The leading 2 is `0x` prefix, the trailing 1 is `\0` suffix+mpToHex :: MP -> IO ByteString+mpToHex mp = withMP mp $ \ mpPtr -> do+    numBytes <- mpNumBytes mp+    allocaBytes (2 + (numBytes * 2) + 1) $ \ bytesPtr -> do+        throwBotanIfNegative_ $ botan_mp_to_hex mpPtr bytesPtr+        ByteString.packCString bytesPtr++mpToStr :: MP -> Int -> IO ByteString+mpToStr mp base = withMP mp $ \ mpPtr -> do+    allocBytesQueryingCString $ \ bytesPtr szPtr -> +        botan_mp_to_str mpPtr (fromIntegral base) bytesPtr szPtr++mpClear :: MP -> IO ()+mpClear = mkAction withMP botan_mp_clear++mpSetFromInt :: MP -> Int -> IO ()+mpSetFromInt = mkSetCInt withMP botan_mp_set_from_int++mpSetFromMP :: MP -> MP -> IO ()+mpSetFromMP = mkUnaryOp withMP botan_mp_set_from_mp++-- NOTE: Convenience function+mpCopy :: MP -> IO MP+mpCopy mp = do+    copy <- mpInit+    mpSetFromMP copy mp+    return copy++mpSetFromStr :: MP -> ByteString -> IO ()+mpSetFromStr = mkSetCString withMP (\ mp cstr -> botan_mp_set_from_str mp (ConstPtr cstr))++-- NOTE: According to unit tests, this function *does not* prepend "0x" to the value+mpSetFromRadixStr :: MP -> ByteString -> Int -> IO ()+mpSetFromRadixStr = mkSetCString_csize withMP (\ mp cstr radix -> botan_mp_set_from_radix_str mp (ConstPtr cstr) radix)++mpNumBits :: MP -> IO Int+mpNumBits = mkGetSize withMP botan_mp_num_bits++mpNumBytes :: MP -> IO Int+mpNumBytes = mkGetSize withMP botan_mp_num_bytes++mpToBin :: MP -> IO ByteString+mpToBin mp = withMP mp $ \ mpPtr -> do+    numBytes <- mpNumBytes mp+    allocBytes numBytes $ \ bytesPtr -> do+        throwBotanIfNegative_ $ botan_mp_to_bin mpPtr bytesPtr++-- NOTE: Awkward, more like mpSetFromBin+--  When we wrap it in higher level, fromBin should be :: ByteString -> IO Integer+mpFromBin :: MP -> ByteString -> IO ()+mpFromBin = mkSetBytesLen withMP (\ mp cbytes len -> botan_mp_from_bin mp (ConstPtr cbytes) len)++mpToWord32 :: MP -> IO Word32+mpToWord32 mp = withMP mp $ \ mpPtr -> do+    alloca $ \ valPtr -> do+        throwBotanIfNegative_ $ botan_mp_to_uint32 mpPtr valPtr+        peek valPtr++mpIsPositive :: MP -> IO Bool+mpIsPositive = mkGetBoolCode withMP botan_mp_is_positive++mpIsNegative :: MP -> IO Bool+mpIsNegative = mkGetBoolCode withMP botan_mp_is_negative++mpFlipSign :: MP -> IO ()+mpFlipSign = mkAction withMP botan_mp_flip_sign++mpIsZero :: MP -> IO Bool+mpIsZero = mkGetBoolCode withMP botan_mp_is_zero++mpAddWord32 :: MP -> MP -> Word32 -> IO ()+mpAddWord32 result x y = withMP result $ \ resultPtr -> do+    withMP x $ \ xPtr -> do+        throwBotanIfNegative_ $ botan_mp_add_u32 resultPtr xPtr y++mpSubWord32 :: MP -> MP -> Word32 -> IO ()+mpSubWord32 result x y = withMP result $ \ resultPtr -> do+    withMP x $ \ xPtr -> do+        throwBotanIfNegative_ $ botan_mp_sub_u32 resultPtr xPtr y++mpAdd :: MP -> MP -> MP -> IO ()+mpAdd = mkBinaryOp withMP botan_mp_add++mpSub :: MP -> MP -> MP -> IO ()+mpSub = mkBinaryOp withMP botan_mp_sub++mpMul :: MP -> MP -> MP -> IO ()+mpMul = mkBinaryOp withMP botan_mp_mul++mpDiv :: MP -> MP -> MP -> MP -> IO ()+mpDiv = mkBinaryDuplexOp withMP botan_mp_div++mpModMul :: MP -> MP -> MP -> MP -> IO ()+mpModMul = mkTrinaryOp withMP botan_mp_mod_mul++-- NOTE: Cannot use mkGetBoolCode unless+mpEqual :: MP -> MP -> IO Bool+mpEqual a b = withMP a $ \ aPtr -> do+    withMP b $ \ bPtr -> do+        throwBotanCatchingBool $ botan_mp_equal aPtr bPtr++-- TODO: Convert Int to Ordering in >1:1 low-level bindings+mpCmp :: MP -> MP -> IO Int+mpCmp a b = withMP a $ \ aPtr -> do+    withMP b $ \ bPtr -> do+        alloca $ \ resultPtr -> do+            throwBotanIfNegative_ $ botan_mp_cmp resultPtr aPtr bPtr+            fromIntegral <$> peek resultPtr++mpSwap :: MP -> MP -> IO ()+mpSwap a b = withMP a $ \ aPtr -> do+    withMP b $ \ bPtr -> do+        throwBotanIfNegative_ $ botan_mp_swap aPtr bPtr++mpPowMod :: MP -> MP -> MP -> MP -> IO ()+mpPowMod = mkTrinaryOp withMP botan_mp_powmod++mpLeftShift :: MP -> MP -> Int -> IO ()+mpLeftShift = mkUnaryOp_csize withMP botan_mp_lshift++mpRightShift :: MP -> MP -> Int -> IO ()+mpRightShift = mkUnaryOp_csize withMP botan_mp_rshift++mpModInverse :: MP -> MP -> MP -> IO ()+mpModInverse = mkBinaryOp withMP botan_mp_mod_inverse++mpRandBits :: MP -> RNG -> Int -> IO ()+mpRandBits mp rng sz = withMP mp $ \ mpPtr -> do+   withRNG rng $ \ botanRNG -> do+        throwBotanIfNegative_ $ botan_mp_rand_bits mpPtr botanRNG (fromIntegral sz)++-- NOTE: Never includes upper bound+mpRandRange :: MP -> RNG -> MP -> MP -> IO ()+mpRandRange mp rng lower upper = withMP mp $ \ mpPtr -> do+   withRNG rng $ \ botanRNG -> do+        withMP lower $ \ lowerPtr -> do+            withMP upper $ \ upperPtr -> do+                throwBotanIfNegative_ $ botan_mp_rand_range mpPtr botanRNG lowerPtr upperPtr++mpGCD :: MP -> MP -> MP -> IO ()+mpGCD = mkBinaryOp withMP botan_mp_gcd++-- NOTE: Miller–Rabin primality test+mpIsPrime :: MP -> RNG -> Int -> IO Bool+mpIsPrime mp rng probability = withMP mp $ \ mpPtr -> do+    withRNG rng $ \ botanRNG -> do+        throwBotanCatchingBool $ botan_mp_is_prime mpPtr botanRNG (fromIntegral probability)++mpGetBit :: MP -> Int -> IO Bool+mpGetBit = mkGetBoolCode_csize withMP botan_mp_get_bit++mpSetBit :: MP -> Int -> IO ()+mpSetBit = mkSetCSize withMP botan_mp_set_bit++mpClearBit :: MP -> Int -> IO ()+mpClearBit = mkSetCSize withMP botan_mp_clear_bit++--+-- Helpers+--++-- int botan_...(botan_mp_t dest, const botan_mp_t source);+type UnaryOp ptr = ptr -> ptr -> IO BotanErrorCode++mkUnaryOp :: WithPtr typ ptr -> UnaryOp ptr -> typ -> typ -> IO ()+mkUnaryOp withPtr unary dest source = withPtr dest $ \ destPtr -> do+    withPtr source $ \ sourcePtr -> do+        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++mkUnaryOp_csize :: WithPtr typ ptr -> UnaryOp_csize ptr -> typ -> typ -> Int -> IO ()+mkUnaryOp_csize withPtr unary dest source factor  = withPtr dest $ \ destPtr -> do+    withPtr source $ \ sourcePtr -> do+        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++mkBinaryOp :: WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()+mkBinaryOp withPtr binary dest a b = withPtr dest $ \ destPtr -> do+    withPtr a $ \ aPtr -> do+        withPtr b $ \ bPtr -> do+            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++-- NOTE: Do not confuse for mkTrinaryOp+mkBinaryDuplexOp :: WithPtr typ ptr -> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO ()+mkBinaryDuplexOp withPtr binary a b x y = withPtr a $ \ aPtr -> do+    withPtr b $ \ bPtr -> do+        withPtr x $ \ xPtr -> do+            withPtr y $ \ yPtr -> do+                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++-- NOTE: Do not confuse for mkBinaryDuplexOp+mkTrinaryOp :: WithPtr typ ptr -> TrinaryOp ptr -> typ -> typ -> typ -> typ -> IO ()+mkTrinaryOp withPtr binary a x y z = withPtr a $ \ aPtr -> do+    withPtr x $ \ xPtr -> do+        withPtr y $ \ yPtr -> do+            withPtr z $ \ zPtr -> do+                throwBotanIfNegative_ $ binary aPtr xPtr yPtr zPtr
+ src/Botan/Low/Make.hs view
@@ -0,0 +1,471 @@+module Botan.Low.Make where++import qualified Data.ByteString as ByteString++import Botan.Low.Error+import Botan.Low.Prelude++{-+Basic botan type template+-}++{-+-- Raw bindings+data TypStruct+type TypPtr = Ptr TypStruct++-- Low-level bindings+newtype Typ = MkTyp { getTypForeignPtr :: ForeignPtr TypStruct }++withTypPtr :: Typ -> (TypPtr -> IO a) -> IO a+withTypPtr = withForeignPtr . getTypForeignPtr++-- Common / optional associated types+type TypName = ByteString+type TypFlags = Word32+-}++{-+Helper types+-}++type WithPtr typ ptr = (forall a . typ -> (ptr -> IO a) -> IO a)+-- NOTE: WithPtr typ ptr ~ typ -> Codensity IO ptr +--  where: type Codensity m a = forall b . (a -> m b) -> m b+-- TODO: Refine further per:+--  https://discourse.haskell.org/t/questions-about-ffi-foreignptr-and-opaque-types/6914/21?u=apothecalabs++{-+Initializers and destroyers+-}++-- TODO: Generalize all this away to simplify+--  Note the change in position of the destructor argument within the mk function itself,+--  as well as the position of the argument within the initializer+{-+type Construct struct typ = ForeignPtr struct -> typ+type Destruct struct = FinalizerPtr struct+type Initialize0 struct = Ptr (Ptr struct) -> IO BotanErrorCode++mkInit0+    :: Construct struct typ+    -> Destruct struct+    -> Initialize0 struct+    -> IO typ+mkInit0 construct destruct init0 = do+    alloca $ \ outPtr -> do+        throwBotanIfNegative_ $ init0 outPtr+        out <- peek outPtr+        foreignPtr <- newForeignPtr destruct out+        return $ construct foreignPtr+-}+-- More complex constructors can build on this with more arguments, but there is a choice+--  This choice is left vs right, return arguments before or after.+--  The effectiveness of this choice depends on the structure of the FFI+--  If we changed the FFI to always have trailing return arguments (instead of leading),+--  then we could type+--      Initializer1 withArg0 ... struct+--  instead of+--      Initializer1 struct withArg0 ...+--  Note that even Construct follows trailing return arguments as does Haskell,+--  so there is justifcation for converting the FFI to that format wholesale;+--  such effort (rewriting the Botan FFI to be 100% consistent) is far beyond+--  the scope of this project at this time.+-- SEE: mkInit_with+-- EXAMPLE:+{-+mkFoo :: A -> B -> C -> IO Foo+mkFoo a b c = withA a $ \ a' -> do+    withB b $ \ b' -> do+        withC c $ \ c' -> do+            -- Trailing-return style+            mkInit0 MkFoo botan_foo_destroy $ botan_foo_create a' b' c'+            -- Vs current leading-return style+            mkInit MkFoo (\ ptr -> botan_foo_create ptr a' b' c') botan_x509_cert_store_destroy+            -- Note the explicit ptr argument and the necessary parenthesis+-}+-- SEE: x509CertStoreSqlite3Create for how the current style makes ad-hoc constructors+--  more difficult than necessary unless we initialize the return pointer first+-- Also note that initializing the return value pointer last is probably a good practice in general+--  and trailing-return style makes that easy+-- ON THE OTHER HAND trailing-return style makes querying for sizes difficult+-- END TODO++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 Destructor struct = FinalizerPtr struct++mkInit+    :: Constr struct typ+    -> Initializer struct+    -> Destructor struct+    -> IO typ+mkInit constr init destroy = do+    alloca $ \ outPtr -> do+        throwBotanIfNegative_ $ init outPtr+        out <- peek outPtr+        foreignPtr <- newForeignPtr destroy out+        return $ constr foreignPtr++mkInit_name+    :: Constr struct typ+    -> Initializer_name struct+    -> Destructor struct+    -> ByteString -> IO typ+mkInit_name constr init destroy name = do+    alloca $ \ outPtr -> do+        asCString name $ \ namePtr -> do +            throwBotanIfNegative_ $ init outPtr namePtr+        out <- peek outPtr+        foreignPtr <- newForeignPtr destroy out+        return $ constr foreignPtr++mkInit_name_flags+    :: Constr struct typ+    -> Initializer_name_flags struct+    -> Destructor struct+    -> ByteString -> Word32 -> IO typ+mkInit_name_flags constr init destroy name flags = do+    alloca $ \ outPtr -> do+        asCString name $ \ namePtr -> do +            throwBotanIfNegative_ $ init outPtr namePtr flags+        out <- peek outPtr+        foreignPtr <- newForeignPtr destroy out+        return $ constr foreignPtr++-- NOTE: Assumes that length is known+mkInit_bytes+    :: Constr struct typ+    -> Initializer_bytes struct+    -> Destructor struct+    -> ByteString -> IO typ+mkInit_bytes constr init destroy bytes = do+    asBytes bytes $ \ bytesPtr -> do +        alloca $ \ outPtr -> do+            throwBotanIfNegative_ $ init outPtr bytesPtr+            out <- peek outPtr+            foreignPtr <- newForeignPtr destroy out+            return $ constr foreignPtr++mkInit_bytes_len+    :: Constr struct typ+    -> Initializer_bytes_len struct+    -> Destructor struct+    -> ByteString -> IO typ+mkInit_bytes_len constr init destroy bytes = do+    asBytesLen bytes $ \ bytesPtr bytesLen -> do +        alloca $ \ outPtr -> do+            throwBotanIfNegative_ $ init outPtr bytesPtr bytesLen+            out <- peek outPtr+            foreignPtr <- newForeignPtr destroy out+            return $ constr foreignPtr++-- 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++mkInit_with+    :: Constr struct typ+    -> Initializer_with struct withptr+    -> Destructor struct+    -> (withtyp -> (withptr -> IO typ) -> IO typ)+    -> withtyp -> IO typ+mkInit_with constr init destroy withTypPtr typ = alloca $ \ outPtr -> do+    withTypPtr typ $ \ typPtr -> do+        throwBotanIfNegative_ $ init outPtr typPtr+        out <- peek outPtr+        foreignPtr <- newForeignPtr destroy out+        return $ constr foreignPtr++{-+Non-effectful queries+-}++-- type GetName ptr = ptr -> Ptr CChar -> Ptr CSize -> IO BotanErrorCode++-- Replaced by the new mkGetCString+-- -- TODO: Prefer mkGetBytes / mkGetCString to mkGetName+-- mkGetName+--     :: WithPtr typ ptr+--     -> GetName ptr+--     -> typ -> IO ByteString+-- mkGetName withPtr get typ = withPtr typ $ \ typPtr -> do+--     -- TODO: Take advantage of allocBytesQuerying+--     -- TODO: use ByteString.Internal.createAndTrim?+--     -- NOTE: This uses copy to mimic ByteArray.take (which copies!) so we can drop the rest of the bytestring+--     -- alloca $ \ szPtr -> do+--     --     bytes <- allocBytes 64 $ \ bytesPtr -> do+--     --         throwBotanIfNegative_ $ get typPtr bytesPtr szPtr+--     --     sz <- peek szPtr+--     --     return $! ByteString.copy $! ByteString.take (fromIntegral sz) bytes+--     allocBytesQueryingCString $ \ bytesPtr szPtr -> get typPtr bytesPtr szPtr++-- 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++mkGetBytes+    :: WithPtr typ ptr+    -> GetBytes ptr byte+    -> typ -> IO ByteString+mkGetBytes withPtr get typ = withPtr typ $ \ typPtr -> do+    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++mkGetCString+    :: WithPtr typ ptr+    -> GetCString ptr byte+    -> typ -> IO ByteString+mkGetCString withPtr get typ = withPtr typ $ \ typPtr -> do+    allocBytesQueryingCString $ \ outPtr outLen -> get typPtr outPtr outLen++type GetInt ptr = ptr -> Ptr CInt -> IO BotanErrorCode++mkGetInt+    :: WithPtr typ ptr+    -> GetInt ptr+    -> typ -> IO Int+mkGetInt withPtr get typ = withPtr typ $ \ typPtr -> do+    alloca $ \ szPtr -> do+        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++mkGetSize+    :: WithPtr typ ptr+    -> GetSize ptr+    -> typ -> IO Int+mkGetSize withPtr get typ = withPtr typ $ \ typPtr -> do+    alloca $ \ szPtr -> do+        throwBotanIfNegative_ $ get typPtr szPtr+        fromIntegral <$> peek szPtr++mkGetSize_csize+    :: WithPtr typ ptr+    -> GetSize_csize ptr+    -> typ -> Int -> IO Int+mkGetSize_csize withPtr get typ forSz = withPtr typ $ \ typPtr -> do+    alloca $ \ szPtr -> do+        throwBotanIfNegative_ $ get typPtr (fromIntegral forSz) szPtr+        fromIntegral <$> peek szPtr++mkGetSizes2+    :: WithPtr typ ptr+    -> GetSizes2 ptr+    -> typ -> IO (Int,Int)+mkGetSizes2 withPtr get typ = withPtr typ $ \ typPtr -> do+    alloca $ \ szPtrA -> alloca $ \ szPtrB -> do+        throwBotanIfNegative_ $ get typPtr szPtrA szPtrB+        szA <- fromIntegral <$> peek szPtrA+        szB <- fromIntegral <$> peek szPtrB+        return (szA,szB)++mkGetSizes3+    :: WithPtr typ ptr+    -> GetSizes3 ptr+    -> typ -> IO (Int,Int,Int)+mkGetSizes3 withPtr get typ = withPtr typ $ \ typPtr -> do+    alloca $ \ szPtrA -> alloca $ \ szPtrB -> alloca $ \ szPtrC -> do+        throwBotanIfNegative_ $ get typPtr szPtrA szPtrB szPtrC+        szA <- fromIntegral <$> peek szPtrA+        szB <- fromIntegral <$> peek szPtrB+        szC <- fromIntegral <$> peek szPtrC+        return (szA,szB,szC)++-- type GetBytes ptr = ptr -> Ptr Word8 -> CSize -> IO BotanErrorCode++-- 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++mkGetBoolCode+    :: WithPtr typ ptr+    -> GetBoolCode ptr+    -> typ -> IO Bool+mkGetBoolCode withPtr get typ = withPtr typ $ \ typPtr -> do+    throwBotanCatchingBool $ get typPtr++mkGetBoolCode_csize+    :: WithPtr typ ptr+    -> GetBoolCode_csize ptr+    -> typ -> Int -> IO Bool+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++mkGetIntCode+    :: WithPtr typ ptr+    -> GetIntCode ptr+    -> typ -> IO Int+mkGetIntCode withPtr get typ = withPtr typ $ \ typPtr -> do+    throwBotanCatchingInt $ get typPtr++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++{-+Effectful actions+-}++type Action ptr = ptr -> IO BotanErrorCode+mkAction+    :: WithPtr typ ptr+    -> Action ptr+    -> typ -> IO ()+mkAction withPtr action typ = withPtr typ $ \ typPtr -> do+    throwBotanIfNegative_ $ action typPtr++mkSet+    :: WithPtr typ ptr+    -> (ptr -> a -> IO BotanErrorCode)+    -> typ -> a -> IO ()+mkSet withPtr set typ a = withPtr typ $ \ typPtr -> do+    throwBotanIfNegative_ $ set typPtr a++mkSetOn+    :: WithPtr typ ptr+    -> (a -> b)+    -> (ptr -> b -> IO BotanErrorCode)+    -> 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++mkSetCSize+    :: WithPtr typ ptr+    -> SetCSize ptr+    -> typ -> Int -> IO ()+mkSetCSize withPtr set typ sz = withPtr typ $ \ typPtr -> do+    throwBotanIfNegative_ $ set typPtr (fromIntegral sz)++mkSetCInt+    :: WithPtr typ ptr+    -> SetCInt ptr+    -> typ -> Int -> IO ()+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++mkSetCString+    :: WithPtr typ ptr+    -> SetCString ptr+    -> typ -> ByteString -> IO ()+mkSetCString withPtr set typ cstring = withPtr typ $ \ typPtr -> do+    asCString cstring $ \ cstringPtr -> do +        throwBotanIfNegative_ $ set typPtr cstringPtr++mkSetCString_csize+    :: WithPtr typ ptr+    -> SetCString_csize ptr+    -> typ -> ByteString -> Int -> IO ()+mkSetCString_csize withPtr set typ cstring sz = withPtr typ $ \ typPtr -> do+    asCString cstring $ \ cstringPtr -> do +        throwBotanIfNegative_ $ set typPtr cstringPtr (fromIntegral sz)++type SetBytesLen ptr = ptr -> Ptr Word8 -> CSize -> IO BotanErrorCode++mkSetBytesLen+    :: WithPtr typ ptr+    -> SetBytesLen ptr+    -> typ -> ByteString -> IO ()+mkSetBytesLen withPtr set typ bytes = withPtr typ $ \ typPtr -> do+    asBytesLen bytes $ \ bytesPtr bytesLen -> do +        throwBotanIfNegative_ $ set typPtr bytesPtr bytesLen++-- EXPERIMENTAL++-- TODO: allocBytesEstimating++-- 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 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: Does not check length of taken string, vulnerable to null byte injection+allocBytesQueryingCString :: (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString+allocBytesQueryingCString action = do+    cstring <- allocBytesQuerying action+    return $!! ByteString.takeWhile (/= 0) cstring++-- ALSO EXPERIMENTAL++-- LAZY BUT EFFECTIVE++mkWithTemp :: IO t -> (t -> IO ()) -> (t -> IO a) -> IO a+mkWithTemp = bracket++mkWithTemp1 :: (x -> IO t) -> (t -> IO ()) -> x -> (t -> IO a) -> IO a+mkWithTemp1 init destroy x = bracket (init x) destroy++mkWithTemp2 :: (x -> y -> IO t) -> (t -> IO ()) -> x -> y -> (t -> IO a) -> IO a+mkWithTemp2 init destroy x y = bracket (init x y) destroy++mkWithTemp3 :: (x -> y -> z -> IO t) -> (t -> IO ()) -> x -> y -> z -> (t -> IO a) -> IO a+mkWithTemp3 init destroy x y z = bracket (init x y z) destroy++mkWithTemp4 :: (x -> y -> z -> w -> IO t) -> (t -> IO ()) -> x -> y -> z -> w -> (t -> IO a) -> IO a+mkWithTemp4 init destroy x y z w = bracket (init x y z w) destroy++--++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:))++-- withNullablePtr++-- withNullablePtrList
+ src/Botan/Low/Prelude.hs view
@@ -0,0 +1,247 @@+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
+ src/Botan/Low/PubKey.hs view
@@ -0,0 +1,847 @@+{-|+Module      : Botan.Low.PubKey+Description : Public key cryptography+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Public key cryptography is a collection of techniques allowing+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++-- * Public Keys++, PubKey(..)+, withPubKey+, pubKeyLoad+, pubKeyDestroy+, pubKeyAlgoName+, pubKeyCheckKey+, pubKeyEstimatedStrength+, pubKeyFingerprint+, pubKeyGetField+, pubKeyExport++-- * PK Algorithms++, 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++-- ** DLGroup++, 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++-- ** ECGroup++, 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++-- ** XMSS++, 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++-- * EME++, 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++-- * EMSA++, EMSAName(..)+, emsa_none+, emsa_emsa4+, emsa_hash+, emsa_ed25519Pure+, emsa_ed25519Prehashed+, emsa_ed25519GnuPG+, emsa_sm2SignParam++-- * Convenience++-- , PKPaddingName(..)+, createPrivKey+, createPubKey+, mkPrivKeyLoad1_name+, mkPrivKeyLoad3+, mkPrivKeyLoad4+, mkPubKeyLoad2+, mkPubKeyLoad2_name+, mkPubKeyLoad3+, mkPubKeyLoad4+    +) where++import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Unsafe as ByteString++import Botan.Bindings.MPI+import Botan.Bindings.PubKey+import Botan.Bindings.RNG++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++{- $introduction++-}++{- $usage++Unless you need a specific `public key cryptosystem`, it is strongly+recommended that you use the `RSA`, `Ed25519`, or `Curve25519` algorithms,+depending on your desired operation.++Create an RSA keypair:++> import Botan.Low.RNG+> import Botan.Low.PubKey+> rng <- rngInit "user"+> -- Alice generates her keys+> alicePrivKey <- privKeyCreate RSA "4096" rng+> alicePubKey <- privKeyExportPubKey alicePrivKey++> NOTE: For algorithm-specific parameters, consult the Botan documentation and+source++Encrypt a message:++> import Botan.Low.PubKey.Encrypt+> message = "Fee fi fo fum!"+> -- Bob encrypts a message for Alice using her public key+> -- Unlike `Crypto.Saltine.Core.Box`, the message is only encrypted, not signed.+> encrypter <- encryptCreate alicePubKey EME_PKCS1_v1_5+> ciphertext <- encrypt encrypter rng message++> NOTE: For algorithm-specific padding parameters, consult the Botan+documentation and source++Decrypt a message:++> import Botan.Low.PubKey.Decrypt+> -- Alice decrypts the message from Bob using her private key+> decrypter <- decryptCreate alicePrivKey EME_PKCS1_v1_5+> plaintext <- decrypt decrypter ciphertext+> message == plaintext -- True++> NOTE: The same padding must be used for both encryption and decryption++Sign a message:++> import Botan.Low.PubKey.Sign+> import Botan.Low.Hash+> message = "Fee fi fo fum!"+> -- Alice signs the message using her private key+> signer <- signCreate alicePrivKey (emsa_emsa4 SHA3) StandardFormatSignature+> signUpdate signer message+> sig <- signFinish signer rng++> NOTE: Signing uses a different set of padding algorithms `EMSA` from+encryption `EME`, and different signing / encryption algorithms support+different specific padding algorithms++> NOTE: Signing does not yet have proper constants for selecting a padding+mechanism. For more information, refer to the `Botan.PubKey`,+`Botan.PubKey.Sign`, or the Botan C++ documentation. This area will be improved+in the near future.++Verify a message:++> import Botan.Low.PubKey.Verify+> -- Bob verifies the message using Alice's public key+> verifier <- verifyCreate alicePubKey (emsa_emsa4 SHA3) StandardFormatSignature+> verifyUpdate verifier message+> verified <- verifyFinish verifier sig+> verified -- True++> NOTE: The same padding must be used for both encryption and decryption++-}++-- 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, _)+    = mkBindings+        MkBotanPrivKey runBotanPrivKey+        MkPrivKey getPrivKeyForeignPtr+        botan_privkey_destroy++type PrivKeyName = ByteString++type PKName = ByteString++pattern RSA+    ,   SM2+    ,   ElGamal+    ,   DSA+    ,   ECDSA+    ,   ECKCDSA+    ,   ECGDSA+    ,   GOST_34_10+    ,   Ed25519+    ,   XMSS+    ,   DH+    ,   ECDH+    ,   Curve25519+    ,   Dilithium+    ,   Kyber+    -- ,   SPHINCSPlus+    ,   McEliece+    ::  PKName++pattern RSA         = BOTAN_PK_RSA+pattern SM2         = BOTAN_PK_SM2+pattern ElGamal     = BOTAN_PK_ELGAMAL+pattern DSA         = BOTAN_PK_DSA+pattern ECDSA       = BOTAN_PK_ECDSA+pattern ECKCDSA     = BOTAN_PK_ECKCDSA+pattern ECGDSA      = BOTAN_PK_ECGDSA+pattern GOST_34_10  = BOTAN_PK_GOST_34_10+pattern Ed25519     = BOTAN_PK_ED25519+pattern XMSS        = BOTAN_PK_XMSS+pattern DH          = BOTAN_PK_DH+pattern ECDH        = BOTAN_PK_ECDH+pattern Curve25519  = BOTAN_PK_CURVE25519+pattern Dilithium   = BOTAN_PK_DILITHIUM+pattern Kyber       = BOTAN_PK_KYBER+-- pattern SPHINCSPlus = BOTAN_PK_SPHINCSPLUS+pattern McEliece    = BOTAN_PK_MCELIECE++type XMSSName = ByteString++pattern XMSS_SHA2_10_256+    ,   XMSS_SHA2_16_256+    ,   XMSS_SHA2_20_256+    ,   XMSS_SHA2_10_512+    ,   XMSS_SHA2_16_512+    ,   XMSS_SHA2_20_512+    ,   XMSS_SHAKE_10_256+    ,   XMSS_SHAKE_16_256+    ,   XMSS_SHAKE_20_256+    ,   XMSS_SHAKE_10_512+    ,   XMSS_SHAKE_16_512+    ,   XMSS_SHAKE_20_512+    ::  XMSSName++pattern XMSS_SHA2_10_256 = BOTAN_XMSS_SHA2_10_256+pattern XMSS_SHA2_16_256 = BOTAN_XMSS_SHA2_16_256+pattern XMSS_SHA2_20_256 = BOTAN_XMSS_SHA2_20_256+pattern XMSS_SHA2_10_512 = BOTAN_XMSS_SHA2_10_512+pattern XMSS_SHA2_16_512 = BOTAN_XMSS_SHA2_16_512+pattern XMSS_SHA2_20_512 = BOTAN_XMSS_SHA2_20_512+pattern XMSS_SHAKE_10_256 = BOTAN_XMSS_SHAKE_10_256+pattern XMSS_SHAKE_16_256 = BOTAN_XMSS_SHAKE_16_256+pattern XMSS_SHAKE_20_256 = BOTAN_XMSS_SHAKE_20_256+pattern XMSS_SHAKE_10_512 = BOTAN_XMSS_SHAKE_10_512+pattern XMSS_SHAKE_16_512 = BOTAN_XMSS_SHAKE_16_512+pattern XMSS_SHAKE_20_512 = BOTAN_XMSS_SHAKE_20_512++type ECGroupName = ByteString++pattern 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+    ::  ECGroupName++pattern Secp160k1       = BOTAN_ECGROUP_SECP_160_K1+pattern Secp160r1       = BOTAN_ECGROUP_SECP_160_R1+pattern Secp160r2       = BOTAN_ECGROUP_SECP_160_R2+pattern Secp192k1       = BOTAN_ECGROUP_SECP_192_K1+pattern Secp192r1       = BOTAN_ECGROUP_SECP_192_R1+pattern Secp224k1       = BOTAN_ECGROUP_SECP_224_K1+pattern Secp224r1       = BOTAN_ECGROUP_SECP_224_R1+pattern Secp256k1       = BOTAN_ECGROUP_SECP_256_K1+pattern Secp256r1       = BOTAN_ECGROUP_SECP_256_R1+pattern Secp384r1       = BOTAN_ECGROUP_SECP_384_R1+pattern Secp521r1       = BOTAN_ECGROUP_SECP_521_R1+pattern Brainpool160r1  = BOTAN_ECGROUP_BRAINPOOL_160_R1+pattern Brainpool192r1  = BOTAN_ECGROUP_BRAINPOOL_192_R1+pattern Brainpool224r1  = BOTAN_ECGROUP_BRAINPOOL_224_R1+pattern Brainpool256r1  = BOTAN_ECGROUP_BRAINPOOL_256_R1+pattern Brainpool320r1  = BOTAN_ECGROUP_BRAINPOOL_320_R1+pattern Brainpool384r1  = BOTAN_ECGROUP_BRAINPOOL_384_R1+pattern Brainpool512r1  = BOTAN_ECGROUP_BRAINPOOL_512_R1+pattern X962_p192v2     = BOTAN_ECGROUP_X962_P192_V2+pattern X962_p192v3     = BOTAN_ECGROUP_X962_P192_V3+pattern X962_p239v1     = BOTAN_ECGROUP_X962_P239_V1+pattern X962_p239v2     = BOTAN_ECGROUP_X962_P239_V2+pattern X962_p239v3     = BOTAN_ECGROUP_X962_P239_V3+pattern Gost_256A       = BOTAN_ECGROUP_GOST_256A+pattern Gost_512A       = BOTAN_ECGROUP_GOST_512A+pattern Frp256v1        = BOTAN_ECGROUP_FRP_256_V1+pattern Sm2p256v1       = BOTAN_ECGROUP_SM2_P256_V1++type DLGroupName = ByteString++pattern 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+    ::  DLGroupName++pattern FFDHE_IETF_2048 = BOTAN_DLGROUP_FFDHE_IETF_2048+pattern FFDHE_IETF_3072 = BOTAN_DLGROUP_FFDHE_IETF_3072+pattern FFDHE_IETF_4096 = BOTAN_DLGROUP_FFDHE_IETF_4096+pattern FFDHE_IETF_6144 = BOTAN_DLGROUP_FFDHE_IETF_6144+pattern FFDHE_IETF_8192 = BOTAN_DLGROUP_FFDHE_IETF_8192+pattern MODP_IETF_1024  = BOTAN_DLGROUP_MODP_IETF_1024+pattern MODP_IETF_1536  = BOTAN_DLGROUP_MODP_IETF_1536+pattern MODP_IETF_2048  = BOTAN_DLGROUP_MODP_IETF_2048+pattern MODP_IETF_3072  = BOTAN_DLGROUP_MODP_IETF_3072+pattern MODP_IETF_4096  = BOTAN_DLGROUP_MODP_IETF_4096+pattern MODP_IETF_6144  = BOTAN_DLGROUP_MODP_IETF_6144+pattern MODP_IETF_8192  = BOTAN_DLGROUP_MODP_IETF_8192+pattern MODP_SRP_1024   = BOTAN_DLGROUP_MODP_SRP_1024+pattern MODP_SRP_1536   = BOTAN_DLGROUP_MODP_SRP_1536+pattern MODP_SRP_2048   = BOTAN_DLGROUP_MODP_SRP_2048+pattern MODP_SRP_3072   = BOTAN_DLGROUP_MODP_SRP_3072+pattern MODP_SRP_4096   = BOTAN_DLGROUP_MODP_SRP_4096+pattern MODP_SRP_6144   = BOTAN_DLGROUP_MODP_SRP_6144+pattern MODP_SRP_8192   = BOTAN_DLGROUP_MODP_SRP_8192+pattern DSA_JCE_1024    = BOTAN_DLGROUP_DSA_JCE_1024+pattern DSA_BOTAN_2048  = BOTAN_DLGROUP_DSA_BOTAN_2048+pattern DSA_BOTAN_3072  = BOTAN_DLGROUP_DSA_BOTAN_3072++{- |+Encoding Method for Encryption++WARNING: Name is not completely accurate, may be changed to PKEncryptParams+-}+type EMEName = ByteString++pattern EME_RAW+    ,   EME_PKCS1_v1_5+    ,   EME_OAEP+    :: EMEName++pattern EME_RAW = BOTAN_EME_RAW+pattern EME_PKCS1_v1_5 = BOTAN_EME_PKCS1_v1_5+pattern EME_OAEP = BOTAN_EME_OAEP++eme_raw :: EMEName+eme_raw = EME_RAW++eme_pkcs1_v1_5 :: EMEName+eme_pkcs1_v1_5 = EME_PKCS1_v1_5++eme_oaep :: HashName -> EMEName+eme_oaep h = EME_OAEP /$ h++-- TODO: OAEP with MGF, L+-- eme_oaep_mgf :: HashName -> MGFName -> EMEName+-- eme_oaep_mgf h m = EME_OAEP /$ h <> "," <> m++eme_hash :: HashName -> EMEName+eme_hash = id++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++WARNING: Name is not completely accurate, may be changed to PKSignParams+-}+type EMSAName = ByteString++-- emsa_rsa :: ++emsa_emsa4 :: HashName -> EMSAName+emsa_emsa4 h = "EMSA4(" <> h <> ")"++emsa_ed25519Pure :: EMSAName+emsa_ed25519Pure = "Pure"++emsa_ed25519Prehashed :: EMSAName+emsa_ed25519Prehashed = "Ed25519ph"++emsa_ed25519GnuPG :: HashName -> EMSAName+emsa_ed25519GnuPG = emsa_hash++emsa_hash :: HashName -> EMSAName+emsa_hash = id++emsa_sm2SignParam :: ByteString -> HashName -> EMSAName+emsa_sm2SignParam uid h = uid <> "," <> h++-- emsa_xmss+-- emsa_dilithium++emsa_none :: EMSAName+emsa_none = ""        ++-- | Create a new private key+privKeyCreate+    :: ByteString   -- ^ __algo_name__: something like "RSA" or "ECDSA"+    -> ByteString   -- ^ __algo_params__: is specific to the algorithm. For RSA, specifies+                    --   the modulus bit length. For ECC is the name of the curve.+    -> RNG          -- ^ __rng__: a random number generator+    -> IO PrivKey   -- ^ __key__: the new object will be placed here+privKeyCreate name params rng = asCString name $ \ namePtr -> do+    asCString params $ \ paramsPtr -> do+        withRNG rng $ \ botanRNG -> do+            createPrivKey $ \ out -> botan_privkey_create+                out+                (ConstPtr namePtr)+                (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++pattern CheckKeyNormalTests+    ,   CheckKeyExpensiveTests+    ::  CheckKeyFlags+pattern CheckKeyNormalTests    = BOTAN_CHECK_KEY_NORMAL_TESTS+pattern CheckKeyExpensiveTests = BOTAN_CHECK_KEY_EXPENSIVE_TESTS++-- TODO: Probably catch -1 (INVALID_INPUT), return Bool+-- | Check the validity of a private key+privKeyCheckKey+    :: PrivKey          -- ^ __key__+    -> RNG              -- ^ __rng__+    -> CheckKeyFlags    -- ^ __flags__+    -> IO ()+privKeyCheckKey sk rng flags = withPrivKey sk $ \ skPtr -> do+    withRNG rng $ \ botanRNG -> do+        throwBotanIfNegative_ $ botan_privkey_check_key skPtr botanRNG flags++-- NOTE: Expectes PKCS #8 / PEM structure+-- botan_privkey_export -> null password? and botan_privkey_export_encrypted_... -> use a password?+-- NOTE: This is probably a bad implementation; null pointer and empty string are different+--  and unencrypted is not the same as encrypted with "" as a pasword+--  We'll fix this by having privKeyLoad and privKeyLoadEncrypted be separate functions+{- |+Input currently assumed to be PKCS #8 structure;+Set password to NULL to indicate no encryption expected+Starting in 2.8.0, the rng parameter is unused and may be set to null+-}+privKeyLoad+    :: ByteString   -- ^ __bits[]__+    -> ByteString   -- ^ __password__+    -> IO PrivKey   -- ^ __key__+privKeyLoad bits password = asBytesLen bits $ \ bitsPtr bitsLen -> do+    let asCStringNullable str act = if ByteString.null str+        then act nullPtr+        else asCString str act+    asCStringNullable password $ \ passwordPtr -> do+        createPrivKey $ \ out -> botan_privkey_load+            out+            (MkBotanRNG nullPtr)+            (ConstPtr bitsPtr)+            bitsLen+            (ConstPtr passwordPtr)++type PrivKeyExportFlags = Word32++pattern PrivKeyExportDER+    ,   PrivKeyExportPEM+    ::  PrivKeyExportFlags++pattern PrivKeyExportDER = BOTAN_PRIVKEY_EXPORT_FLAG_DER+pattern PrivKeyExportPEM = BOTAN_PRIVKEY_EXPORT_FLAG_PEM++-- NOTE: Different from allocBytesQuerying / INSUFFICIENT_BUFFER_SPACE+{- |+On input *out_len is number of bytes in out[]+On output *out_len is number of bytes written (or required)+If out is not big enough no output is written, *out_len is set and 1 is returned+Returns 0 on success and sets+If some other error occurs a negative integer is returned.+-}      +privKeyExport+    :: PrivKey              -- ^ __key__+    -> PrivKeyExportFlags   -- ^ __flags__+    -> IO ByteString        -- ^ __out[]__+privKeyExport sk flags = withPrivKey sk $ \ skPtr -> do+    alloca $ \szPtr -> do+        poke szPtr 0+        -- NOTE: Presumed be -1+        _ <- botan_privkey_export skPtr nullPtr szPtr flags+        sz <- peek szPtr+        allocBytes (fromIntegral sz) $ \ bytesPtr -> do+            throwBotanIfNegative_ $ botan_privkey_export skPtr bytesPtr szPtr flags++-- TODO:+-- | View the private key's DER encoding+-- privKeyViewDER+--         :: BotanPrivKey                         -- ^ __key__+--         -> BotanViewContext ctx                 -- ^ __ctx__+--         -> FunPtr (BotanViewBinCallback ctx)    -- ^ __view__+--         -> IO CInt++-- TODO:+-- | View the private key's PEM encoding+-- privKeyViewPEM+--         :: BotanPrivKey                         -- ^ __key__+--         -> BotanViewContext ctx                 -- ^ __ctx__+--         -> FunPtr (BotanViewStrCallback ctx)    -- ^ __view__+--         -> IO CInt++privKeyAlgoName+    :: PrivKey          -- ^ __key__+    -> IO ByteString    -- ^ __out[]__+privKeyAlgoName = mkGetCString withPrivKey botan_privkey_algo_name++-- TODO:+-- privKeyExportEncryptedPBKDFMsec+--     :: PrivKey+--     -> RNG+--     -> ByteString   -- Passphrase+--     -> Word32       -- Msec runtime+--     -> ByteString   -- Cipher algo+--     -> ByteString   -- PBKDF algo+--     -> Word32       -- Flags+--     -> IO ByteString +-- privKeyExportEncryptedPBKDFMsec = undefined++-- TODO:+-- privKeyExportEncryptedPBKDFIter+--     :: PrivKey+--     -> RNG+--     -> ByteString   -- Passphrase+--     -> CSize        -- Iterations+--     -> ByteString   -- Cipher algo+--     -> ByteString   -- PBKDF algo+--     -> Word32       -- Flags+--     -> IO ByteString +-- privKeyExportEncryptedPBKDFIter = undefined++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, _)+    = mkBindings+        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__+privKeyExportPubKey = mkCreateObjectWith createPubKey withPrivKey botan_privkey_export_pubkey++type PubKeyExportFlags = PrivKeyExportFlags++pattern PubKeyExportDER+    ,   PubKeyExportPEM+    ::  PubKeyExportFlags++pattern PubKeyExportDER = PrivKeyExportDER+pattern PubKeyExportPEM = PrivKeyExportPEM++-- NOTE: Different from allocBytesQuerying / INSUFFICIENT_BUFFER_SPACE     +pubKeyExport+    :: PubKey               -- ^ __key__+    -> PubKeyExportFlags    -- ^ __flags__+    -> IO ByteString        -- ^ __out[]__+pubKeyExport pk flags = withPubKey pk $ \ pkPtr -> do+    alloca $ \szPtr -> do+        poke szPtr 0+        -- NOTE: Presumed be -1+        _ <- botan_pubkey_export pkPtr nullPtr szPtr flags+        sz <- peek szPtr+        allocBytes (fromIntegral sz) $ \ bytesPtr -> do+            throwBotanIfNegative_ $ botan_pubkey_export pkPtr bytesPtr szPtr flags+++pubKeyAlgoName+    :: PubKey           -- ^ __key__+    -> 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++-- 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++pubKeyFingerprint+    :: PubKey           -- ^ __key__+    -> HashName         -- ^ __hash__+    -> IO ByteString    -- ^ __out[]__+pubKeyFingerprint pk algo = withPubKey pk $ \ pkPtr -> do+    asCString algo $ \ algoPtr -> do+        allocBytesQuerying $ \ outPtr outLen -> botan_pubkey_fingerprint+            pkPtr+            (ConstPtr algoPtr)+            outPtr+            outLen++-- | Get arbitrary named fields from public or private keys+pubKeyGetField+    :: MP           -- ^ __output__+    -> PubKey       -- ^ __key__+    -> ByteString   -- ^ __field_name__+    -> IO ()+pubKeyGetField mp pk field = withMP mp $ \ mpPtr -> do+    withPubKey pk $ \ pkPtr -> do+        asCString field $ \ fieldPtr -> do+            throwBotanIfNegative_ $ botan_pubkey_get_field+                mpPtr+                pkPtr+                (ConstPtr fieldPtr)++-- | Get arbitrary named fields from public or private keys+privKeyGetField+    :: MP           -- ^ __output__+    -> PrivKey      -- ^ __key__+    -> ByteString   -- ^ __field_name__+    -> IO ()+privKeyGetField mp sk field = withMP mp $ \ mpPtr -> do+    withPrivKey sk $ \ skPtr -> do+        asCString field $ \ fieldPtr -> do+            throwBotanIfNegative_ $ botan_privkey_get_field+                mpPtr+                skPtr+                (ConstPtr fieldPtr)++-- Helpers++mkPrivKeyLoad1_name+    :: (Ptr BotanPrivKey -> BotanMP -> ConstPtr CChar -> IO BotanErrorCode)+    -> 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)+    -> 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++mkPrivKeyLoad4+    :: (Ptr BotanPrivKey -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode)+    -> 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++--++mkPubKeyLoad2+    :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> IO BotanErrorCode)+    -> MP -> MP -> IO PubKey+mkPubKeyLoad2 load a b = withMany withMP [a,b] $ \ [aPtr,bPtr] -> do+    createPubKey $ \ out -> load out aPtr bPtr++mkPubKeyLoad2_name+    :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> ConstPtr CChar -> IO BotanErrorCode)+    -> MP -> MP -> ByteString -> IO PubKey+mkPubKeyLoad2_name load x y name = withMany withMP [x,y] $ \ [xPtr,yPtr] -> do+    asCString name $ \ namePtr -> do+        createPubKey $ \ out -> load out xPtr yPtr (ConstPtr namePtr)++mkPubKeyLoad3+    :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode)+    -> 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++mkPubKeyLoad4+    :: (Ptr BotanPubKey -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO BotanErrorCode)+    -> 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
+ src/Botan/Low/PubKey/DH.hs view
@@ -0,0 +1,35 @@+{-|+Module      : Botan.Low.DSA+Description : Algorithm specific key operations: Diffie Hellman+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.DH where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey.DH++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey++privKeyLoadDH+    :: MP           -- ^ __p__: prime order of a Z_p group+    -> MP           -- ^ __g__: group generator+    -> MP           -- ^ __x__: private key+    -> IO PrivKey   -- ^ __key__: variable populated with key material+privKeyLoadDH = mkPrivKeyLoad3 botan_privkey_load_dh++pubKeyLoadDH+    :: MP           -- ^ __p__: prime order of a Z_p group+    -> MP           -- ^ __g__: group generator+    -> MP           -- ^ __y__: public key+    -> IO PubKey    -- ^ __key__: variable populated with key material+pubKeyLoadDH = mkPubKeyLoad3 botan_pubkey_load_dh
+ src/Botan/Low/PubKey/DSA.hs view
@@ -0,0 +1,53 @@+{-|+Module      : Botan.Low.DSA+Description : Algorithm specific key operations: DSA+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.DSA where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey+import Botan.Bindings.PubKey.DSA++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey+import Botan.Low.RNG++privKeyCreateDSA+    :: RNG          -- ^ __rng__: initialized PRNG+    -> Int          -- ^ __pbits__: length of the key in bits. Must be between in range (1024, 3072)+                    --   and multiple of 64. Bit size of the prime 'p'+    -> Int          -- ^ __qbits__: qbits order of the subgroup. Must be in range (160, 256) and multiple+                    --   of 8+    -> IO PrivKey   -- ^ __key__: handler to the resulting key+privKeyCreateDSA rng pbits qbits = withRNG rng $ \ botanRNG -> do+    createPrivKey $ \ out -> botan_privkey_create_dsa+        out+        botanRNG+        (fromIntegral pbits)+        (fromIntegral qbits)+        +privKeyLoadDSA +    :: MP           -- ^ __p__+    -> MP           -- ^ __q__+    -> MP           -- ^ __g__+    -> MP           -- ^ __x__+    -> IO PrivKey   -- ^ __key__+privKeyLoadDSA = mkPrivKeyLoad4 botan_privkey_load_dsa++pubKeyLoadDSA+    :: MP           -- ^ __p__+    -> MP           -- ^ __q__+    -> MP           -- ^ __g__+    -> MP           -- ^ __y__+    -> IO PubKey    -- ^ __key__+pubKeyLoadDSA = mkPubKeyLoad4 botan_pubkey_load_dsa
+ src/Botan/Low/PubKey/Decrypt.hs view
@@ -0,0 +1,84 @@+{-|+Module      : Botan.Low.PubKey.Decrypt+Description : Public Key Decryption+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.Decrypt+(++-- * Public key decryption+  Decrypt(..)+, withDecrypt+, decryptCreate+, decryptDestroy+, decryptOutputLength+, decrypt  ++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey.Decrypt++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.RNG+import Botan.Low.PubKey+import Botan.Low.Remake++-- /*+-- * Public Key Decryption+-- */++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, _)+    = mkBindings+        MkBotanPKOpDecrypt runBotanPKOpDecrypt+        MkDecrypt getDecryptForeignPtr+        botan_pk_op_decrypt_destroy++decryptCreate+    :: PrivKey  -- ^ __key__+    -> EMEName  -- ^ __padding__+    -> IO Decrypt+decryptCreate sk padding =  withPrivKey sk $ \ skPtr -> do+    asCString padding $ \ paddingPtr -> do+        createDecrypt $ \ out -> botan_pk_op_decrypt_create+            out+            skPtr+            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+            decPtr+            outPtr+            szPtr+            (ConstPtr ctextPtr)+            ctextLen
+ src/Botan/Low/PubKey/ECDH.hs view
@@ -0,0 +1,21 @@+module Botan.Low.PubKey.ECDH where++import Botan.Bindings.PubKey+import Botan.Bindings.PubKey.ECDH++import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey++privKeyLoadECDH+    :: MP           -- ^ __scalar__+    -> ByteString   -- ^ __curve_name__+    -> IO PrivKey   -- ^ __key__+privKeyLoadECDH = mkPrivKeyLoad1_name botan_privkey_load_ecdh++pubKeyLoadECDH+    :: MP           -- ^ __public_x__+    -> MP           -- ^ __public_y__+    -> ByteString   -- ^ __curve_name__+    -> IO PubKey    -- ^ __key__+pubKeyLoadECDH = mkPubKeyLoad2_name botan_pubkey_load_ecdh
+ src/Botan/Low/PubKey/ECDSA.hs view
@@ -0,0 +1,21 @@+module Botan.Low.PubKey.ECDSA where++import Botan.Bindings.PubKey+import Botan.Bindings.PubKey.ECDSA++import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey++privKeyLoadECDSA+    :: MP           -- ^ __scalar__+    -> ByteString   -- ^ __curve_name__+    -> IO PrivKey   -- ^ __key__+privKeyLoadECDSA = mkPrivKeyLoad1_name botan_privkey_load_ecdsa++pubKeyLoadECDSA+    :: MP           -- ^ __public_x__+    -> MP           -- ^ __public_y__+    -> ByteString   -- ^ __curve_name__+    -> IO PubKey    -- ^ __key__+pubKeyLoadECDSA = mkPubKeyLoad2_name botan_pubkey_load_ecdsa
+ src/Botan/Low/PubKey/Ed25519.hs view
@@ -0,0 +1,52 @@+{-|+Module      : Botan.Low.Ed25519+Description : Algorithm specific key operations: Ed25519+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.Ed25519 where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey+import Botan.Bindings.PubKey.Ed25519++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.PubKey+import Botan.Low.Remake++-- /*+-- * Algorithm specific key operations: Ed25519+-- */++-- NOTE: Input must be exactly 32 bytes long+privKeyLoadEd25519+    :: ByteString       -- ^ __privkey[32]__+    -> IO PrivKey       -- ^ __key__+privKeyLoadEd25519 = mkCreateObjectCBytes createPrivKey botan_privkey_load_ed25519++-- NOTE: Input must be exactly 32 bytes long+pubKeyLoadEd25519+    :: ByteString       -- ^ __pubkey[32]__+    -> IO PubKey        -- ^ __key__+pubKeyLoadEd25519 = mkCreateObjectCBytes createPubKey botan_pubkey_load_ed25519++privKeyEd25519GetPrivKey+    :: PrivKey          -- ^ __output[64]__+    -> IO ByteString    -- ^ __key__+privKeyEd25519GetPrivKey sk = withPrivKey sk $ \ skPtr -> do+    allocBytes 64 $ \ outPtr -> do+        throwBotanIfNegative_ $ botan_privkey_ed25519_get_privkey skPtr outPtr++pubKeyEd25519GetPubKey+    :: PubKey           -- ^ __pubkey[32]__+    -> IO ByteString    -- ^ __key__+pubKeyEd25519GetPubKey pk = withPubKey pk $ \ pkPtr -> do+    allocBytes 32 $ \ outPtr -> do+        throwBotanIfNegative_ $ botan_pubkey_ed25519_get_pubkey pkPtr outPtr
+ src/Botan/Low/PubKey/ElGamal.hs view
@@ -0,0 +1,53 @@+{-|+Module      : Botan.Low.ElGamal+Description : Algorithm specific key operations: ElGamal+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.ElGamal where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey+import Botan.Bindings.PubKey.ElGamal++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey+import Botan.Low.RNG++-- /*+-- * Algorithm specific key operations: ElGamal+-- */++privKeyCreateElGamal+    :: RNG          -- ^ __rng__: initialized PRNG+    -> Int          -- ^ __pbits__: length of the key in bits. Must be at least 1024+    -> Int          -- ^ __qbits__: order of the subgroup. Must be at least 160+    -> IO PrivKey   -- ^ __key__: handler to the resulting key+privKeyCreateElGamal rng pbits qbits = withRNG rng $ \ botanRNG -> do+    createPrivKey $ \ out -> botan_privkey_create_elgamal+        out+        botanRNG+        (fromIntegral pbits)+        (fromIntegral qbits)++privKeyLoadElGamal+    :: MP           -- ^ __p__: prime order of a Z_p group+    -> MP           -- ^ __g__: group generator+    -> MP           -- ^ __x__: public key+    -> IO PrivKey   -- ^ __key__: variable populated with key material+privKeyLoadElGamal = mkPrivKeyLoad3 botan_privkey_load_elgamal++pubKeyLoadElGamal+    :: MP           -- ^ __p__: prime order of a Z_p group+    -> MP           -- ^ __g__: group generator+    -> MP           -- ^ __y__: private key+    -> IO PubKey    -- ^ __key__: variable populated with key material+pubKeyLoadElGamal = mkPubKeyLoad3 botan_pubkey_load_elgamal
+ src/Botan/Low/PubKey/Encrypt.hs view
@@ -0,0 +1,93 @@+{-|+Module      : Botan.Low.Encrypt+Description : Public Key Encryption+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.Encrypt+(++-- * Public key encryption+  Encrypt(..)+, withEncrypt+, encryptCreate+, encryptDestroy+, encryptOutputLength+, encrypt++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey.Encrypt++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.RNG+import Botan.Low.PubKey+import Botan.Low.Remake++-- /*+-- * Public Key Encryption+-- */++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, _)+    = mkBindings+        MkBotanPKOpEncrypt runBotanPKOpEncrypt+        MkEncrypt getEncryptForeignPtr+        botan_pk_op_encrypt_destroy++encryptCreate+    :: PubKey       -- ^ __key__+    -> EMEName      -- ^ __padding__+    -> IO Encrypt   -- ^ __op__+encryptCreate pk padding = withPubKey pk $ \ pkPtr -> do+    asCString padding $ \ paddingPtr -> do+        createEncrypt $ \ out -> botan_pk_op_encrypt_create+            out+            pkPtr+            (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
+ src/Botan/Low/PubKey/KeyAgreement.hs view
@@ -0,0 +1,199 @@+{-|+Module      : Botan.Low.KeyAgreement+Description : Key Agreement+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.KeyAgreement+(++-- * PK Key Agreement+-- $introduction+-- * Usage+-- $usage++-- * Key agreement+  KeyAgreement(..)+, withKeyAgreement+, keyAgreementCreate+, keyAgreementDestroy+, keyAgreementExportPublic+, keyAgreementSize+, keyAgreement ++) where++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++{- $introduction++Key agreement is a scheme where two parties exchange public keys, after which+it is possible for them to derive a secret key which is known only to the two+of them.++There are different approaches possible for key agreement. In many protocols,+both parties generate a new key, exchange public keys, and derive a secret,+after which they throw away their private keys, using them only the once.+However this requires the parties to both be online and able to communicate+with each other.++In other protocols, one of the parties publishes their public key online in+some way, and then it is possible for someone to send encrypted messages to+that recipient by generating a new keypair, performing key exchange with the+published public key, and then sending both the message along with their+ephemeral public key. Then the recipient uses the provided public key along+with their private key to complete the key exchange, recover the shared secret,+and decrypt the message.++Typically the raw output of the key agreement function is not uniformly+distributed, and may not be of an appropriate length to use as a key. To+resolve these problems, key agreement will use a Key Derivation Functions (KDF)+on the shared secret to produce an output of the desired length.++- ECDH over GF(p) Weierstrass curves+- ECDH over x25519+- DH over prime fields++-}++{- $usage++First, Alice and Bob generate their private keys:++> import Botan.Low.PubKey+> import Botan.Low.PubKey.KeyAgreement+> import Botan.Low.RNG+> import Botan.Low.Hash+> import Botan.Low.KDF+> rng <- rngInit "system"+> -- Alice creates her private key+> alicePrivKey <- privKeyCreate ECDH Secp521r1 rng +> -- Bob creates his private key+> bobPrivKey <-  privKeyCreate ECDH Secp521r1 rng ++Then, they exchange their public keys using any channel, private or public:++> -- Alice and Bob exchange public keys+> alicePubKey <- keyAgreementExportPublic alicePrivKey+> bobPubKey <- keyAgreementExportPublic bobPrivKey+> -- ...++Then, they may separately generate the same agreed-upon key and a randomized,+agreed-upon salt:++> salt <- rngGet rng 4+> -- Alice generates her shared key:+> aliceKeyAgreement <- keyAgreementCreate alicePrivKey (kdf2 SHA256)+> aliceSharedKey    <- keyAgreement aliceKeyAgreement bobPubKey salt+> -- Bob generates his shared key:+> bobKeyAgreement   <- keyAgreementCreate bobPrivKey (kdf2 SHA256)+> bobSharedKey      <- keyAgreement bobKeyAgreement alicePubKey salt+> -- They are the same+> aliceSharedKey == bobSharedKey+> -- True++> WARNING: There used to be a memory leak in keyAgreement. Please+> report this bug to the maintainers if it returns.++-}++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, _)+    = mkBindings+        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++-- 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<const Botan::PK_Key_Agreement_Key*>(&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+        skPtr+        outPtr+        outLen++keyAgreementSize+    :: KeyAgreement -- ^ __op__+    -> IO Int       -- ^ __out_len__+keyAgreementSize = mkGetSize withKeyAgreement botan_pk_op_key_agreement_size++{-# WARNING keyAgreement "This function was leaking memory and causing crashes. Please observe carefully and report any future leaks." #-}+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
+ src/Botan/Low/PubKey/KeyEncapsulation.hs view
@@ -0,0 +1,251 @@+{-|+Module      : Botan.Low.KeyEncapsulation+Description : Key Encapsulation+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.KeyEncapsulation+(++-- * PK Key Encapsulation+-- $introduction+-- * Usage+-- $usage++-- * KEM Encryption+  KEMSharedKey(..)+, KEMEncapsulatedKey(..)+, KEMEncrypt(..)+, withKEMEncrypt+, kemEncryptDestroy+, kemEncryptCreate+, kemEncryptSharedKeyLength+, kemEncryptEncapsulatedKeyLength+, kemEncryptCreateSharedKey++-- * KEM Decryption+, KEMDecrypt(..)+, withKEMDecrypt+, kemDecryptDestroy+, kemDecryptCreate+, kemDecryptSharedKeyLength+, kemDecryptSharedKey++) where++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++{- $introduction++Key encapsulation (KEM) is a variation on public key encryption which is+commonly used by post-quantum secure schemes. Instead of choosing a random+secret and encrypting it, as in typical public key encryption, a KEM encryption+takes no inputs and produces two values, the shared secret and the encapsulated+key. The decryption operation takes in the encapsulated key and returns the+shared secret.++-}++{- $usage++> NOTE: KEM only requires the public knowledge of one person's key pair, unlike+> Key Agreement.++First, Alice generates her private and public key pair:++> import Botan.Low.PubKey+> import Botan.Low.PubKey.KeyEncapsulation+> import Botan.Low.Hash+> import Botan.Low.KDF+> import Botan.Low.RNG+> rng <- rngInit UserRNG+> -- Alice generates her private and public keys+> alicePrivKey <- privKeyCreate RSA "2048" rng+> alicePubKey <- privKeyExportPubKey alicePrivKey++Then, Alice shares her public key somewhere where others can see. When Bob+wants to create a shared key with Alice, they choose a KDF algorithm, generate+a salt, and choose a shared key length.++> kdfAlg = hkdf SHA256+> salt <- rngGet rng 4+> sharedKeyLength = 256++Then, Bob generates the shared + encapsulated key, and sends the+encapsulated key to Alice:++> encryptCtx <- kemEncryptCreate alicePubKey kdfAlg+> (bobSharedKey, encapsulatedKey) <- kemEncryptCreateSharedKey encryptCtx rng salt sharedKeyLength+> -- sendToAlice encapsulatedKey++Upon receiving the encapsulated key, Alice can decrypt and extract the shared+key using her private key:++> decryptCtx <- kemDecryptCreate alicePrivKey kdfAlg+> aliceSharedKey <- kemDecryptSharedKey decryptCtx salt encapsulatedKey sharedKeyLength+> bobSharedKey == aliceSharedKey+> -- True++Then, this shared key may be used for any suitable purpose.++-}++-- TODO: KEM supports the following key types:+--      RSA+--      Kyber+--      McEliece+--  https://botan.randombit.net/handbook/api_ref/pubkey.html#key-encapsulation+-- KYBER is post-quantum++type KEMSharedKey = ByteString+type KEMEncapsulatedKey = ByteString++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, _)+    = mkBindings+        MkBotanPKOpKEMEncrypt runBotanPKOpKEMEncrypt+        MkKEMEncrypt getKEMEncryptForeignPtr+        botan_pk_op_kem_encrypt_destroy++++++kemEncryptCreate+    :: PubKey           -- ^ __key__+    -> KDFName          -- ^ __kdf__+    -> IO KEMEncrypt    -- ^ __op__+kemEncryptCreate pk algo = withPubKey pk $ \ pkPtr -> do+    asCString algo $ \ algoPtr -> do+        createKEMEncrypt $ \ out -> botan_pk_op_kem_encrypt_create+            out+            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__+    -> IO Int       -- ^ __output_shared_key_length__+kemEncryptSharedKeyLength = mkGetSize_csize withKEMEncrypt botan_pk_op_kem_encrypt_shared_key_length+++kemEncryptEncapsulatedKeyLength+    :: KEMEncrypt   -- ^ __op__+    -> IO Int       -- ^ __output_encapsulated_key_length__+kemEncryptEncapsulatedKeyLength = mkGetSize withKEMEncrypt botan_pk_op_kem_encrypt_encapsulated_key_length++-- NOTE: Awkward because of double-query and returning double bytestrings+--  Cannot use allocBytesQuerying because of double-return+-- NOTE: Returns (SharedKey, EncapsulatedKey)+++kemEncryptCreateSharedKey+    :: KEMEncrypt                           -- ^ __op__+    -> RNG                                  -- ^ __rng__+    -> ByteString                           -- ^ __salt[]__+    -> Int                                  -- ^ __desired_shared_key_len__+    -> IO (KEMSharedKey,KEMEncapsulatedKey) -- ^ __(shared_key,encapsulated_key)__+kemEncryptCreateSharedKey ke rng salt desiredLen = withKEMEncrypt ke $ \ kePtr -> do+    withRNG rng $ \ botanRNG -> do+        asBytesLen salt $ \ saltPtr saltLen -> do+            alloca $ \ sharedSzPtr -> do +                alloca $ \ encapSzPtr -> do+                    sharedSz <- kemEncryptSharedKeyLength ke desiredLen+                    encapSz <-  kemEncryptEncapsulatedKeyLength ke+                    poke sharedSzPtr (fromIntegral sharedSz)+                    poke encapSzPtr (fromIntegral encapSz)+                    allocBytesWith encapSz $ \ encapPtr -> do+                        allocBytes sharedSz $ \ sharedPtr -> do+                            throwBotanIfNegative_ $ botan_pk_op_kem_encrypt_create_shared_key+                                kePtr+                                botanRNG+                                (ConstPtr saltPtr)+                                saltLen+                                (fromIntegral desiredLen)+                                sharedPtr+                                sharedSzPtr+                                encapPtr+                                encapSzPtr++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, _)+    = mkBindings+        MkBotanPKOpKEMDecrypt runBotanPKOpKEMDecrypt+        MkKEMDecrypt getKEMDecryptForeignPtr+        botan_pk_op_kem_decrypt_destroy++kemDecryptCreate+    :: PrivKey          -- ^ __key__+    -> KDFName          -- ^ __kdf__+    -> IO KEMDecrypt    -- ^ __op__+kemDecryptCreate sk algo = withPrivKey sk $ \ skPtr -> do+    asCString algo $ \ algoPtr -> do+        createKEMDecrypt $ \ out -> botan_pk_op_kem_decrypt_create+            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__+    -> Int          -- ^ __desired_shared_key_length__+    -> IO Int       -- ^ __output_shared_key_length__+kemDecryptSharedKeyLength = mkGetSize_csize withKEMDecrypt botan_pk_op_kem_decrypt_shared_key_length++kemDecryptSharedKey+    :: KEMDecrypt           -- ^ __op__+    -> ByteString           -- ^ __salt[]__+    -> KEMEncapsulatedKey   -- ^ __encapsulated_key[]__+    -> Int                  -- ^ __desired_shared_key_len__+    -> IO KEMSharedKey      -- ^ __shared_key[]__+kemDecryptSharedKey kd salt encap desiredLen = withKEMDecrypt kd $ \ kdPtr -> do+    asBytesLen salt $ \ saltPtr saltLen -> do+        asBytesLen encap $ \ encapPtr encapLen -> do+            -- TODO: Consolidate with allocBytesUpperBound or whatever I end up calling it+            alloca $ \ sharedSzPtr -> do+                sharedSz <- kemDecryptSharedKeyLength kd desiredLen+                poke sharedSzPtr (fromIntegral sharedSz)+                bytes <- allocBytes sharedSz $ \ outPtr -> do+                    throwBotanIfNegative_ $ botan_pk_op_kem_decrypt_shared_key+                        kdPtr+                        (ConstPtr saltPtr)+                        saltLen+                        (ConstPtr encapPtr)+                        encapLen+                        (fromIntegral desiredLen)+                        outPtr+                        sharedSzPtr+                actualSharedSz <- peek sharedSzPtr+                return $!! ByteString.take (fromIntegral actualSharedSz) bytes+
+ src/Botan/Low/PubKey/RSA.hs view
@@ -0,0 +1,51 @@+{-|+Module      : Botan.Low.RSA+Description : Algorithm specific key operations: RSA+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.RSA where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey.RSA++import Botan.Low.Error+import Botan.Low.Remake+import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey++-- /*+-- * Algorithm specific key operations: RSA+-- */++privKeyLoadRSA+    :: MP           -- ^ __p__+    -> MP           -- ^ __q__+    -> MP           -- ^ __e__+    -> IO PrivKey   -- ^ __key__+privKeyLoadRSA = mkPrivKeyLoad3 botan_privkey_load_rsa++privKeyLoadRSA_PKCS1+    :: ByteString   -- ^ __bits__+    -> IO PrivKey   -- ^ __key__+privKeyLoadRSA_PKCS1 = mkCreateObjectCBytesLen createPrivKey botan_privkey_load_rsa_pkcs1++privKeyRSAGetPrivKey+    :: PrivKey          -- ^ __rsa_key__+    -> Word32           -- ^ __flags__+    -> IO ByteString    -- ^ __out__+-- WRONG: privKeyRSAGetPrivKey = mkCreateObjectCBytesLen1 botan_privkey_rsa_get_privkey+privKeyRSAGetPrivKey = mkWithObjectGetterCBytesLen1 withPrivKey+    $ \ rsa_key flags out out_len -> botan_privkey_rsa_get_privkey rsa_key out out_len flags++pubKeyLoadRSA+    :: MP           -- ^ __n__+    -> MP           -- ^ __e__+    -> IO PubKey    -- ^ __key__+pubKeyLoadRSA = mkPubKeyLoad2 botan_pubkey_load_rsa
+ src/Botan/Low/PubKey/SM2.hs view
@@ -0,0 +1,29 @@+module Botan.Low.PubKey.SM2 where++import Botan.Bindings.PubKey+import Botan.Bindings.PubKey.SM2++import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey++privKeyLoadSM2+    :: MP           -- ^ __scalar__+    -> ByteString   -- ^ __curve_name__+    -> IO PrivKey   -- ^ __key__+privKeyLoadSM2 = mkPrivKeyLoad1_name botan_privkey_load_sm2+ +pubKeyLoadSM2+    :: MP           -- ^ __public_x__+    -> MP           -- ^ __public_y__+    -> ByteString   -- ^ __curve_name__+    -> IO PubKey    -- ^ __key__+pubKeyLoadSM2 = mkPubKeyLoad2_name botan_pubkey_load_sm2++-- TODO:+-- pubKeySM2ComputeZA+--     :: ByteString       -- ^ __ident__+--     -> ByteString       -- ^ __hash_algo__+--     -> PubKey           -- ^ __key__+--     -> IO ByteString    -- ^ __out[]__+-- pubKeySM2omputeZA = undefined
+ src/Botan/Low/PubKey/Sign.hs view
@@ -0,0 +1,129 @@+{-|+Module      : Botan.Low.PubKey.Sign+Description : Signature Generation+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.Sign+(++-- * Public key signatures+  Sign(..)+, SigningFlags(..)+, pattern StandardFormatSignature+, pattern DERFormatSignature+, withSign+, signCreate+, signDestroy+, signOutputLength+, signUpdate+, signFinish++) where++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++-- /*+-- * Signature Generation+-- */++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, _)+    = mkBindings+        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+    ,   DERFormatSignature+    ::  SigningFlags+pattern StandardFormatSignature = BOTAN_PUBKEY_STD_FORMAT_SIGNATURE+pattern DERFormatSignature = BOTAN_PUBKEY_DER_FORMAT_SIGNATURE++signCreate+    :: PrivKey      -- ^ __key__+    -> EMSAName     -- ^ __hash_and_padding__+    -> SigningFlags -- ^ __flags__+    -> IO Sign      -- ^ __op__+signCreate sk algo flags = withPrivKey sk $ \ skPtr -> do+    asCString algo $ \ algoPtr -> do+        createSign $ \ out -> botan_pk_op_sign_create+            out+            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__+    -> IO Int   -- ^ __olen__+signOutputLength = mkGetSize withSign botan_pk_op_sign_output_length++signUpdate+    :: Sign         -- ^ __op__+    -> ByteString   -- ^ __in[]__+    -> IO ()+-- signUpdate = mkSetBytesLen withSign botan_pk_op_sign_update+signUpdate = mkWithObjectSetterCBytesLen withSign botan_pk_op_sign_update++-- TODO: Signature type+-- NOTE: This function is still highly suspect+signFinish+    :: Sign             -- ^ __op__+    -> RNG              -- ^ __rng__+    -> IO ByteString    -- ^ __sig[]__+signFinish sign rng = withSign sign $ \ signPtr -> do+    withRNG rng $ \ botanRNG -> do+        -- NOTE: Investigation into DER format shows lots of trailing nulls that may need to be trimmed+        --  using the output of szPtr if sz is just an upper-bound estimate+        -- sz <- signOutputLength sign+        -- allocBytes sz $ \ sigPtr -> do+        --     alloca $ \ szPtr -> do+        --         poke szPtr (fromIntegral sz)+        --         throwBotanIfNegative_ $ botan_pk_op_sign_finish signPtr botanRNG sigPtr szPtr+        -- NOTE: This doesn't work, I think the output length poke is necessary+        -- allocBytesQuerying $ \ sigPtr szPtr -> do+        --     botan_pk_op_sign_finish signPtr botanRNG sigPtr szPtr+        -- NOTE: Trying combo, this should be packaged as allocBytesUpperBound or something+        --  We get an upper bound, allocate at least that many, poke the size, perform the+        --  op, read the actual size, and trim.+        sz <- signOutputLength sign+        (sz',bytes) <- allocBytesWith sz $ \ sigPtr -> do+            alloca $ \ szPtr -> do+                poke szPtr (fromIntegral sz)+                throwBotanIfNegative_ $ botan_pk_op_sign_finish signPtr botanRNG sigPtr szPtr+                peek szPtr+        return $!! ByteString.take (fromIntegral sz') bytes+{-# WARNING signFinish "Depending on the algorithm, signatures produced using StandardFormatSignature may have trailing null bytes." #-}++-- /**+-- * Signature Scheme Utility Functions+-- */++-- TODO: botan_pkcs_hash_id
+ src/Botan/Low/PubKey/Verify.hs view
@@ -0,0 +1,87 @@+{-|+Module      : Botan.Low.Verify+Description : Signature Verification+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.Verify+(++-- * Public key signature verification+  Verify(..)+, withVerify+, verifyCreate+, verifyDestroy+, verifyUpdate+, verifyFinish++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey.Verify++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++-- /*+-- * Signature Verification+-- */++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, _)+    = mkBindings+        MkBotanPKOpVerify runBotanPKOpVerify+        MkVerify getVerifyForeignPtr+        botan_pk_op_verify_destroy++type VerifyAlgo = ByteString++verifyCreate+    :: PubKey       -- ^ __key__+    -> EMSAName     -- ^ __hash_and_padding__+    -> SigningFlags -- ^ __flags__+    -> IO Verify    -- ^ __op__+verifyCreate pk algo flags =  withPubKey pk $ \ pkPtr -> do+    asCString algo $ \ algoPtr -> do+        createVerify $ \ out -> botan_pk_op_verify_create+            out+            pkPtr+            (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[]__+    -> IO ()+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
+ src/Botan/Low/PubKey/X25519.hs view
@@ -0,0 +1,59 @@+{-|+Module      : Botan.Low.X25519+Description : Algorithm specific key operations: X25519+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.PubKey.X25519 where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PubKey++import Botan.Bindings.PubKey.X25519++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.MPI+import Botan.Low.Prelude+import Botan.Low.PubKey+import Botan.Low.Remake++-- /*+-- * Algorithm specific key operations: X25519+-- */++-- NOTE: X25519 is Curve25519:+--  lib/pubkey/curve25519/curve25519.h:+--      typedef Curve25519_PublicKey X25519_PublicKey;+--      typedef Curve25519_PrivateKey X25519_PrivateKey;++-- NOTE: Input must be exactly 32 bytes long+privKeyLoadX25519+    :: ByteString   -- ^ __privkey[32]__+    -> IO PrivKey   -- ^ __key__+privKeyLoadX25519 = mkCreateObjectCBytes createPrivKey botan_privkey_load_x25519++-- NOTE: Input must be exactly 32 bytes long+pubKeyLoadX25519+    :: ByteString   -- ^ __pubkey[32]__+    -> IO PubKey    -- ^ __key__+pubKeyLoadX25519 = mkCreateObjectCBytes createPubKey botan_pubkey_load_x25519++privKeyX25519GetPrivKey+    :: PrivKey          -- ^ __key__+    -> IO ByteString    -- ^ __output[32]__+privKeyX25519GetPrivKey sk = withPrivKey sk $ \ skPtr -> do+    allocBytes 32 $ \ outPtr -> do+        throwBotanIfNegative_ $ botan_privkey_x25519_get_privkey skPtr outPtr++pubKeyX25519GetPubKey+    :: PubKey           -- ^ __key__+    -> IO ByteString    -- ^ __pubkey[32]__+pubKeyX25519GetPubKey pk = withPubKey pk $ \ pkPtr -> do+    allocBytes 32 $ \ outPtr -> do+        throwBotanIfNegative_ $ botan_pubkey_x25519_get_pubkey pkPtr outPtr
+ src/Botan/Low/PwdHash.hs view
@@ -0,0 +1,130 @@+{-|+Module      : Botan.Low.PwdHash+Description : Password hashing+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Derive a key from a passphrase+-}++module Botan.Low.PwdHash+(++-- * Password hashing++  PBKDFName(..)+, pwdhash+, pwdhashTimed++-- * Password hashing algorithms++, pattern PBKDF2+, pbkdf2+, pattern Scrypt+, pattern Argon2d+, pattern Argon2i+, pattern Argon2id+, pattern Bcrypt_PBKDF+, pattern OpenPGP_S2K+, openPGP_S2K+    +) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.PwdHash++import Botan.Low.Hash+import Botan.Low.MAC+import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude++type PBKDFName = ByteString++pattern PBKDF2+    ,   Scrypt+    ,   Argon2d+    ,   Argon2i+    ,   Argon2id+    ,   Bcrypt_PBKDF+    ,   OpenPGP_S2K+    :: PBKDFName++pattern PBKDF2 = BOTAN_PBKDF_PBKDF2+pattern Scrypt = BOTAN_PBKDF_SCRYPT+pattern Argon2d = BOTAN_PBKDF_ARGON2D+pattern Argon2i = BOTAN_PBKDF_ARGON2I+pattern Argon2id = BOTAN_PBKDF_ARGON2ID+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:: 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.+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+{-# WARNING pwdhash "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)+{-# WARNING pwdhashTimed "pwdhash and pwdhashTimed's parameter order may be inconsistent. See botan-low/test/Botan/Low/PwdHashSpec.hs for more information." #-}
+ src/Botan/Low/RNG.hs view
@@ -0,0 +1,180 @@+{-|+Module      : Botan.Low.RNG+Description : Random number generators+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Pseudo-random number generation.+-}++module Botan.Low.RNG+( ++-- * Random number generators+-- $introduction++-- * Usage+-- $usage++  RNG(..)+, RNGType(..)+, withRNG+, rngInit+, rngDestroy+, rngGet+, systemRNGGet+, rngReseed+, rngReseedFromRNG+, rngAddEntropy++-- * RNG Types++, pattern SystemRNG+, pattern UserRNG+, pattern UserThreadsafeRNG+, pattern RDRandRNG++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.RNG++import Botan.Low.Error ( throwBotanIfNegative_ )+import Botan.Low.Make ( mkWithTemp1 )+import Botan.Low.Remake+import Botan.Low.Prelude++{- $introduction++A `random number generator` is used to generate uniform samples of pseudorandom+bytes.++-}++{- $usage++You can always use the system `RNG`:++> import Botan.Low.RNG+> randomBytes <- systemRNGGet 16++Unless you need a specific `RNG`, it is strongly recommended that you use the+autoseeded `user` RNG.++> import Botan.Low.RNG+> rng <- rngInit "user"+> randomBytes <- rngGet rng 16++You can reseed a generator using the system generator:++> rngReseed rng 64++You can also reseed a generator using a specific generator:++> systemRNG <- rngInit "system"+> rngReseedFromRNG rng systemRNG 64++You can also seed it with your own entropy; this is safe and can never+*decrease* the amount of entropy in the generator.++> rngAddEntropy rng "Fee fi fo fum!"++-}++-- NOTE: Does not take advantage of Remake+-- NOTE: Uses ConstPtr / unConstPtr manually+-- TODO: Take advantage of Remake / better peek / (peekConst or constPeek) functions++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++type RNGType = ByteString++pattern SystemRNG           -- ^ system RNG+    ,   UserRNG             -- ^ userspace RNG+    ,   UserThreadsafeRNG   -- ^ userspace RNG, with internal locking+    ,   RDRandRNG           -- ^ directly read RDRAND+    ::  RNGType+pattern SystemRNG           = BOTAN_RNG_TYPE_SYSTEM+pattern UserRNG             = BOTAN_RNG_TYPE_USER+pattern UserThreadsafeRNG   = BOTAN_RNG_TYPE_USER_THREADSAFE+pattern RDRandRNG           = BOTAN_RNG_TYPE_RDRAND++{- |+Initialize a random number generator object++rng_type has the possible values:++    - "system": system RNG+    - "user": userspace RNG+    - "user-threadsafe": userspace RNG, with internal locking+    - "rdrand": directly read RDRAND++Set rng_type to null to let the library choose some default.+-}+rngInit+    :: 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+    :: RNG              -- ^ __rng__: rng object+    -> Int              -- ^ __out_len__: number of requested bytes+    -> IO ByteString    -- ^ __out__: output buffer of size out_len+rngGet rng len = withRNG rng $ \ botanRNG -> do+    allocBytes len $ \ bytesPtr -> do+        throwBotanIfNegative_ $ botan_rng_get botanRNG bytesPtr (fromIntegral len)++-- | Get random bytes from system random number generator+systemRNGGet+    :: Int              -- ^ __out_len__: number of requested bytes+    -> IO ByteString    -- ^ __out__: output buffer of size out_len+systemRNGGet len = allocBytes len $ \ bytesPtr -> do+    throwBotanIfNegative_ $ botan_system_rng_get bytesPtr (fromIntegral len)++{- |+Reseed a random number generator++Uses the System_RNG as a seed generator.+-}+rngReseed+    :: RNG  -- ^ __rng__: rng object+    -> Int  -- ^ __bits__: number of bits to reseed with+    -> IO ()+rngReseed rng bits = withRNG rng $ \ botanRNG -> do+    throwBotanIfNegative_ $ botan_rng_reseed botanRNG (fromIntegral bits)++-- | Reseed a random number generator+rngReseedFromRNG+    :: RNG      -- ^ __rng__: rng object+    -> RNG      -- ^ __source_rng__: the rng that will be read from+    -> Int      -- ^ __bits__: number of bits to reseed with+    -> IO ()+rngReseedFromRNG rng source bits = withRNG rng $ \ botanRNG -> do+    withRNG source $ \ sourcePtr -> do+        throwBotanIfNegative_ $ botan_rng_reseed_from_rng botanRNG sourcePtr (fromIntegral bits)++-- | Add some seed material to a random number generator+rngAddEntropy+    :: RNG          -- ^ __rng__: rng object+    -> ByteString   -- ^ __entropy__: the data to add+    -> IO ()+rngAddEntropy rng bytes = withRNG rng $ \ botanRNG -> do+    asBytesLen bytes $ \ bytesPtr bytesLen -> do+        throwBotanIfNegative_ $ botan_rng_add_entropy botanRNG (ConstPtr bytesPtr) bytesLen
+ src/Botan/Low/Remake.hs view
@@ -0,0 +1,273 @@+{-|+Module      : Botan.Low.Remake+Description : Low-level binding generators+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++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 }++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+    +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+    ->  (botan -> Ptr struct)                                   -- runBotan+    ->  (ForeignPtr struct -> object)                           -- mkForeign+    ->  (object -> ForeignPtr struct)                           -- runForeign+    ->  FinalizerPtr struct                                     -- destroy / finalizer+    ->  (   botan -> IO object                                  -- newObject+        ,   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)+    newObject botan = do+        foreignPtr <- newForeignPtr destroy (runBotan botan)+        return $ mkForeign foreignPtr+    withObject object f = withForeignPtr (runForeign object) (f . mkBotan)+    objectDestroy object = finalizeForeignPtr (runForeign object)+    -- NOTE: This ^ is really a Haskell finalizer+    --  We could include the actual C++ botan destructor instead of indirectly omitting it:+    --      objectFinalize obj = new stable foreign ptr ... destroy+    --      objectDestroy obj = withObject obj destroy+    createObject = mkCreateObject newObject+    createObjects = mkCreateObjects newObject++{-+Create functions+-}++-- TODO: Rename mkCreate+mkCreateObject+    :: (Storable botan)+    => (botan -> IO object)+    -> (Ptr botan-> IO CInt)+    -> IO object+mkCreateObject newObject init = mask_ $ alloca $ \ outPtr -> do+        throwBotanIfNegative_ $ init outPtr+        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)+    -> (Ptr botan -> carg -> IO CInt)+    -> arg+    -> IO object+mkCreateObjectWith createObject withArg init arg = withArg arg $ \ carg -> do+    createObject $ \ outPtr -> init outPtr carg++-- TODO: Rename mkCreateCString+mkCreateObjectCString+    :: ((Ptr botan -> IO CInt) -> IO object)+    -> (Ptr botan -> ConstPtr CChar -> IO CInt)+    -> ByteString+    -> IO object+-- mkCreateObjectCString createObject init cstr = withCString cstr $ \ namePtr -> do+--     createObject $ \ outPtr -> init outPtr (ConstPtr namePtr)+mkCreateObjectCString createObject = mkCreateObjectWith createObject withConstCString++-- TODO: Rename mkCreateCString1+mkCreateObjectCString1+    :: ((Ptr botan -> IO CInt) -> IO object)+    -> (Ptr botan -> ConstPtr CChar -> a -> IO CInt)+    -> ByteString+    -> a+    -> IO object+mkCreateObjectCString1 createObject init str a = withCString str $ \ cstr -> do+    createObject $ \ outPtr -> init outPtr (ConstPtr cstr) a++-- TODO: Rename mkCreateCBytes+mkCreateObjectCBytes+    :: ((Ptr botan -> IO CInt) -> IO object)+    -> (Ptr botan -> ConstPtr Word8 -> IO CInt)+    -> ByteString+    -> IO object+mkCreateObjectCBytes createObject init bytes = withCBytes bytes $ \ cbytes -> do+    createObject $ \ out -> init out (ConstPtr cbytes)+{-# WARNING mkCreateObjectCBytes "You probably want mkCreateObjectCBytesLen; this is for functions that expect a bytestring of known exact length." #-}++-- TODO: Rename mkCreateCBytesLen+mkCreateObjectCBytesLen+    :: ((Ptr botan -> IO CInt) -> IO object)+    -> (Ptr botan -> ConstPtr Word8 -> CSize -> IO CInt)+    -> ByteString+    -> IO object+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+-}+ +-- TODO: Rename mkAction+mkWithObjectAction+    :: (forall a . object -> (botan -> IO a) -> IO a)+    -> (botan -> IO CInt)+    -> object+    -> IO ()+mkWithObjectAction withObject action obj = withObject obj $ \ cobj -> do+    throwBotanIfNegative_ $ action cobj++{-+Getters+-}++-- 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)+    -> (botan -> a -> Ptr Word8 -> Ptr CSize -> IO CInt)+    -> object+    -> a+    -> IO ByteString+mkWithObjectGetterCBytesLen1 withObject getter obj a = withObject obj $ \ cobj -> do+    allocBytesQuerying $ \ outPtr outLen -> getter+        cobj+        a+        outPtr+        outLen++{-+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)+    -> object+    -> ByteString+    -> IO ()+mkWithObjectSetterCBytesLen withObject setter obj bytes = withObject obj $ \ cobj -> do+    withCBytesLen bytes $ \ (cbytes,len) -> do+        throwBotanIfNegative_ $ setter cobj (ConstPtr cbytes) (fromIntegral len)
+ src/Botan/Low/SRP6.hs view
@@ -0,0 +1,333 @@+{-|+Module      : Botan.Low.SRP6+Description : Secure remote password+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++The library contains an implementation of the SRP6-a password+authenticated key exchange protocol.++-}++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(..)++-- * 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++import qualified Data.ByteString as ByteString++import Botan.Bindings.SRP6++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++{- $introduction++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.++SRP works in a discrete logarithm group. Special parameter sets for+SRP6 are defined, denoted in the library as @modp\/srp\/<size>@, for+example @modp\/srp\/2048@.++Warning++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.++SRP6 may be used as part of SSL/TLS: https://www.rfc-editor.org/rfc/rfc5054++-}++{- $usage++On signup, the client generates a salt and verifier, and securely sends them to a server:++> 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, 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:++> -- rng <- rngInit UserRNG+> session <- srp6ServerSessionInit +> -- (verifier, salt, group, hash) <- lookupUser identifier+> serverKey <- srp6ServerSessionStep1 session verifier group hash rng++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:++> -- serverKey <- didReceiveServerKey+> (clientKey, clientSessionKey) <- srp6ClientAgree identifier password group hash salt serverKey rng+> -- sendClientKey clientKey++The server then receives client key, and generates a matching session key:++> -- clientKey <- didReceiveClientKey+> serverSessionKey <- srp6ServerSessionStep2 session clientKey++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.++There are many ways to do this, but preferrably, an (h)mac digest should be used+to also include authentication and avoid impersonation.++> 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:++The client should first calculate and send the HMAC auth, using identifier + salt + clientKey:++> mac <- macInit (hmac SHA3)+> macSetKey mac clientSessionKey+> macUpdate mac $ identifier <> salt <> clientKey+> clientAuth <- macFinal mac+> -- sendClientAuth clientAuth++The server should then verify the client auth, and send its own HMAC+auth back to the client using serverKey + clientAuth:++> -- 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++The client then receives the server HMAC auth, and validates it++> -- serverAuth <- didReceiveServerAuth+> macClear mac+> macSetKey mac clientSessionKey+> macUpdate mac $ serverKey <> clientAuth+> verifiedServerAuth <- macFinal mac+> -- serverAuth == verifiedServerAuth++After this, the shared session key may be safely used.++-}+++-- TODO: Unify with other / move to botan+type Identifier = ByteString+type Password = ByteString+type Salt = ByteString++type SRP6Verifier = ByteString+type SRP6BValue = ByteString+type SRP6AValue = ByteString+type SRP6SharedSecret = ByteString++newtype SRP6ServerSession = MkSRP6ServerSession { getSRP6ServerSessionForeignPtr :: ForeignPtr BotanSRP6ServerSessionStruct }++newSRP6ServerSession      :: BotanSRP6ServerSession -> IO SRP6ServerSession+withSRP6ServerSession     :: SRP6ServerSession -> (BotanSRP6ServerSession -> IO a) -> IO a+-- | Destroy a SRP6 server session object immediately+srp6ServerSessionDestroy  :: SRP6ServerSession -> IO ()+createSRP6ServerSession   :: (Ptr BotanSRP6ServerSession -> IO CInt) -> IO SRP6ServerSession+(newSRP6ServerSession, withSRP6ServerSession, srp6ServerSessionDestroy, createSRP6ServerSession, _)+    = mkBindings+        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 = 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 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++-- 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++-- NOTE: Missing FFI function: srp6_group_identifierz++-- | 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+    alloca $ \ szPtr -> do+        throwBotanIfNegative_ $ botan_srp6_group_size (ConstPtr groupIdPtr) szPtr+        fromIntegral <$> peek szPtr
+ src/Botan/Low/TOTP.hs view
@@ -0,0 +1,234 @@+{-|+Module      : Botan.Low.TOTP+Description : Time-based one time passwords+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++One time password schemes are a user authentication method that+relies on a fixed secret key which is used to derive a sequence+of short passwords, each of which is accepted only once. Commonly+this is used to implement two-factor authentication (2FA), where+the user authenticates using both a conventional password (or a+public key signature) and an OTP generated by a small device such+as a mobile phone.++-}++module Botan.Low.TOTP+(++-- * Time-based one time passwords+-- $introduction+-- * Usage+-- $usage++-- * TOTP++  TOTP(..)+, TOTPHashName(..)+, TOTPTimestep(..)+, TOTPTimestamp(..)+, TOTPCode(..)+, withTOTP+, totpInit+, totpDestroy+, totpGenerate+, totpCheck++-- * TOTP Hashes++, pattern TOTP_SHA1+, pattern TOTP_SHA256+, pattern TOTP_SHA512++-- * Convenience++, totpHashes++) where++import qualified Data.ByteString as ByteString++import Botan.Bindings.TOTP++import Botan.Low.Error+import Botan.Low.Hash+import Botan.Low.Make+import Botan.Low.Prelude+import Botan.Low.Remake++-- NOTE: RFC 6238++{- $introduction++Botan implements the HOTP and TOTP schemes from RFC 4226 and 6238.++Since the range of possible OTPs is quite small, applications must+rate limit OTP authentication attempts to some small number per +second. Otherwise an attacker could quickly try all 1000000 6-digit+OTPs in a brief amount of time.++TOTP generates OTPs that are a short numeric sequence, between 6+and 8 digits (most applications use 6 digits), created using a+64-bit timestamp counter value. If the counter ever repeats the+OTP will also repeat, thus both parties must assure the counter+only increments and is never repeated or decremented. Thus both+client and server must keep their clocks synchronized.++Anyone with access to the client-specific secret key can authenticate+as that client, so it should be treated with the same security+consideration as would be given to any other symmetric key or+plaintext password.++TOTP is based on the same algorithm as HOTP, but instead of a+counter a timestamp is used.++-}++{- $usage++To use TOTP for MFA / 2FA, the client authenticator must generate a+client-specific shared secret, and securely communicate it to the+server authenticator.++The secret key may be any bytestring value with more than 160 bits, such as+a Bcrypt digest or SRP6 shared key.++> import Botan.Low.TOTP+> import Botan.Low.RNG+> import Data.Time.Clock.POSIX+> timestep = 30+> drift = 3+> sharedSecret <- systemRNGGet 16++The client and server authenticators are now in a shared state, and any login+attempts from a new device may be authenticated using TOTP as MFA.++A client has requested a new connection, and TOTP is being used as MFA/2FA to+authenticate their request. The server authenticator receives the client connection+request and initializes a TOTP session using the stored client-specific shared+secret, and then sends an authentication request to the client authenticator:++> -- serverSharedSecret <- lookupServerSharedSecret+> serverSession <- totpInit serverSharedSecret TOTP_SHA512 8 timestep+> -- sendMFAAuthenticationRequest++> NOTE: We are using a timestep value of 30 seconds, which means that the+> code will refresh every 30 seconds++The client authenticator receives the authentication request, generates a+client-side code using their timestamp, and displays the TOTP code to+the user:++> -- clientSharedSecret <- lookupClientSharedSecret+> clientSession <- totpInit clientSharedSecret TOTP_SHA512 8 timestep+> (clientTimestamp :: TOTPTimestamp) <- round <$> getPOSIXTime+> clientCode <- totpGenerate clientSession clientTimestamp+> -- displayClientCode clientCode++The client then sends the client code to the server authenticator using the+unauthenticated / requested connection:++> -- clientCode <- readClientCode+> -- sendMFAAuthenticationResponse clientCode++The server authenticator receives the authentication response, and performs+a check of the key, with an acceptable clock drift in steps, in case the client+and server are slightly desynchronized. ++> -- serverClientCode <- didreceiveMFAAuthenticationResponse+> (serverTimestamp :: TOTPTimestamp) <- round <$> getPOSIXTime+> isValid <- totpCheck serverSession serverClientCode serverTimestamp drift++> NOTE: We are using a acceptable clock drift value of 3, which means that the+> codes for the previous 3 time steps are still valid.++If the code is valid, then the signin may be completed on the new connection+as normal.++The server should discontinue the session and refuse any new connections+to the account after multiple unsuccessful authentication attempts.+The user should then be notified.++-}++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, _)+    = mkBindings+        MkBotanTOTP runBotanTOTP+        MkTOTP getTOTPForeignPtr+        botan_totp_destroy++type TOTPHashName = HashName++pattern TOTP_SHA1 +    ,   TOTP_SHA256+    ,   TOTP_SHA512+    ::  TOTPHashName++pattern TOTP_SHA1   = SHA1+pattern TOTP_SHA256 = SHA256+pattern TOTP_SHA512 = SHA512++-- TODO: Do any other hashes work?+totpHashes =+    [ TOTP_SHA1+    , TOTP_SHA256+    , TOTP_SHA512+    ]++type TOTPTimestep = Word64+type TOTPTimestamp = Word64+type TOTPCode = Word32++-- | Initialize a TOTP instance+--+-- NOTE: Digits should be 6-8+totpInit+    :: ByteString   -- ^ __key[]__+    -> TOTPHashName -- ^ __hash_algo__+    -> Int          -- ^ __digits__+    -> TOTPTimestep -- ^ __time_step__+    -> IO TOTP      -- ^ __totp__+totpInit key algo digits timestep = asBytesLen key $ \ keyPtr keyLen -> do+    asCString algo $ \ algoPtr -> do+        createTOTP $ \ out -> botan_totp_init+            out+            (ConstPtr keyPtr)+            keyLen+            (ConstPtr algoPtr)+            (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+    -> TOTPTimestamp    -- ^ __totp_code__: the OTP code will be written here+    -> IO TOTPCode      -- ^ __timestamp__: the current local timestamp+totpGenerate totp timestamp = withTOTP totp $ \ totpPtr -> do+    alloca $ \ outPtr -> do+        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)
+ src/Botan/Low/Utility.hs view
@@ -0,0 +1,128 @@+{-|+Module      : Botan.Low.Utility+Description : Utility functions+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX+-}++module Botan.Low.Utility+( constantTimeCompare+, scrubMem+, HexEncodingFlags+, pattern HexUpperCase+, pattern HexLowerCase+, hexEncode+, hexDecode+, base64Encode+, base64Decode+) where++import Data.Bool++import qualified Data.Text as 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`++-- | 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++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++pattern HexUpperCase = BOTAN_FFI_HEX_UPPER_CASE+pattern 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++-- | "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++-- 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++-- | 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
+ src/Botan/Low/Version.hs view
@@ -0,0 +1,70 @@+{-|+Module      : Botan.Low.Version+Description : Botan version info+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : 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++import Botan.Low.Prelude+import Botan.Low.Error (throwBotanCatchingSuccess)+import GHC.Generics ((:.:)(unComp1))++-- https://botan.randombit.net/handbook/api_ref/ffi.html#versioning++-- | 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.+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++botanVersionString :: IO ByteString+botanVersionString = botan_version_string >>= peekCString . unConstPtr++-- | Returns the major version of the library+botanVersionMajor :: IO Int+botanVersionMajor = fromIntegral <$> botan_version_major++-- | Returns the minor version of the library+botanVersionMinor :: IO Int+botanVersionMinor = fromIntegral <$> botan_version_minor++-- | Returns the patch version of the library+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+botanVersionDatestamp :: IO Int+botanVersionDatestamp = fromIntegral <$> botan_version_datestamp
+ src/Botan/Low/View.hs view
@@ -0,0 +1,39 @@+{-|+Module      : Botan.Low.View+Description : View functions+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : 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++import Botan.Bindings.View++import Botan.Low.Error+import Botan.Low.Make+import Botan.Low.Prelude++viewBin :: BotanViewBinFn ctx -> (BotanViewBinCallback ctx -> IO a) -> IO a+viewBin f = bracket (mallocBotanViewBinCallback f) freeBotanViewBinCallback++viewStr :: BotanViewStrFn ctx -> (BotanViewStrCallback ctx -> IO a) -> IO a+viewStr f = bracket (mallocBotanViewStrCallback f) freeBotanViewStrCallback
+ src/Botan/Low/X509.hs view
@@ -0,0 +1,429 @@+{-|+Module      : Botan.Low.X509+Description : X.509 Certificates and CRLs+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++A certificate is a binding between some identifying information+(called a subject) and a public key. This binding is asserted by+a signature on the certificate, which is placed there by some+authority (the issuer) that at least claims that it knows the+subject named in the certificate really “owns” the private key+corresponding to the public key in the certificate.++The major certificate format in use today is X.509v3, used for+instance in the Transport Layer Security (TLS) protocol.+-}++module Botan.Low.X509+(++-- * 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++-- * X509 Key constraints++, 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++, X509CRL(..)+, withX509CRL+, x509CRLLoad+, x509CRLLoadFile+, x509CRLDestroy+, x509IsRevoked+, x509CertVerifyWithCLR++-- * Convenience+, DistinguishedName(..)++) where++import qualified Data.ByteString as ByteString+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 qualified Foreign.C.String as String (withCString)+import Botan.Low.Remake (mkCreateObjectCBytesLen)+import Botan.Low.PubKey (createPubKey)++-- TODO: Use *.Make module to ensure consistency++-- /*+-- * X.509 certificates+-- **************************/++type DistinguishedName = ByteString++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++x509CertLoad+    :: ByteString   -- ^ __cert[]__+    -> IO X509Cert  -- ^ __cert_obj__+x509CertLoad = mkCreateObjectCBytesLen createX509Cert botan_x509_cert_load++x509CertLoadFile+    :: FilePath     -- ^ __filename__+    -> IO X509Cert  -- ^ __cert_obj__+x509CertLoadFile = mkCreateObjectCString createX509Cert botan_x509_cert_load_file . Char8.pack++x509CertDup+    :: X509Cert     -- ^ __new_cert__+    -> IO X509Cert  -- ^ __cert__+x509CertDup = mkCreateObjectWith createX509Cert withX509Cert botan_x509_cert_dup++x509CertGetTimeStarts+    :: X509Cert         -- ^ __cert__+    -> IO ByteString    -- ^ __out[]__+x509CertGetTimeStarts = mkGetBytes withX509Cert botan_x509_cert_get_time_starts++x509CertGetTimeExpires+    :: X509Cert         -- ^ __cert__+    -> IO ByteString    -- ^ __out[]__+x509CertGetTimeExpires = mkGetBytes withX509Cert botan_x509_cert_get_time_expires++-- TODO: mkGetIntegral+x509CertNotBefore+    :: X509Cert     -- ^ __cert__+    -> IO Word64    -- ^ __time_since_epoch__+x509CertNotBefore cert = withX509Cert cert $ \ certPtr -> do+    alloca $ \ timePtr -> do+        botan_x509_cert_not_before+            certPtr+            timePtr+        fromIntegral <$> peek timePtr++-- TODO: mkGetIntegral+x509CertNotAfter+    :: X509Cert     -- ^ __cert__+    -> IO Word64    -- ^ __time_since_epoch__+x509CertNotAfter cert = withX509Cert cert $ \ certPtr -> do+    alloca $ \ timePtr -> do+        botan_x509_cert_not_after+            certPtr+            timePtr+        fromIntegral <$> peek timePtr+++x509CertGetPubKeyFingerprint+    :: X509Cert         -- ^ __cert__+    -> HashName         -- ^ __hash__+    -> IO ByteString    -- ^ __out[]__+x509CertGetPubKeyFingerprint cert algo = withX509Cert cert $ \ certPtr -> do+    asCString algo $ \ algoPtr -> do+        allocBytesQuerying $ \ outPtr outLen -> botan_x509_cert_get_fingerprint+            certPtr+            (ConstPtr algoPtr)+            outPtr+            outLen++x509CertGetSerialNumber+    :: X509Cert         -- ^ __cert__+    -> IO ByteString    -- ^ __out[]__+x509CertGetSerialNumber = mkGetBytes withX509Cert botan_x509_cert_get_serial_number++x509CertGetAuthorityKeyId+    :: X509Cert         -- ^ __cert__+    -> IO ByteString    -- ^ __out[]__+x509CertGetAuthorityKeyId = mkGetBytes withX509Cert botan_x509_cert_get_authority_key_id++x509CertGetSubjectKeyId +    :: X509Cert         -- ^ __cert__+    -> IO ByteString    -- ^ __out[]__+x509CertGetSubjectKeyId = mkGetBytes withX509Cert botan_x509_cert_get_subject_key_id++x509CertGetPublicKeyBits+    :: X509Cert         -- ^ __cert__+    -> IO ByteString    -- ^ __out[]__+x509CertGetPublicKeyBits = mkGetBytes withX509Cert botan_x509_cert_get_public_key_bits++-- NOTE: Unique / quirk - the return value is the second argument?+--  This necessitates the use of `flip`+x509CertGetPublicKey+    :: X509Cert     -- ^ __cert__+    -> IO PubKey    -- ^ __key__+x509CertGetPublicKey = mkCreateObjectWith createPubKey withX509Cert (flip botan_x509_cert_get_public_key)++-- Distinguished Names+--  SEE: https://www.ibm.com/docs/en/ibm-mq/7.5?topic=certificates-distinguished-names+x509CertGetIssuerDN+    :: X509Cert         -- ^ __cert__+    -> ByteString       -- ^ __key__+    -> Int              -- ^ __index__+    -> IO ByteString    -- ^ __out[]__+x509CertGetIssuerDN cert key index = withX509Cert cert $ \ certPtr -> do+    asCString key $ \ keyPtr -> do+        allocBytesQuerying $ \ outPtr outLen -> botan_x509_cert_get_issuer_dn+            certPtr+            (ConstPtr keyPtr)+            (fromIntegral index)+            outPtr+            outLen++-- Distinguished Names+--  SEE: https://www.ibm.com/docs/en/ibm-mq/7.5?topic=certificates-distinguished-names+x509CertGetSubjectDN+    :: X509Cert         -- ^ __cert__+    -> ByteString       -- ^ __key__+    -> Int              -- ^ __index__+    -> IO ByteString    -- ^ __out[]__+x509CertGetSubjectDN cert key index = withX509Cert cert $ \ certPtr -> do+    asCString key $ \ keyPtr -> do+        allocBytesQuerying $ \ outPtr outLen -> botan_x509_cert_get_issuer_dn+            certPtr+            (ConstPtr keyPtr)+            (fromIntegral index)+            outPtr+            outLen++x509CertToString+    :: X509Cert         -- ^ __cert__+    -> IO ByteString    -- ^ __out[]__+x509CertToString = mkGetCString withX509Cert botan_x509_cert_to_string++-- NOTE: Per X509 key usage extension, the extension should+--  only be present if at least one of the bits is set, and+--  usage is unrestricted if the extension is not present.+--  That is, it is an optional restriction.+-- pattern NoConstraints = BOTAN_X509_CERT_KEY_CONSTRAINTS_NO_CONSTRAINTS+-- pattern DigitalSignature = BOTAN_X509_CERT_KEY_CONSTRAINTS_DIGITAL_SIGNATURE+-- pattern NonRepudiation = BOTAN_X509_CERT_KEY_CONSTRAINTS_NON_REPUDIATION+-- pattern KeyEncipherment = BOTAN_X509_CERT_KEY_CONSTRAINTS_KEY_ENCIPHERMENT+-- pattern DataEncipherment = BOTAN_X509_CERT_KEY_CONSTRAINTS_DATA_ENCIPHERMENT+-- pattern KeyAgreement = BOTAN_X509_CERT_KEY_CONSTRAINTS_KEY_AGREEMENT+-- pattern KeyCertSign = BOTAN_X509_CERT_KEY_CONSTRAINTS_KEY_CERT_SIGN+-- pattern CRLSign = BOTAN_X509_CERT_KEY_CONSTRAINTS_CRL_SIGN+-- pattern EncipherOnly = BOTAN_X509_CERT_KEY_CONSTRAINTS_ENCIPHER_ONLY+-- pattern DecipherOnly = BOTAN_X509_CERT_KEY_CONSTRAINTS_DECIPHER_ONLY+type X509KeyConstraints = CUInt++pattern NoConstraints+    ,   DigitalSignature+    ,   NonRepudiation+    ,   KeyEncipherment+    ,   DataEncipherment+    ,   KeyAgreement+    ,   KeyCertSign+    ,   CRLSign+    ,   EncipherOnly+    ,   DecipherOnly+    ::  X509KeyConstraints+pattern NoConstraints = NO_CONSTRAINTS+pattern DigitalSignature = DIGITAL_SIGNATURE+pattern NonRepudiation = NON_REPUDIATION+pattern KeyEncipherment = KEY_ENCIPHERMENT+pattern DataEncipherment = DATA_ENCIPHERMENT+pattern KeyAgreement = KEY_AGREEMENT+pattern KeyCertSign = KEY_CERT_SIGN+pattern CRLSign = CRL_SIGN+pattern EncipherOnly = ENCIPHER_ONLY+pattern DecipherOnly = DECIPHER_ONLY++{-# WARNING x509CertAllowedUsage "Unexplained function, best-guess implementation" #-}+-- NOTE: This function lacks documentation, and it is unknown whether this is+--  setting a value (as implied by Z-botan), or whether it is using either+--  a negative error or INVALID_IDENTIFIER to return a bool+x509CertAllowedUsage+    :: X509Cert             -- ^ __cert__+    -> X509KeyConstraints   -- ^ __key_usage__+    -> IO Bool+x509CertAllowedUsage cert usage = withX509Cert cert $ \ certPtr -> do+    throwBotanCatchingSuccess $ botan_x509_cert_allowed_usage certPtr usage++{-# WARNING x509CertHostnameMatch "Unexplained function, best-guess implementation" #-}+{- |+Check if the certificate matches the specified hostname via alternative name or CN match.+RFC 5280 wildcards also supported.+-}+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)++{- |+Returns 0 if the validation was successful, 1 if validation failed,+and negative on error. A status code with details is written to+*validation_result++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)+    -- TODO: The above works, but there's more to it+    --  Need to allow null pointer for empty lists too, something like:+    --      where+    --          withNullPtr withPtr m = if m == mempty then ($ nullPtr) else withPtr m+    --  but we'll need to fiddle with this function (and x509CertVerifyWithCLR)++x509CertValidationStatus+    :: Int  -- ^ __code__+    -> IO (Maybe ByteString)+x509CertValidationStatus code = do+    status <- botan_x509_cert_validation_status (fromIntegral code)+    if status == ConstPtr nullPtr+        then return Nothing+        else Just <$> packCString (unConstPtr status)++-- /*+-- * X.509 CRL+-- **************************/++-- TODO: Move to Botan.Low.X509.CRL after merging extended FFI++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++x509CRLLoad+    :: ByteString   -- ^ __crl_bits[]__        +    -> IO X509CRL   -- ^ __crl_obj__        +x509CRLLoad = mkCreateObjectCBytesLen createX509CRL botan_x509_crl_load++x509CRLLoadFile+    :: FilePath     -- ^ __crl_path__+    -> IO X509CRL   -- ^ __crl_obj__+x509CRLLoadFile = mkCreateObjectCString createX509CRL botan_x509_crl_load_file . Char8.pack++{- |+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++{- |+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)
+ src/Botan/Low/X509/CA.hs view
@@ -0,0 +1,115 @@+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
+ src/Botan/Low/X509/CRL.hs view
@@ -0,0 +1,151 @@+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
+ src/Botan/Low/X509/CSR.hs view
@@ -0,0 +1,85 @@+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
+ src/Botan/Low/X509/DN.hs view
@@ -0,0 +1,60 @@+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
+ src/Botan/Low/X509/Extensions.hs view
@@ -0,0 +1,26 @@+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+
+ src/Botan/Low/X509/Options.hs view
@@ -0,0 +1,157 @@+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
+ src/Botan/Low/X509/Path.hs view
@@ -0,0 +1,141 @@+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
+ src/Botan/Low/X509/Store.hs view
@@ -0,0 +1,326 @@+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
+ src/Botan/Low/ZFEC.hs view
@@ -0,0 +1,187 @@+{-|+Module      : Botan.Low.ZFEC+Description : ZFEC Forward Error Correction+Copyright   : (c) Leo D, 2023+License     : BSD-3-Clause+Maintainer  : leo@apotheca.io+Stability   : experimental+Portability : POSIX++Forward error correction takes an input and creates multiple+“shares”, such that any K of N shares is sufficient to recover+the entire original input.++-}++module Botan.Low.ZFEC+(++-- * Forward Error Correction+-- $introduction+-- * Usage+-- $usage++-- * ZFEC+  ZFECShare(..)+, zfecEncode+, zfecDecode++) where++import Control.Concurrent++import Data.Foldable++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++{- $introduction++The ZFEC module provides forward error correction compatible+with the zfec library.++Note++Specific to the ZFEC format, the first K generated shares are+identical to the original input data, followed by N-K shares of+error correcting code. This is very different from threshold+secret sharing, where having fewer than K shares gives no+information about the original input.++Warning++If a corrupted share is provided to the decoding algorithm, the+resulting decoding will be invalid. It is recommended to protect+shares using a technique such as a MAC or public key signature,+if corruption is likely in your application.++-}++{- $usage++Forward error correction takes an input and creates multiple+“shares”, such that any K of N shares is sufficient to recover+the entire original input.++First, we choose a K value appropriate to our message - the higher K is,+the smaller (but more numerous) the resulting shares will be:++> k = 7+> message = "The length of this message must be divisible by K"++> NOTE: ZFEC requires that the input length be exactly divisible by K; if+needed define a padding scheme to pad your input to the necessary+size.++We can calculate N = K + R, where R is the number of redundant shares,+meaning we can tolerate the loss of up to R shares and still recover+the original message.++We want 2 additional shares of redundancy, so we set R and N appropriately:++> r = 2+> n = k + r -- 7 + 2 = 9++Then, we encode the message into N shares:++> shares <- zfecEncode k n message+> length shares+> -- 9++Then, we can recover the message from any K of N shares:++> someShares <- take k <$> shuffle shares+> recoveredMessage <- zfecDecode k n someShares+> message == recoveredMessage+> -- True++-}++type ZFECShare = (Int, ByteString)++-- Or should this be?:+-- zfecEncode :: Int -> Int -> Int -> Input -> IO [ZFECShare]+-- zfecEncode k n shareSz input = ...+-- ^ is more 'raw'.++-- | Encode some bytes with certain ZFEC parameters.+--+-- NOTE: The length in bytes of input must be a multiple of K+zfecEncode+    :: Int              -- ^ __K__: the number of shares needed for recovery+    -> Int              -- ^ __N__: the number of shares generated+    -> ByteString       -- ^ __input__: the data to FEC+    -> IO [ZFECShare]   +zfecEncode k n input = asBytesLen input $ \ inputPtr inputLen -> do+    let shareSize = div (fromIntegral inputLen) k+    allocaBytes (n * shareSize) $ \ outPtr -> do+        allocaArray n $ \ (sharePtrArrayPtr :: Ptr (Ptr Word8)) -> do+            let sharePtrs = fmap (advancePtr outPtr . (* shareSize)) [0..(n-1)]+            pokeArray sharePtrArrayPtr sharePtrs+            throwBotanIfNegative_ $ botan_zfec_encode+                (fromIntegral k)+                (fromIntegral n)+                (ConstPtr inputPtr)+                inputLen+                sharePtrArrayPtr+            shares <- traverse (ByteString.packCStringLen . (,shareSize) . castPtr) sharePtrs+            return $!! zip [0..(n-1)] shares++-- TODO: Throw a fit if shares are not equal length, not k shares+    +-- | Decode some previously encoded shares using certain ZFEC parameters.+--+-- NOTE: There must be at least K shares of equal length+zfecDecode+    :: Int              -- ^ __K__: the number of shares needed for recovery+    -> Int              -- ^ __N__: the total number of shares+    -> [ZFECShare]      -- ^ __inputs__: K previously encoded shares to decode+    -> IO ByteString    -- ^ __outputs__: An out parameter pointing to a fully allocated array of size+                        --   [N][size / K].  For all n in range, an encoded block will be+                        --   written to the memory starting at outputs[n][0].+zfecDecode _ _ [] = return ""+zfecDecode k n shares@((_,share0):_) = do+    allocaArray k $ \ (indexesPtr :: Ptr CSize) -> do+        pokeArray indexesPtr shareIndexes+        withPtrs unsafeAsBytes shareBytes $ \ (sharePtrs :: [Ptr Word8]) -> do+            allocaArray k $ \ (sharePtrArrayPtr :: Ptr (Ptr Word8)) -> do+                pokeArray sharePtrArrayPtr sharePtrs+                -- NOTE: This extra work may potentially be avoided by allocating a+                --  single contiguous block+                -- withPtrs (const $ allocaBytes shareSize) [0..(k-1)] $ \ outPtrs -> do+                --     allocaArray k $ \ outPtrArrayPtr -> do+                --         pokeArray outPtrArrayPtr outPtrs+                --         throwBotanIfNegative_ $ botan_zfec_decode+                --             (fromIntegral k)+                --             (fromIntegral n)+                --             indexesPtr+                --             sharePtrArrayPtr+                --             (fromIntegral shareSize)+                --             outPtrArrayPtr+                --         decodedShares <- traverse (ByteString.unsafePackCStringLen . (,shareSize) . castPtr) outPtrs+                --         return $!! ByteString.copy $ ByteString.concat decodedShares+                -- Single contiguous block method+                -- This way is probably superior absent any surprise alignment issues+                allocBytes (k * shareSize) $ \ outPtr -> do+                    allocaArray n $ \ (outPtrArrayPtr :: Ptr (Ptr Word8)) -> do+                        let outPtrs = fmap (advancePtr outPtr . (* shareSize)) [0..(n-1)]+                        pokeArray outPtrArrayPtr outPtrs+                        throwBotanIfNegative_ $ botan_zfec_decode+                            (fromIntegral k)+                            (fromIntegral n)+                            (ConstPtr indexesPtr)+                            -- NOTE: Use of castPtr here because allocating+                            --  as a ConstPtr (ConstPtr a) is tedious+                            (ConstPtr $ castPtr sharePtrArrayPtr)+                            (fromIntegral shareSize)+                            outPtrArrayPtr+    where+        shareIndexes = fmap (fromIntegral . fst) shares+        shareBytes = fmap snd shares+        shareSize = ByteString.length share0
+ test-data/4096b-rsa-example-cert.der view

binary file changed (absent → 990 bytes)

+ test-data/4096b-rsa-example-cert.pem view
@@ -0,0 +1,23 @@+-----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-----
+ test/Botan/Low/BcryptSpec.hs view
@@ -0,0 +1,25 @@+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
+ test/Botan/Low/BlockCipherSpec.hs view
@@ -0,0 +1,68 @@+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
+ test/Botan/Low/CipherSpec.hs view
@@ -0,0 +1,221 @@+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
+ test/Botan/Low/FPESpec.hs view
@@ -0,0 +1,97 @@+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
+ test/Botan/Low/HOTPSpec.hs view
@@ -0,0 +1,27 @@+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
+ test/Botan/Low/HashSpec.hs view
@@ -0,0 +1,48 @@+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
+ test/Botan/Low/KDFSpec.hs view
@@ -0,0 +1,34 @@+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
+ test/Botan/Low/KeyWrapSpec.hs view
@@ -0,0 +1,42 @@+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
+ test/Botan/Low/MACSpec.hs view
@@ -0,0 +1,132 @@+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
+ test/Botan/Low/MPISpec.hs view
@@ -0,0 +1,380 @@+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+        r <- mpInit+        x <- mpInit+        mpSetFromInt x 512+        mod <- mpInit+        mpSetFromInt mod 29+        mpModInverse r x mod+        -- TODO: Actually check more than just being bound+        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
+ test/Botan/Low/PubKey/DHSpec.hs view
@@ -0,0 +1,69 @@+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
+ test/Botan/Low/PubKey/DSASpec.hs view
@@ -0,0 +1,76 @@+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
+ test/Botan/Low/PubKey/DecryptSpec.hs view
@@ -0,0 +1,43 @@+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
+ test/Botan/Low/PubKey/ECDHSpec.hs view
@@ -0,0 +1,78 @@+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
+ test/Botan/Low/PubKey/ECDSASpec.hs view
@@ -0,0 +1,72 @@+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
+ test/Botan/Low/PubKey/Ed25519Spec.hs view
@@ -0,0 +1,34 @@+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
+ test/Botan/Low/PubKey/ElGamalSpec.hs view
@@ -0,0 +1,71 @@+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
+ test/Botan/Low/PubKey/EncryptSpec.hs view
@@ -0,0 +1,42 @@+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
+ test/Botan/Low/PubKey/KeyAgreementSpec.hs view
@@ -0,0 +1,50 @@+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
+ test/Botan/Low/PubKey/KeyEncapsulationSpec.hs view
@@ -0,0 +1,67 @@+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
+ test/Botan/Low/PubKey/RSASpec.hs view
@@ -0,0 +1,43 @@+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
+ test/Botan/Low/PubKey/SM2Spec.hs view
@@ -0,0 +1,71 @@+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
+ test/Botan/Low/PubKey/SignSpec.hs view
@@ -0,0 +1,67 @@+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
+ test/Botan/Low/PubKey/VerifySpec.hs view
@@ -0,0 +1,79 @@+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
+ test/Botan/Low/PubKey/X25519Spec.hs view
@@ -0,0 +1,34 @@+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
+ test/Botan/Low/PubKeySpec.hs view
@@ -0,0 +1,188 @@+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
+ test/Botan/Low/PwdHashSpec.hs view
@@ -0,0 +1,61 @@+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
+ test/Botan/Low/RNGSpec.hs view
@@ -0,0 +1,42 @@+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
+ test/Botan/Low/SRP6Spec.hs view
@@ -0,0 +1,63 @@+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
+ test/Botan/Low/TOTPSpec.hs view
@@ -0,0 +1,31 @@+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
+ test/Botan/Low/UtilitySpec.hs view
@@ -0,0 +1,41 @@+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
+ test/Botan/Low/X509Spec.hs view
@@ -0,0 +1,171 @@+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+
+ test/Botan/Low/ZFECSpec.hs view
@@ -0,0 +1,27 @@+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
+ test/Test/Prelude.hs view
@@ -0,0 +1,50 @@+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