From 9fbe05c5438f6da071e4a73342390311e064842a Mon Sep 17 00:00:00 2001 From: Peter Taoussanis Date: Mon, 16 Oct 2023 13:21:39 +0200 Subject: [PATCH] [wip] Add initial code --- IMPORT_DOCS.md | 179 +++++ src/taoensso/tempel.clj | 1039 ++++++++++++++++++++++++++++- src/taoensso/tempel/bytes.clj | 352 ++++++++++ src/taoensso/tempel/df.clj | 209 ++++++ src/taoensso/tempel/impl.clj | 926 ++++++++++++++++++++++++++ src/taoensso/tempel/keys.clj | 1117 ++++++++++++++++++++++++++++++++ src/taoensso/tempel/pbkdf.clj | 410 ++++++++++++ test/taoensso/tempel_tests.clj | 638 +++++++++++++++++- 8 files changed, 4861 insertions(+), 9 deletions(-) create mode 100644 IMPORT_DOCS.md create mode 100644 src/taoensso/tempel/bytes.clj create mode 100644 src/taoensso/tempel/df.clj create mode 100644 src/taoensso/tempel/impl.clj create mode 100644 src/taoensso/tempel/keys.clj create mode 100644 src/taoensso/tempel/pbkdf.clj diff --git a/IMPORT_DOCS.md b/IMPORT_DOCS.md new file mode 100644 index 0000000..adae283 --- /dev/null +++ b/IMPORT_DOCS.md @@ -0,0 +1,179 @@ +# TODO + +========== +AuthKit docs + + One common usage pattern (see GitHub Wiki for more): + + User creates new account: + 1. User provides username `u1` and password `p1`. + 2. `auth-create` is used to generate user's `ba-auth` and private `ba-key`. + 3. `ba-auth` is saved to DB and associated with username `u1`. + 4. User is logged in by adding `ba-key` to the user's session. + This key can be used to encrypt + decrypt user's private data while they + retain the session. + + User logs in to pre-existing account: + 1. User provides username `u1` and password `p2`. + 2. `ba-auth` associated with username `u1` is loaded from DB. + 3. `auth-check` is used to verify that `p2`==`p1`. + Will return user's `ba-key` ff `p2`==`p1`, otherwise returns nil. + 4. User is logged in by adding `ba-key` to the user's session. + This key can be used to encrypt + decrypt user's private data while they + retain the session. + + Important capability: because `ba-auth` contains all the settings necessary to + regenerate key from its password, different accounts can seamlessly use different + settings. This enables: + + - Accounts with varying levels of security (e.g. different PBKDF algorithms + and/or work factors). + + - Easily and automatically increasing default security level over time as + improvements in computing hardware or cryptanalysis expose weaknesses in + certain algorithms and/or work factors. + + +;; Describe backup-key and backup-key-opts stuff with a master keychain to support +;; forgotten passwords, etc. Mention risks, incl. weak link and high attack value. + +=============== + +auth-kit-update example (currently out-of-date): + + Example: + (def auth1 (:ba-auth (auth-create \"pwd1\"))) + + (def auth2 ; Change password, keep all keys + (:ba-auth (auth-update auth1 \"pwd1\" {:new-password \"pwd2\"}))) + + (def auth3 ; Keep password, change ba-key + (:ba-auth (auth-update auth1 \"pwd1\" {:new-key? true}))) + + (def auth4 ; Change password, change ba-key + (:ba-auth (auth-update auth1 \"pwd1\" {:new-password \"pwd2\", + :new-key? true}))) + +==== + +;; - Tutorial/example +;; - Warn that - for simplicity - the API mostly leaves (asym) key management up +;; to user. Supporting multiple keys, or frequent key rotation or algo changes +;; can be a non-trivial problem with many different approaches and trade-offs. +;; So this is better left to the user. Note that key management is rarely a +;; concern when payloads are ephemeral. The more long held payloads, and the +;; more common key rotations and/or algo changes, the more likely you'll need +;; a key management solution. +;; +;; Note `ba-auth`'s ba-aad and ba-prv-cnt hooks for integration with a +;; custom key management solution. +;; +;; - 2 user secret messaging +;; Use `ba-auth` to encrypt user's algo-2kp private key +;; - >2 user secret messaging +;; 1 user acts as owner/hub, generates random key to share with other +;; participants via pairwise hybrid-2kp +;; - esession pattern +;; - How to allow password reset when user's data encrypted? +;; - Write user's data using hybrid-2kp and root's pub-1kp. +;; - Key rotations +;; - Password to ba-auth can be changed without affecting ba-key +;; - But if you DO want to rotate ba-key and/or asymmetric keypair/s: +;; - Either re-encrypt previous data with new key/s +;; - Or retain private keys for any retired keypairs +;; - Tip: can use AAD to store key ids, etc. in blobs + +;; NB mention risks inherent in encrypting valuable data - +;; the data may be lost! +;; due to lost keys +;; due to corrupted keys or data +;; due to bugs in the software +;; etc. + +;; Incl. some discussion of the ethics of handling (esp. retaining) user data, +;; relate to Mindfund. And protecting data well can be tough! Tempel provides +;; help with this. + +==== + +- Lots of beginning-oriented documentation. + E.g. not just mentioning the existance of a feature, but explaining + when+why it would be useful. + +;; TODO (to rework) Updated copy/objectives for Wiki/README/etc. +- Limited scope with specific tradeoffs +- I've needed this several times for myself, decided to generalize + a bit and open-source + +- Simplest possible API for some of the commonest use-cases of crypto, + - With <=medium security requirements + - With low flexibility requirements + - With no need for interop with other (non-Tempel) systems + +- In exchange, you get: + - Simplest possible API for some of the commonest use-cases + - Reasonable defaults + - Automatic updates to methods and params (esp. work factors) over time + +- The JVM has extensive, highly-configurable crypto facilities. +- Likewise many good libraries exist, incl. + - Bouncy Castle, bc-clj, buddy-core, etc. + - https://github.com/sebhoss/bc-clj + - https://cljdoc.org/d/buddy/buddy-core/1.10.1/doc/user-guide + - etc. + +- But even the libraries often emphasize flexibility with many + different use cases, interop, and tons of options. They're designed + as general-purpose crypto toolkits. +- BC in particular is huge. + +- Tempel is instead optimized for smallness and ease-of-use for the + a small set of the very most common operations, and as ~minimal + crypto implementation for Nippy, etc. that supports seamless + automatic updates to the data format over time (e.g. to fix issues, + update methods/algos, update parameters - esp. work factors). + +- So focus on: ease, documentation, sensible defaults, auto updates. +- NB ZERO goal to interop with other systems/protocols! +- Stress MINIMAL size and functionality. SMALL lib. + +- Knowing which methods and parameters to use can be tricky, + and keeping up-to-date with developing recommendations often worse. + Tempel attempts to make this simple by: + - Offering sane defaults for common use cases. + - Simply explaining what config options you might need to pay attention to, + when, and why. + - Automatically selecting the best possible methods + params for your system. + - Providing a data format that supports automatic updates over time to: + - Fix any bugs that may come up. + - Update methods and/or parameters (esp. work factors) as recommendations change over time. + +- Lib goals, etc. +- Mention ability to seamlessly fix bugs and adjust methods + params over time +- Incl. data format section, mention need to read code for now. + Portability/interop is NOT an objective. +- explain esession pattern? + + + + Terminology: + crypto-kit - Typed bundle of algos, opts, method implementations, etc. + ba-content - Plaintext content, as byte array + ba-encrypted-content - Ciphertext content, as byte array + ba-encrypted-blob - Ciphertext content, plus envelope data + + Notes: + - Optimized for ease of common cases >> config flexibility. + Users can always drop down to Java / other libs when flexibility + needed. + + - Sensible defaults via documented \"cryptokit\" bundles. + + - Future-proofing: methods + params (esp. work factors) can be + easily/auto updated over time w/o breaking compatibility with + previously written data. + + - Support optional deps (e.g. scrypt), and auto-selection of + best available methods, etc. + + - Functionality will be rolled out (/ made public) over time. \ No newline at end of file diff --git a/src/taoensso/tempel.clj b/src/taoensso/tempel.clj index 83afb52..464854b 100644 --- a/src/taoensso/tempel.clj +++ b/src/taoensso/tempel.clj @@ -1 +1,1038 @@ -(ns taoensso.tempel) +(ns taoensso.tempel + "Data security framework for Clojure. + + See the GitHub page (esp. Wiki) for info on motivation and design: + + + See `df.clj` for data formats. + All formats intended to support non-breaking future updates. + + Abbreviations: + pbkdf - password based key derivation function + aad - additional associated data (see also `doc-aad`) + akm - additional keying material (see also `doc-akm`) + kek - key encryption key (key used to encrypt another key) + cnt - content + ecnt - encrypted content" + + {:author "Peter Taoussanis (@ptaoussanis)"} + (:require + [taoensso.encore :as enc :refer [have have?]] + [taoensso.tempel.bytes :as bytes] + [taoensso.tempel.df :as df] + [taoensso.tempel.impl :as impl] + [taoensso.tempel.pbkdf :as pbkdf] + [taoensso.tempel.keys :as keys])) + +(comment + (remove-ns 'taoensso.tempel) + (:public (enc/interns-overview))) + +(enc/assert-min-encore-version [3 68 0]) + +;;;; TODO +;; - Confirm: would 512-bit (64 byte) keys be possible? +;; - Move bytes API to encore? (For use by Carmine, Nippy, etc.) +;; - General review: API, impln, tests +;; - Initial README and Wiki content (see sketch IMPORT_DOCS.md) +;; - Extra (generative?) tests? + +;; - Check Signal's algos: +;; - "Double Ratchet Algorithm", Ref. +;; - "X3DH", Ref. + +;;;; Aliases + +(enc/defaliases + enc/str->utf8-ba + enc/utf8-ba->str + bytes/as-ba + + impl/with-srng + impl/with-srng-insecure-deterministic!!! + impl/keypair-create + impl/keypair-creator + pbkdf/pbkdf-nwf-estimate + + keys/chainkey? + keys/keychain? + keys/keychain + keys/keychain-encrypt + keys/keychain-decrypt + keys/keychain-add-symmetric-key + keys/keychain-add-asymmetric-keypair + keys/keychain-update-priority + keys/keychain-normalize-priorities + keys/keychain-remove + + {:alias encrypt-keychain, :src keychain-encrypt, :doc "Alias for `keychain-encrypt`"} + {:alias decrypt-keychain, :src keychain-decrypt, :doc "Alias for `keychain-decrypt`"}) + +;;;; Doc vars + +(def doc-aad + "\"Additional Authenticated Data\" (AAD) is optional arbitrary byte[] data that + may be provided to many of Tempel's API functions (e.g. `encrypt-with-X` when + using an AEAD cipher). + + When so provided, AAD will be embedded *UNENCRYPTED* with the API function's + output byte[]. + + It may then later be retrieved: + - Without verification: using `public-data` (see its docstring for details). + - With verification: using the appropriate complementary API function + (e.g. `decrypt-with-X`). + + Verification in this context means confirmation of: + 1. Data integrity (the data is intact, and unmodified) + 2. Authenticity (the data was indeed created/signed/etc. by the expected key). + + Examples of common AAD content: + - Metadata like the sender, receiver, timestamp, etc. + - Routing information + - A description of the encrypted content + - File or data integrity checks (hashes, etc.) + - Cryptographic signatures + - Arbitrary Clojure data via Nippy, Ref. " + nil) + +(def doc-akm + "\"Additional Keying Material\" (AKM) is optional arbitrary byte[] data that + may be provided to many of Tempel's API functions (e.g. `encrypt-with-X`). + + When so provided, AKM will act as additional secret material to supplement any + main cryptographic keys, and so enhance security through increased resistance + to certain types of attacks, etc. + + When an AKM is provided to an API function (e.g. `encrypt-with-X`), the same + AKM *must* be provided to the function's complement (e.g. `decrypt-with-X`). + + In some contexts, an AKM may also be known as \"Shared Keying Material\" (SKM). + + Examples of common AKM content: + - Metadata like the sender and receiver of an encrypted message + - Random numbers or Nonces stored or transmitted separately + - Key derivation parameters + - Protocol-specific values + - Security credentials or certificates + - Arbitrary Clojure data via Nippy, Ref. " + nil) + +;;;; Config + +(enc/defonce default-keypair-creator_ + "Default stateful KeyPair generator with options: + {:buffer-len 16, :n-threads [:perc 10]}" + (delay (impl/keypair-creator {:buffer-len 16, :n-threads [:perc 10]}))) + +(comment (@default-keypair-creator_ :rsa-1024)) + +(def default-config + "Default initial value for `*config*`." + + ;; Recommended pairing: + ;; - 128-bit AES with 128-bit salt, 3072-bit RSA/DH + ;; - 256-bit AES with 256-bit salt, 4096-bit+ RSA/DH + + {:hash-algo :sha-256 + :pbkdf-algo pbkdf/pbkdf-kit-best-available #_:best-available + :pbkdf-nwf :ref-100-msecs + :sym-cipher-algo :aes-gcm-128-v1 + + :keypair-creator default-keypair-creator_ + :symmetric-keys [:random] + :asymmetric-keypairs [:rsa-3072 :dh-3072] + + :embed-key-ids? true}) + +(enc/defonce ^:dynamic *config* + "Tempel's behaviour is controlled in two ways: + 1. Through options manually provided in calls to its API functions. + 2. Through options in this `*config*` map. + + Any time an API function uses config options, the relevant config keys will + be mentioned in that function's docstring. + + As a convenience, relevant config options (2) can also be overridden through + call options (1). For example, these are equivalent: + + (binding [*config* (assoc *config* :hash-algo :sha-256)] + (encrypt-with-password ba-content password {})) + + (encrypt-with-password ba-content password {:hash-algo :sha-256}) + + Options: + + Default values should be sensible for most common use cases. + + `:hash-algo` ∈ #{:md5 :sha-1 *:sha-256 :sha-512} + Hash algorithm used for internal HMACs, etc. + Default: `:sha-256`, and there's usually no good reason to change this. + + `:pbkdf-algo` ∈ #{*:scrypt-r8p1-v1 :pbkdf2-hmac-sha-256-v1} + Algorithm to use for password-based key stretching. + Default: `:scrypt-r8p1-v1` when `com.lambdaworks.crypto.SCrypt` is available, + or `:pbkdf2-hmac-sha-256-v1` otherwise. + + `:pbkdf-nwf` + ∈ #{:ref-10-msecs :ref-50-msecs *:ref-100-msecs :ref-200-msecs :ref-500-msecs + :ref-1000-msecs :ref-2000-msecs :ref-5000-msecs } + + Normalized work factor (nwf) that describes how much computational effort + should be used for password stretching. + + More effort means more resistance to brute-force attacks, but also more time + and resources spent during normal operation. + + The `:ref--msecs` keywords take approximately the described amount of + time on a 2020 M1 Macbook Pro. See also `pbkdf-nwf-estimate` docstring. + + Default: `:ref-100-msecs`, a reasonable value for many logins. + + `:sym-cipher-algo` ∈ #{*:aes-gcm-128-v1 :aes-gcm-256-v1} + The symmetric cipher algorithm to use. A cipher that supports \"AEAD\" + (Authenticated Encryption with Associated Data) must generally be provided + in order to use `:ba-aad` options (see `doc-aad` docstring). + + Default: `:aes-gcm-128-v1`, a good general-purpose symmetric cipher with + AEAD support. + + Note that the 256 bit AES cipher is not necessarily stronger than the 128 + bit, and may even be weaker due to possible unique attack vectors + (Ref. ). + + `:keypair-creator` ∈ #{ } + The function to use when generating asymmetric keypairs. + See the `keypair-create` and `keypair-creator` docstrings for details. + + Default: `default-keypair-creator_`, which uses up to 10% of threads + to buffer up to 16 keypairs per type. + + This is often something you'll want to customize. + + `:symmetric-keys` + Symmetric keys to add to new `KeyChain`s. + See the `keychain` docstring for details. + + Default: a single random symmetric key. + + `:asymmetric-keypairs` + Asymmetric keypairs to add to new `KeyChain`s. + See the `keychain` docstring for details. + + Default: + - A single new `:rsa-3072` keypair, and + - A single new `:dh-3072` keypair + + Together these support all common Tempel functionality, and are a + reasonable choice in most cases. + + `:embed-key-ids?` + Should key ids be embedded in output when using `KeyChain`s? + This will allow the automatic selection of relevant keys during decryption, + in exchange for leaking (making public) the ids used for encryption. + + This is often convenient, and *usually* safe unless you have custom key ids + that contain private information and/or if it's important that you not leak + information about which public `KeyChain`s might contain the necessary keys. + + Default: true. + You may want to disable this for maximum security, but note that doing so + may complicate decryption. See the Tempel Wiki for details." + + default-config) + +(defn get-config "Implementation detail" [opts] (conj (or *config* {}) opts)) +(comment (get-config {})) + +;;;; Public data + +(defn public-data + "Given an encrypted Tempel byte[], returns a map of *UNVERIFIED* public + (unencrypted) data embedded in the byte[]. + + Possible keys: + `:ba-aad` - See `doc-aad` docstring. + `:keychain` - Public-key part of encrypted `KeyChain` + `:key-id` - See `:embed-key-ids?` option of `encrypt-X` API + `:receiver-key-id` - '' + `:sender-key-id` - '' + `:key-algo` - ∈ #{:rsa- :dh- :ec-} + `:version` - Integer version of data format (1, 2, etc.). + `:kind` - ∈ #{:encrypted-with-symmetric-key + :encrypted-with-password + :encrypted-with-1-keypair + :encrypted-with-2-keypairs + :encrypted-keychain + :signed} + + NB: provides *UNVERIFIED* data that could be corrupted or forged! + For cryptographically verified data, use the appropriate API function + (e.g. `decrypt-X`) instead." + + #_df/reference-data-formats + [ba-tempel-output] + (bytes/with-in [in] ba-tempel-output + (let [_ (df/read-head! in) + env-kid (df/read-kid in :envelope) + ;; [kind version] (re-find #"^(\w+)-v(\d+)$" (name env-kid)) + asm enc/assoc-some] + + (case env-kid + :encrypted-with-symmetric-key-v1 + (let [?ba-aad (bytes/read-dynamic-ba in) + ?key-id (bytes/read-dynamic-str in)] + (asm + {:kind :encrypted-with-symmetric-key, :version 1} + :ba-aad ?ba-aad + :key-id ?key-id)) + + :encrypted-with-password-v1 + (let [?ba-aad (bytes/read-dynamic-ba in)] + (asm + {:kind :encrypted-with-password, :version 1} + :ba-aad ?ba-aad)) + + :signed-v1 + (let [?ba-aad (bytes/read-dynamic-ba in) + key-algo (df/read-kid in :key-algo) + ?key-id (bytes/read-dynamic-str in) + ba-content (bytes/read-dynamic-ba in)] + (impl/key-algo! key-algo [:sig-algo]) + (asm + {:kind :signed, :version 1, :key-algo key-algo} + :ba-aad ?ba-aad + :key-id ?key-id + :ba-content ba-content)) + + (:encrypted-with-1-keypair-simple-v1 + :encrypted-with-1-keypair-hybrid-v1) + (let [hybrid? (= env-kid :encrypted-with-1-keypair-hybrid-v1) + ?ba-aad (when hybrid? (bytes/read-dynamic-ba in)) + key-algo (df/read-kid in :key-algo) + ?key-id (bytes/read-dynamic-str in)] + (impl/key-algo! key-algo [:asym-cipher-algo]) + (asm + {:kind :encrypted-with-1-keypair, :version 1, :key-algo key-algo} + :hybrid? (when hybrid? true) + :ba-aad ?ba-aad + :key-id ?key-id)) + + :encrypted-with-2-keypairs-v1 + (let [?ba-aad (bytes/read-dynamic-ba in) + key-algo (df/read-kid in :key-algo) + ?recp-key-id (bytes/read-dynamic-str in) + ?send-key-id (bytes/read-dynamic-str in)] + (impl/key-algo! key-algo [:ka-algo]) + (asm + {:kind :encrypted-with-2-keypairs, :version 1, :key-algo key-algo} + :ba-aad ?ba-aad + :receiver-key-id ?recp-key-id + :sender-key-id ?send-key-id)) + + :encrypted-keychain-v1 + (let [?ba-aad (bytes/read-dynamic-ba in) + ba-kc-pub (bytes/read-dynamic-ba! in)] + (asm + {:kind :encrypted-keychain, :version 1, + :keychain (keys/keychain-restore ba-kc-pub)} + :ba-aad ?ba-aad)) + + (enc/unexpected-arg! env-kid + :expected :envelope-with-public-data + :context `public-data))))) + +(defn- public-data-test + [ba-tempel-output] + (when-let [{:keys [ba-aad ba-content] :as pd} (public-data ba-tempel-output)] + ;; As with :_test elsewhere + (enc/assoc-some (dissoc pd :ba-aad :ba-content) + :aad (bytes/utf8-?ba->str ba-aad) + :cnt (bytes/utf8-?ba->str ba-content)))) + +;;;; Cipher API + +(defn- return-val [context return-kind ?ba-cnt ?ba-aad] + (case return-kind + :ba-content ?ba-cnt + :ba-aad ?ba-aad + :as-map + (enc/assoc-some {} + :ba-content ?ba-cnt + :ba-aad ?ba-aad) + + :_test ; Undocumented, used for tests + (enc/assoc-some {} + :aad (bytes/utf8-?ba->str ?ba-aad) + :cnt (bytes/utf8-?ba->str ?ba-cnt)) + + (enc/unexpected-arg! return-kind + :expected #{:ba-content :ba-aad :as-map} + :context context))) + +(defn encrypt-with-password + "Uses a symmetric cipher to encrypt the given byte[] content and return + a byte[] that includes: + - The encrypted content + - Optional unencrypted AAD (see `doc-aad` docstring) + - Envelope data necessary for decryption (specifies algorithms, etc.) + + Takes a password (string, byte[], or char[]). + Password will be \"stretched\" using an appropriate \"Password-Based Key + Derivation Function\" (PBKDF). + + Decrypt output with: `decrypt-with-password`. + + Options: + `:ba-aad` - See `doc-aad` docstring + `:ba-akm` - See `doc-akm` dosctring + + Relevant `*config*` keys (see that var's docstring for details): + `hash-algo`, `sym-cipher-algo`, `pbkdf-algo`, `pbkdf-nwf`, `embed-key-ids?`" + + #_(df/reference-data-formats :encrypted-with-password-v1) + ^bytes + [ba-content password & + [{:keys [ba-aad ba-akm, :config + hash-algo sym-cipher-algo + pbkdf-algo pbkdf-nwf + embed-key-ids?]}]] + + (let [{:keys [hash-algo sym-cipher-algo pbkdf-algo pbkdf-nwf + embed-key-ids?]} (get-config config) + _ (have? some? hash-algo sym-cipher-algo pbkdf-algo pbkdf-nwf) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + key-len (impl/sck-key-len sck) + + ba-iv (impl/rand-ba (max 16 (impl/sck-iv-len sck))) + ba-salt (impl/hmac hash-algo ba-iv (bytes/str->utf8-ba "iv->salt")) + + pbkdf-nwf (pbkdf/pbkdf-nwf-parse pbkdf-algo pbkdf-nwf) + ba-key (let [ba-pkey (pbkdf/pbkdf pbkdf-algo key-len ba-salt password pbkdf-nwf)] + (impl/hmac hash-algo ba-pkey ba-akm)) + + ba-ecnt (impl/sck-encrypt sck ba-iv ba-key ba-content ba-aad)] + + (bytes/with-out [out] [24 ba-ecnt ba-aad ba-iv] + (df/write-head out) + (df/write-kid out :envelope :encrypted-with-password-v1) + (bytes/write-dynamic-ba out ba-aad) + (df/write-kid out :hash-algo hash-algo) + (df/write-kid out :sym-cipher-algo sym-cipher-algo) + (df/write-kid out :pbkdf-algo pbkdf-algo) + (bytes/write-ushort out pbkdf-nwf) + (bytes/write-dynamic-ba out nil #_ba-salt) + (bytes/write-dynamic-ba out ba-iv) + (bytes/write-dynamic-ba out ba-ecnt) + (df/write-resv out)))) + +(comment (public-data-test (encrypt-with-password (as-ba "cnt") "pwd"))) + +(defn decrypt-with-password + "Complement of `encrypt-with-password`. + + Uses a symmetric cipher to decrypt the given byte[]. + Return value depends on `:return` option: + `:ba-content` - Returns decrypted byte[] content (default) + `:ba-aad` - Returns verified unencrypted embedded ?byte[] AAD + `:as-map` - Returns {:keys [ba-aad ba-content]} map + + Takes a password (string, byte[], or char[]). Password will be \"stretched\" + using an appropriate \"Password-Based Key Derivation Function\" (PBKDF). + + Will throw on decryption failure (bad password, etc.)." + + #_(df/reference-data-formats :encrypted-with-password-v1) + [ba-encrypted password & + [{:keys [return ba-akm] + :or {return :ba-content}}]] + + (bytes/with-in [in] ba-encrypted + (let [env-kid :encrypted-with-password-v1 + _ (df/read-head! in) + _ (df/read-kid in :envelope env-kid) + ?ba-aad (bytes/read-dynamic-ba in) + hash-algo (df/read-kid in :hash-algo) + sym-cipher-algo (df/read-kid in :sym-cipher-algo) + pbkdf-algo (df/read-kid in :pbkdf-algo) + pbkdf-nwf (bytes/read-ushort in) + ?ba-salt (bytes/read-dynamic-ba in) + ba-iv (bytes/read-dynamic-ba! in) + ba-ecnt (bytes/read-dynamic-ba! in) + _ (df/read-resv! in) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + ba-key + (let [key-len (impl/sck-key-len sck) + ba-salt (or ?ba-salt (impl/hmac hash-algo ba-iv (bytes/str->utf8-ba "iv->salt"))) + ba-pkey (pbkdf/pbkdf pbkdf-algo key-len ba-salt password pbkdf-nwf)] + + (impl/hmac hash-algo ba-pkey ba-akm)) + + ba-cnt + (try + (impl/sck-decrypt sck ba-iv ba-key ba-ecnt ?ba-aad) + (catch Throwable t + (keys/decrypt-failed! + (ex-info "Failed to decrypt Tempel data (with password)" {} t))))] + + (return-val env-kid return ba-cnt ?ba-aad)))) + +(comment + (let [ba-enc (encrypt-with-password (as-ba "cnt") "pwd")] + (decrypt-with-password ba-enc "pwd" {:return :_test}))) + +(defn encrypt-with-symmetric-key + "Uses a symmetric cipher to encrypt the given byte[] content and return + a byte[] that includes: + - The encrypted content + - Optional unencrypted AAD (see `doc-aad` docstring) + - Envelope data necessary for decryption (specifies algorithms, etc.) + + Takes a `KeyChain` (see `keychain`) or byte[] key. + Decrypt output with: `decrypt-with-symmetric-key`. + + Options: + `:ba-aad` - See `doc-aad` docstring + `:ba-akm` - See `doc-akm` docstring + + Relevant `*config*` keys (see that var's docstring for details): + `hash-algo`, `sym-cipher-algo`, `embed-key-ids?`" + + #_(df/reference-data-formats :encrypted-with-symmetric-key-v1) + ^bytes + [ba-content key-sym & + [{:keys [ba-aad ba-akm, :config + hash-algo sym-cipher-algo embed-key-ids?] :as opts}]] + + (let [{:keys [hash-algo sym-cipher-algo embed-key-ids?]} (get-config opts) + _ (have? some? hash-algo sym-cipher-algo) + + ckey-sym (keys/get-ckeys-sym-cipher key-sym) + {:keys [key-sym key-id]} @ckey-sym + ba-key (have enc/bytes? key-sym) + ?ba-key-id (when embed-key-ids? (bytes/?str->utf8-ba key-id)) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + ba-iv (impl/rand-ba (impl/sck-iv-len sck)) + ba-key* (impl/hmac hash-algo ba-key ba-akm ba-iv) ; +IV for forward secrecy + ba-ecnt (impl/sck-encrypt sck ba-iv ba-key* ba-content ba-aad)] + + (bytes/with-out [out] [16 ba-ecnt ba-aad ?ba-key-id ba-iv] + (df/write-head out) + (df/write-kid out :envelope :encrypted-with-symmetric-key-v1) + (bytes/write-dynamic-ba out ba-aad) + (bytes/write-dynamic-ba out ?ba-key-id) + (df/write-kid out :hash-algo hash-algo) + (df/write-kid out :sym-cipher-algo sym-cipher-algo) + (bytes/write-dynamic-ba out ba-iv) + (bytes/write-dynamic-ba out ba-ecnt) + (df/write-resv out)))) + +(comment (public-data-test (encrypt-with-symmetric-key (as-ba "cnt") (keychain)))) + +(defn decrypt-with-symmetric-key + "Complement of `encrypt-with-symmetric-key`. + + Uses a symmetric cipher to decrypt the given byte[]. + Return value depends on `:return` option: + `:ba-content` - Returns decrypted byte[] content (default) + `:ba-aad` - Returns verified unencrypted embedded ?byte[] AAD + `:as-map` - Returns {:keys [ba-aad ba-content]} map + + Takes a `KeyChain` (see `keychain`) or byte[] key. + Will throw on decryption failure (bad key, etc.)." + + #_(df/reference-data-formats :encrypted-with-symmetric-key-v1) + [ba-encrypted key-sym & + [{:keys [return ba-aad ba-akm] + :or {return :ba-content}}]] + + (bytes/with-in [in] ba-encrypted + (let [env-kid :encrypted-with-symmetric-key-v1 + _ (df/read-head! in) + _ (df/read-kid in :envelope env-kid) + ?ba-aad (bytes/read-dynamic-ba in) + ?key-id (bytes/read-dynamic-str in) + hash-algo (df/read-kid in :hash-algo) + sym-cipher-algo (df/read-kid in :sym-cipher-algo) + ba-iv (bytes/read-dynamic-ba! in) + ba-ecnt (bytes/read-dynamic-ba! in) + _ (df/read-resv! in) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + ckeys-sym (keys/get-ckeys-sym-cipher key-sym ?key-id) + ba-cnt + (keys/try-decrypt-with-keys! `decrypt-with-symmetric-key + (some? ?key-id) ckeys-sym + (fn [ckey-sym] + (let [{:keys [key-sym]} @ckey-sym + ba-key (have enc/bytes? key-sym) + ba-key* (impl/hmac hash-algo ba-key ba-akm ba-iv) ; +IV for forward secrecy + ba-cnt (impl/sck-decrypt sck ba-iv ba-key* ba-ecnt ?ba-aad)] + ba-cnt)))] + + (return-val env-kid return ba-cnt ?ba-aad)))) + +(comment + (let [kc (keychain) + ba-enc (encrypt-with-symmetric-key (as-ba "cnt") kc)] + (decrypt-with-symmetric-key ba-enc kc {:return :_test}))) + +(defn encrypt-with-1-keypair + "Uses a symmetric or hybrid (symmetric + asymmetric) scheme to encrypt the + given content byte[] and return a byte[] that includes: + - The encrypted content + - Optional unencrypted AAD (see `doc-aad` docstring) + - Envelope data necessary for decryption (specifies algorithms, etc.) + + Takes a `KeyChain` (see `keychain`) or `KeyPair` (see `keypair-create`). + Key algorithm must support use as an asymmetric cipher. + Suitable algorithms: `:rsa-` + + Encryption uses receiver's asymmetric public key. + Decryption uses receiver's asymmetric private key. + + Decrypt output byte[] with: `decrypt-with-1-keypair`. + + Options: + `:ba-aad` - See `doc-aad` docstring + `:ba-akm` - See `doc-akm` docstring + + Relevant `*config*` keys (see that var's docstring for details): + `hash-algo`, `sym-cipher-algo`, `asym-cipher-algo`, `embed-key-ids`?" + + ^bytes + [ba-content receiver-key-pub & + [{:keys [ba-aad ba-akm, :config + hash-algo sym-cipher-algo asym-cipher-algo + embed-key-ids?] :as opts}]] + + (let [{:keys [asym-cipher-algo embed-key-ids?] :as opts*} + (get-config opts) + + ckey-pub (keys/get-ckeys-asym-cipher receiver-key-pub) + {:keys [key-pub key-id key-algo]} @ckey-pub + + ?ba-key-id (when embed-key-ids? (bytes/?str->utf8-ba key-id)) + asym-cipher-algo (have (or asym-cipher-algo (get (impl/key-algo-info key-algo) :asym-cipher-algo))) + + ;; Simple optimization to cover ~common case of encrypting symmetric keys + hybrid? (or ba-aad ba-akm (> (alength ^bytes ba-content) 64))] + + (if hybrid? + + ;; Hybrid scheme: + ;; - Use a random 1-time symmetric key to encrypt content + ;; - Wrap symmetric key with asymmetric encryption, embed + + #_(df/reference-data-formats :encrypted-with-1-keypair-hybrid-v1) + (let [{:keys [hash-algo sym-cipher-algo]} opts* + _ (have? some? hash-algo sym-cipher-algo) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + ba-iv (impl/rand-ba (impl/sck-iv-len sck)) + ba-key-pre-akm (impl/rand-ba (impl/sck-key-len sck)) ; Random symmetric key (=> forward secrecy) + ba-key-post-akm (impl/hmac hash-algo ba-key-pre-akm ba-akm) + ba-ecnt (impl/sck-encrypt sck ba-iv ba-key-post-akm ba-content ba-aad) + ba-ekey (impl/encrypt-asymmetric asym-cipher-algo + key-algo key-pub ba-key-pre-akm)] + + #_(df/reference-data-formats :encrypted-with-1-keypair-simple-v1) + (bytes/with-out [out] [24 ba-ecnt ba-aad ba-iv ba-ekey] + (df/write-head out) + (df/write-kid out :envelope :encrypted-with-1-keypair-hybrid-v1) + (bytes/write-dynamic-ba out ba-aad) + (df/write-kid out :key-algo key-algo) + (bytes/write-dynamic-ba out ?ba-key-id) + (df/write-kid out :hash-algo hash-algo) + (df/write-kid out :sym-cipher-algo sym-cipher-algo) + (df/write-kid out :asym-cipher-algo asym-cipher-algo) + (bytes/write-dynamic-ba out ba-iv) + (bytes/write-dynamic-ba out ba-ecnt) + (bytes/write-dynamic-ba out ba-ekey) + (df/write-resv out))) + + (let [ba-ecnt (impl/encrypt-asymmetric asym-cipher-algo key-algo key-pub ba-content)] + + (bytes/with-out [out] [24 ba-ecnt] + (df/write-head out) + (df/write-kid out :envelope :encrypted-with-1-keypair-simple-v1) + ;; (bytes/write-dynamic-ba out ba-aad + (df/write-kid out :key-algo key-algo) + (bytes/write-dynamic-ba out ?ba-key-id) + ;; (df/write-kid out :hash-algo hash-algo) + ;; (df/write-kid out :sym-cipher-algo sym-cipher-algo) + (df/write-kid out :asym-cipher-algo asym-cipher-algo) + ;; (bytes/write-dynamic-ba out ba-iv) + (bytes/write-dynamic-ba out ba-ecnt) + ;; (bytes/write-dynamic-ba out ba-ekey) + (df/write-resv out)))))) + +(comment + [(public-data-test (encrypt-with-1-keypair (impl/rand-ba 32) (keychain))) + (public-data-test (encrypt-with-1-keypair (impl/rand-ba 128) (keychain)))]) + +(defn decrypt-with-1-keypair + "Complement of `encrypt-with-1-keypair`. + + Uses a hybrid (symmetric + asymmetric) scheme to decrypt the given byte[]. + Return value depends on `:return` option: + `:ba-content` - Returns decrypted byte[] content (default) + `:ba-aad` - Returns verified unencrypted embedded ?byte[] AAD + `:as-map` - Returns {:keys [ba-aad ba-content]} map + + Takes a `KeyChain` (see `keychain`) or `KeyPair` (see `keypair-create`). + Key algorithm must support use as an asymmetric cipher. + Suitable algorithms: `:rsa-` + + Encryption uses receiver's asymmetric public key. + Decryption uses receiver's asymmetric private key. + + Will throw on decryption failure (bad key, etc.)." + + [ba-encrypted receiver-key-prv & + [{:keys [return ba-aad ba-akm] + :or {return :ba-content}}]] + + (bytes/with-in [in] ba-encrypted + (let [_ (df/read-head! in) + env-kid (df/read-kid in :envelope + #{:encrypted-with-1-keypair-hybrid-v1 + :encrypted-with-1-keypair-simple-v1})] + + (case env-kid + :encrypted-with-1-keypair-hybrid-v1 + #_(df/reference-data-formats :encrypted-with-1-keypair-hybrid-v1) + (let [?ba-aad (bytes/read-dynamic-ba in) + key-algo (df/read-kid in :key-algo) + ?key-id (bytes/read-dynamic-str in) + hash-algo (df/read-kid in :hash-algo) + sym-cipher-algo (df/read-kid in :sym-cipher-algo) + asym-cipher-algo (df/read-kid in :asym-cipher-algo) + ba-iv (bytes/read-dynamic-ba! in) + ba-ecnt (bytes/read-dynamic-ba! in) + ba-ekey (bytes/read-dynamic-ba! in) + _ (df/read-resv! in) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + ckeys-prv (keys/get-ckeys-asym-cipher receiver-key-prv key-algo ?key-id) + ba-cnt + (keys/try-decrypt-with-keys! `decrypt-with-1-keypair + (some? ?key-id) ckeys-prv + (fn [ckey-prv] + (let [{:keys [key-prv]} @ckey-prv + ba-key-pre-akm (impl/decrypt-asymmetric asym-cipher-algo + key-algo key-prv ba-ekey) ; Symmetric key + ba-key-post-akm (impl/hmac hash-algo ba-key-pre-akm ba-akm) + ba-cnt (impl/sck-decrypt sck ba-iv ba-key-post-akm ba-ecnt ?ba-aad)] + ba-cnt)))] + + (return-val env-kid return ba-cnt ?ba-aad)) + + :encrypted-with-1-keypair-simple-v1 + #_(df/reference-data-formats :encrypted-with-1-keypair-simple-v1) + (let [;; ?ba-aad (bytes/read-dynamic-ba in) + key-algo (df/read-kid in :key-algo) + ?key-id (bytes/read-dynamic-str in) + ;; hash-algo (df/read-kid in :hash-algo) + ;; sym-cipher-algo (df/read-kid in :sym-cipher-algo) + asym-cipher-algo (df/read-kid in :asym-cipher-algo) + ;; ba-iv (bytes/read-dynamic-ba! in) + ba-ecnt (bytes/read-dynamic-ba! in) + ;; ba-ekey (bytes/read-dynamic-ba! in) + _ (df/read-resv! in) + + ckeys-prv (keys/get-ckeys-asym-cipher receiver-key-prv key-algo ?key-id) + ba-cnt + (keys/try-decrypt-with-keys! `decrypt-with-1-keypair + (some? ?key-id) ckeys-prv + (fn [ckey-prv] + (let [{:keys [key-prv]} @ckey-prv + ba-cnt (impl/decrypt-asymmetric asym-cipher-algo key-algo key-prv ba-ecnt)] + ba-cnt)))] + + (return-val env-kid return ba-cnt nil)) + + (enc/unexpected-arg! env-kid + :context `decrypt-with-1-keypair + :expected + {:encrypted-with-1-keypair-hybrid-v1 + :encrypted-with-1-keypair-simple-v1}))))) + +(comment + (let [kc (keychain) + ba-enc (encrypt-with-1-keypair (as-ba "cnt") kc)] + (decrypt-with-1-keypair ba-enc kc {:return :_test}))) + +(defn encrypt-with-2-keypairs + "Uses a hybrid (symmetric + asymmetric) scheme to encrypt the given content + byte[] and return a byte[] that includes: + - The encrypted content + - Optional unencrypted AAD (see `doc-aad` docstring) + - Envelope data necessary for decryption (specifies algorithms, etc.) + + Takes `KeyChain`s (see `keychain`) and/or `KeyPair`s (see `keypair-create`). + Key algorithm must support key agreement. + Suitable algorithms: `:dh-`, `:ec-` + + Encryption uses: + - Receiver's asymmetric public key + - Sender's asymmetric private key + + Decryption uses: + - Receiver's asymmetric private key + - Sender's asymmetric public key + + Decrypt output byte[] with: `decrypt-with-2-keypairs`. + + Options: + `:ba-aad` - See `doc-aad` docstring + `:ba-akm` - See `doc-akm` docstring + + Relevant `*config*` keys (see that var's docstring for details): + `hash-algo`, `ka-algo`, `sym-cipher-algo`, `embed-key-ids?`" + + #_(df/reference-data-formats :encrypted-with-2-keypairs-v1) + ^bytes + [ba-content receiver-key-pub sender-key-prv & + [{:keys [ba-aad ba-akm, :config + hash-algo ka-algo sym-cipher-algo embed-key-ids?] :as opts}]] + + ;; Hybrid scheme: + ;; - Gen symmetric key via key agreement + ;; - Use symmetric key to encrypt content + + ;; Ref. NIST SP 800-56A §5.9.1 to §5.9.3. for SKM/AKM + + (let [{:keys [hash-algo ka-algo sym-cipher-algo embed-key-ids?]} (get-config opts) + _ (have? some? hash-algo sym-cipher-algo) + + [recvr-ckey-pub sendr-ckey-prv] (keys/get-ckeys-ka receiver-key-pub sender-key-prv) + {:keys [key-pub ], recvr-key-id :key-id} @recvr-ckey-pub + {:keys [key-prv key-algo], sendr-key-id :key-id} @sendr-ckey-prv + + ?ba-recvr-key-id (when embed-key-ids? (bytes/?str->utf8-ba recvr-key-id)) + ?ba-sendr-key-id (when embed-key-ids? (bytes/?str->utf8-ba sendr-key-id)) + + ka-algo (have (or ka-algo (get (impl/key-algo-info key-algo) :ka-algo))) + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + ba-iv (impl/rand-ba (impl/sck-iv-len sck)) + ba-key + (let [ba-shared-key (impl/key-shared-create ka-algo key-algo key-prv key-pub)] + (impl/hmac hash-algo ba-shared-key ba-akm ba-iv)) ; +IV for forward secrecy + + ba-ecnt (impl/sck-encrypt sck ba-iv ba-key ba-content ba-aad)] + + (bytes/with-out [out] [16 ba-ecnt ba-aad ?ba-recvr-key-id ?ba-sendr-key-id ba-iv] + (df/write-head out) + (df/write-kid out :envelope :encrypted-with-2-keypairs-v1) + (bytes/write-dynamic-ba out ba-aad) + (df/write-kid out :key-algo key-algo) + (bytes/write-dynamic-ba out ?ba-recvr-key-id) + (bytes/write-dynamic-ba out ?ba-sendr-key-id) + (df/write-kid out :hash-algo hash-algo) + (df/write-kid out :ka-algo ka-algo) + (df/write-kid out :sym-cipher-algo sym-cipher-algo) + (bytes/write-dynamic-ba out ba-iv) + (bytes/write-dynamic-ba out ba-ecnt) + (df/write-resv out)))) + +(comment (public-data-test (encrypt-with-2-keypairs (as-ba "cnt") (keychain) (keychain)))) + +(defn decrypt-with-2-keypairs + "Complement of `encrypt-with-2-keypairs`. + + Uses a hybrid (symmetric + asymmetric) scheme to decrypt the given byte[]. + Return value depends on `:return` option: + `:ba-content` - Returns decrypted byte[] content (default) + `:ba-aad` - Returns verified unencrypted embedded ?byte[] AAD + `:as-map` - Returns {:keys [ba-aad ba-content]} map + + Takes `KeyChain`s (see `keychain`) and/or `KeyPair`s (see `keypair-create`). + Key algorithm must support key agreement. + Suitable algorithms: `:dh-`, `:ec-` + + Encryption uses: + - Receiver's asymmetric public key + - Sender's asymmetric private key + + Decryption uses: + - Receiver's asymmetric private key + - Sender's asymmetric public key + + Will throw on decryption failure (bad key, etc.)." + + #_(df/reference-data-formats :encrypted-with-2-keypairs-v1) + [ba-encrypted receiver-key-prv sender-key-pub & + [{:keys [return ba-aad ba-akm] + :or {return :ba-content}}]] + + (bytes/with-in [in] ba-encrypted + (let [env-kid :encrypted-with-2-keypairs-v1 + _ (df/read-head! in) + _ (df/read-kid in :envelope env-kid) + ?ba-aad (bytes/read-dynamic-ba in) + key-algo (df/read-kid in :key-algo) + ?recvr-key-id (bytes/read-dynamic-str in) + ?sendr-key-id (bytes/read-dynamic-str in) + + hash-algo (df/read-kid in :hash-algo) + ka-algo (df/read-kid in :ka-algo) + sym-cipher-algo (df/read-kid in :sym-cipher-algo) + ba-iv (bytes/read-dynamic-ba! in) + ba-ecnt (bytes/read-dynamic-ba! in) + _ (df/read-resv! in) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + + ckey-pairs ; [[ ] ...] + (keys/get-ckeys-ka key-algo + [receiver-key-prv ?recvr-key-id] + [sender-key-pub ?sendr-key-id]) + + ba-cnt + (keys/try-decrypt-with-keys! `decrypt-with-2-keypairs + (some? ?recvr-key-id) ckey-pairs + (fn [[recvr-ckey-prv sendr-ckey-pub]] + (let [{:keys [key-prv]} @recvr-ckey-prv + {:keys [key-pub]} @sendr-ckey-pub + + ba-key + (let [ba-shared-key (impl/key-shared-create ka-algo key-algo key-prv key-pub)] + (impl/hmac hash-algo ba-shared-key ba-akm ba-iv)) + + ba-cnt (impl/sck-decrypt sck ba-iv ba-key ba-ecnt ?ba-aad)] + + ba-cnt)))] + + (return-val env-kid return ba-cnt ?ba-aad)))) + +(comment + (let [kc1 (keychain) + kc2 (keychain) + ba-enc (encrypt-with-2-keypairs (as-ba "cnt") kc1 kc2)] + (decrypt-with-2-keypairs ba-enc kc1 kc2 {:return :_test}))) + +;;;; Signature API + +(defn sign + "Cryptographically signs the given content byte[] and returns a byte[] + that includes: + - Optional unencrypted content (see `embed-content?` option below) + - Optional unencrypted AAD (see `doc-aad` docstring) + - Envelope data necessary for verification (specifies algorithms, etc.) + + Basically produces: + - Signed content when `embed-content?` is true (default) + - A signature when `embed-content?` is false + + Takes a `KeyChain` (see `keychain`) or `KeyPair` (see `keypair-create`). + Key algorithm must support signatures. + Suitable algorithms: `:rsa-`, `:ec-` + + Signing uses signer's asymmetric private key. + Verification uses signer's asymmetric public key. + + Verify a signature with: `signature-verify`. + + Relevant `*config*` keys (see that var's docstring for details): + `hash-algo`, `sig-algo`, `embed-key-ids?`" + + #_(df/reference-data-formats :signed-v1) + ^bytes + [ba-content signer-key-prv & + [{:keys [ba-aad ba-akm embed-content?, :config + hash-algo sig-algo embed-key-ids?] + :as opts + :or {embed-content? true}}]] + + (let [{:keys [hash-algo sig-algo embed-key-ids?]} (get-config opts) + _ (have? some? hash-algo) + + ckey-prv (keys/get-ckeys-sig signer-key-prv) + {:keys [key-prv key-id key-algo]} @ckey-prv + ?ba-key-id (when embed-key-ids? (bytes/?str->utf8-ba key-id)) + ?ba-em-cnt (when embed-content? ba-content) + + sig-algo (have (or sig-algo (get (impl/key-algo-info key-algo) :sig-algo))) + ba-to-sign (impl/hash-ba-cascade hash-algo ba-content ba-akm ba-aad) + ba-sig (impl/signature-create sig-algo key-algo key-prv ba-to-sign)] + + (bytes/with-out [out] [8 ba-aad ?ba-key-id ba-sig ?ba-em-cnt] + (df/write-head out) + (df/write-kid out :envelope :signed-v1) + (bytes/write-dynamic-ba out ba-aad) + (df/write-kid out :key-algo key-algo) + (bytes/write-dynamic-ba out ?ba-key-id) + (bytes/write-dynamic-ba out ?ba-em-cnt) + (df/write-kid out :hash-algo hash-algo) + (df/write-kid out :sig-algo sig-algo) + (bytes/write-dynamic-ba out ba-sig) + (df/write-resv out)))) + +(comment (public-data-test (sign (as-ba "cnt") (keychain)))) + +(defn signed + "Complement of `sign`. + + Cryptographically verifies if the given signed byte[] was signed by the + private key corresponding to the given public key. + + Return value depends on `:return` option: + `:ba-content` - Returns verified ?byte[] content (when embedded) + `:ba-aad` - Returns verified ?byte[] AAD (when embedded) + `:as-map` - Returns {:keys [ba-aad ba-content]} map (default) + + Returns nil when verification fails. + + Takes a `KeyChain` (see `keychain`) or `KeyPair` (see `keypair-create`). + Key algorithm must support signatures. + Suitable algorithms: `:rsa-`, `:ec-` + + Signing uses signer's asymmetric private key. + Verification uses signer's asymmetric public key." + + #_(df/reference-data-formats :signature-v1) + [ba-signed signer-key-pub & + [{:keys [return ba-content ba-aad ba-akm] + :or {return :as-map}}]] + + (bytes/with-in [in] ba-signed + (let [env-kid :signed-v1 + _ (df/read-head! in) + _ (df/read-kid in :envelope env-kid) + ?ba-aad (bytes/read-dynamic-ba in) + key-algo (df/read-kid in :key-algo) + ?key-id (bytes/read-dynamic-str in) + ?ba-em-cnt (bytes/read-dynamic-ba in) + hash-algo (df/read-kid in :hash-algo) + sig-algo (df/read-kid in :sig-algo) + ba-sig (bytes/read-dynamic-ba! in) + _ (df/read-resv! in) + + ba-cnt + (or ba-content ?ba-em-cnt + (throw + (ex-info "Cannot check signature without embedded or provided content" + {:content {:embedded nil, :provided nil}}))) + + ckeys-pub (keys/get-ckeys-sig signer-key-pub key-algo ?key-id) + ba-to-sign (impl/hash-ba-cascade hash-algo ba-cnt ba-akm ?ba-aad) + + {:keys [success _error _errors]} + (keys/try-keys (some? ?key-id) ckeys-pub + (fn [ckey-pub] + (let [{:keys [key-pub]} @ckey-pub] + (if (impl/signature-verify sig-algo key-algo key-pub ba-to-sign ba-sig) + {:ba-content ba-cnt + :ba-aad ?ba-aad}))))] + + (when-let [{:keys [ba-content ba-aad]} success] + (return-val `signed return ba-content ba-aad))))) + +(comment + (let [kc (keychain) + ba-signed (sign (as-ba "cnt") kc {:ba-aad (as-ba "aad")})] + (signed ba-signed kc {:return :_test}))) diff --git a/src/taoensso/tempel/bytes.clj b/src/taoensso/tempel/bytes.clj new file mode 100644 index 0000000..852d068 --- /dev/null +++ b/src/taoensso/tempel/bytes.clj @@ -0,0 +1,352 @@ +(ns ^:no-doc taoensso.tempel.bytes + "Private ns, implementation detail. + Byte[] and related utils." + (:refer-clojure :exclude [bytes?]) + (:require + [taoensso.encore :as enc :refer [have have?]]) + + (:import + [java.nio.charset StandardCharsets] + [java.io + DataInput DataInputStream + DataOutput DataOutputStream + ByteArrayInputStream + ByteArrayOutputStream])) + +(comment + (remove-ns 'taoensso.tempel.bytes) + (:public (enc/interns-overview))) + +;;;; Aliases + +(enc/defaliases + enc/bytes? + enc/ba= + enc/str->utf8-ba + enc/utf8-ba->str) + +;;;; Basics + +(def ^:private ^:const utf8-str "hello ಬಾ ಇಲ್ಲಿ ಸಂಭವಿಸ") +(defn ba-len ^long [?ba] (if ?ba (alength ^bytes ?ba) 0)) + +(defn ba-join* + "Returns byte[] concatenation of >= 0 ?byte[]s." + ^bytes [bas] + (let [total-len (reduce (fn [^long acc in] (if in (+ acc (alength ^bytes in)) acc)) 0 bas) + out (byte-array total-len)] + (loop [idx 0, remaining bas] + (if-let [[in] remaining] + (if in + (let [len (alength ^bytes in)] + (do + (System/arraycopy in 0 out idx len) + (recur (+ idx len) (next remaining)))) + (recur idx (next remaining))) + out)))) + +(let [ba0 (byte-array 0)] + (defn ba-join + "Returns byte[] concatenation of >= 0 ?byte[]s." + (^bytes [ ] ba0) + (^bytes [ba ] (or ba ba0)) + (^bytes [ba1 ba2] + (enc/cond + (nil? ba1) (or ba2 ba0) + (nil? ba2) (or ba1 ba0) + :else + (let [l1 (alength ^bytes ba1) + l2 (alength ^bytes ba2) + out (byte-array (+ l1 l2))] + (System/arraycopy ba1 0 out 0 l1) + (System/arraycopy ba2 0 out l1 l2) + (do out)))) + + (^bytes [ba1 ba2 & more] + (ba-join (ba-join ba1 ba2) (ba-join* more))))) + +(comment (vec (let [ba byte-array] (ba-join nil (ba [0]) (ba [1 2]) nil (ba [3 4 5]) nil nil (ba [6]))))) + +(let [ba-range + (fn [^bytes ba ^long lidx ^long ridx] + (when (pos? (- ridx lidx)) + (java.util.Arrays/copyOfRange ba lidx ridx)))] + + (defn ba-parts* + "Returns `to` with partitions of given byte[] coinjoined." + [to ba start-idx lengths] + (loop [idx (long start-idx), remaining lengths, acc to] + (if-let [[^int len] remaining] + (recur (+ idx len) (next remaining) + (conj acc (ba-range ba idx (+ idx len)))) + (conj acc (ba-range ba idx (alength ^bytes ba)))))) + + (defn ba-parts + "Returns vector of partitions of given byte[]." + ([ba start-idx len1] ; => [] + (let [idx2 (+ ^int start-idx ^int len1)] + [(ba-range ba start-idx idx2) + (ba-range ba idx2 (alength ^bytes ba))])) + + ([ba start-idx len1 len2] ; => [] + (let [idx2 (+ ^int start-idx ^int len1) + idx3 (+ idx2 ^int len2)] + [(ba-range ba start-idx idx2) + (ba-range ba idx2 idx3) + (ba-range ba idx3 (alength ^bytes ba))])) + + ([ba start-idx len1 len2 & more] ; => [<...>] + (let [idx2 (+ ^int start-idx ^int len1) + idx3 (+ idx2 ^int len2) + acc + [(ba-range ba start-idx idx2) + (ba-range ba idx2 idx3)]] + + (ba-parts* acc ba idx3 more))))) + +(comment (mapv vec (ba-parts (byte-array (range 16)) 0 1 2 3 4))) + +(defn ba->len + "Returns given byte[] `ba` if its length exactly matches `target-len`. + Otherwise returns a truncated or zero-padded copy of `ba` as necessary." + ^bytes [target-len ^bytes ba] + (let [target-len (int target-len)] + (if (== target-len (alength ba)) + ba + (java.util.Arrays/copyOf ba target-len)))) + +(defn ba->sublen + "Like `ba->len`, but will throw instead of padding." + ^bytes [target-len ^bytes ba] + (let [actual-len (alength ba) + target-len (int target-len)] + + (enc/cond + (== target-len actual-len) ba + (< target-len actual-len) (java.util.Arrays/copyOf ba target-len) + :else + (throw + (ex-info "Given byte[] too short" + {:length {:actual actual-len, :target target-len}}))))) + +;;;; To/from integers + +(do + (def ^:const ubyte-max "Max unsigned byte: 255" (- Byte/MAX_VALUE Byte/MIN_VALUE)) + (def ^:const ushort-max "Max unsigned short: 65,535" (- Short/MAX_VALUE Short/MIN_VALUE)) + (def ^:const uint-max "Max unsigned int: 4,294,967,295" (- Integer/MAX_VALUE Integer/MIN_VALUE)) + + (let [fail! + (fn [n target-type] + (throw + (ex-info "Numerical overflow" + {:target-type target-type + :given {:value n :type (type n)}})))] + + (defn as-byte ^long [^long n] (if (and (>= n Byte/MIN_VALUE) (<= n Byte/MAX_VALUE)) n (fail! n :byte))) + (defn as-short ^long [^long n] (if (and (>= n Short/MIN_VALUE) (<= n Short/MAX_VALUE)) n (fail! n :short))) + (defn as-int ^long [^long n] (if (and (>= n Integer/MIN_VALUE) (<= n Integer/MAX_VALUE)) n (fail! n :int))) + + (defn as-ubyte ^long [^long n] (if (and (>= n 0) (<= n ubyte-max)) n (fail! n :ubyte))) + (defn as-ushort ^long [^long n] (if (and (>= n 0) (<= n ushort-max)) n (fail! n :ushort))) + (defn as-uint ^long [^long n] (if (and (>= n 0) (<= n uint-max)) n (fail! n :uint))))) + +(do + (defn to-ubyte "ℤ[-128,127] -> ℕ[0,255]" ^long [^long n] (as-ubyte (- n Byte/MIN_VALUE))) + (defn to-ushort "ℤ[-32768 32767] -> ℕ[0,65535]" ^long [^long n] (as-ushort (- n Short/MIN_VALUE))) + (defn to-uint "ℤ -> ℕ[0,max]" ^long [^long n] (as-uint (- n Integer/MIN_VALUE))) + + (defn from-ubyte "ℕ[0,255] -> ℤ[-128,127]" ^long [^long n] (+ (as-ubyte n) Byte/MIN_VALUE)) + (defn from-ushort "ℕ[0,65535] -> ℤ[-32768,32767]" ^long [^long n] (+ (as-ushort n) Short/MIN_VALUE)) + (defn from-uint "ℕ[0,max] -> ℤ" ^long [^long n] (+ (as-uint n) Integer/MIN_VALUE)) + + (defn n-bytes->n-bits ^long [n-bytes] (* (int n-bytes) 8)) + (defn n-bits->n-bytes ^long [n-bits] (quot (int n-bits) 8))) + +(do + (defn byte->ba ^bytes [n] (let [bb (java.nio.ByteBuffer/allocate 1)] (.put bb (byte (as-byte n))) (.array bb))) + (defn short->ba ^bytes [n] (let [bb (java.nio.ByteBuffer/allocate Short/BYTES)] (.putShort bb (short (as-short n))) (.array bb))) + (defn int->ba ^bytes [n] (let [bb (java.nio.ByteBuffer/allocate Integer/BYTES)] (.putInt bb (int (as-int n))) (.array bb))) + + (defn ba->byte [^bytes ba] (aget ba 0)) + (defn ba->short [^bytes ba] (let [bb (java.nio.ByteBuffer/allocate Short/BYTES)] (.put bb ba) (.flip bb) (.getShort bb))) + (defn ba->int [^bytes ba] (let [bb (java.nio.ByteBuffer/allocate Integer/BYTES)] (.put bb ba) (.flip bb) (.getInt bb)))) + +(comment + (enc/qb 1e6 ; [66.26 68.72 70.05] + (ba->byte (byte->ba 25)) + (ba->short (short->ba 25)) + (ba->int (int->ba 25)))) + +;;;; To/from strings +;; Java strings are UTF-16, but we'll use UTF-8 encoding when converting to/from bytes + +(def ^:const utf8-str "ಬಾ ಇಲ್ಲಿ ಸಂಭವಿಸ") +(defn utf8-?ba->str [?ba] (when-let [ba ?ba] (enc/utf8-ba->str ba))) +(defn ?str->utf8-ba [?s] (when-let [s ?s] (enc/str->utf8-ba s))) +(declare ca->utf8-ba chars?) + +(defn ^:public as-ba + "Returns a byte[] from given input: + byte[] -> byte[] + string[] -> corresponding UTF-8 byte[] + char[] -> corresponding UTF-8 byte[] + int -> (byte-array ) + seqable -> (byte-array ) + + When `target-len` is provided, trim or zero-pad the returned array as necessary." + (^bytes [target-len x] (ba->len target-len (as-ba x))) + (^bytes [ x] + (enc/cond + (bytes? x) x + (string? x) (str->utf8-ba x) + (chars? x) (ca->utf8-ba x) + (enc/int? x) (byte-array x) + (seqable? x) (byte-array x) + :else + (enc/unexpected-arg! x + :context `as-ba + :expected '#{byte-array string char-array int seqable})))) + +(comment (vec (as-ba 16 "hello"))) + +(defn as-?ba + ([target-len x] (when x (as-ba target-len x))) + ([ x] (when x (as-ba x)))) + +#_ +(defn as-str ^String [x] + (enc/cond + (string? x) x + (bytes? x) (enc/utf8-ba->str x) + (chars? x) (String/valueOf ^chars x) + :else (str x))) + +#_(defn as-?str [x] (when x (as-str x))) + +;;;; To/from char[]s + +(let [c (Class/forName "[C")] (defn chars? [x] (instance? c x))) + +(defn as-ca + "If given a char[]: returns the char[]. + If given a string or byte[]: returns the corresponding char[]." + ^chars [x] + (enc/cond + (chars? x) x + (string? x) (.toCharArray ^String x) + (bytes? x) (.toCharArray ^String (utf8-ba->str x)) + :else + (enc/unexpected-arg! x + :context `as-ca + :expected '#{char-array string byte-array}))) + +;;;; Byte streams + +(defn with-out* ^bytes [buffer-len out-fn] + (let [baos (ByteArrayOutputStream. buffer-len) + out (DataOutputStream. baos)] + (out-fn out baos) + (.toByteArray baos))) + +(defn with-in* [^bytes ba in-fn] + (let [bais (ByteArrayInputStream. ba) + in (DataInputStream. bais)] + (in-fn in bais))) + +(defn parse-buffer-len [spec] + (reduce + (fn [^long acc in] + (if in + (if (bytes? in) + (+ acc (alength ^bytes in)) + (+ acc (long in))) + acc)) + 0 spec)) + +(defmacro with-out [[dos-sym ?baos-sym] buffer-len & body] + (let [baos-sym (or ?baos-sym '__baos) + buffer-len + (if (vector? buffer-len) + `(parse-buffer-len ~buffer-len) + (do buffer-len))] + + `(with-out* ~buffer-len + (fn [~(with-meta dos-sym {:tag 'java.io.DataOutputStream}) + ~(with-meta baos-sym {:tag 'java.io.ByteArrayOutputStream})] + ~@body)))) + +(defmacro with-in [[din-sym ?bais-sym] ba & body] + (let [bais-sym (or ?bais-sym '__bais)] + `(with-in* ~ba + (fn [~(with-meta din-sym {:tag 'java.io.DataInput}) + ~(with-meta bais-sym {:tag 'java.io.ByteArrayInputStream})] + ~@body)))) + +;;;; + +(defn read-ba! ^bytes [^DataInput in len] (let [ba (byte-array len)] (.readFully in ba) ba)) +(defn read-ba [^DataInput in len] (when (pos? ^long len) (read-ba! in len))) + +(defn write-dynamic-uint + "Writes given unsigned int to `out` as 1-5 bytes. + Returns the number of bytes written." + ^long [^DataOutput out unsigned-int] + (let [n (long unsigned-int)] + Byte/MIN_VALUE + ;; [-128,124] used for [0,252] ; (from-ubyte 252) + ;; [125, 127] used to indicate typed size prefix + (enc/cond + (<= n 252) (do (.writeByte out (from-ubyte n)) 1) ; 1 byte for [0,252] + (<= n ubyte-max) (do (.writeByte out 125) (.writeByte out (from-ubyte n)) 2) ; 1+1=2 bytes for [0,255] + (<= n ushort-max) (do (.writeByte out 126) (.writeShort out (from-ushort n)) 3) ; 1+2=3 bytes for [0,65535] + (<= n uint-max) (do (.writeByte out 127) (.writeInt out (from-uint n)) 5) ; 1+4=5 bytes for [0,4294967295] + :else + (throw + (ex-info "Dynamic unsigned integer exceeds max" + {:value n, :max uint-max}))))) + +(defn write-dynamic-ba + "Writes possible byte[] `?ba` to `out` as 1-5 bytes. + Returns the number of bytes written." + ^long [^DataOutput out ?ba] + (if-let [^bytes ba ?ba] + (let [ba-len (alength ba) + uint-len (write-dynamic-uint out ba-len)] + (.write out ba 0 ba-len) + (+ ba-len uint-len)) + + (write-dynamic-uint out 0))) + +(defn write-dynamic-str + ^long [^DataOutput out ?s] (write-dynamic-ba out (?str->utf8-ba ?s))) + +(defn read-dynamic-uint + "Reads 1-5 bytes from `in`, and returns unsigned int." + ^long [^DataInput in] + (let [b1 (.readByte in)] + (case b1 + 127 (to-uint (.readInt in)) ; 1+4=5 bytes for [0,4294967295] + 126 (to-ushort (.readShort in)) ; 1+2=3 bytes for [0,65535] + 125 (to-ubyte (.readByte in)) ; 1+1=2 bytes for [0,255] + (do (to-ubyte b1)) ; 1 byte for [0,252] + ))) + +(defn skip-dynamic-ba [^DataInput in] (.skipBytes in (read-dynamic-uint in))) +(defn read-dynamic-ba [^DataInput in] (read-ba in (read-dynamic-uint in))) +(defn read-dynamic-ba! ^bytes [^DataInput in] (read-ba! in (read-dynamic-uint in))) +(defn read-dynamic-ba* [^DataInputStream in] + (let [n0 (.available in)] + [(read-dynamic-ba in) (- n0 (.available in))])) + +(defn read-dynamic-str [^DataInput in] (utf8-?ba->str (read-dynamic-ba in))) +(defn read-dynamic-str! ^String [^DataInput in] (enc/utf8-ba->str (read-dynamic-ba! in))) + +(do + (defn write-ubyte "Writes 1 byte" [^DataOutput out n] (.writeByte out (from-ubyte n))) + (defn write-ushort "Writes 2 bytes" [^DataOutput out n] (.writeShort out (from-ushort n))) + (defn write-uint "Writes 4 bytes" [^DataOutput out n] (.writeInt out (from-uint n))) + + (defn read-ubyte "Reads 1 byte" ^long [^DataInput in] (to-ubyte (.readByte in))) + (defn read-ushort "Reads 2 bytes" ^long [^DataInput in] (to-ushort (.readShort in))) + (defn read-uint "Reads 4 bytes" ^long [^DataInput in] (to-uint (.readInt in)))) diff --git a/src/taoensso/tempel/df.clj b/src/taoensso/tempel/df.clj new file mode 100644 index 0000000..c1ba862 --- /dev/null +++ b/src/taoensso/tempel/df.clj @@ -0,0 +1,209 @@ +(ns ^:no-doc taoensso.tempel.df + "Private ns, implementation detail. + Data format stuff." + (:require + [taoensso.encore :as enc :refer [have have?]] + [taoensso.tempel.bytes :as bytes]) + + (:import + [java.io + DataOutput DataOutputStream + DataInput DataInputStream])) + +(comment + (remove-ns 'taoensso.tempel.df) + (:public (enc/interns-overview))) + +;;;; IDs +;; - `kid` => keyword id, used to uniquely identify some algo/kit/etc. +;; - `bid` => byte id, used to uniquely freeze (serialize) some `kid`. +;; - All standard `bid`s should be ∈ ℕ[0,126]. +;; - All `bid`s currently hard-coded, closed to extension. +;; - `bid` 127 reserved for possible later use by >1 byte ids. +;; - `bid`s ∈ ℤ[-128,-1] reserved for possible later use by users. +;; - `bid`s included in envelope data during encryption so that decryption +;; can automatically identify the correct config. This enables easy +;; automatic migration of kit/algo/etc. over time. + +(def ^:private ^:const error-msg-newer-version + "The data might have been written by a newer version of Tempel, or it might be corrupt.") + +(def ^:private ^:const error-msg-not-tempel + "The data might not have been written by Tempel, or it might be corrupt.") + +(let [m-ids + (let [+entries + (fn [acc kind m-kids-by-bid] + (-> acc + (assoc-in [:by-bid kind] m-kids-by-bid) + (assoc-in [:by-kid kind] (enc/invert-map m-kids-by-bid))))] + + (-> {} + (+entries :envelope + {; 0 nil + 1 :encrypted-with-symmetric-key-v1 + 2 :encrypted-with-password-v1 + 3 :encrypted-with-1-keypair-hybrid-v1 + 4 :encrypted-with-1-keypair-simple-v1 + 5 :encrypted-with-2-keypairs-v1 + 6 :encrypted-keychain-v1 + 7 :keychain-prv-v1 + 8 :keychain-pub-v1 + 9 :signed-v1}) + + (+entries :pbkdf-algo + {; 0 nil + 1 :pbkdf2-hmac-sha-256-v1 + 2 :scrypt-r8p1-v1 + 3 :sha-512-v1-deprecated}) + + (+entries :sym-cipher-algo + {; 0 nil + 1 :aes-gcm-128-v1 + 2 :aes-gcm-256-v1 + 3 :aes-cbc-128-v1-deprecated + 4 :aes-cbc-256-v1-deprecated}) + + (+entries :asym-cipher-algo + {; 0 nil + 1 :rsa-oaep-sha-256-mgf1}) + + (+entries :sig-algo + {; 0 nil + 1 :sha-256-rsa + 2 :sha-512-rsa + 3 :sha-256-ecdsa + 4 :sha-256-ecdsa}) + + (+entries :ka-algo + {; 0 nil + 1 :dh + 2 :ecdh}) + + (+entries :key-algo + {; 0 nil + 1 :symmetric + 2 :rsa-1024 + 3 :rsa-2048 + 4 :rsa-3072 + 5 :rsa-4096 + 6 :dh-1024 + 7 :dh-2048 + 8 :dh-3072 + 9 :dh-4096 + 10 :ec-secp256r1 + 11 :ec-secp384r1 + 12 :ec-secp521r1}) + + (+entries :key-type + {0 nil ; For removed ckey entries + 1 :sym + 2 :pub + 3 :prv}) + + (+entries :hash-algo + {; 0 nil + 1 :md5 + 2 :sha-1 + 3 :sha-256 + 4 :sha-512}))) + + lup + (fn lookup-id [m kind id thaw?] + (if-let [e (find m id)] + (val e) + (throw + (ex-info + (if thaw? + (str "Unexpected Tempel identifier: `" id "`. " error-msg-newer-version) + (str "Unexpected Tempel identifier: `" id "`")) + {:identifier {:kind kind, :value id, :type (type id)} + :expected (set (keys m))}))))] + + (let [m (:by-kid m-ids)] (defn- freeze-kid [kind kid] (-> m (lup kind kind false) (lup kind kid false)))) + (let [m (:by-bid m-ids)] (defn- thaw-bid [kind bid] (-> m (lup kind kind true) (lup kind bid true))))) + +(comment + (thaw-bid :envelope (freeze-kid :envelope :encrypted-with-symmetric-key-v1)) + (thaw-bid :key-algo (freeze-kid :key-algo :symmetric))) + +(defn write-kid [^DataOutput out kind kid] (.writeByte out (freeze-kid kind kid))) +(defn read-kid + ([^DataInput in kind ] (thaw-bid kind (.readByte in))) + ([^DataInput in kind expected-kid] + (let [kid (read-kid in kind) + pass? (if (set? expected-kid) + (contains? expected-kid kid) + (= expected-kid kid))] + (if pass? + kid + (throw + (ex-info (str "Unexpected Tempel identifier: `" kid "`. " error-msg-newer-version) + {:identifier {:actual kid, :expected expected-kid} + :kind kind})))))) + +;;;; Headers, etc. + +(let [ba-head (bytes/str->utf8-ba "TPL")] + (defn write-head [^DataOutput out] (.write out ba-head)) + (defn read-head [^DataInput in] + (try + (let [ba (bytes/read-ba! in 3)] ba) + (catch java.io.EOFException _ nil))) + + (defn read-head? [^DataInput in] (when-let [ba (read-head in)] (enc/ba= ba ba-head))) + (defn read-head! [^DataInput in] + (let [ba (read-head in)] + (or + (and ba (enc/ba= ba ba-head)) + (throw + (ex-info (str "Expected Tempel header not found in data stream. " error-msg-not-tempel) + {:read {:actual (vec ba), :expected (vec ba-head)}})))))) + +(defn write-resv [^DataOutput out] (bytes/write-dynamic-ba out nil)) +(defn read-resv ^long [^DataInput in] (long (.readByte in))) +(defn read-resv! [^DataInput in] + (let [b (read-resv in)] + (or + (== b (bytes/from-ubyte 0)) + (throw + (ex-info + (str "Reserved Tempel extension point unexpectedly in use. " error-msg-newer-version) + {:value {:actual b, :expected 0}}))))) + +;;;; Envelope data formats + +(def reference-data-formats + "{ [ ]} + Public data includes: aad, content, key-algo, key-ids + Other data in order: other algos, params, content" + '{:encrypted-with-password-v1 + [:public-data [3 head] [1 env] [$ ?ba-aad] + :rest [1 hash-algo] [1 sym-cipher-algo] [1 pbkdf-algo] [2 pbkdf-nwf] [$ ba-salt] [$ ba-iv] [$ ba-ecnt] [1 resv]] + + :encrypted-with-symmetric-key-v1 + [:public-data [3 head] [1 env] [$ ?ba-aad] [$ key-id] + :rest [1 hash-algo] [1 sym-cipher-algo] [$ ba-iv] [$ ba-ecnt] [1 resv]] + + :signed-v1 + [:public-data [3 head] [1 env] [$ ?ba-aad] [1 key-algo] [$ key-id] [$ba-cnt] + :rest [1 hash-algo] [1 sig-algo] [$ ba-sig] [1 resv]] + + :encrypted-with-1-keypair--v1 ; ∈ #{hybrid simple} + [:public-data [3 head] [1 env] [$ ?ba-aad] [1 key-algo] [$ key-id] + :rest [?1 hash-algo] [?1 sym-cipher-algo] [1 asym-cipher-algo] [?$ ba-iv] [$ ba-ecnt] [?$ ba-ekey] [1 resv]] + + :encrypted-with-2-keypairs-v1 + [:public-data [3 head] [1 env] [$ ?ba-aad] [1 key-algo] [$ receiver-key-id] [$ sender-key-id] + :rest [1 hash-algo] [1 ka-algo] [1 sym-cipher-algo] [$ ba-iv] [$ ba-ecnt] [1 resv]] + + :encrypted-keychain-v1 + [:public-data [3 head] [1 env] [$ ?ba-aad] [$ ba-kc-pub] [1 resv] + :rest [1 hash-algo] [1 sym-cipher-algo] [1 pbkdf-algo] [2 pbkdf-nwf] [$ ba-salt] [1 resv] + [$ ba-iv] [$ ba-ecnt] [1 resv] [$ ba-ekey] [1 resv] + [?32 ba-hmac] [1 resv]] + + :keychain--v1 ; ∈ #{prv pub} + [[3 head] [1 env] [1 resv] [2 n-entries] [2 resv] + [[[$ key-id] [1 key-type] ?[[1 key-algo] [2 key-priority] [$ key-cnt]]] ...] + [1 resv]]}) diff --git a/src/taoensso/tempel/impl.clj b/src/taoensso/tempel/impl.clj new file mode 100644 index 0000000..ac7e678 --- /dev/null +++ b/src/taoensso/tempel/impl.clj @@ -0,0 +1,926 @@ +(ns ^:no-doc taoensso.tempel.impl + "Private ns, implementation detail. + Low level cryptography stuff. + + Notes: + - These low-level utils should use minimal/zero envelope data! + - For JVM crypto algorithm names, Ref. + , + , etc." + + (:refer-clojure :exclude [rand-nth]) + (:require + [taoensso.encore :as enc :refer [have have?]] + [taoensso.tempel.bytes :as bytes :refer [as-ba]])) + +(comment + (remove-ns 'taoensso.tempel.impl) + (:public (enc/interns-overview))) + +;;;; IDs +;; +;; ✓ pbkdf-kit - #{:scrypt-r8p1-v1 :pbkdf2-hmac-sha-256-v1 :sha-512-v1-deprecated} +;; ✓ sym-cipher-kit - #{:aes-gcm--v1 :aes-cbc--v1-deprecated} +;; +;; ✓ hash-algo - #{:md5 :sha-1 :sha-256 :sha-512} +;; ✓ sym-cipher-algo - #{:aes-gcm :aes-cbc} +;; ✓ asym-cipher-algo - #{:rsa-oaep-sha-256-mgf1} +;; ✓ sig-algo - #{:sha--rsa :sha--ecdsa} +;; +;; ✓ ka-algo - #{:dh :ecdh} +;; ✓ kf-algo - #{:rsa :dh :ec} +;; ✓ key-algo - #{:rsa- :dh- :ec- :symmetric} +;; ✓ key-type - #{:sym :pub :prv} +;; ✓ key-capability - #{:ka :sig :sym-cipher :asym-cipher} + +;;;; Misc + +(defmacro non-throwing? [form] `(try (do ~form true) (catch Throwable _# false))) + +(defn missing-dep! [dep maven-gid context] + (throw + (ex-info + (str "Missing optional dependency: `" maven-gid "`") + {:dependency dep + :maven-group-id maven-gid + :context context}))) + +(comment + (missing-dep! + 'org.apache.commons.codec.binary.Hex + 'commons-codec/commons-codec + 'context)) + +(let [bytes? enc/bytes? + ba-hash enc/ba-hash + ba= enc/ba=] + + (defn cnt-hash + ([x ] (if (bytes? x) (ba-hash x) (hash x))) + ([x y] (hash [(cnt-hash x) (cnt-hash y)]))) + + (defn cnt= [x y] + (or (identical? x y) + (and (= (type x) (type y)) (if (bytes? x) (ba= x y) (= x y)))))) + +;;;; Randomness + +(do + (def ^:dynamic *srng* + "(fn instance-fn []) => `java.security.SecureRandom`. + Used as the sole source of randomness in Tempel. + See also `srng`, `with-srng`, `with-srng-insecure-deterministic`." + enc/secure-rng) + + (defn srng + "Returns `java.security.SecureRandom` instance by calling (*srng*). + See also `*srng*`." + ^java.security.SecureRandom [] (*srng*)) + + (defmacro ^:public with-srng + "Evaluates body with given (instance-fn) used as sole source of + randomness in Tempel. + + (instance-fn) should return a `java.security.SecureRandom` instance." + [instance-fn & body] `(binding [*srng* ~instance-fn] ~@body)) + + (defmacro ^:public with-srng-insecure-deterministic!!! + "Evaluates body with *INSECURE* deterministic `java.util.Random` used + as sole source of randomness in Tempel. + + Never use when encrypting real data, etc. Provided only for testing." + [long-seed & body] + `(let [mock-srng# (enc/secure-rng-mock!!! ~long-seed)] + (with-srng (fn [] mock-srng#) ~@body)))) + +(do + (defn rand-nth [coll] (nth coll (int (* (.nextDouble (srng)) (count coll))))) + (defn rand-ba ^bytes [len] (let [ba (byte-array len)] (.nextBytes (srng) ba) ba)) + (defn rand-double ^double [] (.nextDouble (srng))) + (defn rand-gauss ^double [] (.nextGaussian (srng))) + (defn rand-bool [] (.nextBoolean (srng))) + (defn rand-long + (^long [ ] (.nextLong (srng))) + (^long [nmax] (long (* (long nmax) (.nextDouble (srng)))))) + + (defn rand-hex-str ^String [nbytes] (enc/ba->hex-str (rand-ba nbytes)))) + +(comment + (enc/qb 1e6 (rand-long)) ; 616.31 + (with-srng enc/secure-rng (rand-long)) + (with-srng-insecure-deterministic!!! 5 (rand-long))) + +;;;; Hashing + +;; (defn hash-murmur3 ^long [^String s] (clojure.lang.Murmur3/hashUnencodedChars s)) +;; (comment (hash-murmur3 "hello")) + +(let [md-md5_ (enc/thread-local (java.security.MessageDigest/getInstance "MD5")) + md-sha-1_ (enc/thread-local (java.security.MessageDigest/getInstance "SHA-1")) + md-sha-256_ (enc/thread-local (java.security.MessageDigest/getInstance "SHA-256")) + md-sha-512_ (enc/thread-local (java.security.MessageDigest/getInstance "SHA-512"))] + + (defn as-message-digest + "Returns `java.security.MessageDigest`, or throws. + Takes `hash-algo` ∈ #{:md5 :sha-1 :sha-256 :sha-512}." + ^java.security.MessageDigest [hash-algo] + (case hash-algo + :md5 @md-md5_ + :sha-1 @md-sha-1_ + :sha-256 @md-sha-256_ + :sha-512 @md-sha-512_ + (enc/unexpected-arg! hash-algo + :expected #{:md5 :sha-1 :sha-256 :sha-512} + :context `as-message-digest)))) + +(let [ba0 (byte-array 0)] + (defn hash-ba-concat + "Returns hash digest of given byte[] ?content. + Takes `hash-algo` ∈ #{:md5 :sha-1 :sha-256 :sha-512}. + + For multi-arg content: concatenates all content then hashes the + concatenation once. + + Less computationally expensive than `hash-ba-cascade`, but also less + resistant to length-extension attacks, etc." + (^bytes [hash-algo ] (.digest (as-message-digest hash-algo) ba0)) + (^bytes [hash-algo ba-content] (.digest (as-message-digest hash-algo) (or ba-content ba0))) + (^bytes [hash-algo ba-content & more] + (let [md (as-message-digest hash-algo)] + (when-let [bac ba-content] (.update md ^bytes bac)) + (doseq [bac more] (when bac (.update md ^bytes bac))) + (do (.digest md)))))) + +(defn hash-ba-cascade + "Returns hash digest of given byte[] ?content. + Takes `hash-algo` ∈ #{:md5 :sha-1 :sha-256 :sha-512}. + + For multi-arg content: hashes each individual arg, concatenates the + hashes, then hashes the concatenation. + + More computationally expensive than `hash-ba-concat`, but also more + resistant to length-extension attacks, etc." + ^bytes [hash-algo & ba-content] + (let [md (as-message-digest hash-algo) + hashes (mapv #(when % (.digest md %)) ba-content) + joined (bytes/ba-join* hashes)] + (.digest md joined))) + +(comment (vec (hash-ba-cascade :sha-256 (as-ba "1") (as-ba "2")))) + +(enc/defaliases + {:alias hash-ba, :src hash-ba-cascade, :doc "Alias for `hash-ba-cascade`"}) + +;;;; HMAC (Hash-based Message Authentication Code) +;; Concept: hash the combination of shared secret (e.g. key) and some content. +;; Note that HMAC can also be used as part of HKDF (RFC 5869), in which case +;; an optional/zeroed salt is used as shared secret. + +(let [hmac-md5_ (enc/thread-local (javax.crypto.Mac/getInstance "HmacMD5")) + hmac-sha-1_ (enc/thread-local (javax.crypto.Mac/getInstance "HmacSHA1")) + hmac-sha-256_ (enc/thread-local (javax.crypto.Mac/getInstance "HmacSHA256")) + hmac-sha-512_ (enc/thread-local (javax.crypto.Mac/getInstance "HmacSHA512"))] + + (defn- as-hmac + "Returns `javax.crypto.Mac`, or throws. + Takes `hash-algo` ∈ #{:md5 :sha-1 :sha-256 :sha-512}." + ^javax.crypto.Mac [hash-algo] + (case hash-algo + :md5 @hmac-md5_ + :sha-1 @hmac-sha-1_ + :sha-256 @hmac-sha-256_ + :sha-512 @hmac-sha-512_ + (enc/unexpected-arg! hash-algo + :expected #{:md5 :sha-1 :sha-256 :sha-512} + :context `as-hmac)))) + +(defn hmac + "Returns HMAC of given byte[] secret and byte[] ?content. + Takes `hash-algo` ∈ #{:md5 :sha-1 :sha-256 :sha-512}. + + Has several uses, including derive additional keys from secret: + (hmac :sha-256 ba-secret ba-label1), etc." + (^bytes [hash-algo ba-secret ] (have ba-secret)) + (^bytes [hash-algo ba-secret ba-content] + (have? ba-secret) + (if (nil? ba-content) + ba-secret + (let [hmac (as-hmac hash-algo) + key-spec (javax.crypto.spec.SecretKeySpec. ba-secret (.getAlgorithm hmac))] + + (.init hmac key-spec) + (.doFinal hmac ba-content)))) + + (^bytes [hash-algo ba-secret ba-content & more] + (have? ba-secret) + (let [hmac (as-hmac hash-algo) + key-spec (javax.crypto.spec.SecretKeySpec. ba-secret (.getAlgorithm hmac))] + + (do (.init hmac key-spec)) + (when-let [bac ba-content] (.update hmac ^bytes bac)) + (doseq [bac more] (when bac (.update hmac ^bytes bac))) + (do (.doFinal hmac))))) + +;;;; Symmetric ciphers (AES, etc.) + +(def ^:const max-sym-key-len "256 bits" 32) + +(let [cipher-aes-gcm_ (enc/thread-local (javax.crypto.Cipher/getInstance "AES/GCM/NoPadding")) + cipher-aes-cbc_ (enc/thread-local (javax.crypto.Cipher/getInstance "AES/CBC/PKCS5Padding"))] + + (defn- as-symmetric-cipher + "Returns `javax.crypto.Cipher`, or throws. + Takes `sym-cipher-algo` ∈ #{:aes-gcm :aes-cbc}." + ^javax.crypto.Cipher [sym-cipher-algo] + (case sym-cipher-algo + :aes-gcm @cipher-aes-gcm_ + :aes-cbc @cipher-aes-cbc_ + (enc/unexpected-arg! sym-cipher-algo + :expected #{:aes-gcm :aes-cbc} + :context `as-symmetric-cipher)))) + +(defprotocol ISymmetricCipherKit + "Private protocol, lowest level symmetric API. Zero enveloping." + ( sck-kid [_]) + (^bytes sck-encrypt [_ ba-iv ba-key ba-content ?ba-aad] "=> ba-encrypted-content") + (^bytes sck-decrypt [_ ba-iv ba-key ba-encrypted-content ?ba-aad] "=> ba-content-decrypted") + (^long sck-key-len [_]) + (^long sck-iv-len [_])) + +(deftype SymmetricCipherKit-aes-gcm-v1 + [^int key-len ^int iv-len ^int auth-tag-nbits] + + ISymmetricCipherKit + (sck-kid [_] :aes-gcm-v1) + (sck-key-len [_] key-len) + (sck-iv-len [_] iv-len) + (sck-encrypt [_ ba-iv ba-key ba-content ?ba-aad] + (let [cipher (as-symmetric-cipher :aes-gcm) + ba-key (bytes/ba->sublen key-len ba-key) + ba-iv (bytes/ba->sublen iv-len ba-iv) + key-spec (javax.crypto.spec.SecretKeySpec. ba-key "AES") + param-spec (javax.crypto.spec.GCMParameterSpec. auth-tag-nbits ba-iv)] + + (.init cipher javax.crypto.Cipher/ENCRYPT_MODE key-spec param-spec) + (when-let [^bytes ba-aad ?ba-aad] (.updateAAD cipher ba-aad)) ; Influences tag in ciphertext + + (.doFinal cipher ba-content))) + + (sck-decrypt [_ ba-iv ba-key ba-encrypted-content ?ba-aad] + (let [cipher (as-symmetric-cipher :aes-gcm) + ba-key (bytes/ba->sublen key-len ba-key) + ba-iv (bytes/ba->sublen iv-len ba-iv) + key-spec (javax.crypto.spec.SecretKeySpec. ba-key "AES") + param-spec (javax.crypto.spec.GCMParameterSpec. auth-tag-nbits ba-iv)] + + (.init cipher javax.crypto.Cipher/DECRYPT_MODE key-spec param-spec) + (when-let [^bytes ba-aad ?ba-aad] (.updateAAD cipher ba-aad)) + + (.doFinal cipher ba-encrypted-content)))) + +(deftype SymmetricCipherKit-aes-cbc-v1-deprecated + [^int key-len ^int iv-len] + + ;; Deprecated since: + ;; - Doesn't include MAC, so cannot verify key before attempting decryption. + ;; - GCM mode generally preferred (faster, more secure, includes MAC, etc.). + + ;; Could write a v2 kit with manual MAC: + ;; - On encrypt: + ;; - Add MAC to ciphertext = (hmac ba-derived-key (+ ba-iv ba-encrypted-content ?ba-aad)) + ;; - Where ba-derived-key is something like (hmac ba-key ba-const-auth) or (hmac ba-key ba-iv), etc. + ;; - On decrypt: regen MAC and compare to MAC w/in envelope to provide protection against: + ;; 1. Attempting decryption with wrong key + ;; 2. Accidental data/aad corruption + ;; 3. Intentional data/aad manipulation (attacker cannot regen MAC without ba-key) + + ISymmetricCipherKit + (sck-kid [_] :aes-cbc-v1-deprecated) + (sck-key-len [_] key-len) + (sck-iv-len [_] iv-len) + (sck-encrypt [_ ba-iv ba-key ba-content ?ba-aad] + (let [cipher (as-symmetric-cipher :aes-cbc) + ba-key (bytes/ba->sublen key-len ba-key) + ba-iv (bytes/ba->sublen iv-len ba-iv) + key-spec (javax.crypto.spec.SecretKeySpec. ba-key "AES") + param-spec (javax.crypto.spec.IvParameterSpec. ba-iv)] + + (.init cipher javax.crypto.Cipher/ENCRYPT_MODE key-spec param-spec) + (.doFinal cipher ba-content))) + + (sck-decrypt [_ ba-iv ba-key ba-encrypted-content ?ba-aad] + (let [cipher (as-symmetric-cipher :aes-cbc) + ba-key (bytes/ba->sublen key-len ba-key) + ba-iv (bytes/ba->sublen iv-len ba-iv) + key-spec (javax.crypto.spec.SecretKeySpec. ba-key "AES") + param-spec (javax.crypto.spec.IvParameterSpec. ba-iv)] + + (.init cipher javax.crypto.Cipher/DECRYPT_MODE key-spec param-spec) + (.doFinal cipher ba-encrypted-content)))) + +(let [;; Ref. NIST SP800-38D §5.2.1.1 for params + sck-aes-gcm-128-v1 (SymmetricCipherKit-aes-gcm-v1. 16 12 128) + sck-aes-gcm-192-v1 (SymmetricCipherKit-aes-gcm-v1. 24 12 128) + sck-aes-gcm-256-v1 (SymmetricCipherKit-aes-gcm-v1. 32 12 128) + + sck-aes-cbc-128-v1-deprecated (SymmetricCipherKit-aes-cbc-v1-deprecated. 16 16) + sck-aes-cbc-256-v1-deprecated (SymmetricCipherKit-aes-cbc-v1-deprecated. 32 16) + expected #{:aes-gcm-128-v1 + :aes-gcm-192-v1 + :aes-gcm-256-v1 + :aes-cbc-128-v1-deprecated + :aes-cbc-256-v1-deprecated}] + + (defn as-symmetric-cipher-kit + "Returns `ISymmetricCipherKit` implementer, or throws. + Takes `sym-cipher-algo` ∈ #{:aes-gcm--v1 :aes-cbc--v1-deprecated}." + [sym-cipher-algo] + (if (keyword? sym-cipher-algo) + (case sym-cipher-algo + :aes-gcm-128-v1 sck-aes-gcm-128-v1 + :aes-gcm-192-v1 sck-aes-gcm-192-v1 + :aes-gcm-256-v1 sck-aes-gcm-256-v1 + + :aes-cbc-128-v1-deprecated sck-aes-cbc-128-v1-deprecated + :aes-cbc-256-v1-deprecated sck-aes-cbc-256-v1-deprecated + + (enc/unexpected-arg! sym-cipher-algo + :expected expected + :context `as-symmetric-cipher-kit)) + + (enc/satisfies! ISymmetricCipherKit sym-cipher-algo + :expected expected + :context `as-symmetric-cipher-kit)))) + +;;;; Asymmetric crypto + +(defn- key-algo-unknown! [x context] + (enc/unexpected-arg! x + :context context + :expected + #{:symmetric + :rsa :rsa- + :dh :dh- + :ec :ec-})) + +(defn key-algo-info + "Returns ?{:keys [kf-algo ka-algo sig-algo cipher-algo, asymmetric? symmetric? wild?]}. + + Capabilities exist iff {:keys [ka-algo sig-algo sym-cipher-algo asym-cipher-algo]} do. + These specify the default algo for each corresponding capability." + [key-algo] + (case key-algo + :symmetric + {:sym-cipher-algo :aes-gcm-128-v1 + :symmetric? true} + + :rsa {:kf-algo :rsa, :asymmetric? true, :wild? true} + (:rsa-1024 :rsa-2048 :rsa-3072 :rsa-4096) + {:kf-algo :rsa + ;; :ka-algo nil + :sig-algo :sha-256-rsa + :asym-cipher-algo :rsa-oaep-sha-256-mgf1 + :asymmetric? true} + + :dh {:kf-algo :dh, :asymmetric? true, :wild? true} + (:dh-1024 :dh-2048 :dh-3072 :dh-4096) + {:kf-algo :dh + :ka-algo :dh + ;; :sig-algo nil + ;; :asym-cipher-algo nil + :asymmetric? true} + + :ec {:kf-algo :ec, :asymmetric? true, :wild? true} + (:ec-secp256r1 :ec-secp384r1 :ec-secp521r1) + {:kf-algo :ec + :ka-algo :ecdh + :sig-algo :sha-256-ecdsa + ;; :asym-cipher-algo nil + :asymmetric? true} + + #_(key-algo-unknown! key-algo) + nil)) + +(comment (key-algo-info :ec-secp256r1)) + +(defn key-algo? + "Returns given `key-algo` matching needs, or nil." + ([key-algo ] (when (key-algo-info key-algo) key-algo)) + ([key-algo needs] + (when-let [m-info (key-algo-info key-algo)] + (when (enc/revery? m-info needs) + key-algo)))) + +(defn key-algo! + "Returns given `key-algo` matching needs, or throws." + ([key-algo ] (if (key-algo? key-algo) key-algo (key-algo-unknown! key-algo `key-algo!))) + ([key-algo needs] + (if-let [m-info (key-algo-info key-algo)] + (do + (doseq [need needs] + (when-not (get m-info need) + (throw + (case need + :symmetric? (ex-info "Unexpected key algorithm: need symmetric type" {:key-algo key-algo, :type {:actual :asymmetric, :expected :symmetric}}) + :asymmetric? (ex-info "Unexpected key algorithm: need asymmetric type" {:key-algo key-algo, :type {:actual :symmetric, :expected :asymmetric}}) + :sig-algo (ex-info "Unexpected key algorithm: need signature support" {:key-algo {:given key-algo, :expected #{:rsa- :ec-}}}) + :ka-algo (ex-info "Unexpected key algorithm: need key agreement support" {:key-algo {:given key-algo, :expected #{:dh- :ec-}}}) + :asym-cipher-algo (ex-info "Unexpected key algorithm: need asymmetric cipher support" {:key-algo {:given key-algo, :expected #{:rsa-}}}) + (do (ex-info "Unexpected key algorithm: doesn't meet need" {:key-algo key-algo, :need need})))))) + key-algo) + + (key-algo-unknown! key-algo `key-algo!)))) + +(comment + (key-algo! :dh-1024 [:asymmetric? :ka-algo]) + (key-algo! :dh-1024 [:asymmetric? :sig-algo])) + +(defn key-algo= [key-algo1 key-algo2] + (or + (enc/identical-kw? key-algo1 key-algo2) + (let [info1 (key-algo-info key-algo1) + info2 (key-algo-info key-algo2)] + (and + (or (get info1 :wild?) (get info2 :wild?)) + (enc/identical-kw? (get info1 :kf-algo) (get info2 :kf-algo)))) + false)) + +(comment + [(key-algo= :rsa :rsa-1024) + (key-algo= :rsa-1024 :rsa-2048)]) + +;;;; + +(defn- kpg-get [algo-name algo-params] + (have? string? algo-name) + (let [kpg (java.security.KeyPairGenerator/getInstance algo-name) + sr (srng)] + + (enc/cond + (int? algo-params) (.initialize kpg (int algo-params) sr) + (keyword? algo-params) + (case algo-params + :ec-secp256r1 (.initialize kpg (java.security.spec.ECGenParameterSpec. "secp256r1") sr) ; NIST-P-256 + :ec-secp384r1 (.initialize kpg (java.security.spec.ECGenParameterSpec. "secp384r1") sr) ; NIST-P-384 + :ec-secp521r1 (.initialize kpg (java.security.spec.ECGenParameterSpec. "secp521r1") sr) ; NIST-P-521 + + (enc/unexpected-arg! algo-params + :expected #{:ec-secp256-r1})) + + :else + (.initialize kpg ^java.security.spec.AlgorithmParameterSpec algo-params sr)) + + kpg)) + +(let [;; Avoid thread-locals here since we want fresh *srng* + ;; kpb-get* + ;; (fn [algo-name algo-params] + ;; (enc/thread-local (kpg-get algo-name algo-params))) + ;; + ;; kpg-rsa-1024_ (kpg-get* "RSA" 1024) ; etc. + ] + + (defn- as-keypair-generator + "Returns `java.security.KeyPairGenerator`, or throws. + Takes `key-algo` ∈ #{:rsa- :dh- :ec-}." + ^java.security.KeyPairGenerator [key-algo] + (case key-algo + ;; :rsa-1024 @kpg-rsa-1024_ + :rsa-1024 (kpg-get "RSA" 1024) + :rsa-2048 (kpg-get "RSA" 2048) + :rsa-3072 (kpg-get "RSA" 3072) + :rsa-4096 (kpg-get "RSA" 4096) + + :dh-1024 (kpg-get "DH" 1024) + :dh-2048 (kpg-get "DH" 2048) + :dh-3072 (kpg-get "DH" 3072) + :dh-4096 (kpg-get "DH" 4096) + + :ec-secp256r1 (kpg-get "EC" :ec-secp256r1) + :ec-secp384r1 (kpg-get "EC" :ec-secp384r1) + :ec-secp521r1 (kpg-get "EC" :ec-secp521r1) + + (enc/unexpected-arg! key-algo + :expected #{:rsa- :dh- :ec-} + :context `as-keypair-generator)))) + +(defn ^:public keypair-create + "Generates and returns a new `java.security.KeyPair` for given + `key-algo` ∈ #{:rsa :rsa- :dh :dh- :ec-}. + + Slow! Consider instead using `keypair-creator`." + (^java.security.KeyPair [key-algo needs] (keypair-create (key-algo! key-algo needs))) + (^java.security.KeyPair [key-algo ] + (let [kpg (as-keypair-generator key-algo)] + (.generateKeyPair kpg)))) + +(defn ^:public keypair-creator + "Returns a stateful (fn keypair-get [key-algo]) like `keypair-create` that + eagerly pre-computes keypairs of all previously-requested algos. + + Compare: + (keypair-create :rsa-2048) ; Slow, keypair generated on demand + ;; vs + (defonce kpc (keypair-create {:buffer-len 128, :n-threads [:perc 10]})) + (kpc :rsa-2048) ; Slow first call, keypair generated on demand + (kpc :rsa-2048) ; Fast subsequent calls, will use cache of up to + ; 128 pre-generated keypairs" + [& + [{:keys [buffer-len n-threads] + :or {buffer-len 16 + n-threads [:perc 10]}}]] + + (let [fns_ (atom {}) ; { (fn keypair-get [])} + shared-fp (enc/future-pool n-threads)] + + (fn keypair-get + ([key-algo needs] (keypair-get (key-algo! key-algo needs))) + ([key-algo ] + (let [fn_ + (enc/swap-val! fns_ key-algo + (fn [?fn_] + (or + ?fn_ + (delay + (enc/pre-cache buffer-len shared-fp + (fn keypair-get [] (keypair-create key-algo)))))))] + (@fn_)))))) + +(defn keypair-create* + "Like `keypair-create` but returns {:keys [keypair key-prv key-pub ba-prv ba-pub ...]}." + ([key-algo needs] (keypair-create* (key-algo! key-algo needs))) + ([key-algo ] + (let [kp (keypair-create key-algo) ; java.security.KeyPair + key-prv (.getPrivate kp) ; java.security.Key + key-pub (.getPublic kp) ; java.security.Key + ] + + {:key-algo key-algo + :keypair kp + :key-prv key-prv + :key-pub key-pub + :ba-prv (.getEncoded key-prv) + :ba-pub (.getEncoded key-pub) + ;; :fmt-prv (.getFormat key-prv) + ;; :fmt-pub (.getFormat key-pub) + }))) + +(comment + (keypair-create :rsa-1024 ) + (keypair-create :rsa-1024 [:sig-algo]) + + (enc/qb 10 ; [953.16 5.16 4.61] + (keypair-create :rsa-2048) + (keypair-create :dh-2048) + (keypair-create :ec-secp256r1)) + + (let [kpc (keypair-creator)] + (kpc :rsa-2048) ; Trigger pre-cache + (Thread/sleep 2000) ; Warm-up + (enc/qb 10 ; [795.2 3.02] + (keypair-create :rsa-2048) + (kpc :rsa-2048))) + + (with-srng-insecure-deterministic!!! 10 + (vec (:ba-pub (keypair-create* :rsa-2048))))) + +;;;; + +(defprotocol IKeyPair + (^:private -keypair-info [x] "Returns ?{:keys [key-algo key-prv key-pub]}")) + +(defn- keypair-info-rsa [^java.security.interfaces.RSAKey key] + (let [n-bits (.bitLength (.getModulus key)) + key-algo (keyword (str "rsa-" n-bits))] + {:key-algo key-algo})) + +(defn- keypair-info-dh [^javax.crypto.interfaces.DHKey key] + (let [n-bits (.bitLength (.getP (.getParams key))) + key-algo (keyword (str "dh-" n-bits))] + {:key-algo key-algo})) + +(defn- ec-params [^java.security.interfaces.ECKey key] + (let [curve (.getCurve (.getParams key))] + [(let [f (.getField curve)] + (when (instance? java.security.spec.ECFieldFp f) + (.getP ^java.security.spec.ECFieldFp f))) + (.getA curve) + (.getB curve)])) + +(comment (ec-params (:key-prv (keypair-create* :ec-secp256r1)))) + +(defn- keypair-info-ec [^java.security.interfaces.ECKey key] + ;; Unfortunately the only way to identify a curve is via its field+coefficients + (let [key-algo + (case (ec-params key) + [115792089210356248762697446949407573530086143415290314195533631308867097853951N + 115792089210356248762697446949407573530086143415290314195533631308867097853948N + 41058363725152142129326129780047268409114441015993725554835256314039467401291N] + :ec-secp256r1 + + [39402006196394479212279040100143613805079739270465446667948293404245721771496870329047266088258938001861606973112319N + 39402006196394479212279040100143613805079739270465446667948293404245721771496870329047266088258938001861606973112316N + 27580193559959705877849011840389048093056905856361568521428707301988689241309860865136260764883745107765439761230575N] + :ec-secp384r1 + + [6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057151N + 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057148N + 1093849038073734274511112390766805569936207598951683748994586394495953116150735016013708737573759623248592132296706313309438452531591012912142327488478985984N] + :ec-secp521r1 + + (throw + (ex-info "Unexpected `java.security.interfaces.ECKey` curve" + {:expected #{:ec-secp256-r1 :ec-secp384r1 :ec-secp521r1}})))] + + {:key-algo key-algo})) + +(comment (keypair-info-ec (:key-prv (keypair-create* :ec-secp256r1)))) + +(extend-protocol IKeyPair + java.security.interfaces.RSAPrivateKey (-keypair-info [x] (assoc (keypair-info-rsa x) :key-prv x)) + java.security.interfaces.RSAPublicKey (-keypair-info [x] (assoc (keypair-info-rsa x) :key-pub x)) + javax.crypto.interfaces.DHPrivateKey (-keypair-info [x] (assoc (keypair-info-dh x) :key-prv x)) + javax.crypto.interfaces.DHPublicKey (-keypair-info [x] (assoc (keypair-info-dh x) :key-pub x)) + java.security.interfaces.ECPrivateKey (-keypair-info [x] (assoc (keypair-info-ec x) :key-prv x)) + java.security.interfaces.ECPublicKey (-keypair-info [x] (assoc (keypair-info-ec x) :key-pub x)) + java.security.KeyPair + (-keypair-info [x] + (let [{key-algo-prv :key-algo, :as info-prv} (-keypair-info (.getPrivate x)) + {key-algo-pub :key-algo, :as info-pub} (-keypair-info (.getPublic x))] + + (if (and key-algo-prv key-algo-pub (not= key-algo-prv key-algo-pub)) + (throw + (ex-info "Unmatched `java.security.KeyPair` algorithms" + {:key-algos {:private key-algo-prv, :public key-algo-prv}})) + + (merge info-prv info-pub)))) + + nil (-keypair-info [_] nil) + Object (-keypair-info [_] nil)) + +(comment + (keypair-info (java.security.KeyPair. nil nil)) + (keypair-info + (java.security.KeyPair. + (:key-pub (keypair-create* :rsa-1024)) + (:key-prv (keypair-create* :rsa-2048))))) + +(defn keypair-info + "Returns ?{:keys [key-algo key-prv key-pub]}" + [x] + (when (or + (instance? java.security.Key x) + (instance? java.security.KeyPair x)) + (-keypair-info x))) + +(defn keypair-algo [x] (get (keypair-info x) :key-algo)) + +(comment + [(keypair-algo (:keypair (keypair-create* :rsa-2048))) + (keypair-info (:keypair (keypair-create* :rsa-2048))) + (keypair-info (:key-pub (keypair-create* :rsa-2048))) + (keypair-info (:key-prv (keypair-create* :rsa-2048))) + (keypair-info (:keypair (keypair-create* :dh-2048))) + (keypair-info (:key-pub (keypair-create* :dh-2048))) + (keypair-info (:key-prv (keypair-create* :dh-4096))) + (keypair-info (:key-prv (keypair-create* :ec-secp384r1))) + (keypair-info nil)]) + +;;;; + +(let [kf-rsa_ (enc/thread-local (java.security.KeyFactory/getInstance "RSA")) + kf-dh_ (enc/thread-local (java.security.KeyFactory/getInstance "DiffieHellman")) + kf-ec_ (enc/thread-local (java.security.KeyFactory/getInstance "EC"))] + + (defn- as-key-factory + "Returns `java.security.KeyFactory`, or throws. + Takes `key-algo` ∈ #{:rsa :rsa- :dh :dh- :ec-}." + ^java.security.KeyFactory + [key-algo] + (case key-algo + (:rsa :rsa-1024 :rsa-2048 :rsa-3072 :rsa-4096) @kf-rsa_ + (:dh :dh-1024 :dh-2048 :dh-3072 :dh-4096) @kf-dh_ + (:ec :ec-secp256r1 :ec-secp384r1 :ec-secp521r1) @kf-ec_ + + (enc/unexpected-arg! key-algo + :expected #{:rsa :rsa- :dh :dh- :ec :ec-} + :context `as-key-factory)))) + +(let [decode-prv (fn [^java.security.KeyFactory kf ba-prv] (.generatePrivate kf (java.security.spec.PKCS8EncodedKeySpec. ba-prv))) + decode-pub (fn [^java.security.KeyFactory kf ba-pub] (.generatePublic kf (java.security.spec.X509EncodedKeySpec. ba-pub)))] + + (defn as-key + "Returns `java.security.Key` matching given needs, or throws. + Takes `key-algo` ∈ #{:rsa :rsa- :dh :dh- :ec :ec-}." + ^java.security.Key [private? ?key-algo ?needs x-key] + + ;; Check if needs are in principle met by given key-algo + (when (and ?key-algo ?needs) (key-algo! ?key-algo ?needs)) + + (let [key-class (if private? java.security.PrivateKey java.security.PublicKey) + fail! + (fn [throwable error-data] + (throw + (ex-info (str "Failed to prepare expected `" (.getName ^java.lang.Class key-class) "`") + (enc/assoc-some error-data + :given-type (type x-key) + :requested-key-algo ?key-algo) + throwable))) + + key + (enc/cond + (instance? java.security.Key x-key) x-key + (instance? java.security.KeyPair x-key) + (if private? + (.getPrivate ^java.security.KeyPair x-key) + (.getPublic ^java.security.KeyPair x-key)) + + (enc/bytes? x-key) + (let [kf (as-key-factory ?key-algo)] + (try + (if private? + (decode-prv kf x-key) + (decode-pub kf x-key)) + (catch Throwable t + (fail! t {:error :decode-failure})))) + + :else + (fail! nil + {:error :unexpected-key-arg-type + :type {:actual (type x-key) + :expected '#{java.security.Key java.security.KeyPair byte-array}}})) + + {:keys [key-algo]} (keypair-info key)] + + (enc/cond + (not (instance? key-class key)) + (fail! nil + {:error :key-type-mismatch + :type {:actual (type key) + :expected key-class}}) + + (and ?key-algo (not (key-algo= ?key-algo key-algo))) + (fail! nil + {:error :key-algo-mismatch + :algo {:actual key-algo + :expected ?key-algo}}) + + :if-let [t (when ?needs (enc/throws (key-algo! key-algo ?needs)))] + (fail! t + {:error :key-needs-mismatch + :algo key-algo + :capabilities {:actual (key-algo-info key-algo), + :expected ?needs}}) + + :else key)))) + +(defn as-key-pub + "Returns `java.security.PublicKey`, or throws. + Takes `key-algo` ∈ #{:rsa :rsa- :dh :dh- :ec :ec-}." + ^java.security.PublicKey [?key-algo ?needs x-pub] + (as-key false ?key-algo ?needs x-pub)) + +(defn as-key-prv + "Returns `java.security.PrivateKey`, or throws. + Takes `key-algo` ∈ #{:rsa- :dh- :ec :ec-}." + ^java.security.PrivateKey [?key-algo ?needs x-prv] + (as-key true ?key-algo ?needs x-prv)) + +(comment + [(as-key-pub :rsa-2048 nil (:ba-pub (keypair-create* :rsa-2048))) + (as-key-pub :rsa nil (:ba-pub (keypair-create* :rsa-2048))) + (as-key-pub nil nil (:keypair (keypair-create* :rsa-2048)))] + [(as-key-pub :rsa-1024 nil (:ba-pub (keypair-create* :rsa-2048)))]) + +;;;; Asymmetric ciphers using 1 keypair + +(let [cipher-rsa-oaep-sha-256-mgf1_ + (enc/thread-local + (javax.crypto.Cipher/getInstance + "RSA/ECB/OAEPWithSHA-256AndMGF1Padding"))] + + (defn- as-asymmetric-cipher + "Returns `javax.crypto.Cipher`, or throws. + Takes `asym-cipher-algo` ∈ #{:rsa-oaep-sha-256-mgf1}." + ^javax.crypto.Cipher [asym-cipher-algo] + (case asym-cipher-algo + :rsa-oaep-sha-256-mgf1 @cipher-rsa-oaep-sha-256-mgf1_ + (enc/unexpected-arg! asym-cipher-algo + :expected #{:rsa-oaep-sha-256-mgf1} + :context `as-asymmetric-cipher)))) + +(defn encrypt-asymmetric + "Takes `asym-cipher-algo` ∈ #{:rsa-oaep-sha-256-mgf1}. + Content length is limited by public key length, so generally used + only to encrypt a random key for a symmetric cipher." + ^bytes [asym-cipher-algo key-algo key-pub ba-content] + (let [cipher (as-asymmetric-cipher asym-cipher-algo) + key-pub (as-key-pub key-algo [:asymmetric? :asym-cipher-algo] key-pub)] + (.init cipher javax.crypto.Cipher/ENCRYPT_MODE key-pub) + (.doFinal cipher ba-content))) + +(defn decrypt-asymmetric + "Takes `asym-cipher-algo` ∈ #{:rsa-oaep-sha-256-mgf1}." + ^bytes [asym-cipher-algo key-algo key-prv ba-encrypted-content] + (let [cipher (as-asymmetric-cipher asym-cipher-algo) + key-prv (as-key-prv key-algo [:asymmetric? :asym-cipher-algo] key-prv)] + (.init cipher javax.crypto.Cipher/DECRYPT_MODE key-prv) + (.doFinal cipher ba-encrypted-content))) + +;;;; Asymmetric ciphers using 2 keypairs +;; Note that >2 party key-agreement is possible, but impractical since it +;; needs multiple (combinatorial!) passing of awkward partial agreements +;; between parties. +;; +;; In practice, it's often better (simpler and more flexible) to instead do +;; something like the following for parties `p1` ... `pn`: +;; - `p1` acts as owner/hub, generates a random key `rk` +;; - `p1` then shares `rk` with `pi`s using pairwise DH +;; +;; Note that this also easily supports the addition + removal of +;; participants (removal => `p1` rotate key). +;; +;; Ref. , +;; + +(let [ka-dh_ (enc/thread-local (javax.crypto.KeyAgreement/getInstance "DiffieHellman")) ; PKCS #3 + ka-ecdh_ (enc/thread-local (javax.crypto.KeyAgreement/getInstance "ECDH")) ; RFC 3278 + ;; ka-ecmqv_ (enc/thread-local (javax.crypto.KeyAgreement/getInstance "ECMQV")) + ] + + (defn as-key-agreement + "Returns `javax.crypto.KeyAgreement`, or throws. + Takes `ka-algo` ∈ #{:dh :ecdh}" + ^javax.crypto.KeyAgreement [ka-algo] + (case ka-algo + :dh @ka-dh_ + :ecdh @ka-ecdh_ + (enc/unexpected-arg! ka-algo + :expected #{:dh :ecdh} + :context `as-key-agreement)))) + +(defn key-shared-create + "Returns the shared key generated by the given key agreement + protocol and input private and public keys: + + (bytes= + (key-shared-create :dh participant1-key-prv participant2-key-pub) + (key-shared-create :dh participant2-key-prv participant1-key-pub)) + => true + + Takes `ka-algo` ∈ #{:dh :ecdh}" + ^bytes [ka-algo key-algo participant1-key-prv participant2-key-pub] + (let [ka (as-key-agreement ka-algo) + key-prv (as-key-prv key-algo [:asymmetric? :ka-algo] participant1-key-prv) + key-pub (as-key-pub key-algo [:asymmetric? :ka-algo] participant2-key-pub)] + (.init ka key-prv (srng)) + (.doPhase ka key-pub true) + (.generateSecret ka))) + +;;;; Signatures + +(let [sig-sha-256-rsa_ (enc/thread-local (java.security.Signature/getInstance "SHA256withRSA")) + sig-sha-512-rsa_ (enc/thread-local (java.security.Signature/getInstance "SHA512withRSA")) + sig-sha-256-ecdsa_ (enc/thread-local (java.security.Signature/getInstance "SHA256withECDSA")) + sig-sha-512-ecdsa_ (enc/thread-local (java.security.Signature/getInstance "SHA512withECDSA"))] + + (defn- as-signature + "Returns `java.security.Signature` or throws. + Takes `sig-algo` ∈ #{:sha--rsa :sha--ecdsa}." + ^java.security.Signature [sig-algo] + (case sig-algo + :sha-256-rsa @sig-sha-256-rsa_ + :sha-512-rsa @sig-sha-512-rsa_ + :sha-256-ecdsa @sig-sha-256-ecdsa_ + :sha-512-ecdsa @sig-sha-512-ecdsa_ + (enc/unexpected-arg! sig-algo + :expected #{:sha--rsa :sha--ecdsa} + :context `as-signature)))) + +(defn signature-create + "Returns the signature created by signing the given content with the + given private key. + + Takes `sig-algo` ∈ #{:sha--rsa :sha--ecdsa}." + ^bytes [sig-algo key-algo signer-key-prv ba-content] + (let [sig (as-signature sig-algo) + signer-key-prv (as-key-prv key-algo [:asymmetric? :sig-algo] signer-key-prv)] + + (.initSign sig signer-key-prv) + (.update sig ^bytes ba-content) + (.sign sig))) + +(defn signature-verify + "Returns true iff the given signature was created by signing the given + content with the private key corresponding to the given public key. + + I.e. verifies if the keypair owner signed this content. + + Takes `sig-algo` ∈ #{:sha-256-rsa :sha-512-rsa}." + [sig-algo key-algo signer-key-pub ba-content ba-signature] + (let [sig (as-signature sig-algo) + signer-key-pub (as-key-pub key-algo [:asymmetric? :sig-algo] signer-key-pub)] + + (.initVerify sig signer-key-pub) + (.update sig ^bytes ba-content) + (.verify sig ba-signature))) diff --git a/src/taoensso/tempel/keys.clj b/src/taoensso/tempel/keys.clj new file mode 100644 index 0000000..297df34 --- /dev/null +++ b/src/taoensso/tempel/keys.clj @@ -0,0 +1,1117 @@ +(ns ^:no-doc taoensso.tempel.keys + "Private ns, implementation detail. + Key management stuff, supports the changing of algos and/or keys over time." + (:require + [taoensso.encore :as enc :refer [have have?]] + [taoensso.tempel.bytes :as bytes] + [taoensso.tempel.df :as df] + [taoensso.tempel.impl :as impl] + [taoensso.tempel.pbkdf :as pbkdf])) + +(comment + (remove-ns 'taoensso.tempel.keys) + (:public (enc/interns-overview))) + +(enc/declare-remote + taoensso.tempel/get-config + taoensso.tempel/encrypt-with-1-keypair + taoensso.tempel/decrypt-with-1-keypair) + +(alias 'core 'taoensso.tempel) + +;;;; ChainKey + +(deftype ChainKey [key-type key-algo ?meta ?key-id key-cnt] + Object + (equals [this other] (impl/cnt= key-cnt (.-key-cnt ^ChainKey other))) + (hashCode [this] (impl/cnt-hash key-cnt)) + (toString [this] + (let [m (select-keys @this [:key-algo :symmetric? :private? :public?])] + (str "ChainKey[" m " " (enc/ident-hex-str this) "]"))) + + clojure.lang.IObj + (meta [_ ] ?meta) + (withMeta [_ m] (ChainKey. (have key-type) (have key-algo) m ?key-id key-cnt)) + + clojure.lang.IHashEq (hasheq [this] (impl/cnt-hash key-cnt)) + clojure.lang.IDeref + (deref [_] + (conj + (case key-type + :sym {:key-type :sym, :key-algo key-algo, :symmetric? true, :key-sym key-cnt} + :prv {:key-type :prv, :key-algo key-algo, :asymmetric? true, :private? true, :key-prv key-cnt} + :pub {:key-type :pub, :key-algo key-algo, :asymmetric? true, :public? true, :key-pub key-cnt} + (enc/unexpected-arg! key-type :expected #{:sym :pub :prv})) + + (enc/assoc-some {:key-cnt key-cnt} :key-id ?key-id)))) + +(enc/deftype-print-methods ChainKey) +(defn ^:public chainkey? [x] (instance? ChainKey x)) + +(defn- -chainkey [key-type ?key-algo ?needs ?key-id x-key] + (let [fail! + (fn [cause] + (throw + (ex-info "Failed to prepare appropriate `ChainKey`" + (enc/assoc-some + {:key-type key-type, :x-key {:value 'redacted, :type (type x-key)}} + :needs ?needs + :key-algo ?key-algo + :key-id ?key-id) + cause))) + + x-key + (or + (when (map? x-key) ; mkc-entry + (get x-key (case key-type :prv :key-prv, :pub :key-pub, :sym :key-sym, (Object.)))) + x-key)] + + (enc/cond + (not (or (nil? ?key-id) (string? ?key-id))) + (fail! (ex-info "Unexpected `ChainKey` :key-id type" {:expected '?string, :actual {:value ?key-id, :type (type ?key-id)}})) + + (chainkey? x-key) + (enc/cond + :let [key-type* (.-key-type ^ChainKey x-key)] + (not= key-type* key-type) + (fail! (ex-info "Unexpected `ChainKey` :key-type value" {:expected key-type, :actual key-type*})) + + :let [key-algo* (.-key-algo ^ChainKey x-key)] + (and ?key-algo (not= key-algo* ?key-algo)) + (fail! (ex-info "Unexpected `ChainKey` :key-algo value" {:expected ?key-algo, :actual key-algo*})) + + :let [key-id* (.-?key-id ^ChainKey x-key)] + (and ?key-id (not= key-id* ?key-id)) + (ChainKey. (have key-type*) (have key-algo*) (.-?meta ^ChainKey x-key) ?key-id (.-key-cnt ^ChainKey x-key)) + + :else x-key) + + :else + (case key-type + :prv + (try + (let [key-prv (impl/as-key-prv ?key-algo ?needs x-key) + key-algo (impl/keypair-algo key-prv)] + (ChainKey. :prv (have key-algo) nil ?key-id key-prv)) + (catch Throwable t (fail! t))) + + :pub + (try + (let [key-pub (impl/as-key-pub ?key-algo ?needs x-key) + key-algo (impl/keypair-algo key-pub)] + (ChainKey. :pub (have key-algo) nil ?key-id key-pub)) + (catch Throwable t (fail! t))) + + :sym + (enc/cond + (= :random x-key) (ChainKey. :sym :symmetric nil ?key-id (impl/rand-ba impl/max-sym-key-len)) + (enc/bytes? x-key) + (if (>= (alength ^bytes x-key) impl/max-sym-key-len) + (ChainKey. :sym :symmetric nil ?key-id x-key) + (fail! + (ex-info + (format "Symmetric keys must be at least %s bytes long" impl/max-sym-key-len) + {:length {:expected impl/max-sym-key-len, :actual (alength ^bytes x-key)}}))) + + :else (fail! (ex-info "Unexpected `ChainKey` :key-sym type" {:expected 'bytes, :actual (type x-key)}))) + (enc/unexpected-arg! key-type + :expected #{:prv :pub :sym} + :context `-chainkey))))) + +(comment + [(-chainkey :sym :symmetric nil nil (impl/rand-ba 32)) + (-chainkey :pub :rsa-1024 nil nil (impl/keypair-create :rsa-1024)) + (= + (-chainkey :sym :symmetric nil nil (byte-array (range 32))) + (-chainkey :sym :symmetric nil nil (byte-array (range 32))))]) + +;;;; KeyChain + +(def ^:private reference-mkc + "m-keychain, public data structure. + Optimized for user ergonomics: readability, ease of update, etc." + '{"a" {:key-algo :symmetric, :priority 10, :key-sym ck-a-sym-10} + "b" {:key-algo :rsa-1024, :priority 11, :key-prv ck-b-prv-rsa-11, :key-pub ck-b-pub-rsa-11} + "c" {:key-algo :rsa-1024, :priority 10, :key-prv ck-c-prv-rsa-10} + "d" {:key-algo :dh-1024, :priority 10, :key-prv ck-d-prv-dh-10} + "e" {:key-algo :symmetric, :priority 11, :key-sym ck-e-sym-11}}) + +(def ^:private reference-midx + "m-idex, private data structure. + Optimized for fast + easy ckey lookup." + '{:symmetric {:key-sym [ck-e-sym-11 ck-a-sym-10]} + :rsa-1024 {:key-prv [ck-b-prv-rsa-11 ck-c-prv-rsa-10], :key-pub [ck-b-pub-rsa-11]} + :dh-1024 {:key-prv [ck-d-prv-dh-10]} + + ;;; By capability + :ka {:key-prv [ck-d-prv-dh-10]} + :sig {:key-prv [ck-b-prv-rsa-11 ck-c-prv-rsa-10], :key-pub [ck-b-pub-rsa-11]} + :asym-cipher {:key-prv [ck-b-prv-rsa-11 ck-c-prv-rsa-10], :key-pub [ck-b-pub-rsa-11]} + :sym-cipher {:key-sym [ck-e-sym-11 ck-a-sym-10]}}) + +(defn- mkc-next-key-id [m-keychain] + (Integer/toString (inc (count m-keychain)) (min Character/MAX_RADIX 62))) + +(defn- mkc-top-priority [m-keychain] + (inc ^long + (reduce-kv + (fn [^long max-priority key-id {:keys [priority]}] + (let [p (long (or priority -1))] + (if (> p max-priority) p max-priority))) + -1 + m-keychain))) + +(comment + (mkc-next-key-id {"a" {}}) + (mkc-top-priority {"a" {}}) + (mkc-index reference-mkc)) + +(defprotocol IKeyChain + (keychain-counts [kc] "Returns {:keys [n-sym n-prv n-pub]}") + (keychain-freeze [kc] "Returns {:keys [ba-kc-prv ba-kc-pub]}") + (keychain-ckeys [kc index-path] "Returns sorted ?[ ... ]") + (keychain-update [kc validate? f] "Returns (possibly new) KeyChain")) + +(declare + ^:private -keychain + ^:private mkc-key-counts + ^:private mkc-index + ^:private mkc-freeze + ^:private mkc-thaw) + +(deftype KeyChain [m-keychain m-key-counts_ m-index_ m-frozen_ ?meta] + clojure.lang.IDeref (deref [_] m-keychain) + clojure.lang.IHashEq (hasheq [_] (hash m-keychain)) + + Object + (toString [this] (str "KeyChain[" @m-key-counts_ " " (enc/ident-hex-str this) "]")) + (hashCode [this] (hash m-keychain)) + (equals [this other] (= m-keychain (.-m-keychain ^KeyChain other))) + + clojure.lang.IObj + (meta [_ ] ?meta) + (withMeta [_ m] (KeyChain. m-keychain m-key-counts_ m-index_ m-frozen_ m)) + + IKeyChain + (keychain-counts [_] @m-key-counts_) + (keychain-freeze [_] @m-frozen_) + (keychain-ckeys [_ index-path] (not-empty (get-in @m-index_ index-path))) + (keychain-update [this validate? f] + (let [new-mkc (f m-keychain)] + (if (= new-mkc m-keychain) + this + (let [new-kc (-keychain ?meta new-mkc)] + (when validate? @(.-m-frozen_ ^KeyChain new-kc)) ; Confirm freezable + new-kc))))) + +(enc/deftype-print-methods KeyChain) +(defn ^:public keychain? [x] (instance? KeyChain x)) +(defn- -keychain [?meta m-keychain] + (KeyChain. m-keychain + (delay (mkc-key-counts m-keychain)) + (delay (mkc-index m-keychain)) + (delay (mkc-freeze m-keychain)) + ?meta)) + +(defn keychain-restore + ([ ba-kc-pub] (-keychain nil (mkc-thaw nil ba-kc-pub))) + ([ba-kc-prv ba-kc-pub] (-keychain nil (mkc-thaw ba-kc-prv ba-kc-pub)))) + +;;;; KeyChain public utils + +(defn- auto-key-id! [v_ mkc] (vreset! v_ (mkc-next-key-id mkc))) + +(defn ^:public keychain-add-symmetric-key + "Produces a ?new `KeyChain` that contains the given symmetric key. + + `x-key` may be: `:random`, byte[] of length >= 32, or {:keys [key-sym]} map. + New keys will by default get top priority, override with `:priority` option. + + Return value depends on `:return` option: + `:keychain` - Returns (possibly new) `KeyChain` (default) + `:as-map` - Returns {:keys [keychain changed? key-id]}" + + [keychain x-key & + [{:keys [return key-id priority] + :or {return :keychain}}]] + + (have? keychain? keychain) + + (let [auto-key-id_ (volatile! nil) + kc1 keychain + kc2 + (keychain-update kc1 false + (fn [mkc] + (let [key-id (have string? (or key-id (auto-key-id! auto-key-id_ mkc))) + ckey (-chainkey :sym :symmetric nil key-id x-key) + priority (or priority (mkc-top-priority mkc))] + (assoc mkc key-id + {:key-algo :symmetric, :priority priority, :key-sym ckey}))))] + + (case return + :keychain kc2 + :as-map + (enc/assoc-some + {:keychain keychain, :changed? (not (identical? kc1 kc2))} + :key-id @auto-key-id_) + + (enc/unexpected-arg! return + :expected #{:keychain :as-map} + :context `keychain-add-symmetric-key)))) + +(comment (keychain-add-symmetric-key (keychain) :random {:return :as-map})) + +(defn ^:public keychain-add-asymmetric-keypair + "Produces a ?new `KeyChain` that contains the given asymmetric keypair. + + `x-keypair` may be: ∈ #{:rsa- :dh- :ec-}, + a `java.security.KeyPair`, or a map with {:keys [key-prv key-pub]}. + + New keys will by default get top priority, override with `:priority` option. + + Return value depends on `:return` option: + `:keychain` - Returns (possibly new) `KeyChain` (default) + `:as-map` - Returns {:keys [keychain changed? key-id]} + + Relevant `*config*` keys (see that var's docstring for details): + `keypair-creator`." + + [keychain x-keypair & + [{:keys [return key-id priority, :config keypair-creator] + :or {return :keychain} + :as opts}]] + + (have? keychain? keychain) + (let [{:keys [keypair-creator]} (core/get-config opts) + keypair + (have [:instance? java.security.KeyPair] + (enc/cond + (keyword? x-keypair) ; key-algo + (let [kpc (force (have keypair-creator))] + (kpc x-keypair)) + + (map? x-keypair) ; mkc-entry + (let [{:keys [key-algo key-prv key-pub]} x-keypair] + (java.security.KeyPair. + (if (chainkey? key-pub) (.-key-cnt ^ChainKey key-pub) (when key-pub (impl/as-key-pub key-algo nil key-pub))) + (if (chainkey? key-prv) (.-key-cnt ^ChainKey key-prv) (when key-prv (impl/as-key-prv key-algo nil key-prv))))) + x-keypair)) + + {:keys [key-algo key-prv key-pub]} (impl/keypair-info keypair) + + auto-key-id_ (volatile! nil) + kc1 keychain + kc2 + (keychain-update keychain false + (fn [mkc] + (let [key-id (have string? (or key-id (auto-key-id! auto-key-id_ mkc))) + priority (or priority (mkc-top-priority mkc))] + (assoc mkc key-id + (enc/assoc-some + {:key-algo key-algo, :priority priority} + :key-prv (when key-prv (-chainkey :prv key-algo nil key-id key-prv)) + :key-pub (when key-pub (-chainkey :pub key-algo nil key-id key-pub)))))))] + + (case return + :keychain kc2 + :as-map + (enc/assoc-some + {:keychain keychain, :changed? (not (identical? kc1 kc2))} + :key-id @auto-key-id_) + + (enc/unexpected-arg! return + :expected #{:keychain :as-map} + :context `keychain-add-asymmetric-keypair)))) + +(comment (keychain-add-asymmetric-keypair (keychain) + (impl/keypair-create :rsa-1024))) + +(defn ^:public keychain-update-priority + "Returns a ?new `KeyChain` with the identified key's + `:priority` updated to be (update-fn ). + + Priority values can be any integer, positive or negative. + When multiple keys in a `KeyChain` are appropriate for a + task, the key with highest priority will be selected." + + [keychain key-id update-fn] + + (have? keychain? keychain) + (have? string? key-id) + + (keychain-update keychain false + (fn [mkc] + (if-let [mkc-entry (get mkc key-id)] + (assoc mkc key-id + (assoc mkc-entry :priority + (update-fn (get mkc-entry :priority 0)))) + mkc)))) + +(defn ^:public keychain-normalize-priorities + "Returns a ?new `KeyChain` with key priorities normalized + to their relative rank order: + {\"a\" {:priority -3}, \"b\" {:priority 8}} => + {\"a\" {:priority 0}, \"b\" {:priority 1}}" + + [keychain] + (have? keychain? keychain) + (keychain-update keychain false + (fn [mkc] + (let [m-norm-priorities ; { }, as ordinal ranks + (let [m-priorities (into #{} (map #(get % :priority 0)) (vals mkc))] + (into {} (map-indexed (fn [idx p] [p idx])) (sort m-priorities)))] + + (reduce-kv + (fn [m key-id {:keys [priority] :as mkc-entry}] + (if (empty? mkc-entry) + m + (assoc m key-id + (assoc mkc-entry :priority (get m-norm-priorities priority))))) + mkc + mkc))))) + +(comment + (keychain-update-priority (keychain) "nx-id" inc) + (-> + (keychain) + (keychain-add-symmetric-key :random {:key-id "my-id"}) + (keychain-update-priority "my-id" (fn [p] -100)) + (keychain-update-priority "nx-id" dec) + (keychain-normalize-priorities) + (deref))) + +(defn ^:public keychain-remove + "Returns a ?new `KeyChain` with the identified key removed. + Options: + `:keep-private?` - Should only the public component of keypairs + be removed? (Default true)" + [keychain key-id + & [{:keys [keep-private?] + :or {keep-private? true}}]] + + (have? keychain? keychain) + (have? string? key-id) + + (keychain-update keychain false + (fn [mkc] + (if-let [mck (get mkc key-id)] + (assoc mkc key-id ; Nb *always* keep entry for key-id + (if (and keep-private? (get mck :key-prv)) + (dissoc mck :key-sym :key-pub) + {})) + mkc)))) + +(comment + (-> + (keychain) + (keychain-add-symmetric-key :random {:key-id "my-id"}) + (keychain-remove "my-id"))) + +(defn ^:public keychain + "Returns a new `KeyChain` with key/pairs as specified by options: + `:symmetric-keys` - Seq of keys given to `keychain-add-symmetric-key` + `:asymmetric-keypairs` - Seq of keypairs given to `keychain-add-asymmetric-keypair` + + (keychain + :symmetric-keys [:random :random (byte-array [1 2 3 4))] + :asymmetric-keypairs [:rsa-1024 :dh-1024 :ec-secp384r1]) + + Relevant `*config*` keys (see that var's docstring for details): + `keypair-creator`, `symmetric-keys`, `asymmetric-keys`." + + [& [{:keys [empty?, :config + symmetric-keys asymmetric-keypairs keypair-creator] :as opts}]] + + (if empty? + (-keychain nil {}) + (let [{:keys [symmetric-keys asymmetric-keypairs]} (if (get opts :only?) opts (core/get-config opts)) + kc (-keychain nil {}) + kc (reduce (fn [acc in] (keychain-add-symmetric-key acc in opts)) kc symmetric-keys) + kc (reduce (fn [acc in] (keychain-add-asymmetric-keypair acc in opts)) kc asymmetric-keypairs)] + kc))) + +(comment + @(keychain) + @(keychain {:empty? true}) + @(keychain + {:symmetric-keys [(impl/rand-ba 32) :random] + :asymmetric-keypairs + [(impl/keypair-create :rsa-1024) + (impl/keypair-create :dh-1024)]})) + +;;;; State utils + +(defn- mkc-key-counts + "Returns {:keys [n-sym n-prv n-pub]}" + [m-keychain] + (reduce-kv + (fn [acc _key-id m-in] + (let [acc (if (get m-in :key-sym) (update acc :n-sym #(inc (long (or % 0)))) acc) + acc (if (get m-in :key-prv) (update acc :n-prv #(inc (long (or % 0)))) acc) + acc (if (get m-in :key-pub) (update acc :n-pub #(inc (long (or % 0)))) acc)] + acc)) + {} + m-keychain)) + +(comment (mkc-key-counts {"a" {:key-sym 'ckey} "b" {:key-prv 'ckey :key-pub 'ckey}})) + +(defn- mkc-index + "`reference-mkc` -> `reference-midx`, etc." + [m-keychain] + (let [sorted-ckeys ; [ ...] + (fn self + ([algo-pred] + (enc/assoc-some {} + :key-sym (self :key-sym algo-pred) + :key-prv (self :key-prv algo-pred) + :key-pub (self :key-pub algo-pred))) + + ([key-at algo-pred] + (let [v-sorted-maps ; [{:keys [ckey sort-by]} ...] + (reduce-kv + (fn [v key-id m-ckey] + (if-let [ckey + (and + (algo-pred (get m-ckey :key-algo)) + (do (get m-ckey key-at)))] + + (conj v {:ckey ckey, :sort-by [(get m-ckey :priority 0) key-id]}) + (do v))) + [] m-keychain)] + + ;; Desc sort: higher priority and alpha first ("2" > "0", etc.) + (not-empty (mapv :ckey (sort-by :sort-by enc/rcompare v-sorted-maps))))))] + + (enc/assoc-some + ;; By key-algo + (let [key-algos (into #{} (map :key-algo) (vals m-keychain))] ; #{:symmetric :rsa- :dh- :ec- ...} + (reduce (fn [m key-algo] (assoc m key-algo (sorted-ckeys #(= % key-algo)))) + {} key-algos)) + + ;; By capability + :ka (sorted-ckeys (fn [key-algo] (impl/key-algo? key-algo [:asymmetric? :ka-algo]))) + :sig (sorted-ckeys (fn [key-algo] (impl/key-algo? key-algo [:asymmetric? :sig-algo]))) + :asym-cipher (sorted-ckeys (fn [key-algo] (impl/key-algo? key-algo [:asymmetric? :asym-cipher-algo]))) + :sym-cipher (sorted-ckeys (fn [key-algo] (impl/key-algo? key-algo [:symmetric? :sym-cipher-algo])))))) + +(comment (= (mkc-index reference-mkc) reference-midx)) + +(defn- mkc-freeze + "Returns {:keys [ba-kc-prv ba-kc-pub]}." + #_(df/reference-data-formats :keychain--v1) + [m-keychain] + (have? map? m-keychain) + (let [fail! (fn [msg ex-data] (throw (ex-info msg ex-data))) + entry-fn ; => ?{:keys [key-type key-algo priority key-ba]} + (fn [key-id mkc-entry key-at expected-class key-ba-fn] + + (when-not (string? key-id) + (fail! "Unexpected :key-id type in `KeyChain` entry" + {:expected 'string, :actual {:value key-id, :type (type key-id)}})) + + (when-let [ckey (get mkc-entry key-at)] + (let [{:keys [key-algo priority]} mkc-entry + {:keys [key-type key-cnt], key-algo* :key-algo} @(have chainkey? ckey)] + + (enc/cond + (not= key-algo* key-algo) + (fail! "Unexpected :key-algo value in `KeyChain` entry" + {:expected key-algo, :actual key-algo*, :key-id key-id}) + + (not (instance? expected-class key-cnt)) + (fail! "Unexpected key content type in `KeyChain` entry" + {:expected expected-class, :actual (type key-cnt), :key-id key-id}) + + :else + {:key-type (have key-type) + :key-algo (have key-algo) + :priority (have priority) + :key-ba (key-ba-fn key-cnt)})))) + + freeze-part + (fn [mode env-kid] + (let [entry-fn ; => ?{:keys [key-type key-algo priority key-ba]} + (case mode + :ba-kc-pub + (fn [key-id mkc-entry] + (entry-fn key-id mkc-entry :key-pub java.security.PublicKey + #(have (.getEncoded ^java.security.PrivateKey %)))) + + :ba-kc-prv + (fn [key-id mkc-entry] + (or + (entry-fn key-id mkc-entry :key-sym enc/bytes-class identity) + (entry-fn key-id mkc-entry :key-prv java.security.PrivateKey + #(have (.getEncoded ^java.security.PrivateKey %))) + {:key-type nil} ; Include all key-ids for `mkc-next-key-id`, etc. + )) + + (enc/unexpected-arg! mode + :expected #{:ba-kc-prv :ba-kc-pub})) + + mkc + (reduce-kv + (fn [m key-id mkc-entry] + (if-let [entry (entry-fn key-id mkc-entry)] + (assoc m key-id entry) + (dissoc m key-id))) + m-keychain + m-keychain)] + + (bytes/with-out [out] [8192] + (df/write-head out) + (df/write-kid out :envelope env-kid) + (df/write-resv out) + (bytes/write-ushort out (count mkc)) + (bytes/write-ushort out 0) ; Reserved for possible idx, etc. + (enc/run-kv! + (fn [key-id {:keys [key-type key-algo priority key-ba]}] + (bytes/write-dynamic-str out key-id) + (df/write-kid out :key-type key-type) + (when key-type + (df/write-kid out :key-algo key-algo) + (bytes/write-ushort out priority) + (bytes/write-dynamic-ba out key-ba))) + mkc) + (df/write-resv out))))] + + {:ba-kc-prv (freeze-part :ba-kc-prv :keychain-prv-v1) + :ba-kc-pub (freeze-part :ba-kc-pub :keychain-pub-v1)})) + +(comment + (enc/map-vals count (keychain-freeze (keychain {:empty? true}))) + (let [{:keys [ba-kc-prv ba-kc-pub]} + (mkc-freeze + @(keychain {:symmetric-keys [(impl/rand-ba 32)] + :asymmetric-keypairs [(impl/keypair-create :rsa-1024)]}))] + [(count ba-kc-prv) + (count ba-kc-pub)])) + +(defn- mkc-thaw + #_(df/reference-data-formats :keychain--v1) + [ba-kc-prv ba-kc-pub] + (have? [:or nil? enc/bytes?] ba-kc-prv ba-kc-pub) + (let [thaw1 + (fn [acc env-kid ba] + (bytes/with-in [in] ba + (df/read-head! in) + (df/read-kid in :envelope env-kid) + (df/read-resv in) + (let [n-entries (bytes/read-ushort in) + _resv (bytes/read-ushort in) + acc + (enc/reduce-n + (fn [acc _] + (let [key-id (bytes/read-dynamic-str! in) + key-type (df/read-kid in :key-type) + mkc-entry + (when key-type + (let [key-algo (df/read-kid in :key-algo) + priority (bytes/read-ushort in) + key-ba (bytes/read-dynamic-ba in) + [key-at key-cnt] + (case key-type + :sym [:key-sym (do key-ba)] + :prv [:key-prv (impl/as-key-prv key-algo nil key-ba)] + :pub [:key-pub (impl/as-key-pub key-algo nil key-ba)] + (enc/unexpected-arg! key-type + :expected #{:sym :prv :pub})) + + ckey (ChainKey. (have key-type) (have key-algo) nil key-id key-cnt)] + {:key-algo key-algo, :priority priority, key-at ckey}))] + + (update acc key-id + (fn [m] (conj (or m {}) mkc-entry))))) + + acc n-entries)] + + (df/read-resv in) + acc))) + + mkc {} + mkc (if-let [ba ba-kc-prv] (thaw1 mkc :keychain-prv-v1 ba) mkc) + mkc (if-let [ba ba-kc-pub] (thaw1 mkc :keychain-pub-v1 ba) mkc)] + + mkc)) + +(comment + (let [kc (keychain {:symmetric-keys [(impl/rand-ba 32)] + :asymmetric-keypairs [(impl/keypair-create :rsa-1024)]}) + {:keys [ba-kc-prv ba-kc-pub]} (mkc-freeze @kc)] + (= (mkc-thaw ba-kc-prv ba-kc-pub) @kc))) + +;;;;; Integration API +;; Utils used by core for KeyChain support + +(defn- missing-ckey! + ([ ex-data] (missing-ckey! nil ex-data)) + ([cause ex-data] (throw (ex-info "Appropriate key/s not available in `KeyChain`" ex-data cause)))) + +(defn get-ckeys-sym-cipher + "Arity 1: for encryption => + Arity 2: for decryption => [ ...]" + ([x-sym] + (if (keychain? x-sym) + (or + (when-let [[ck1] (keychain-ckeys x-sym [:sym-cipher :key-sym])] ck1) + (missing-ckey! {:need "Symmetric private key", :key-algo :sym, :key-type :sym})) + (-chainkey :sym :symmetric nil nil x-sym))) + + ([x-sym ?key-id] + (have? [:or nil? string? ?key-id]) + (if (keychain? x-sym) + (if-let [key-id ?key-id] + (let [mkc @x-sym] + (or + (when-let [ck (get-in mkc [key-id :key-sym])] [ck]) + (missing-ckey! {:need (str "Symmetric private key with id: " key-id), + :key-algo :sym, :key-id key-id, :key-type :sym}))) + (or + (keychain-ckeys x-sym [:sym-cipher :key-sym]) + (missing-ckey! {:need "Symmetric private key", + :key-algo :symmetric, :key-type :sym}))) + + [(-chainkey :sym :symmetric nil nil x-sym)]))) + +(comment :see-tests) + +(defn get-ckeys-asym-cipher + "Arity 1: for encryption => + Arity 3: for decryption => [ ...]" + ([x-pub] + (if (keychain? x-pub) + (or + (when-let [[ck1] (keychain-ckeys x-pub [:asym-cipher :key-pub])] ck1) + (missing-ckey! {:need "Asymmetric public key with cipher support", :key-type :pub})) + (-chainkey :pub nil [:asymmetric? :asym-cipher-algo] nil x-pub))) + + ([x-prv key-algo ?key-id] + (have? [:or nil? string? ?key-id]) + (if (keychain? x-prv) + (if-let [key-id ?key-id] + (let [mkc @x-prv] + (or + (when-let [ck (get-in mkc [key-id :key-prv])] [ck]) + (missing-ckey! {:need (format "Asymmetric `%s` private key with cipher support and id: %s" key-algo key-id), + :key-algo key-algo, :key-id key-id, :key-type :prv}))) + (or + (keychain-ckeys x-prv [key-algo :key-prv]) + (missing-ckey! {:need (format "Asymmetric `%s` private key with cipher support" key-algo), + :key-algo key-algo, :key-type :prv}))) + + [(-chainkey :prv key-algo [:asymmetric? :asym-cipher-algo] nil x-prv)]))) + +(comment :see-tests) + +(defn get-ckeys-sig + "Arity 1: for signing => + Arity 3: for verification => [ ...]" + ([x-prv] + (if (keychain? x-prv) + (or + (when-let [[ck1] (keychain-ckeys x-prv [:sig :key-prv])] ck1) + (missing-ckey! {:need "Asymmetric private key with signature support", :key-type :prv})) + (-chainkey :prv nil [:asymmetric? :sig-algo] nil x-prv))) + + ([x-pub key-algo ?key-id] + (have? [:or nil? string? ?key-id]) + (if (keychain? x-pub) + (if-let [key-id ?key-id] + (let [mkc @x-pub] + (or + (when-let [ck (get-in mkc [key-id :key-pub])] [ck]) + (missing-ckey! {:need (format "Asymmetric `%s` public key with signature support and id: %s" key-algo key-id), + :key-algo key-algo, :key-id key-id, :key-type :pub}))) + (or + (keychain-ckeys x-pub [key-algo :key-pub]) + (missing-ckey! {:need (format "Asymmetric `%s` public key with signature support" key-algo), + :key-algo key-algo, :key-type :pub}))) + + [(-chainkey :pub key-algo [:asymmetric? :sig-algo] nil x-pub)]))) + +(comment :see-tests) + +(defn- reduce-pairs + "Reduces using (rf acc x y), with [x y] pairs as in (for [x xs, y ys] [x y])." + [rf init xs ys] + (reduce + (fn [acc x] + (reduce (enc/preserve-reduced (fn [acc y] (rf acc x y))) acc ys)) + init xs)) + +(comment (reduce-pairs (fn [acc x y] (conj acc x y)) [] [:a :b] [1 2])) + +(defn- matching-ckey-pair? [ck-prv ck-pub] + (let [{:keys [key-prv]} @ck-prv + {:keys [key-pub]} @ck-pub] + + (when (and key-prv key-pub) + (let [algo-prv (impl/keypair-algo key-prv) + algo-pub (impl/keypair-algo key-pub)] + (and algo-prv (= algo-prv algo-pub)))))) + +(defn- get-ckeys-ka* + "Returns ?[ ...], may throw" + [fail! prv? ?key-algo [x ?key-id]] + (if (keychain? x) + (if-let [key-id ?key-id] + (let [key-algo (have ?key-algo) + mkc @x] + (or + (when-let [ck (get-in mkc [key-id (if prv? :key-prv :key-pub)])] [ck]) + (missing-ckey! {:need (format "Asymmetric `%s` %s key with key id: %s" key-algo (if prv? "private" "public") key-id) + :key-algo ?key-algo, :key-id key-id, :key-type (if prv? :prv :pub)}))) + + (keychain-ckeys x [(or ?key-algo :ka) (if prv? :key-prv :key-pub)])) + [(-chainkey (if prv? :prv :pub) ?key-algo [:asymmetric? :ka-algo] nil x)])) + +(defn get-ckeys-ka + "Arity 2: for encryption => [ ] + Arity 3: for decryption => [[ ] ...]" + ([receiver-x-pub sender-x-prv] + (let [fail! (fn [cause] (missing-ckey! cause + {:context :encrypt-with-2-keypairs, + :given {:receiver-pub (type receiver-x-pub) + :sender-prv (type sender-x-prv)}})) + + recvr-cks-pub (get-ckeys-ka* fail! false nil [receiver-x-pub nil]) + sendr-cks-prv (get-ckeys-ka* fail! true nil [sender-x-prv nil])] + + (or + (reduce-pairs ; => [ ] + (fn [_ recvr-ck-pub sendr-ck-prv] + (when (matching-ckey-pair? sendr-ck-prv recvr-ck-pub) + (reduced [recvr-ck-pub sendr-ck-prv]))) + nil recvr-cks-pub sendr-cks-prv) + + (throw + (ex-info "No matching asymmetric key pairs available for key agreement via given args" + {:given-types + {:receiver-key-pub (type receiver-x-pub) + :sender-key-prv (type sender-x-prv)} + + :key-algos + {:receiver-key-pub (into #{} (mapv #(impl/keypair-algo (get @% :key-pub)) recvr-cks-pub)) + :sender-key-prv (into #{} (mapv #(impl/keypair-algo (get @% :key-prv)) sendr-cks-prv))}}))))) + + ([key-algo + [receiver-x-prv ?receiver-key-id] + [sender-x-pub ?sender-key-id]] + + (let [fail! (fn [cause] (missing-ckey! cause + {:context :decrypt-with-2-keypairs, + :given {:receiver-prv (type receiver-x-prv) + :sender-pub (type sender-x-pub)}})) + + recvr-cks-prv (get-ckeys-ka* fail! true key-algo [receiver-x-prv ?receiver-key-id]) + sendr-cks-pub (get-ckeys-ka* fail! false key-algo [sender-x-pub ?sender-key-id])] + + (or + (not-empty + (reduce-pairs ; => [ ] + (fn [acc recvr-ck-prv sendr-ck-pub] + (if (matching-ckey-pair? recvr-ck-prv sendr-ck-pub) + (conj acc [recvr-ck-prv sendr-ck-pub]) + (do acc))) + [] recvr-cks-prv sendr-cks-pub)) + + (throw + (ex-info + (format "No matching asymmetric `%s` key pairs available for key agreement via given args" key-algo) + {:given-types + {:receiver-key-prv (type receiver-x-prv) + :sender-key-pub (type sender-x-pub)} + + :key-algos + {:requested key-algo + :receiver-key-prv (into #{} (mapv #(impl/keypair-algo (get @% :key-prv)) recvr-cks-prv)) + :sender-key-pub (into #{} (mapv #(impl/keypair-algo (get @% :key-pub)) sendr-cks-pub))}})))))) + +(comment :see-tests) + +;;;; KeyChain encryption + +(do ; 256 bit consts for derived keys + (def ^:private ba-const-derive-ekc-key (byte-array [-67 -126 -10 -25 37 -82 -63 -86 -73 -105 -87 45 -81 12 -128 71 -106 -68 -47 127 -70 65 22 -123 -88 -110 40 11 -17 108 -41 -93])) + (def ^:private ba-const-derive-ekc-hmac (byte-array [15 78 105 -122 -125 -89 109 -109 -8 -111 -31 62 -56 -5 18 75 53 -114 -117 115 -127 -109 -10 92 -24 -15 85 -100 -4 -74 75 -67]))) + +(defn ^:public keychain-encrypt + "Given a `KeyChain` and password (string, byte[], or char[]), returns a + byte[] that includes: + + - Encrypted: + - The entire keychain + - Optional other content (see `ba-content` option below) + + - Unencrypted: + - Any public keys in keychain (retrieve with `public-data`) + - Optional AAD (see `doc-aad` docstring) + - Envelope data necessary for decryption (specifies algorithms, etc.) + + Output can be safely stored (e.g. in a database). + Decrypt output with: `keychain-decrypt`. + + See Tempel Wiki for detailed usage info, common patterns, examples, etc. + + Options: + `:ba-aad` - See `doc-aad` docstring + `:ba-akm` - See `doc-akm` docstring + `:ba-content` - Optional additional byte[] content that should be encrypted + and included in output for retrieval with `keychain-decrypt`. + + `:backup-key-pub` + Optional `KeyChain` (see `keychain`) or `KeyPair` (see `keypair-create`) + that may later be used as a backup decryption mechanism if given password + is forgotten, etc. + + Key algorithm must support use as an asymmetric cipher. + Suitable algorithms: `:rsa-` + + Relevant `*config*` keys (see that var's docstring for details): + `hash-algo`, `sym-cipher-algo`, `pbkdf-algo`, `pbkdf-nwf`" + + #_(df/reference-data-formats :encrypted-keychain-v1) + ^bytes + [keychain password & + [{:keys [ba-aad ba-akm ba-content embed-hmac? + backup-key-pub backup-opts, :config + hash-algo sym-cipher-algo pbkdf-algo pbkdf-nwf] + :or {embed-hmac? true} + :as opts}]] + + (have? keychain? keychain) + (let [{:keys [hash-algo sym-cipher-algo + pbkdf-algo pbkdf-nwf]} (core/get-config opts) + _ (have? some? hash-algo sym-cipher-algo pbkdf-algo pbkdf-nwf) + + sck (impl/as-symmetric-cipher-kit sym-cipher-algo) + ba-iv (impl/rand-ba impl/max-sym-key-len) + ba-salt (impl/hmac hash-algo ba-iv (bytes/str->utf8-ba "iv->salt")) + pbkdf-nwf (pbkdf/pbkdf-nwf-parse pbkdf-algo pbkdf-nwf) + + ba-key + (let [;; Key stretched from pwd + ba-pkey (pbkdf/pbkdf pbkdf-algo impl/max-sym-key-len + ba-salt password pbkdf-nwf)] + (impl/hmac hash-algo ba-pkey ba-akm ba-const-derive-ekc-key)) + + ?ba-ekey + (when backup-key-pub + (have enc/bytes? + (core/encrypt-with-1-keypair ba-key backup-key-pub + (or backup-opts (dissoc opts :ba-aad :ba-akm))))) + + {:keys [ba-kc-prv ba-kc-pub]} (keychain-freeze keychain) + + ba-cnt ; Private content + (bytes/with-out [out] [11 ba-kc-prv ba-content] + (bytes/write-dynamic-ba out ba-kc-prv) + (bytes/write-dynamic-ba out ba-content) + (df/write-resv out)) + + ba-ecnt (impl/sck-encrypt sck ba-iv ba-key ba-cnt ba-aad) + ba-ekc ; ba-encrypted-keychain + (bytes/with-out [out baos] + [64 ba-aad ba-kc-pub ba-iv ba-ecnt ?ba-ekey (if embed-hmac? 32 0)] + + (df/write-head out) + (df/write-kid out :envelope :encrypted-keychain-v1) + (bytes/write-dynamic-ba out ba-aad) + (bytes/write-dynamic-ba out ba-kc-pub) + (df/write-resv out) + + (df/write-kid out :hash-algo hash-algo) + (df/write-kid out :sym-cipher-algo sym-cipher-algo) + (df/write-kid out :pbkdf-algo pbkdf-algo) + (bytes/write-ushort out pbkdf-nwf) + (bytes/write-dynamic-ba out nil #_ba-salt) + (df/write-resv out) + + (bytes/write-dynamic-ba out ba-iv) + (bytes/write-dynamic-ba out ba-ecnt) + (df/write-resv out) ; Reserved for num of backup keys, etc. + (bytes/write-dynamic-ba out ?ba-ekey) + (df/write-resv out) + + (let [?ba-hmac + (when embed-hmac? + (let [ba-to-hash (.toByteArray baos)] ; Whole ba till now + (impl/hmac hash-algo ba-key + ba-const-derive-ekc-hmac ba-to-hash)))] + (bytes/write-dynamic-ba out ?ba-hmac)) + + (df/write-resv out))] + + ba-ekc)) + +(comment + ;; [3691 124 163] bytes + [(let [kc (keychain) ] (count (keychain-encrypt kc "pwd" {}))) + (let [kc (keychain {:empty? true})] (count (keychain-encrypt kc "pwd" {}))) + (let [kc (keychain {:only? true, :symmetric-keys [:random]})] (count (keychain-encrypt kc "pwd" {})))]) + +(defn ^:public keychain-decrypt + "Complement of `keychain-encrypt`. + + Given a `ba-encrypted-keychain` byte[] as returned by `keychain-encrypt`, + and a password (string, byte[], or char[]) - checks if given password is correct. + + If incorrect, returns nil. + If correct, return value depends on `:return` option: + `:keychain` - Returns decrypted `KeyChain` (default) + `:ba-content` - Returns decrypted byte[] content + `:ba-aad` - Returns verified unencrypted embedded ?byte[] AAD + `:as-map` - Returns {:keys [keychain ba-aad ba-content]} map + + See `keychain-encrypt` docstring for details. + See Tempel Wiki for detailed usage info, common patterns, examples, etc." + + #_(df/reference-data-formats :encrypted-keychain-v1) + [ba-encrypted-keychain password & + [{:keys [return ba-akm backup-key-prv backup-opts ignore-hmac?] + :or {return :keychain} + :as opts}]] + + (let [ba-ekc (have enc/bytes? ba-encrypted-keychain)] + (bytes/with-in [in bais] ba-ekc + (let [env-kid :encrypted-keychain-v1 + _ (df/read-head! in) + _ (df/read-kid in :envelope env-kid) + ?ba-aad (bytes/read-dynamic-ba in) + ba-kc-pub (bytes/read-dynamic-ba in) + _ (df/read-resv! in) + hash-algo (df/read-kid in :hash-algo) + sym-cipher-algo (df/read-kid in :sym-cipher-algo) + pbkdf-algo (df/read-kid in :pbkdf-algo) + pbkdf-nwf (bytes/read-ushort in) + ?ba-salt (bytes/read-dynamic-ba in) + _ (df/read-resv! in) + ba-iv (bytes/read-dynamic-ba! in) + ba-ecnt (bytes/read-dynamic-ba! in) + _ (df/read-resv! in) + ?ba-ekey (bytes/read-dynamic-ba in) + _ (df/read-resv! in) + hmac-idx (- (alength ^bytes ba-ekc) (.available bais)) + ?ba-hmac (bytes/read-dynamic-ba in) + _ (df/read-resv in) + + ba-salt (or ?ba-salt (impl/hmac hash-algo ba-iv (bytes/str->utf8-ba "iv->salt"))) + ba-key + (if backup-key-prv + (if-let [ba-ekey ?ba-ekey] + (try + (core/decrypt-with-1-keypair ba-ekey backup-key-prv + (assoc (or backup-opts (dissoc opts :ba-aad :ba-akm)) + :return :ba-content)) + (catch Throwable t + (throw + (ex-info "Failed to decrypt `KeyChain` with given backup key: wrong key?" + {} t)))) + (throw + (ex-info "Failed to decrypt `KeyChain` with given backup key: no backup key was provided during encryption" + {}))) + + (let [;; Key stretched from pwd + ba-pkey (pbkdf/pbkdf pbkdf-algo impl/max-sym-key-len + ba-salt password pbkdf-nwf)] + (impl/hmac hash-algo ba-pkey ba-akm ba-const-derive-ekc-key))) + + hmac-pass? + (if-let [ba-hmac ?ba-hmac] + (let [ba-to-hash (bytes/ba->sublen hmac-idx ba-ekc) + ba-hmac* (impl/hmac hash-algo ba-key + ba-const-derive-ekc-hmac ba-to-hash)] + (enc/ba= ba-hmac ba-hmac*)) + true)] + + (when (or hmac-pass? ignore-hmac?) + (let [sck (impl/as-symmetric-cipher-kit sym-cipher-algo)] + (when-let [ba-cnt + (try ; Throw possible, but unlikely if ba-hmac was present and passed + (impl/sck-decrypt sck ba-iv ba-key ba-ecnt ?ba-aad) + (catch #_javax.crypto.AEADBadTagException Throwable + _ nil))] + + (bytes/with-in [in] ba-cnt + (let [ba-kc-prv (bytes/read-dynamic-ba! in) + ?ba-ucnt (bytes/read-dynamic-ba in) ; User content + _ (df/read-resv! in) + keychain (keychain-restore ba-kc-prv ba-kc-pub)] + + (case return + :keychain keychain + :ba-content ?ba-ucnt + :ba-aad ?ba-aad + :as-map + (enc/assoc-some + {:keychain keychain + :hmac-pass? (boolean hmac-pass?)} + :ba-content ?ba-ucnt + :ba-aad ?ba-aad) + + :_test ; Undocumented, used for tests + (enc/assoc-some + {:kc keychain} + :aad (bytes/utf8-?ba->str ?ba-aad) + :cnt (bytes/utf8-?ba->str ?ba-ucnt)) + + (enc/unexpected-arg! return + :expected #{:keychain :ba-content :ba-aad :as-map} + :context `keychain-decrypt))))))))))) + +(comment (keychain-decrypt (keychain-encrypt (keychain) "pwd") "pwd")) + +;;;; + +(defn try-keys + "Returns {:keys [success error errors]}" + [embedded-key-ids? possible-keys with-possible-key-fn] + (let [nkeys (count possible-keys)] + (if (== nkeys 1) + (try + {:success (with-possible-key-fn (first possible-keys))} + (catch Throwable t {:error t })) + + ;; >1 keys => using `KeyChain`/s with data written with {:embed-key-ids? false} + (let [errors_ (volatile! [])] + (assert (not embedded-key-ids?)) + (if-let [success + (reduce + (fn [_ possible-key] + (if-let [success + (try + (with-possible-key-fn possible-key) + (catch Throwable t (vswap! errors_ conj t) nil))] + (reduced success) + nil)) + nil + possible-keys)] + + {:success success} + {:errors @errors_}))))) + +(defn decrypt-failed! [ex-info] (throw ex-info)) +(defn try-decrypt-with-keys! + "Special case of `try-keys` that throws decryption errors on failure" + [context embedded-key-ids? possible-keys decrypt-fn] + (let [result (try-keys embedded-key-ids? possible-keys decrypt-fn)] + (enc/cond + :if-let [success (get result :success)] success + :if-let [t (get result :error)] + (decrypt-failed! + (ex-info + (if embedded-key-ids? + "Failed to decrypt Tempel data (1 identified key tried)" + "Failed to decrypt Tempel data (1 unidentified key tried)") + {:context context, :num-keys-tried 1, :embedded-key-ids? embedded-key-ids?} + t)) + + :else + (let [errors (get result :errors) + nkeys (count possible-keys)] + (decrypt-failed! + (ex-info (str "Failed to decrypt Tempel data (" nkeys " unidentified keys tried)") + {:context context + :num-keys-tried nkeys + :embedded-key-ids? embedded-key-ids? + :errors errors})))))) diff --git a/src/taoensso/tempel/pbkdf.clj b/src/taoensso/tempel/pbkdf.clj new file mode 100644 index 0000000..39bc839 --- /dev/null +++ b/src/taoensso/tempel/pbkdf.clj @@ -0,0 +1,410 @@ +(ns ^:no-doc taoensso.tempel.pbkdf + "Private ns, implementation detail. + Key derivation stuff." + (:refer-clojure :exclude [rand-nth]) + (:require + [taoensso.encore :as enc :refer [have have?]] + [taoensso.tempel.bytes :as bytes :refer [as-ba]] + [taoensso.tempel.impl :as impl])) + +(comment + (remove-ns 'taoensso.tempel.pbkdf) + (:public (enc/interns-overview))) + +;; Other options incl.: +;; - HKDF Ref. , etc. ; RFC 5869 +;; - Argon2 Ref. , etc. +;; - BCrypt Ref. , etc. + +;;;; + +(enc/compile-if com.lambdaworks.crypto.SCrypt + (do + (def ^:const have-dep-pbkdf-scrypt? true) + (defn- pbkdf-scrypt + "Password-Based Key Derivation Function as per RFC 7914. + Key stretching: CPU and memory costs scale linearly with `n-work-factor` + (which must be a power of 2). + + For info on scrypt params, + Ref. " + ^bytes + [key-len ?ba-salt ba-secret n-work-factor + {:keys [r p] + :or {r 8, p 1}}] + + (let [ba-salt (or ?ba-salt (byte-array key-len))] + (com.lambdaworks.crypto.SCrypt/scrypt ba-secret ba-salt + n-work-factor r p key-len)))) + + (do + (def ^:const have-dep-pbkdf-scrypt? false) + (defn- ^:missing-dependency pbkdf-scrypt + "Missing dependency: `com.lambdaworks/scrypt`" + ^bytes [key-len ba-salt ba-secret n-work-factor params] + (impl/missing-dep! + 'com.lambdaworks.crypto.SCrypt + 'com.lambdaworks/scrypt + pbkdf-scrypt)))) + +(comment (pbkdf-scrypt 32 (as-ba "salt") (as-ba "pwd") (Math/pow 2 14) {})) + +(let [skf-pbkdf2-hmac-sha-256_ + (enc/thread-local + (javax.crypto.SecretKeyFactory/getInstance + "PBKDF2WithHmacSHA256"))] + + (defn- as-secret-key-factory-pbkdf2 + "Returns `javax.crypto.SecretKeyFactory`, or throws. + Takes `algo-skf` ∈ #{:hmac-sha-256}." + ^javax.crypto.SecretKeyFactory + [algo-skf] + (case algo-skf + :hmac-sha-256 @skf-pbkdf2-hmac-sha-256_ + (enc/unexpected-arg! algo-skf + :expected #{:hmac-sha-256} + :context `as-secret-key-factory-pbkdf2)))) + +(defn- pbkdf-pbkdf2 + "Password-Based Key Derivation Function as per + PKCS #5 / RFC 8018 (formerly RFC 2898). + + Key stretching: CPU cost scales linearly with `n-iterations`. + Takes `algo-skf` ∈ #{:hmac-sha-256}. + + Nb: doesn't automatically clear char[] password, consumer may want to + clear manually for improved security." + ^bytes + [algo-skf key-len ?ba-salt ca-password n-iterations] + + ;; Ref. + (let [ba-salt (or ?ba-salt (byte-array key-len)) + skf (as-secret-key-factory-pbkdf2 algo-skf) + pks + (javax.crypto.spec.PBEKeySpec. + ca-password + ba-salt + (int n-iterations) + (bytes/n-bytes->n-bits key-len)) + + ba-key (.getEncoded (.generateSecret skf pks))] + + (.clearPassword pks) + ba-key)) + +(defn- ^:deprecated pbkdf-sha-512-deprecated + "Custom Password-Based Key Deriviation Function. + Key stretching: CPU cost scales linearly with `n-iterations`. + + Kept only for legacy reasons, prefer other standard PBKDF implementations." + ^bytes + [key-len ?ba-salt ba-secret n-iterations] + + (let [ba-salted-secret (bytes/ba-join ?ba-salt ba-secret) ; hmac would be better + md (impl/as-message-digest :sha-512)] + + (as-ba key-len + (enc/reduce-n (fn [^bytes acc in] (.digest md acc)) + ba-salted-secret n-iterations)))) + +;;;; + +(defprotocol IPBKDFKit + "Private protocol. + - Ref nwfs generated with `pbkdf-nwf-estimate`. + - Upgradability: + - ref-nwfs (kw->nwf mappings) can be trivially upgraded over time. + - nwf->rwf fn can not (would require new kit kid)." + (^:private pbkdf-kit-kid [_]) + (^:private pbkdf-kit-ref-nwfs [_]) + (^:private ^long pbkdf-kit-nwf->rwf [_ nwf]) + (^:private ^bytes pbkdf-kit-derive-ba-key ^bytes [_ key-len ?ba-salt password rwf])) + +(deftype PBKDFKit-scrypt-r8p1-v1 [] + IPBKDFKit + (pbkdf-kit-kid [_] :scrypt-r8p1-v1) ; Version 1, r=8, p=1 + (pbkdf-kit-ref-nwfs [_] {:rmin 0, :r10 10, :r50 13, :r100 14, :r200 15, :r500 16, :r1000 17, :r2000 18, :r5000 19, :rmax 21}) + (pbkdf-kit-nwf->rwf [_ nwf] (long (Math/pow 2 (inc (long nwf))))) + (pbkdf-kit-derive-ba-key [_ key-len ?ba-salt password rwf] + (pbkdf-scrypt key-len ?ba-salt (as-ba password) rwf {:r 8, :p 1}))) + +(deftype PBKDFKit-pbkdf2-hmac-sha-256-v1 [] + IPBKDFKit + (pbkdf-kit-kid [_] :pbkdf2-hmac-sha-256-v1) ; Version 1 + (pbkdf-kit-ref-nwfs [_] {:rmin 0, :r10 6, :r50 28, :r100 55, :r200 111, :r500 277, :r1000 554, :r2000 1108, :r5000 2771, :rmax 11075}) + (pbkdf-kit-nwf->rwf [_ nwf] (* 1024 (long nwf))) + (pbkdf-kit-derive-ba-key [_ key-len ?ba-salt password rwf] + (pbkdf-pbkdf2 :hmac-sha-256 key-len ?ba-salt (bytes/as-ca password) rwf))) + +(deftype PBKDFKit-sha-512-v1-deprecated [] + IPBKDFKit + (pbkdf-kit-kid [_] :sha-512-v1-deprecated) ; Version 1 + (pbkdf-kit-ref-nwfs [_] {:rmin 0, :r10 16, :r50 80, :r100 160, :r200 322, :r500 802, :r1000 1605, :r2000 3208, :r5000 8013, :rmax 31982}) + (pbkdf-kit-nwf->rwf [_ nwf] (* 1024 (long nwf))) + (pbkdf-kit-derive-ba-key [_ key-len ?ba-salt password rwf] + (pbkdf-sha-512-deprecated key-len ?ba-salt (as-ba password) rwf))) + +(def pbkdf-kit-best-available + (enc/cond + have-dep-pbkdf-scrypt? :scrypt-r8p1-v1 + (impl/non-throwing? (as-secret-key-factory-pbkdf2 :hmac-sha-256)) :pbkdf2-hmac-sha-256-v1 + (impl/non-throwing? (impl/as-message-digest :sha-512)) :sha-512-v1-deprecated + (throw (ex-info "No viable PBKDF kit available" {})))) + +(comment pbkdf-kit-best-available) + +(let [kit-scrypt-r8p1-v1 (PBKDFKit-scrypt-r8p1-v1.) + kit-pbkdf2-hmac-sha-256-v1 (PBKDFKit-pbkdf2-hmac-sha-256-v1.) + kit-sha-512-v1-deprecated (PBKDFKit-sha-512-v1-deprecated.) + expected #{:scrypt-r8p1-v1 :pbkdf2-hmac-sha-256-v1 :sha-512-v1-deprecated}] + + (defn- as-pbkdf-kit + "Returns `IPBKDFKit` implementer, or throws. + Takes `kit` ∈ #{:scrypt-r8p1-v1 :pbkdf2-hmac-sha-256-v1 :sha-512-v1-deprecated}." + [pbkdf-algo] + (if (keyword? pbkdf-algo) + (case pbkdf-algo + :best-available (as-pbkdf-kit pbkdf-kit-best-available) + :scrypt-r8p1-v1 kit-scrypt-r8p1-v1 + :pbkdf2-hmac-sha-256-v1 kit-pbkdf2-hmac-sha-256-v1 + :sha-512-v1-deprecated kit-sha-512-v1-deprecated + (enc/unexpected-arg! pbkdf-algo + :expected expected + :context `as-pbkdf-kit)) + + (enc/satisfies! IPBKDFKit pbkdf-algo + :expected expected + :context `as-pbkdf-kit)))) + +(comment (as-pbkdf-kit pbkdf-kit-best-available)) + +;;;; + +(defn pbkdf-nwf-estimate + "Returns normalized work factor (nwf) estimate/s for which pbkdf runtime best + matches given msecs target/s on the current system: + + (pbkdf-nwf-estimate :pbkdf2-hmac-sha-256-v1 [2 3] 200) => + Runs pbkdf2 a total of 2x3=6 times to estimate the normalized + work factor that yields a ~200 msec runtime on the current system. + + Expensive!! Don't use in production. + Used internally to help generate reference `nwf` consts: + `:ref-10-msecs`, `:ref-100-msecs`, etc." + + ([pbkdf-algo bench-spec msecs-target-or-targets] + (let [pbkdf-kit (as-pbkdf-kit pbkdf-algo)] + + (pbkdf-nwf-estimate bench-spec + (fn kfn [rwf] (pbkdf-kit-derive-ba-key pbkdf-kit 32 (as-ba "salt") "pwd" rwf)) + (fn sfn [nwf] (pbkdf-kit-nwf->rwf pbkdf-kit nwf)) + (get (pbkdf-kit-ref-nwfs pbkdf-kit) :r1000) + msecs-target-or-targets))) + + ;; Low-level API + ([bench-spec kfn sfn nwf-to-probe msecs-target-or-targets] + ;; Assumes (kfn rwf) runtime increases linearly with rwf. + ;; Scaling fn `sfn` need not be linear. + + (if (vector? msecs-target-or-targets) ; Bulk targets + (mapv (fn [msecs] (pbkdf-nwf-estimate bench-spec kfn sfn nwf-to-probe msecs)) + msecs-target-or-targets) + + ;; Single target + (let [[n-sets n-laps] (if (vector? bench-spec) bench-spec [4 bench-spec]) + + msecs-target (long msecs-target-or-targets) + rwf (long (sfn nwf-to-probe)) ; Raw/scaled work factor + + msecs-per-set (double (enc/qb bench-spec (kfn rwf))) + msecs-per-lap (double (/ msecs-per-set (double n-laps))) + msecs-per-rwf (double (/ msecs-per-lap (double rwf))) + + ;; This works only for linear sfn (so not for scrypt, etc.) + ;; msecs-per-nwf (double (/ msecs-per-lap (double nwf-to-probe))) + ;; nwf-proposed (long (/ (double msecs-target) msecs-per-nwf)) + + nwf-proposed + ;; Search for wf for which (sfn wf) best predicts msecs-target + (loop [nwf-prop 0] + (let [nwf-next (inc nwf-prop) + msecs-predicted (* (long (sfn nwf-prop)) msecs-per-rwf) + msecs-predicted-next (* (long (sfn nwf-next)) msecs-per-rwf)] + + (if (and + (< msecs-predicted msecs-target) + (< msecs-predicted-next msecs-target)) + (recur nwf-next) + + (let [delta (Math/abs (- msecs-predicted msecs-target)) + delta-next (Math/abs (- msecs-predicted-next msecs-target))] + + (if (< delta delta-next) nwf-prop nwf-next))))) + + msecs-actual (enc/time-ms (kfn (sfn nwf-proposed))) + msecs-delta (- msecs-actual (long msecs-target)) + error-perc (enc/perc msecs-delta msecs-actual) + estimate + {:nwf nwf-proposed + :actual-msecs msecs-actual + :error {:msecs msecs-delta + :perc error-perc + :status (if (<= error-perc 10) :okay :warn)}}] + + (if (> ^long nwf-proposed bytes/ushort-max) + (throw + ;; If target msecs is reasonable, => scaling fn may need adjustment (breaking!) + (ex-info "Estimated PBKDF normalized work factor exceeds unsigned byte range" + estimate)) + + estimate))))) + +(comment ; Reference normalized work factors + (let [msecs-targets [10 50 100 200 500 1000 2000 5000 20000]] + [(pbkdf-nwf-estimate :scrypt-r8p1-v1 [2 2] msecs-targets) + (pbkdf-nwf-estimate :sha-512-v1-deprecated [2 2] msecs-targets) + (pbkdf-nwf-estimate :pbkdf2-hmac-sha-256-v1 [2 2] msecs-targets)]) + + ;; Times from 2020 8-core MBP M1 2020 w/ 16GB memory + {:scrypt-r8p1-v1 + [{:nwf 10, :actual-msecs 7, :error {:msecs -3, :perc -43, :status :warn}} + {:nwf 13, :actual-msecs 58, :error {:msecs 8, :perc 14, :status :warn}} + {:nwf 14, :actual-msecs 117, :error {:msecs 17, :perc 15, :status :warn}} + {:nwf 15, :actual-msecs 238, :error {:msecs 38, :perc 16, :status :warn}} + {:nwf 16, :actual-msecs 518, :error {:msecs 18, :perc 3, :status :okay}} + {:nwf 17, :actual-msecs 1053, :error {:msecs 53, :perc 5, :status :okay}} + {:nwf 18, :actual-msecs 1954, :error {:msecs -46, :perc -2, :status :okay}} + {:nwf 19, :actual-msecs 4400, :error {:msecs -600, :perc -14, :status :warn}} + {:nwf 21, :actual-msecs 18620, :error {:msecs -1380, :perc -7, :status :good}}] + + :sha-512-v1-deprecated + [{:nwf 16, :actual-msecs 10, :error {:msecs 0, :perc 0, :status :good}} + {:nwf 80, :actual-msecs 49, :error {:msecs -1, :perc -2, :status :good}} + {:nwf 160, :actual-msecs 98, :error {:msecs -2, :perc -2, :status :good}} + {:nwf 322, :actual-msecs 201, :error {:msecs 1, :perc 0, :status :good}} + {:nwf 802, :actual-msecs 500, :error {:msecs 0, :perc 0, :status :good}} + {:nwf 1605, :actual-msecs 1001, :error {:msecs 1, :perc 0, :status :good}} + {:nwf 3208, :actual-msecs 2003, :error {:msecs 3, :perc 0, :status :good}} + {:nwf 8013, :actual-msecs 5002, :error {:msecs 2, :perc 0, :status :good}} + {:nwf 31982, :actual-msecs 20004, :error {:msecs 4, :perc 0, :status :good}}] + + :pbkdf2-hmac-sha-256-v1 + [{:nwf 6, :actual-msecs 11, :error {:msecs 1, :perc 9, :status :good}} + {:nwf 28, :actual-msecs 51, :error {:msecs 1, :perc 2, :status :good}} + {:nwf 55, :actual-msecs 100, :error {:msecs 0, :perc 0, :status :good}} + {:nwf 111, :actual-msecs 202, :error {:msecs 2, :perc 1, :status :good}} + {:nwf 277, :actual-msecs 501, :error {:msecs 1, :perc 0, :status :good}} + {:nwf 554, :actual-msecs 1001, :error {:msecs 1, :perc 0, :status :good}} + {:nwf 1108, :actual-msecs 2003, :error {:msecs 3, :perc 0, :status :good}} + {:nwf 2771, :actual-msecs 5008, :error {:msecs 8, :perc 0, :status :good}} + {:nwf 11075, :actual-msecs 19999, :error {:msecs -1, :perc 0, :status :good}}]}) + +(defn pbkdf-nwf-parse + "Given a PBKDF normalized work factor `nwf`: + - Ensures that `nwf` is ∈[rmin,rmax], throws when out of range. + - Supports upgradeable kit-specific `nwf` keyword defaults. + + Returns ushort nwf, or throws." + ^long [pbkdf-algo nwf] + (let [pbkdf-kit (as-pbkdf-kit pbkdf-algo) + ref-nwfs (pbkdf-kit-ref-nwfs pbkdf-kit) + {:keys [rmin rmax]} ref-nwfs + + rmax (min (long rmax) bytes/ushort-max) + nwf + (long + (if (keyword? nwf) + (case nwf + (:ref-min :rmin) rmin + (:ref-10-msecs :r10) (get ref-nwfs :r10) + (:ref-50-msecs :r50) (get ref-nwfs :r50) + (:ref-100-msecs :r100) (get ref-nwfs :r100) + (:ref-200-msecs :r200) (get ref-nwfs :r200) + (:ref-500-msecs :r500) (get ref-nwfs :r500) + (:ref-1000-msecs :r1000) (get ref-nwfs :r1000) + (:ref-2000-msecs :r2000) (get ref-nwfs :r2000) + (:ref-5000-msecs :r5000) (get ref-nwfs :r10) + (:ref-max :rmax) rmax + (enc/unexpected-arg! nwf + :context `pbkdf-nwf-parse + :expected + #{:ref-10-msecs :ref-50-msecs :ref-100-msecs :ref-200-msecs + :ref-500-msecs :ref-1000-msecs :ref-2000-msecs :ref-5000-msecs})) + nwf))] + + (if (or (< nwf ^long rmin) (> nwf ^long rmax)) + (throw + (ex-info (str "Invalid PBKDF normalized work factor: " nwf) + {:pbkdf-kit (get pbkdf-kit :pbkdf-kit) + :nwf {:given nwf :min rmin :max rmax}})) + + (bytes/as-ushort nwf)))) + +(defn pbkdf + "Provides a ~consistent API over various Password Based Key Derivation + Function (PBKDF) implementations. + + The underlying KDFs accessible here all include tunable \"key stretching\", + making them appropriate for low-entropy secrets like passwords. + + Arguments: + + `pbkdf-algo` + ∈ #{:scrypt-r8p1-v1 :pbkdf2-hmac-sha-256-v1 :sha-512-v1-deprecated}. + + Determines the underlying PBKDF implementation, and the + possible values and effect of the `work-factor`. + + `key-len` + The desired key length, in bytes. + Often 16 or 32 bytes (=> 128 or 256 bit keys). + + `?ba-salt` + An optional byte[] to be used as salt. + Important for preventing rainbow/dictionary attacks, etc. + + `password` + A password in the form of a string, byte[], or char[]. + Arrays may be preferable in some very high security environments + since they can be manually cleared (mutated) immediately after use, + leading to less time in memory. + + `normalized-work-factor` + ℕ[0,65535] subset, range may be further restricted by given kit. + + Determines how expensive key derivation will be. The ideal value will + depend on selected implementation (kit) and context (e.g. use case, + system performance, frequency of key derivation, sensitivity of data + being protected by resulting key, likelihood and nature of possible + attacks, etc.). + + Some special reference values may be used: + `:ref-10-msecs` ; Takes ~10 msecs on reference system (2020 M1 MBP) + `:ref-50-msecs` ; ~50 msecs + `:ref-100-msecs` ; ~100 msecs + `:ref-200-msecs` ; ~200 msecs + `:ref-500-msecs` ; ~500 msecs + `:ref-1000-msecs` ; ~1000 msecs + `:ref-2000-msecs` ; ~2000 msecs + `:ref-5000-msecs` ; ~5000 msecs + + NB: the underlying work factors to which these keywords map will be + updated over time to accomodate increases in computing (and so attack) + power. + + See also `pbkdf-nwf-estimate` to estimate the nwf needed on your + particular system to yield a specific target runtime." + + ^bytes [pbkdf-algo key-len ?ba-salt password normalized-work-factor] + (let [pbkdf-kit (as-pbkdf-kit pbkdf-algo) + nwf (pbkdf-nwf-parse pbkdf-kit normalized-work-factor) + rwf (pbkdf-kit-nwf->rwf pbkdf-kit nwf)] + + (pbkdf-kit-derive-ba-key pbkdf-kit key-len + ?ba-salt password rwf))) + +(comment + [(enc/time-ms (pbkdf :scrypt-r8p1-v1 16 nil "pwd" :r100)) + (enc/time-ms (pbkdf :pbkdf2-hmac-sha-256-v1 16 nil "pwd" :r100)) + (enc/time-ms (pbkdf :sha-512-v1-deprecated 16 nil "pwd" :r100)) + (enc/time-ms (pbkdf :best-available 16 nil "pwd" :r100))]) diff --git a/test/taoensso/tempel_tests.clj b/test/taoensso/tempel_tests.clj index ae8efc9..2060b99 100644 --- a/test/taoensso/tempel_tests.clj +++ b/test/taoensso/tempel_tests.clj @@ -1,16 +1,638 @@ (ns taoensso.tempel-tests (:require - [clojure.test :as test :refer [deftest testing is]] - ;; [clojure.test.check :as tc] - ;; [clojure.test.check.generators :as tc-gens] - ;; [clojure.test.check.properties :as tc-props] - [taoensso.encore :as enc] - [taoensso.tempel :as tempel])) + [clojure.test :as test :refer [deftest testing is]] + [taoensso.encore :as enc :refer [have have? throws?]] + [taoensso.tempel.bytes :as bytes :refer [as-ba ba=]] + [taoensso.tempel.df :as df] + [taoensso.tempel.impl :as impl] + [taoensso.tempel.pbkdf :as pbkdf] + [taoensso.tempel.keys :as keys] + [taoensso.tempel :as tempel :refer [*config*]]) + + (:import [javax.crypto AEADBadTagException])) (comment (remove-ns 'taoensso.tempel-tests) (test/run-tests 'taoensso.tempel-tests)) -;;;; +;;;; Bytes + +(deftest _ba-lengths + [(is (= (vec (bytes/ba->len 5 (as-ba [1 2 3]))) [1 2 3 0 0])) + (is (-> (vec (bytes/ba->sublen 5 (as-ba [1 2 3]))) throws?))]) + +(deftest _ba-join (is (= (vec (bytes/ba-join nil (as-ba [0]) (as-ba [1 2]) nil (as-ba [3 4 5]) nil nil (as-ba [6]))) [0 1 2 3 4 5 6]))) +(deftest _ba-parts + (let [ba (bytes/ba-join (as-ba [1 2]) (as-ba [3]) (as-ba [5 6]) (as-ba [7 8 9]))] + (is (= (mapv vec (bytes/ba-parts ba 0 2 1 1 0 0 0 1)) [[1 2] [3] [5] [] [] [] [6] [7 8 9]])))) + +(deftest _unsigned-ints + [(let [n Byte/MAX_VALUE] (is (= (bytes/from-ubyte (bytes/to-ubyte n)) n))) + (let [n Short/MAX_VALUE] (is (= (bytes/from-ushort (bytes/to-ushort n)) n))) + + (let [n bytes/ubyte-max] (is (= (bytes/to-ubyte (bytes/from-ubyte n)) n))) + (let [n bytes/ushort-max] (is (= (bytes/to-ushort (bytes/from-ushort n)) n)))]) + +(deftest _strings + [(let [s bytes/utf8-str] (is (= (-> s bytes/str->utf8-ba bytes/utf8-ba->str) s))) + (let [s bytes/utf8-str] (is (= (vec (bytes/as-ba s)) + [-32 -78 -84 -32 -78 -66 32 -32 -78 -121 -32 -78 -78 -32 -77 -115 -32 -78 -78 -32 + -78 -65 32 -32 -78 -72 -32 -78 -126 -32 -78 -83 -32 -78 -75 -32 -78 -65 -32 -78 -72])))]) + +(deftest _chars (let [s @#'bytes/utf8-str] (is (= (String. (bytes/as-ca s)) s)))) +(deftest _parse-buffer-len (is (= (bytes/parse-buffer-len [1 (as-ba 3)]) 4))) + +(deftest _with-io + [(is (= (bytes/with-in [in] (bytes/with-out [out] 1 (.writeByte out 67)) (.readByte in)) 67)) + (is (= (vec (bytes/with-out [out] [0 (as-ba 6)] (.writeByte out 1))) [1]))]) + +(deftest _dynamic-uints + [(let [ba (bytes/with-out [out] 16 (bytes/write-dynamic-uint out 0))] + [(is (= (count ba) 1)) ; 1+0=1 bytes + (is (= (bytes/with-in [in] ba (bytes/read-dynamic-uint in)) 0))]) + + (let [ba (bytes/with-out [out] 16 (bytes/write-dynamic-uint out bytes/ubyte-max))] + [(is (= (count ba) 2)) ; 1+1=2 bytes + (is (= (bytes/with-in [in] ba (bytes/read-dynamic-uint in)) bytes/ubyte-max))])]) + +(deftest _unsigned-io + [(is (= (bytes/with-in [in] (bytes/with-out [out] 2 (bytes/write-ubyte out bytes/ubyte-max)) (bytes/read-ubyte in)) bytes/ubyte-max)) + (is (= (bytes/with-in [in] (bytes/with-out [out] 2 (bytes/write-ushort out bytes/ushort-max)) (bytes/read-ushort in)) bytes/ushort-max))]) + +(deftest _dynamic-bas + [(let [dba (bytes/with-out [out] 1 (dotimes [_ 3] (bytes/write-dynamic-ba out nil)))] + (bytes/with-in [in] dba + (let [x1 (bytes/read-dynamic-ba in) + x2 (bytes/read-dynamic-ba! in) + [x3 n3] (bytes/read-dynamic-ba* in)] + + [(is (= x1 nil)) + (is (ba= x2 (as-ba 0))) + (is (= n3 1)) + (is (= x3 nil))]))) + + (let [dba (bytes/with-out [out] 1 (dotimes [_ 3] (bytes/write-dynamic-ba out (as-ba 0))))] + (bytes/with-in [in] dba + (let [x1 (bytes/read-dynamic-ba in) + x2 (bytes/read-dynamic-ba! in) + [x3 n3] (bytes/read-dynamic-ba* in)] + + [(is (= x1 nil)) + (is (ba= x2 (as-ba 0))) + (is (= n3 1)) + (is (= x3 nil))]))) + + (let [dba (bytes/with-out [out] 1 (dotimes [_ 3] (bytes/write-dynamic-ba out (as-ba [1 2 3]))))] + (bytes/with-in [in] dba + (let [x1 (bytes/read-dynamic-ba in) + x2 (bytes/read-dynamic-ba! in) + [x3 n3] (bytes/read-dynamic-ba* in)] + + [(is (ba= x1 (as-ba [1 2 3]))) + (is (ba= x2 (as-ba [1 2 3]))) + (is (= n3 4)) + (is (ba= x3 (as-ba [1 2 3])))])))]) + +(deftest _dynamic-strs + (let [dba + (bytes/with-out [out] 1 + (bytes/write-dynamic-str out nil) + (bytes/write-dynamic-str out nil) + (bytes/write-dynamic-str out "") + (bytes/write-dynamic-str out "") + (bytes/write-dynamic-str out bytes/utf8-str))] + + (bytes/with-in [in] dba + (let [x1 (bytes/read-dynamic-str in) + x2 (bytes/read-dynamic-str! in) + x3 (bytes/read-dynamic-str in) + x4 (bytes/read-dynamic-str! in) + x5 (bytes/read-dynamic-str in)] + (is (= [x1 x2 x3 x4 x5] [nil "" nil "" bytes/utf8-str])))))) + +(deftest _headers + [(is (= (bytes/with-in [in] (bytes/with-out [out] 4 (df/write-head out) (.write out 1)) (df/read-head! in) (.readByte in)) 1)) + (is (->> (bytes/with-in [in] (bytes/with-out [out] 4 (.write out 1)) (df/read-head! in)) + (enc/throws? :ex-info {:read {:expected [84 80 76]}})))]) + +;;;; Implementation + +(deftest _randomness + (let [k1 (impl/with-srng-insecure-deterministic!!! 10 (:key-prv (impl/keypair-create* :rsa-2048))) + k2 (impl/with-srng-insecure-deterministic!!! 10 (:key-prv (impl/keypair-create* :rsa-2048))) + k3 (impl/with-srng-insecure-deterministic!!! 11 (:key-prv (impl/keypair-create* :rsa-2048)))] + [(is (= k1 k2)) + (is (not= k1 k3))])) + +(deftest _hash-ba + [(let [h (partial impl/hash-ba-concat :sha-256) + ba-ref (h (as-ba 0))] + (is (enc/revery? #(ba= ba-ref %) [(h) (h nil) (h nil nil) (h nil nil (as-ba 0))]) "Hashing of empty/nil byte[]s")) + + (is (= (vec (impl/hash-ba-concat :md5 (as-ba "hello"))) [93 65 64 42 -68 75 42 118 -71 113 -99 -111 16 23 -59 -110])) + (is (= (vec (impl/hash-ba-cascade :md5 (as-ba "hello"))) [98 16 -110 6 -120 13 56 -92 1 10 -104 -31 18 67 -110 74]))]) + +(deftest _hmac + [(is (= (vec (impl/hmac :md5 (as-ba "secret") (as-ba "cnt"))) [23 67 122 6 109 -56 120 93 -90 43 -73 -68 5 -20 54 -62])) + (is (= (vec (impl/hmac :sha-1 (as-ba "secret") (as-ba "cnt"))) [-40 11 -111 61 59 63 -44 72 -58 -47 49 16 103 -41 44 -95 -36 -84 -111 -86])) + (is (= + (vec (impl/hmac :sha-256 (as-ba "secret") (as-ba "c1") (as-ba "c2"))) + (vec (impl/hmac :sha-256 (as-ba "secret") nil (as-ba "c1") nil (as-ba "c2")))))]) + +(deftest _pbkdf-pbkdf2 + (is (= (vec (#'pbkdf/pbkdf-pbkdf2 :hmac-sha-256 16 (as-ba "salt") (.toCharArray "pwd") 8000)) + [-29 115 -115 -87 92 119 -80 -118 76 -122 127 70 8 67 -43 114]))) + +(deftest _pbkdf-nwf-parse + [(is (= (pbkdf/pbkdf-nwf-parse :scrypt-r8p1-v1 :ref-100-msecs) 14)) + (is (= (pbkdf/pbkdf-nwf-parse :scrypt-r8p1-v1 12) 12)) + (is (-> (pbkdf/pbkdf-nwf-parse :scrypt-r8p1-v1 (inc bytes/ushort-max)) throws?))]) + +(deftest _symmetric-cipher-kit + (let [sck (impl/as-symmetric-cipher-kit :aes-gcm-128-v1) + ba-key (as-ba 32 "pwd") + ba-cnt (as-ba "cnt")] + + [(testing "Basic operation, with AAD" + [(let [ba-iv (impl/rand-ba (impl/sck-iv-len sck)) + ba-aad (impl/rand-ba 128) + ba-ecnt (impl/sck-encrypt sck ba-iv ba-key ba-cnt ba-aad)] + + [(is (->> (impl/sck-decrypt sck ba-iv ba-key ba-ecnt ba-aad) enc/utf8-ba->str (= "cnt"))) + (is (->> (impl/sck-decrypt sck ba-iv (as-ba 32 "!pwd") ba-ecnt ba-aad) (throws? javax.crypto.AEADBadTagException)) "Bad key")]) + + (let [ba-iv (impl/rand-ba (impl/sck-iv-len sck)) + ba-ecnt (impl/sck-encrypt sck ba-iv ba-key ba-cnt nil)] + + [(is (->> (impl/sck-decrypt sck ba-iv ba-key ba-ecnt nil) enc/utf8-ba->str (= "cnt")) "No AAD") + (is (->> (impl/sck-decrypt sck ba-iv ba-key ba-ecnt (impl/rand-ba 128)) + (throws? javax.crypto.AEADBadTagException)) "Bad AAD")])]) + + (testing "Bad ba lengths" + [(is + (->> + (impl/sck-encrypt sck (impl/rand-ba 4) (impl/rand-ba 128) (as-ba "cnt") nil) + (throws? :ex-info {:length {:target 12, :actual 4}})) + "ba-iv too short") + + (is + (->> + (impl/sck-encrypt sck (impl/rand-ba 128) (impl/rand-ba 4) (as-ba "cnt") nil) + (throws? :ex-info {:length {:target 16, :actual 4}})) + "ba-key too short")])])) + +(deftest _keypairs + [(testing "Keypair equality" + [(true? (impl/key-algo= :rsa :rsa-1024)) + (true? (impl/key-algo= :rsa-1024 :rsa-1024)) + (false? (impl/key-algo= :rsa-2048 :rsa-1024)) + + (true? (impl/key-algo= :dh :dh-1024)) + (true? (impl/key-algo= :dh-1024 :dh-1024)) + (false? (impl/key-algo= :dh-2048 :dh-1024)) + + (true? (impl/key-algo= :ec :ec-secp256r1)) + (true? (impl/key-algo= :ec-secp256r1 :ec-secp256r1)) + (false? (impl/key-algo= :ec-secp384r1 :ec-secp256r1)) + + (false? (impl/key-algo= :rsa-1024 :dh-1024)) + (false? (impl/key-algo= :rsa :dh-1024)) + (false? (impl/key-algo= :rsa :ec))]) + + (testing "Keypair creation and verification" + (let [{:keys [keypair, ba-pub key-pub, ba-prv key-prv]} (impl/keypair-create* :rsa-1024)] + [(is (= (impl/as-key-pub :rsa-1024 nil ba-pub) key-pub)) + (is (= (impl/as-key-prv :rsa-1024 nil ba-prv) key-prv)) + (is (= (impl/as-key-pub :rsa nil ba-pub) key-pub) "Loose algo") + (is (= (impl/as-key-pub :rsa nil keypair) key-pub) "Loose algo") + (is (= (impl/as-key-prv :rsa nil keypair) key-prv) "loose algo") + (is (= (impl/as-key-pub :rsa nil keypair) key-pub) "Loose algo") + (is (= (impl/as-key-prv :rsa nil keypair) key-prv) "Loose algo") + (is (= (impl/as-key-pub nil nil keypair) key-pub) "Auto algo") + (is (= (impl/as-key-pub nil nil key-pub) key-pub) "Auto algo") + + (is (->> (impl/as-key-pub :rsa-2048 nil ba-pub) (throws? :ex-info {:algo {:expected :rsa-2048, :actual :rsa-1024}})) "Mismatched key size") + (is (->> (impl/as-key-pub :dh-1024 nil ba-pub) (throws? :ex-info {:error :decode-failure})) "Mismatched algo")])) + + (testing "Keypair needs" + [(is (= (impl/key-algo! :rsa-1024 [:asymmetric? :asym-cipher-algo]) :rsa-1024)) + (is (->> (impl/key-algo! :rsa-1024 [:asymmetric? :ka-algo]) (throws? :ex-info "need key agreement support"))) + (is (= (impl/key-algo! :dh-1024 [:asymmetric? :ka-algo]) :dh-1024)) + (is (->> (impl/key-algo! :dh-1024 [:asymmetric? :sig-algo]) (throws? :ex-info "need signature support"))) + (is (->> (impl/key-algo! :symmetric [:asymmetric?]) (throws? :ex-info "need asymmetric type"))) + (is (= (impl/key-algo! :ec-secp256r1 []) :ec-secp256r1)) + (is (->> (impl/key-algo! :ec-secp256r1 [:nonsense]) (throws? :ex-info "doesn't meet need")))]) + + (testing "Keypair info" + [(is (= (set (keys (impl/keypair-info (impl/keypair-create :rsa-1024)))) #{:key-algo :key-prv :key-pub})) + (is (= (set (keys (impl/keypair-info (:key-pub (impl/keypair-create* :rsa-1024))))) #{:key-algo #_:key-prv :key-pub})) + (is (= (set (keys (impl/keypair-info (:key-prv (impl/keypair-create* :rsa-1024))))) #{:key-algo :key-prv #_:key-pub})) + (is (= (impl/keypair-info nil) nil)) + (is (= (impl/keypair-info "str") nil))])]) + +(deftest _asymmetric-cipher + (let [ba-cnt (as-ba "cnt") + asym-cipher-algo :rsa-oaep-sha-256-mgf1 + key-algo :rsa-1024 + + {:keys [ba-pub ba-prv]} (impl/keypair-create* key-algo) + ecnt (impl/encrypt-asymmetric asym-cipher-algo key-algo ba-pub ba-cnt)] + + (is (= (enc/utf8-ba->str (impl/decrypt-asymmetric asym-cipher-algo key-algo ba-prv ecnt)) "cnt")))) + +(deftest _key-shared-create + (let [kp1 (impl/keypair-create :dh-1024) + kp2 (impl/keypair-create :dh-1024)] + + (enc/ba= + (impl/key-shared-create :dh :dh-1024 kp1 kp2) + (impl/key-shared-create :dh :dh-1024 kp2 kp1)))) + +(deftest _signatures + (let [key-algo :rsa-1024 + {ba-pub1 :ba-pub, ba-prv1 :ba-prv} (impl/keypair-create* key-algo) + {ba-pub2 :ba-pub, ba-prv2 :ba-prv} (impl/keypair-create* key-algo) + + ba-cnt1 (as-ba "cnt1") + ba-cnt2 (as-ba "cnt2") + ba-sig1 (impl/signature-create :sha-256-rsa key-algo ba-prv1 ba-cnt1)] + + [(is (= (impl/signature-verify :sha-256-rsa key-algo ba-pub1 ba-cnt1 ba-sig1) true)) + (is (= (impl/signature-verify :sha-256-rsa key-algo ba-pub1 ba-cnt2 ba-sig1) false) "Mismatch: content") + (is (= (impl/signature-verify :sha-256-rsa key-algo ba-pub2 ba-cnt1 ba-sig1) false) "Mismatch: keypair")])) + +;;;; Key management + +(def kcc keys/keychain-counts) +(def pd @#'tempel/public-data-test) + +(defn ckid [x] (get (enc/force-ref x) :key-id)) +(defn ckids [xs] (mapv ckid xs)) + +(defn ckid-pair [[x y]] [(get (enc/force-ref x) :key-id), (get (enc/force-ref y) :key-id)]) +(defn ckid-pairs [xys] (mapv ckid-pair xys)) + +(deftest _keychains + [(is (keys/keychain? (keys/keychain))) + (is (= (kcc (keys/keychain {:empty? true})) {})) + (is (= (kcc (keys/keychain {:symmetric-keys nil, :asymmetric-keypairs nil})) {})) + (is (= (kcc (keys/keychain {:only? true, :symmetric-keys [:random]})) {:n-sym 1})) + (is (= (kcc (keys/keychain {:only? true, :symmetric-keys [(impl/rand-ba 32) :random]})) {:n-sym 2})) + (is (->> (keys/keychain {:only? true, :symmetric-keys [(impl/rand-ba 5) :random]}) + (throws? :ex-info {:length {:expected 32}})) "Symmetric key too short") + + (let [kc (keys/keychain {:only? true, :symmetric-keys [:random :random :random]})] + (is (= (ckids (keys/keychain-ckeys kc [:symmetric :key-sym])) ["3" "2" "1"]) + "Key priority defaults to order of last-added")) + + (let [kc (-> + (keys/keychain {:empty? true}) + (keys/keychain-add-symmetric-key :random {:key-id "z"}) + (keys/keychain-add-symmetric-key :random {:key-id "a"}) + (keys/keychain-add-symmetric-key :random {:key-id "a"}) ; Replace + (keys/keychain-add-symmetric-key :random {:key-id "y"}) + (keys/keychain-add-symmetric-key :random {:key-id "b"}))] + (is (= (ckids (keys/keychain-ckeys kc [:symmetric :key-sym])) ["b" "y" "a" "z"]) + "Key priority defaults to order of last-added, regardless of key-id")) + + (let [kc (-> + (keys/keychain {:empty? true}) + (keys/keychain-add-symmetric-key :random {:key-id "z", :priority 3}) + (keys/keychain-add-symmetric-key :random {:key-id "a", :priority 100}) + (keys/keychain-add-symmetric-key :random {:key-id "a", :priority 1}) ; Replace + (keys/keychain-add-symmetric-key :random {:key-id "y", :priority 2}) + (keys/keychain-add-symmetric-key :random {:key-id "b", :priority 0}))] + (is (= (ckids (keys/keychain-ckeys kc [:symmetric :key-sym])) ["z" "y" "a" "b"]) + "Key priority can be customized")) + + (let [kc (-> + (keys/keychain {:empty? true}) + (keys/keychain-add-symmetric-key :random {:key-id "first"}) + (keys/keychain-add-symmetric-key (as-ba (range 32)) {:key-id "first"}) ; Replace + (keys/keychain-add-symmetric-key :random))] + [(is (= (ckids (keys/keychain-ckeys kc [:symmetric :key-sym])) ["2" "first"])) + (is (ba= (-> (get @kc "first") :key-sym deref :key-sym) (as-ba (range 32))))]) + + (testing "Key priority by index path" + (let [kc (keys/keychain {:symmetric-keys [#_1 :random #_2 :random] + :asymmetric-keypairs [#_3 :rsa-1024 #_4 :rsa-2048 #_5 :ec-secp256r1 #_6 :dh-2048 #_7 :dh-2048]})] + + [(is (= (@#'keys/mkc-index @#'keys/reference-mkc) @#'keys/reference-midx)) + (is (= (kcc kc) {:n-sym 2, :n-prv 5, :n-pub 5})) + (is (= (ckids (keys/keychain-ckeys kc [:symmetric :key-sym])) ["2" "1"])) + (is (= (ckids (keys/keychain-ckeys kc [:asym-cipher :key-pub])) ["4" "3"])) + (is (= (ckids (keys/keychain-ckeys kc [:ka :key-prv])) ["7" "6" "5"])) + (is (= (ckids (keys/keychain-ckeys kc [:sig :key-prv])) ["5" "4" "3"])) + (is (= (ckids (keys/keychain-ckeys kc [:dh-2048 :key-prv])) ["7" "6"])) + (is (= (ckids (keys/keychain-ckeys kc [:dh-1024 :key-prv])) []))])) + + (testing "ChainKey extraction (based on key priority by index path)" + (let [kc (keys/keychain {:symmetric-keys [#_1 :random #_2 :random] + :asymmetric-keypairs [#_3 :rsa-1024 #_4 :rsa-2048 #_5 :ec-secp256r1 #_6 :dh-2048 #_7 :dh-2048]})] + + [(is (= (ckid (keys/get-ckeys-sym-cipher kc)) "2")) + (is (= (ckids (keys/get-ckeys-sym-cipher kc nil)) ["2" "1"])) + (is (->> (keys/get-ckeys-sym-cipher kc "nx") (throws? :ex-info {:key-id "nx"}))) + + (is (= (ckid (keys/get-ckeys-asym-cipher kc)) "4")) + (is (= (ckids (keys/get-ckeys-asym-cipher kc :rsa-2048 nil)) ["4"])) + (is (->> (keys/get-ckeys-asym-cipher kc :rsa-2048 "nx") (throws? :ex-info {:key-id "nx"}))) + (is (->> (keys/get-ckeys-asym-cipher kc :rsa-3072 nil) (throws? :ex-info {:key-algo :rsa-3072}))) + + (is (= (ckid (keys/get-ckeys-sig kc)) "5")) + (is (= (ckids (keys/get-ckeys-sig kc :rsa-1024 nil)) ["3"])) + (is (->> (keys/get-ckeys-sig kc :rsa-1024 "nx") (throws? :ex-info {:key-id "nx"}))) + (is (->> (keys/get-ckeys-sig kc :rsa-3072 nil) (throws? :ex-info {:key-algo :rsa-3072}))) + + (is (= (ckid-pair (keys/get-ckeys-ka kc kc)) ["7" "7"])) + (is (= (ckid-pairs (keys/get-ckeys-ka :dh-2048 [kc nil] [kc nil])) [["7" "7"] ["7" "6"] ["6" "7"] ["6" "6"]])) + (is (= (ckid-pairs (keys/get-ckeys-ka :ec-secp256r1 [kc nil] [kc nil])) [["5" "5"]])) + (is (->> (keys/get-ckeys-ka :dh-2048 [kc nil] [kc "nx"]) (throws? :ex-info {:key-id "nx"}))) + (is (->> (keys/get-ckeys-ka :ec-secp384r1 [kc nil] [kc nil]) (throws? :ex-info {:key-algos {:requested :ec-secp384r1}})))])) + + (let [kc1 (keys/keychain {:only? true, :symmetric-keys [#_1 :random #_2 :random #_3 :random #_4 :random]}) + kc2 (-> kc1 + (keys/keychain-update-priority "2" #(- (long %) 100)) + (keys/keychain-remove "4") + (keys/keychain-remove "4") + (keys/keychain-remove "nx") + (keys/keychain-update-priority "nx" inc))] + + [(is (= (ckids (keys/keychain-ckeys kc1 [:symmetric :key-sym])) ["4" "3" "2" "1"])) + (is (= (ckids (keys/keychain-ckeys kc2 [:symmetric :key-sym])) ["3" "1" "2"])) + (is (= (get @kc2 "4") {}) "Key removal keeps key-id entry") + + (is (= (enc/map-vals :priority @(do kc2)) {"1" 0, "2" -99, "3" 2, "4" nil})) + (is (= (enc/map-vals :priority @(keys/keychain-normalize-priorities kc2)) {"1" 1, "2" 0, "3" 2, "4" nil}))]) + + (let [kc1 (keys/keychain {:symmetric-keys [#_1 :random] + :asymmetric-keypairs [#_2 :rsa-1024 #_3 :dh-1024]}) + kc2 (keys/keychain + {:symmetric-keys [(get @kc1 "1")] + :asymmetric-keypairs [(get @kc1 "2") (get @kc1 "3")]}) + + kc3 (keys/keychain + {:symmetric-keys [(get @kc1 "1")] + :asymmetric-keypairs [(get @kc1 "2") (dissoc (get @kc1 "3") :key-prv)]})] + + [(is (= kc1 kc2) "KeyChain & ChainKey equality, can add/copy KeyChain entry maps") + (is (= (kcc kc1) {:n-sym 1, :n-prv 2, :n-pub 2})) + (is (= (kcc kc3) {:n-sym 1, :n-prv 1, :n-pub 2}))]) + + (testing "Serialization and encryption" + (let [kc (-> + (keys/keychain {:symmetric-keys [#_1 :random] + :asymmetric-keypairs [#_2 :rsa-1024 #_3 :dh-1024 #_4 :ec-secp256r1]}) + (keys/keychain-add-symmetric-key :random {:key-id "a"}) + (keys/keychain-add-asymmetric-keypair :ec-secp384r1 {:key-id "b"}) + (keys/keychain-add-asymmetric-keypair :dh-2048 {:key-id "c", :priority 100}) + (keys/keychain-add-asymmetric-keypair :dh-2048 {:key-id "d"}) + (keys/keychain-remove "c" {:keep-private? true}) + (keys/keychain-remove "d" {:keep-private? false})) + + ba-enc (keys/keychain-encrypt kc "pwd") + kc-dec (keys/keychain-decrypt ba-enc "pwd")] + + ;; More tests (incl. AAD, AKM, etc.) in later section for core API + + [(is (= (kcc kc) {:n-sym 2, :n-prv 5, :n-pub 4})) + (is (= (kcc kc-dec) {:n-sym 2, :n-prv 5, :n-pub 4})) + (is (= kc kc-dec)) + + (is (= (get @kc-dec "d") {}) "Keep key-ids for empty entries") + (is (= (set (keys (get @kc-dec "c"))) #{:key-prv :key-algo :priority})) + + (is (= (keys/keychain-decrypt ba-enc "!pwd") nil) "Bad pwd") + (is (= (kcc (:keychain (pd ba-enc))) {:n-pub 4}) "Public keychain in public data") + + (is (every? nil? (mapv #(or (:key-sym %) (:key-prv %)) (vals @(:keychain (pd ba-enc))))) + "No private data in public keychain")]))]) + +;;;; Core API + +(do + (def ba-cnt (as-ba "cnt")) + (def ba-!cnt (as-ba "!cnt")) + (def ba-aad (as-ba "aad")) + (def ba-akm (as-ba "akm")) + (def ba-!akm (as-ba "!akm"))) + +(defmacro is= [form expect & [msg]] + `(let [expect# ~expect + result# (try ~form (catch Throwable t# {:err t#}))] + (is + (if-let [err# (:err result#)] + (when-let [expect# (:err expect#)] + (boolean (enc/-matching-error :any expect# err#))) + (if (map? expect#) + (enc/submap? result# expect#) + (= result# expect#))) + ~msg))) + +(comment + [(is= (/ 1 0) {:err "Divide"}) + (is= {:a :A, :b :B} {:a :A}) + (is= true true) + (is= true false)]) + +(deftest _core-roundtrips + [(testing "Encryption with password" + (let [enc (fn [ba-cnt pwd opts] (tempel/encrypt-with-password ba-cnt pwd (merge {} opts))) + dec (fn [ba-enc pwd opts] (tempel/decrypt-with-password ba-enc pwd (merge {:return :_test} opts)))] + + [(is= (dec (enc ba-cnt "pwd" { }) "pwd" { }) {:cnt "cnt"} "-AKM, -AAD") + (is= (dec (enc ba-cnt "pwd" {:ba-akm ba-akm}) "pwd" {:ba-akm ba-akm }) {:cnt "cnt"} "+AKM, -AAD") + (is= (dec (enc ba-cnt "pwd" {:ba-aad ba-aad}) "pwd" { }) {:cnt "cnt", :aad "aad"} "-AKM, +AAD") + (is= (dec (enc ba-cnt "pwd" {:ba-aad ba-aad + :ba-akm ba-akm}) "pwd" {:ba-akm ba-akm }) {:cnt "cnt", :aad "aad"} "+AKM, +AAD") + + (is= (dec (enc ba-cnt "pwd" { }) "!pwd" { }) {:err "Tag mismatch"} "Bad pwd") + (is= (dec (enc ba-cnt "pwd" {:ba-akm ba-akm}) "pwd" {:ba-akm ba-!akm}) {:err "Tag mismatch"} "Bad AKM") + + (is= (pd (enc ba-cnt "pwd" { })) {:kind :encrypted-with-password } "Public data") + (is= (pd (enc ba-cnt "pwd" {:ba-aad ba-aad})) {:kind :encrypted-with-password, :aad "aad"} "Public data +AAD")])) + + (testing "Encryption with symmetric key" + (let [enc (fn [ba-cnt key-sym opts] (tempel/encrypt-with-symmetric-key ba-cnt key-sym (merge {} opts))) + dec (fn [ba-enc key-sym opts] (tempel/decrypt-with-symmetric-key ba-enc key-sym (merge {:return :_test} opts))) + kc1 (-> (keys/keychain) (keys/keychain-add-symmetric-key :random {:key-id "a"})) + kc2 (-> (keys/keychain) (keys/keychain-add-symmetric-key :random {:key-id "a"}))] + + [(is= (dec (enc ba-cnt kc1 { }) kc1 { }) {:cnt "cnt"} "-AKM, -AAD") + (is= (dec (enc ba-cnt kc1 {:ba-akm ba-akm}) kc1 {:ba-akm ba-akm }) {:cnt "cnt"} "+AKM, -AAD") + (is= (dec (enc ba-cnt kc1 {:ba-aad ba-aad}) kc1 { }) {:cnt "cnt", :aad "aad"} "-AKM, +AAD") + (is= (dec (enc ba-cnt kc1 {:ba-aad ba-aad + :ba-akm ba-akm}) kc1 {:ba-akm ba-akm }) {:cnt "cnt", :aad "aad"} "+AKM, +AAD") + + (is= (dec (enc ba-cnt kc1 { }) kc2 { }) {:err "Tag mismatch"} "Bad key") + (is= (dec (enc ba-cnt kc1 {:ba-akm ba-akm}) kc1 {:ba-akm ba-!akm}) {:err "Tag mismatch"} "Bad AKM") + + (is= (pd (enc ba-cnt kc1 { })) {:kind :encrypted-with-symmetric-key, :key-id "a" } "Public data") + (is= (pd (enc ba-cnt kc1 {:ba-aad ba-aad})) {:kind :encrypted-with-symmetric-key, :key-id "a", :aad "aad"} "Public data +AAD")])) + + (testing "Encryption with 1 keypair" + (doall + (for [cnt ["short" (apply str (repeat 128 "x"))]] + (let [enc (fn [ba-cnt key-pub opts] (tempel/encrypt-with-1-keypair (as-ba cnt) key-pub (merge {} opts))) + dec (fn [ba-enc key-prv opts] (tempel/decrypt-with-1-keypair ba-enc key-prv (merge {:return :_test} opts))) + kc1 (-> (keys/keychain) (keys/keychain-add-asymmetric-keypair :rsa-1024 {:key-id "a"})) + kc2 (-> (keys/keychain) (keys/keychain-add-asymmetric-keypair :rsa-1024 {:key-id "a"}))] + + [(is= (dec (enc ba-cnt kc1 { }) kc1 { }) {:cnt cnt} "-AKM, -AAD") + (is= (dec (enc ba-cnt kc1 {:ba-akm ba-akm}) kc1 {:ba-akm ba-akm }) {:cnt cnt} "+AKM, -AAD") + (is= (dec (enc ba-cnt kc1 {:ba-aad ba-aad}) kc1 { }) {:cnt cnt, :aad "aad"} "-AKM, +AAD") + (is= (dec (enc ba-cnt kc1 {:ba-aad ba-aad + :ba-akm ba-akm}) kc1 {:ba-akm ba-akm }) {:cnt cnt, :aad "aad"} "+AKM, +AAD") + + (is= (dec (enc ba-cnt kc1 { }) kc2 { }) {:err "Decryption error"} "Bad key") + (is= (dec (enc ba-cnt kc1 {:ba-akm ba-akm}) kc1 {:ba-akm ba-!akm}) {:err "Tag mismatch"} "Bad AKM") + + (is= (pd (enc ba-cnt kc1 { })) {:kind :encrypted-with-1-keypair, :key-algo :rsa-1024, :key-id "a" } "Public data") + (is= (pd (enc ba-cnt kc1 {:ba-aad ba-aad})) {:kind :encrypted-with-1-keypair, :key-algo :rsa-1024, :key-id "a", :aad "aad"} "Public data +AAD")])))) + + (testing "Encryption with 2 keypairs" + (let [enc (fn [ba-cnt key-pub key-prv opts] (tempel/encrypt-with-2-keypairs ba-cnt key-pub key-prv (merge {} opts))) + dec (fn [ba-enc key-prv key-pub opts] (tempel/decrypt-with-2-keypairs ba-enc key-prv key-pub (merge {:return :_test} opts))) + kc1 (-> (keys/keychain) (keys/keychain-add-asymmetric-keypair :dh-3072 {:key-id "r"})) + kc2 (-> (keys/keychain) (keys/keychain-add-asymmetric-keypair :dh-3072 {:key-id "s"})) + kc3 (-> (keys/keychain) (keys/keychain-add-asymmetric-keypair :dh-3072 {:key-id "s"}))] + + [(is= (dec (enc ba-cnt kc1 kc2 { }) kc1 kc2 { }) {:cnt "cnt"} "-AKM, -AAD") + (is= (dec (enc ba-cnt kc1 kc2 {:ba-akm ba-akm}) kc1 kc2 {:ba-akm ba-akm }) {:cnt "cnt"} "+AKM, -AAD") + (is= (dec (enc ba-cnt kc1 kc2 {:ba-aad ba-aad}) kc1 kc2 { }) {:cnt "cnt", :aad "aad"} "-AKM, +AAD") + (is= (dec (enc ba-cnt kc1 kc2 {:ba-aad ba-aad + :ba-akm ba-akm}) kc1 kc2 {:ba-akm ba-akm }) {:cnt "cnt", :aad "aad"} "+AKM, +AAD") + + (is= (dec (enc ba-cnt kc1 kc2 { }) kc1 kc3 { }) {:err "Tag mismatch"} "Bad key") + (is= (dec (enc ba-cnt kc1 kc2 {:ba-akm ba-akm}) kc1 kc2 {:ba-akm ba-!akm}) {:err "Tag mismatch"} "Bad AKM") + + (is= (pd (enc ba-cnt kc1 kc2 { })) {:kind :encrypted-with-2-keypairs, :key-algo :dh-3072, :receiver-key-id "r", :sender-key-id "s" } "Public data") + (is= (pd (enc ba-cnt kc1 kc2 {:ba-aad ba-aad})) {:kind :encrypted-with-2-keypairs, :key-algo :dh-3072, :receiver-key-id "r", :sender-key-id "s", :aad "aad"} "Public data +AAD")])) + + (testing "Encrypted keychains" + (let [enc (fn [kc pwd opts] (keys/keychain-encrypt kc pwd (merge {} opts))) + dec (fn [ba-enc pwd opts] (keys/keychain-decrypt ba-enc pwd (merge {:return :_test} opts))) + kc (keys/keychain {:symmetric-keys [:random :random] + :asymmetric-keypairs [:rsa-1024 :dh-1024 :ec-secp256r1]})] + + [(is= (dec (enc kc "pwd" { }) "pwd" { }) {:kc kc} "-AKM, -AAD") + (is= (dec (enc kc "pwd" {:ba-akm ba-akm}) "pwd" {:ba-akm ba-akm }) {:kc kc} "+AKM, -AAD") + (is= (dec (enc kc "pwd" {:ba-aad ba-aad}) "pwd" { }) {:kc kc, :aad "aad"} "-AKM, +AAD") + (is= (dec (enc kc "pwd" {:ba-aad ba-aad + :ba-akm ba-akm}) "pwd" {:ba-akm ba-akm }) {:kc kc, :aad "aad"} "+AKM, +AAD") + + (is= (dec (enc kc "pwd" { }) "!pwd" { }) nil "Bad pwd") + (is= (dec (enc kc "pwd" {:ba-akm ba-akm}) "pwd" {:ba-akm ba-!akm}) nil "Bad AKM") + + (is= (pd (enc kc "pwd" { })) {:kind :encrypted-keychain } "Public data") + (is= (pd (enc kc "pwd" {:ba-aad ba-aad})) {:kind :encrypted-keychain, :aad "aad"} "Public data +AAD") + + ;; Embedded (private user) content + (is= (dec (enc kc "pwd" {:ba-content (as-ba "cnt")}) "pwd" {}) {:kc kc, :cnt "cnt"} "Private content") + (let [pd1 (pd (enc kc "pwd" {:ba-content (as-ba "cnt")})) + pd2 (pd (enc kc "pwd" { }))] + (is (= pd1 pd2) "Private content not in public data"))])) + + (testing "Encrypted keychains with backup keys" + (let [kcb (keys/keychain {:only? true :asymmetric-keypairs [:rsa-1024]}) + enc (fn [kc pwd opts] (keys/keychain-encrypt kc pwd (merge {:backup-key-pub kcb} opts))) + dec (fn [ba-enc pwd opts] (keys/keychain-decrypt ba-enc pwd (merge {:backup-key-prv kcb :return :_test} opts))) + kc (keys/keychain {:symmetric-keys [:random :random] + :asymmetric-keypairs [:rsa-1024 :dh-1024 :ec-secp256r1]})] + + [(is= (dec (enc kc "pwd" { }) "!pwd" { }) {:kc kc} "-AKM, -AAD") + (is= (dec (enc kc "pwd" {:ba-akm ba-akm}) "!pwd" {:ba-akm ba-akm }) {:kc kc} "+AKM, -AAD") + (is= (dec (enc kc "pwd" {:ba-aad ba-aad}) "!pwd" { }) {:kc kc, :aad "aad"} "-AKM, +AAD") + (is= (dec (enc kc "pwd" {:ba-aad ba-aad + :ba-akm ba-akm}) "!pwd" {:ba-akm ba-akm }) {:kc kc, :aad "aad"} "+AKM, +AAD") + + (is= (dec (enc kc "pwd" { }) "!pwd" {:backup-key-prv (keys/keychain)}) {:err "wrong key?"} "Bad backup key") + (is= (dec (enc kc "pwd" {:ba-akm ba-akm}) "!pwd" {:ba-akm ba-!akm }) {:kc kc} "Backup bypasses AKM") + + (is= (dec (enc kc "pwd" {:backup-opts {:ba-akm ba-akm}}) "!pwd" {:backup-opts {:ba-akm ba-akm}}) {:kc kc} "Backup AKM") + (is= (dec (enc kc "pwd" {:backup-opts {:ba-akm ba-akm}}) "!pwd" {:backup-opts {:ba-akm ba-!akm}}) {:err "wrong key?"}) + + (is= (pd (enc kc "pwd" { })) {:kind :encrypted-keychain } "Public data") + (is= (pd (enc kc "pwd" {:ba-aad ba-aad})) {:kind :encrypted-keychain, :aad "aad"} "Public data +AAD") + + ;; Embedded (private user) content + (is= (dec (enc kc "pwd" {:ba-content (as-ba "cnt")}) "pwd" {}) {:kc kc, :cnt "cnt"} "Private content") + (let [pd1 (pd (enc kc "pwd" {:ba-content (as-ba "cnt")})) + pd2 (pd (enc kc "pwd" { }))] + (is (= pd1 pd2) "Private content not in public data"))])) + + (testing "Signing" + (let [sig (fn [ba-cnt key-prv opts] (tempel/sign ba-cnt key-prv (merge {} opts))) + ver (fn [ba-sig key-pub opts] (tempel/signed ba-sig key-pub (merge {:return :_test} opts))) + kc1 (-> (keys/keychain) (keys/keychain-add-asymmetric-keypair :rsa-3072 {:key-id "a"})) + kc2 (-> (keys/keychain) (keys/keychain-add-asymmetric-keypair :rsa-3072 {:key-id "a"}))] + + [(is= (ver (sig ba-cnt kc1 { }) kc1 { }) {} "-AKM, -AAD") + (is= (ver (sig ba-cnt kc1 {:ba-akm ba-akm}) kc1 {:ba-akm ba-akm }) {} "+AKM, -AAD") + (is= (ver (sig ba-cnt kc1 {:ba-aad ba-aad}) kc1 { }) {:aad "aad"} "-AKM, +AAD") + (is= (ver (sig ba-cnt kc1 {:ba-aad ba-aad + :ba-akm ba-akm}) kc1 {:ba-akm ba-akm }) {:aad "aad"} "+AKM, +AAD") + + (is= (ver (sig ba-cnt kc1 { }) kc2 { }) nil "Bad key") + (is= (ver (sig ba-cnt kc1 {:ba-akm ba-akm}) kc1 {:ba-akm ba-!akm}) nil "Bad AKM") + + (is= (pd (sig ba-cnt kc1 { })) {:kind :signed, :key-algo :rsa-3072, :key-id "a" } "Public data") + (is= (pd (sig ba-cnt kc1 {:ba-aad ba-aad})) {:kind :signed, :key-algo :rsa-3072, :key-id "a", :aad "aad"} "Public data +AAD") + + ;; Embedded (signed) content + (is= (ver (sig ba-cnt kc1 {:embed-content? true }) kc1 { }) {:cnt "cnt"} "Embedded content") + (is= (ver (sig ba-cnt kc1 {:embed-content? false}) kc1 {:ba-content ba-cnt }) {:cnt "cnt"} "Provided content") + (is= (pd (sig ba-cnt kc1 {:embed-content? true })) {:cnt "cnt"} "Embedded content in public data") + (is= (ver (sig ba-cnt kc1 {:embed-content? false}) kc1 {:ba-content ba-!cnt}) nil "Provided content bad") + (is= (ver (sig ba-cnt kc1 {:embed-content? false}) kc1 { }) {:err "Cannot check signatur"} "Provided content missing")]))]) + +(deftest _core-keychains + [(testing "Encryption with symmetric key, no embedded key ids" + (let [kc1-prv (keys/keychain {:only? true, :symmetric-keys [:random :random :random :random]}) + kc1-pub (:keychain (pd (keys/keychain-encrypt kc1-prv "pwd"))) + kc2-prv (keys/keychain-remove kc1-prv "1") + ck1-sym (get-in @kc1-prv ["1" :key-sym]) ; Manually select lowest-priority key + + ba-enc-named (tempel/encrypt-with-symmetric-key (as-ba "cnt") ck1-sym {:embed-key-ids? true}) + ba-enc-unnamed (tempel/encrypt-with-symmetric-key (as-ba "cnt") ck1-sym {:embed-key-ids? false})] + + [(is (= (kcc kc1-prv) {:n-sym 4})) + (is (= (kcc kc1-pub) {})) + (is (= (get (pd ba-enc-named) :key-id) "1")) + (is (= (get (pd ba-enc-unnamed) :key-id) nil)) + + (is= (tempel/decrypt-with-symmetric-key ba-enc-unnamed ck1-sym {:return :_test}) {:cnt "cnt"} "Try 1 -> succeed: exact key given") + (is= (tempel/decrypt-with-symmetric-key ba-enc-unnamed kc1-prv {:return :_test}) {:cnt "cnt"} "Try 4 -> succeed: must try all") + (is= (tempel/decrypt-with-symmetric-key ba-enc-unnamed kc1-pub {:return :_test}) {:err {:key-type :sym}} "Try 0 -> fail: no sym keys") + (is= (tempel/decrypt-with-symmetric-key ba-enc-unnamed kc2-prv {:return :_test}) {:err {:num-keys-tried 3}} "Try 3 -> fail: relevant key removed") + + (is= (tempel/decrypt-with-symmetric-key ba-enc-named ck1-sym {:return :_test}) {:cnt "cnt"} "Try 1 -> succeed: exact key given") + (is= (tempel/decrypt-with-symmetric-key ba-enc-named kc1-prv {:return :_test}) {:cnt "cnt"} "Try 1 -> succeed: exact key identified") + (is= (tempel/decrypt-with-symmetric-key ba-enc-named kc1-pub {:return :_test}) {:err {:key-id "1"}} "Try 0 -> fail: no sym keys") + (is= (tempel/decrypt-with-symmetric-key ba-enc-named kc2-prv {:return :_test}) {:err {:key-id "1"}} "Try 0 -> fail: exact key missing")])) + + (testing "Encryption with 1 keypair, no embedded key ids" + (let [kc1-prv (keys/keychain {:only? true, :asymmetric-keypairs [:rsa-1024 :rsa-1024 :rsa-1024 :rsa-1024]}) + kc1-pub (:keychain (pd (keys/keychain-encrypt kc1-prv "pwd"))) + kc2-prv (keys/keychain-remove kc1-prv "1" {:keep-private? false}) + + ck1-pub (get-in @kc1-pub ["1" :key-pub]) ; Manually select lowest-priority key + ck1-prv (get-in @kc1-prv ["1" :key-prv]) + + ba-enc-named (tempel/encrypt-with-1-keypair (as-ba "cnt") ck1-pub {:embed-key-ids? true}) + ba-enc-unnamed (tempel/encrypt-with-1-keypair (as-ba "cnt") ck1-pub {:embed-key-ids? false})] + + [(is (= (kcc kc1-prv) {:n-prv 4, :n-pub 4})) + (is (= (kcc kc1-pub) { :n-pub 4})) + (is (= (get (pd ba-enc-named) :key-id) "1")) + (is (= (get (pd ba-enc-unnamed) :key-id) nil)) + + (is= (tempel/decrypt-with-1-keypair ba-enc-unnamed ck1-prv {:return :_test}) {:cnt "cnt"} "Try 1 -> succeed: exact key given") + (is= (tempel/decrypt-with-1-keypair ba-enc-unnamed kc1-prv {:return :_test}) {:cnt "cnt"} "Try 4 -> succeed: must try all") + (is= (tempel/decrypt-with-1-keypair ba-enc-unnamed kc1-pub {:return :_test}) {:err {:key-type :prv}} "Try 0 -> fail: no private keys") + (is= (tempel/decrypt-with-1-keypair ba-enc-unnamed kc2-prv {:return :_test}) {:err {:num-keys-tried 3}} "Try 3 -> fail: relevant key removed") -(deftest _test (is (= 1 1))) + (is= (tempel/decrypt-with-1-keypair ba-enc-named ck1-prv {:return :_test}) {:cnt "cnt"} "Try 1 -> succeed: exact key given") + (is= (tempel/decrypt-with-1-keypair ba-enc-named kc1-prv {:return :_test}) {:cnt "cnt"} "Try 1 -> succeed: exact key identified") + (is= (tempel/decrypt-with-1-keypair ba-enc-named kc1-pub {:return :_test}) {:err {:key-id "1"}} "Try 0 -> fail: no private keys") + (is= (tempel/decrypt-with-1-keypair ba-enc-named kc2-prv {:return :_test}) {:err {:key-id "1"}} "Try 0 -> fail: exact key missing")]))])