mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-10-12 11:39:56 +00:00
Compare commits
14
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d49e3a303b | ||
|
|
cba1382356 | ||
|
|
b5e8a4b8cc | ||
|
|
3b760e8e7b | ||
|
|
f7ca2f956c | ||
|
|
3db4029bb9 | ||
|
|
8a80727fa5 | ||
|
|
d4b2e9e8fc | ||
|
|
a2f985dc68 | ||
|
|
58b47e2a86 | ||
|
|
c18e0297c4 | ||
|
|
6770e732b7 | ||
|
|
9f907a2740 | ||
|
|
26e70edfbf |
+155
-19
@@ -66,8 +66,19 @@ jobs:
|
||||
build:
|
||||
name: "ubuntu-${{ matrix.os }}-${{ matrix.arch }}, GHC: ${{ matrix.ghc }}"
|
||||
needs: maybe-release
|
||||
permissions:
|
||||
contents: write
|
||||
packages: write
|
||||
env:
|
||||
apps: "smp-server xftp-server ntf-server xftp"
|
||||
opt: ${{ github.event_name == 'pull_request' && 'O0' || 'O2' }}
|
||||
ghc_options: ${{ github.event_name == 'pull_request' && '--ghc-options=-O0' || '' }}
|
||||
release: ${{ startsWith(github.ref, 'refs/tags/v') }}
|
||||
postgres_dist: ${{ startsWith(github.ref, 'refs/tags/v') && 'dist-newstyle' || 'dist-postgres' }}
|
||||
branch: ${{ github.base_ref || github.ref_name }}
|
||||
cache_o0: ${{ github.event_name == 'push' && (github.ref == 'refs/heads/master' || github.ref == 'refs/heads/stable') }}
|
||||
image_cache: ghcr.io/simplex-chat/simplexmq-build-cache:${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}
|
||||
source_hashes: dist-newstyle/sources.sha256
|
||||
runs-on: ${{ matrix.runner }}
|
||||
services:
|
||||
postgres:
|
||||
@@ -146,6 +157,18 @@ jobs:
|
||||
sudo apt update
|
||||
sudo apt -y install postgresql-client-15
|
||||
|
||||
- name: Log in to GitHub Container Registry
|
||||
if: matrix.should_run == true && env.release != 'true'
|
||||
shell: bash
|
||||
env:
|
||||
GHCR_TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||
run: echo "$GHCR_TOKEN" | docker login ghcr.io -u "${{ github.actor }}" --password-stdin
|
||||
|
||||
- name: Compute image cache week
|
||||
id: week
|
||||
if: matrix.should_run == true && env.release != 'true'
|
||||
run: echo "week=$(date -u +%G-W%V)" >> "$GITHUB_OUTPUT"
|
||||
|
||||
- name: Build and cache Docker image
|
||||
if: matrix.should_run == true
|
||||
uses: simplex-chat/docker-build-push-action@v6
|
||||
@@ -157,20 +180,14 @@ jobs:
|
||||
build-args: |
|
||||
TAG=${{ matrix.os }}
|
||||
GHC=${{ matrix.ghc }}
|
||||
|
||||
- name: Cache dependencies
|
||||
if: matrix.should_run == true
|
||||
uses: actions/cache@v4
|
||||
with:
|
||||
path: |
|
||||
~/.cabal/store
|
||||
dist-newstyle
|
||||
key: ubuntu-${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
|
||||
cache-from: ${{ env.release != 'true' && format('type=registry,ref={0}-{1}', env.image_cache, steps.week.outputs.week) || '' }}
|
||||
cache-to: ${{ github.event_name == 'push' && github.ref == 'refs/heads/master' && format('type=registry,ref={0}-{1},mode=max,ignore-error=true', env.image_cache, steps.week.outputs.week) || '' }}
|
||||
|
||||
- name: Start container
|
||||
if: matrix.should_run == true
|
||||
shell: bash
|
||||
run: |
|
||||
mkdir -p ~/.cabal
|
||||
docker run -t -d \
|
||||
--device /dev/fuse \
|
||||
--cap-add SYS_ADMIN \
|
||||
@@ -181,21 +198,66 @@ jobs:
|
||||
-v ${{ github.workspace }}:/project \
|
||||
build/${{ matrix.os }}:latest
|
||||
|
||||
- name: Compute cache key prefixes
|
||||
id: keys
|
||||
if: matrix.should_run == true && env.release != 'true'
|
||||
run: |
|
||||
toolchain=$(docker exec builder dpkg-query -W -f '${db:Status-Status} ${binary:Package} ${Version}\n' 'binutils*' 'cpp*' 'gcc*' '*-dev' | grep '^installed ' | sha256sum | cut -c1-16)
|
||||
target=${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-$toolchain
|
||||
echo "deps=deps-$target" >> "$GITHUB_OUTPUT"
|
||||
echo "dist=dist-$target" >> "$GITHUB_OUTPUT"
|
||||
|
||||
- name: Restore dependencies from cache
|
||||
id: restore-deps
|
||||
if: matrix.should_run == true && env.release != 'true'
|
||||
uses: actions/cache/restore@v4
|
||||
with:
|
||||
path: ~/.cabal/store
|
||||
key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ github.sha }}
|
||||
restore-keys: |
|
||||
${{ steps.keys.outputs.deps }}-${{ env.branch }}-
|
||||
${{ steps.keys.outputs.deps }}-
|
||||
|
||||
- name: Warn if dependencies not in cache
|
||||
if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key == ''
|
||||
run: echo "::warning title=Cache miss::${{ steps.keys.outputs.deps }}-${{ env.branch }}"
|
||||
|
||||
- name: Restore build directories from cache
|
||||
id: restore-build
|
||||
if: matrix.should_run == true && env.release != 'true'
|
||||
uses: actions/cache/restore@v4
|
||||
with:
|
||||
path: |
|
||||
dist-newstyle
|
||||
dist-postgres
|
||||
key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }}
|
||||
restore-keys: |
|
||||
${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-
|
||||
${{ steps.keys.outputs.dist }}-${{ env.opt }}-
|
||||
|
||||
- name: Warn if build directories not in cache
|
||||
if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-matched-key == ''
|
||||
run: echo "::warning title=Cache miss::${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}"
|
||||
|
||||
- name: Set old timestamps on unchanged sources (GHC 8.10.7)
|
||||
if: matrix.ghc == '8.10.7' && steps.restore-build.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != ''
|
||||
run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }}
|
||||
|
||||
- name: Build smp-server, xftp-server (postgresql) and tests
|
||||
if: matrix.should_run == true
|
||||
shell: docker exec -t builder sh -eu {0}
|
||||
run: |
|
||||
chmod -fR 777 ~/.cabal ./dist-newstyle || :; git config --global --add safe.directory '*'
|
||||
cabal clean
|
||||
chmod -fR 777 ~/.cabal ./dist-newstyle ./dist-postgres || :; git config --global --add safe.directory '*'
|
||||
scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres
|
||||
cabal update
|
||||
cabal build --jobs=$(nproc) --enable-tests -fserver_postgres
|
||||
cabal build --builddir=${{ env.postgres_dist }} --jobs=$(nproc) --enable-tests -fserver_postgres ${{ env.ghc_options }}
|
||||
mkdir -p /out
|
||||
for i in smp-server xftp-server simplexmq-test; do
|
||||
bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
|
||||
for i in smp-server xftp-server ntf-server simplexmq-test; do
|
||||
bin=$(find /project/${{ env.postgres_dist }} -name "$i" -type f -executable)
|
||||
chmod +x "$bin"
|
||||
mv "$bin" /out/
|
||||
cp "$bin" /out/
|
||||
done
|
||||
strip /out/smp-server /out/xftp-server
|
||||
strip /out/smp-server /out/xftp-server /out/ntf-server
|
||||
|
||||
- name: Copy simplexmq-test from container
|
||||
if: matrix.should_run == true
|
||||
@@ -228,16 +290,17 @@ jobs:
|
||||
cat hashes.output >> "$GITHUB_OUTPUT"
|
||||
|
||||
- name: Build everything else (standard)
|
||||
id: build-standard
|
||||
if: matrix.should_run == true
|
||||
shell: docker exec -t builder sh -eu {0}
|
||||
run: |
|
||||
cabal build --jobs=$(nproc)
|
||||
cabal build --jobs=$(nproc) ${{ env.ghc_options }}
|
||||
mkdir -p /out
|
||||
for i in ${{ env.apps }}; do
|
||||
for i in smp-server xftp-server xftp; do
|
||||
bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
|
||||
strip "$bin"
|
||||
chmod +x "$bin"
|
||||
mv "$bin" /out/
|
||||
cp "$bin" /out/
|
||||
done
|
||||
|
||||
- name: Copy binaries from container and prepare them
|
||||
@@ -282,6 +345,33 @@ jobs:
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||
|
||||
- name: Record source hashes (GHC 8.10.7)
|
||||
if: matrix.should_run == true && matrix.ghc == '8.10.7'
|
||||
shell: docker exec -t builder sh -eu {0}
|
||||
run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }}
|
||||
|
||||
- name: Compute dependency cache key
|
||||
id: hash-deps
|
||||
if: matrix.should_run == true && env.release != 'true'
|
||||
shell: bash
|
||||
run: echo "hash=$(ls ~/.cabal/store/ghc-*/ | sha256sum | cut -c1-16)" >> "$GITHUB_OUTPUT"
|
||||
|
||||
- name: Save dependencies to cache
|
||||
if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key != format('{0}-{1}-{2}', steps.keys.outputs.deps, env.branch, steps.hash-deps.outputs.hash)
|
||||
uses: actions/cache/save@v4
|
||||
with:
|
||||
path: ~/.cabal/store
|
||||
key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ steps.hash-deps.outputs.hash }}
|
||||
|
||||
- name: Save build directories to cache
|
||||
if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-hit != 'true'
|
||||
uses: actions/cache/save@v4
|
||||
with:
|
||||
path: |
|
||||
dist-newstyle
|
||||
dist-postgres
|
||||
key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }}
|
||||
|
||||
- name: Test
|
||||
if: matrix.should_run == true && matrix.arch == 'x86-64'
|
||||
timeout-minutes: 120
|
||||
@@ -306,6 +396,52 @@ jobs:
|
||||
exit 1
|
||||
fi
|
||||
|
||||
- name: Remove -O2 build directories
|
||||
id: remove-o2
|
||||
if: env.cache_o0 == 'true' && !cancelled() && steps.build-standard.outcome == 'success'
|
||||
shell: docker exec -t builder sh -eu {0}
|
||||
run: rm -rf dist-newstyle dist-postgres
|
||||
|
||||
- name: Restore -O0 build directories from cache
|
||||
id: restore-build-o0
|
||||
if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }}
|
||||
uses: actions/cache/restore@v4
|
||||
with:
|
||||
path: |
|
||||
dist-newstyle
|
||||
dist-postgres
|
||||
key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }}
|
||||
restore-keys: |
|
||||
${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-
|
||||
${{ steps.keys.outputs.dist }}-O0-
|
||||
|
||||
- name: Set old timestamps on unchanged sources for -O0 build (GHC 8.10.7)
|
||||
if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.restore-build-o0.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != '' }}
|
||||
run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }}
|
||||
|
||||
- name: Build at -O0 for pull request caches
|
||||
id: build-o0
|
||||
if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }}
|
||||
shell: docker exec -t builder sh -eu {0}
|
||||
run: |
|
||||
scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres
|
||||
cabal build --builddir=dist-postgres --jobs=$(nproc) --enable-tests -fserver_postgres --ghc-options=-O0
|
||||
cabal build --jobs=$(nproc) --ghc-options=-O0
|
||||
|
||||
- name: Record source hashes for -O0 build (GHC 8.10.7)
|
||||
if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.build-o0.outcome == 'success' }}
|
||||
shell: docker exec -t builder sh -eu {0}
|
||||
run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }}
|
||||
|
||||
- name: Save -O0 build directories to cache
|
||||
if: ${{ !cancelled() && steps.build-o0.outcome == 'success' && steps.restore-build-o0.outputs.cache-hit != 'true' }}
|
||||
uses: actions/cache/save@v4
|
||||
with:
|
||||
path: |
|
||||
dist-newstyle
|
||||
dist-postgres
|
||||
key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }}
|
||||
|
||||
# =============================
|
||||
# Resolver test job
|
||||
# =============================
|
||||
|
||||
@@ -4,3 +4,6 @@
|
||||
[submodule "cbits/blst"]
|
||||
path = cbits/blst
|
||||
url = https://github.com/supranational/blst.git
|
||||
[submodule "cbits/libsecp256k1"]
|
||||
path = cbits/libsecp256k1
|
||||
url = https://github.com/bitcoin-core/secp256k1.git
|
||||
|
||||
Submodule
+1
Submodule cbits/libsecp256k1 added at 6e2c8bc4ec
@@ -0,0 +1,301 @@
|
||||
# Ethereum crypto primitives for simplexmq
|
||||
|
||||
Client-side crypto for SimpleX names: enough to derive an Ethereum key and its
|
||||
address from a recovery phrase. General-purpose: these modules contain nothing
|
||||
specific to names, registrars or relayers.
|
||||
|
||||
This is the first part of Workstream B of the SimpleX names v2 plan. The design
|
||||
it serves: names are owned by a plain EOA derived per name from one BIP-39 seed
|
||||
held by the device.
|
||||
|
||||
## What is deliberately absent
|
||||
|
||||
- **No EIP-7702 authorizations.** RLP is implemented only as far as EIP-1559
|
||||
transactions need it, for registering names; the `RSLV` resolver path in
|
||||
this repo stays strictly read-only.
|
||||
- **No stealth addresses and no EIP-712.** Signing covers recoverable ECDSA
|
||||
over a 32-byte digest and EIP-1559 transactions, which name registration
|
||||
requires. EIP-712 typed-data hashing and stealth addresses are added with
|
||||
the first code that uses them.
|
||||
- **No BIP-32 public derivation.** We always hold the seed, so CKDpub, xpub
|
||||
serialization and fingerprints are not implemented. Non-hardened *private*
|
||||
derivation is, because BIP-44 paths end in non-hardened components.
|
||||
- **English wordlist only, and no full NFKD.** Every English BIP-39 word is
|
||||
ASCII, so NFKD normalization, which BIP-39 mandates, does not change a valid
|
||||
phrase's words. NFKD maps Unicode space characters such as U+00A0 and U+3000
|
||||
to a space; `parsePhrase` splits on any character `Data.Char.isSpace`
|
||||
accepts and lower-cases with `Data.Text.toLower`, and a word that is then not
|
||||
in the ASCII wordlist, such as one in fullwidth letters, is rejected. So no
|
||||
normalization dependency is needed. A passphrase is bytes the caller
|
||||
normalizes.
|
||||
|
||||
## Modules
|
||||
|
||||
```
|
||||
Simplex.Messaging.Crypto.Secp256k1 FFI to libsecp256k1
|
||||
Simplex.Messaging.Crypto.BIP39 mnemonics
|
||||
Simplex.Messaging.Crypto.BIP39.English embedded upstream 2048-word list
|
||||
Simplex.Messaging.Crypto.BIP32 HD derivation, WalletMaster
|
||||
Simplex.Messaging.Crypto.BIP44 BIP-44 paths, AccountIndex
|
||||
Simplex.Messaging.Eth.Address addresses, EIP-55
|
||||
Simplex.Messaging.Eth.RLP Recursive Length Prefix encoding
|
||||
Simplex.Messaging.Eth.Transaction signed EIP-1559 transactions
|
||||
```
|
||||
|
||||
`keccak256` is added to `Simplex.Messaging.Crypto`, next to `sha3_256`.
|
||||
|
||||
## Types
|
||||
|
||||
```haskell
|
||||
newtype Secp256k1PrivateKey -- 32 bytes, validated in [1, n-1]
|
||||
newtype Secp256k1PublicKey -- libsecp256k1's opaque 64-byte form
|
||||
newtype Secp256k1Context -- randomised libsecp256k1 context, internal to simplexmq
|
||||
data PubKeyFormat = Compressed | Uncompressed
|
||||
|
||||
newtype WalletEntropy -- 16, 20, 24, 28 or 32 bytes
|
||||
data EntropyStrength = ES128 | ES160 | ES192 | ES224 | ES256
|
||||
|
||||
data ExtendedKey = ExtendedKey {xkKey :: Secp256k1PrivateKey, xkChainCode :: ScrubbedBytes}
|
||||
data WalletMaster -- entropy with the master key it derives
|
||||
|
||||
data CoinType = Ethereum -- SLIP-44 coin types
|
||||
newtype AccountIndex -- below 2^31
|
||||
|
||||
newtype Address -- 20 bytes; StrEncoding is EIP-55, JSON via it
|
||||
```
|
||||
|
||||
Private keys, chain codes, BIP-39 entropy and seeds are `ScrubbedBytes`:
|
||||
constant-time `Eq`, no readable `Show`, and zeroed when freed. A chain code is
|
||||
secret too: with the parent public key and one non-hardened child private key,
|
||||
it yields the parent private key.
|
||||
|
||||
## Functions
|
||||
|
||||
```haskell
|
||||
-- Secp256k1
|
||||
mkPrivateKey :: ScrubbedBytes -> Either String Secp256k1PrivateKey -- 32 bytes in [1, n-1]
|
||||
unPrivateKey :: Secp256k1PrivateKey -> ScrubbedBytes
|
||||
secp256k1PublicKey :: TVar ChaChaDRG -> Secp256k1PrivateKey -> IO Secp256k1PublicKey -- total: key is validated
|
||||
serializePublicKey :: PubKeyFormat -> Secp256k1PublicKey -> IO ByteString
|
||||
privateKeyTweakAdd :: Secp256k1PrivateKey -> ScrubbedBytes -> IO (Maybe Secp256k1PrivateKey)
|
||||
|
||||
-- BIP39
|
||||
mkEntropy :: ScrubbedBytes -> Either String WalletEntropy
|
||||
unEntropy :: WalletEntropy -> ScrubbedBytes
|
||||
randomEntropy :: EntropyStrength -> TVar ChaChaDRG -> STM WalletEntropy
|
||||
parsePhrase :: Text -> Either String WalletEntropy -- word count, wordlist, checksum
|
||||
entropyPhrase :: WalletEntropy -> ByteString -- canonical lowercase phrase
|
||||
entropySeed :: WalletEntropy -> ByteString -> ScrubbedBytes -- PBKDF2 with the passphrase
|
||||
|
||||
-- BIP32
|
||||
masterKey :: ScrubbedBytes -> Either String ExtendedKey
|
||||
derivePath :: TVar ChaChaDRG -> ExtendedKey -> [Word32] -> IO (Either String ExtendedKey)
|
||||
renderPath :: [Word32] -> ByteString
|
||||
hardened :: Word32 -> Word32
|
||||
isHardened :: Word32 -> Bool
|
||||
mkWalletMaster :: WalletEntropy -> Either String WalletMaster -- empty passphrase
|
||||
parseWalletMaster :: ScrubbedBytes -> ScrubbedBytes -> Either String WalletMaster -- entropy and stored master
|
||||
masterEntropy :: WalletMaster -> WalletEntropy
|
||||
walletMasterKey :: WalletMaster -> ExtendedKey
|
||||
masterBytes :: WalletMaster -> ScrubbedBytes -- key then chain code, the storage form
|
||||
|
||||
-- BIP44
|
||||
mkAccountIndex :: Word32 -> Either String AccountIndex
|
||||
unAccountIndex :: AccountIndex -> Word32
|
||||
bip44Path :: CoinType -> AccountIndex -> [Word32] -- m/44'/coin'/account'/0/0
|
||||
|
||||
-- Crypto
|
||||
keccak256 :: ByteString -> ByteString
|
||||
|
||||
-- Eth
|
||||
addressFromPublicKey :: Secp256k1PublicKey -> IO Address
|
||||
addressFromPrivateKey :: TVar ChaChaDRG -> Secp256k1PrivateKey -> IO Address
|
||||
deriveAddress :: TVar ChaChaDRG -> ExtendedKey -> [Word32] -> IO (Either String (ExtendedKey, Address))
|
||||
```
|
||||
|
||||
Internal to simplexmq, for sharing one context:
|
||||
|
||||
```haskell
|
||||
withContext :: TVar ChaChaDRG -> (Secp256k1Context -> IO a) -> IO a
|
||||
secp256k1PublicKey_ :: Secp256k1Context -> Secp256k1PrivateKey -> IO Secp256k1PublicKey
|
||||
derivePath_ :: Secp256k1Context -> ExtendedKey -> [Word32] -> IO (Either String ExtendedKey)
|
||||
```
|
||||
|
||||
`Address` has a `StrEncoding` instance: `strEncode` is the EIP-55 checksummed
|
||||
form and `strP` accepts bare or `0x`-prefixed hex, rejecting a bad mixed-case
|
||||
checksum.
|
||||
|
||||
Like `Simplex.Messaging.Crypto.randomBytes`, `randomEntropy` takes a
|
||||
`TVar ChaChaDRG` and runs in `STM`. Every exported function that computes a
|
||||
public key takes the same generator for the context blinding seed, so this code
|
||||
never reads system entropy itself.
|
||||
|
||||
A value of one of these types is valid by construction: `WalletEntropy` has one
|
||||
of the five sizes, `AccountIndex` is below 2^31, and `WalletMaster` holds a
|
||||
master key derived from its entropy, so every function from them is total. The
|
||||
fallible steps are the boundaries: `parsePhrase` for typed text,
|
||||
`parseWalletMaster` for a stored row and `mkAccountIndex` for a number.
|
||||
|
||||
BIP-32 declares a master or child key invalid when its IL is 0 or at least n,
|
||||
one case in 2^128, and says to use the next index. This code instead applies
|
||||
SLIP-0010's rule, which trezor-crypto also implements: recompute the HMAC over
|
||||
`I` for a master key, or over `0x01 || IR || ser32(i)` for a child. Every key
|
||||
BIP-32 produces is produced unchanged; only an index BIP-32 would skip gets a
|
||||
key. The recomputation is bounded to three attempts, after which `masterKey`,
|
||||
`mkWalletMaster`, `derivePath` and `deriveAddress` return
|
||||
`Left "derivation failed after 3 attempts"`, an error no input is expected to
|
||||
produce, which consumers report as an internal error rather than a wallet
|
||||
condition.
|
||||
|
||||
Because `parsePhrase` lower-cases each word, a recovery phrase with a
|
||||
capitalised word is accepted. This does not change the derived seed:
|
||||
`entropyPhrase` always rebuilds the canonical lowercase sentence from the
|
||||
wordlist, and that is what `entropySeed` hashes.
|
||||
|
||||
## How applications use it
|
||||
|
||||
An application defines the derivation path. For SimpleX names, one seed per
|
||||
device and one account per name, as in `Simplex.Chat.Wallet` in simplex-chat:
|
||||
|
||||
```haskell
|
||||
ent <- either fail pure $ parsePhrase phrase -- phrase :: Text
|
||||
master <- either fail pure $ mkWalletMaster ent
|
||||
n <- either fail pure $ mkAccountIndex account
|
||||
(xk, addr) <- either fail pure =<< deriveAddress g (walletMasterKey master) (bip44Path Ethereum n)
|
||||
```
|
||||
|
||||
## libsecp256k1 C API mapping
|
||||
|
||||
```c
|
||||
secp256k1_context_create(SECP256K1_CONTEXT_NONE) /* per withContext, then _randomize */
|
||||
secp256k1_context_destroy(ctx)
|
||||
secp256k1_ec_pubkey_create(ctx, pubkey, seckey)
|
||||
secp256k1_ec_pubkey_serialize(secp256k1_context_static, output, outputlen, pubkey, flags)
|
||||
secp256k1_ec_seckey_tweak_add(secp256k1_context_static, seckey, tweak)
|
||||
```
|
||||
|
||||
Context randomisation blinds only the multiplication of a secret scalar by the
|
||||
generator, which only `secp256k1_ec_pubkey_create` performs here. `withContext`
|
||||
creates a context, randomises it with 32 bytes from the caller's
|
||||
`TVar ChaChaDRG`, passes it to the action and destroys it after. Each exported
|
||||
function that computes a public key creates one context: `deriveAddress` uses
|
||||
it for the derivation and the address of its result. Functions that end in `_`
|
||||
take the context and are defined for sharing it inside simplexmq.
|
||||
`secp256k1_ec_pubkey_serialize` and `secp256k1_ec_seckey_tweak_add` run on
|
||||
`secp256k1_context_static`, so `serializePublicKey`, `addressFromPublicKey`
|
||||
and `privateKeyTweakAdd` take no generator. Every function that calls
|
||||
libsecp256k1 runs in `IO`; `unsafePerformIO` is used only to read
|
||||
`secp256k1_context_static` once. The functions that take a `Secp256k1Context`
|
||||
are therefore not evaluated after the context is destroyed; the context is not
|
||||
retained past `withContext`.
|
||||
|
||||
`Secp256k1PublicKey` is produced only by libsecp256k1 and has no encoding: its
|
||||
64-byte form is not portable between libsecp256k1 versions, and
|
||||
`serializePublicKey` returns the SEC1 bytes.
|
||||
|
||||
`secp256k1_ec_seckey_tweak_add` returns 0 exactly when BIP-32 declares the
|
||||
child invalid (tweak out of range, or a zero result), which is why
|
||||
`privateKeyTweakAdd` returns `Maybe`; `deriveChild` then recomputes as above.
|
||||
|
||||
libsecp256k1 never reads OS entropy: the caller supplies the context blinding
|
||||
seed. So unlike libbbs it causes no `getentropy` / ITMS-90338 issue on iOS, and
|
||||
requires no equivalent of the `commoncrypto` flag.
|
||||
|
||||
## Build
|
||||
|
||||
Submodule in `cbits/`, same pattern as blst and libbbs:
|
||||
`cbits/libsecp256k1`, https://github.com/bitcoin-core/secp256k1, pinned to
|
||||
**v0.8.0**.
|
||||
|
||||
```
|
||||
c-sources: cbits/libsecp256k1/src/{secp256k1,precomputed_ecmult,precomputed_ecmult_gen}.c
|
||||
```
|
||||
|
||||
No `include-dirs` are needed: every libsecp256k1 include is quoted and relative
|
||||
to the including file. The embedded wordlist makes `file-embed` a library
|
||||
dependency; before this change only the `smp-server` and `xftp-server`
|
||||
executables and the test suite used it. `wide-word` provides `Word128` and
|
||||
`Word256` for transaction fields, each as narrow as both geth and reth accept.
|
||||
|
||||
Built with one `-D` of our own, `ENABLE_MODULE_RECOVERY=1`, for recoverable
|
||||
signatures. The table-size settings (`ECMULT_WINDOW_SIZE`, `COMB_BLOCKS`,
|
||||
`COMB_TEETH`) have `#ifndef` defaults in the headers, and the checked-in
|
||||
precomputed tables are generated for those defaults; every other option, such
|
||||
as the other optional modules and x86-64 assembly, is off unless a `-D`
|
||||
enables it. `secp256k1.c` defines `SECP256K1_BUILD` itself.
|
||||
|
||||
32-bit targets (armv7a-android, i686 musl) are covered by libsecp256k1's own
|
||||
fallback: `src/util.h` selects `SECP256K1_WIDEMUL_INT64`, and with it the 10x26
|
||||
field and 8x32 scalar backends, when the target has neither a native 128-bit
|
||||
integer nor 64-bit pointers.
|
||||
|
||||
No `flake.nix` change is needed in simplex-chat: the per-platform overrides
|
||||
there only force `packages.simplexmq.components.library.libs` (external
|
||||
libraries, i.e. openssl for `extra-libraries: crypto`) and flags. Vendored
|
||||
`c-sources` require no nix entry, which is why blst and libbbs have none either.
|
||||
|
||||
### Cross-compilation status
|
||||
|
||||
Verified by building simplex-chat through its flake, before the wordlist in
|
||||
`Simplex.Messaging.Crypto.BIP39.English` was embedded with Template Haskell
|
||||
(`embedFile`), the construct the armv7a build fails on below. These builds have
|
||||
to be rerun:
|
||||
|
||||
| Target | Result |
|
||||
|---|---|
|
||||
| `x86_64-linux` (native, nix) | compiles and links |
|
||||
| `aarch64-android` | **compiles and links** into the final shared object |
|
||||
| `armv7a-android` | libsecp256k1 compiles; final link not reached (see below) |
|
||||
| `x86_64-windows` (mingw) | blocked before our code, see below |
|
||||
| `aarch64-darwin-ios` | not yet run (requires a darwin host) |
|
||||
|
||||
`aarch64-android` is the meaningful pass: it proves the C both cross-compiles
|
||||
and links into the shared object included in the app.
|
||||
|
||||
The `armv7a-android` build compiles libsecp256k1, which proves that its
|
||||
`SECP256K1_WIDEMUL_INT64` fallback builds under the NDK, but the build then
|
||||
fails in simplex-chat's own `Simplex.Chat.Operators`, on the
|
||||
`$(embedFile "PRIVACY.md")` splice. Cross-compiled Template Haskell runs the
|
||||
splice on the target via `iserv-proxy` under `qemu-arm`, and that interpreter
|
||||
fails to resolve `realpath` from `libHSdirectory` and segfaults. So 32-bit
|
||||
*linking* remains unproven.
|
||||
|
||||
`x86_64-windows` fails while bootstrapping the mingw cross-GHC, before any
|
||||
simplexmq code is compiled: haskell.nix applies
|
||||
`ghc-9.6-fix-code-symbol-jumps.patch` to `rts/linker/PEi386.c` twice from the
|
||||
same store path, and the second application aborts. That is a duplicate entry in
|
||||
the patch list of the pinned haskell.nix branch
|
||||
(`github:input-output-hk/haskell.nix/armv7a`), not something this change can
|
||||
influence.
|
||||
|
||||
Both gaps can be closed without GHC by compiling the three C files with the
|
||||
cross toolchain directly and linking a test program against them, which verifies
|
||||
the C code independently of the Haskell build.
|
||||
|
||||
## Tests
|
||||
|
||||
`tests/CoreTests/EthCryptoTests.hs`, 104 examples, with published vectors read
|
||||
from vendored upstream files in `tests/fixtures`, each pinned by a sha256 test:
|
||||
|
||||
- **BIP-39**: all 24 English vectors of `trezor/python-mnemonic/vectors.json`:
|
||||
entropy to phrase, phrase to entropy, seed with the `TREZOR` passphrase, and
|
||||
the master key against the vector's `xprv`.
|
||||
- **BIP-32**: vectors 1 to 4 of `bip-0032.mediawiki`, every chain, against its
|
||||
`xprv`; the two vector 5 keys outside `[1, n-1]` drive the `mkPrivateKey`
|
||||
rejections. The test decodes base58check itself; the library does not parse
|
||||
`xprv`, so vector 5's malformed serializations do not apply.
|
||||
- **EIP-55**: the eight addresses from the EIP-55 spec, round-tripped.
|
||||
- **BIP-44**: the well-known `0x9858EfFD232B4033E47d90003D41EC34EcaEda94` for
|
||||
the `abandon ... about` mnemonic at `m/44'/60'/0'/0/0`, plus accounts 1 and 2,
|
||||
all through `deriveAddress`, whose key is checked against `derivePath`.
|
||||
- Keccak-256 of the empty string and of `abc`.
|
||||
- Recovery phrases with capitalised words, extra whitespace, and non-breaking or
|
||||
ideographic spaces between words.
|
||||
- Negative cases: zero, short and out-of-range private keys, a tweak that makes
|
||||
the key zero or is not 32 bytes, bad BIP-39 checksums and word counts,
|
||||
out-of-range seeds, a stored master that does not match its entropy, account
|
||||
indexes at or above 2^31, and bad EIP-55 checksums.
|
||||
|
||||
The BIP-44 expectations were additionally reproduced by an independent
|
||||
pure-Python secp256k1 reference written for the purpose, so they were not
|
||||
computed only by this implementation.
|
||||
@@ -27,6 +27,9 @@ Recipient only. The sender is unchanged.
|
||||
- `OK`: `True`.
|
||||
- `MSG`: `False`; the message is written to `msgQ`.
|
||||
- Apps: `received_qend` is added to `RcvSwitchStatus`.
|
||||
- Migration `20261008_rcv_switch_status`, SQLite and Postgres:
|
||||
- up: index `idx_rcv_queues_switch_status` on `rcv_queues(switch_status)`.
|
||||
- down: `received_qend` is set to `NULL`, the index is dropped.
|
||||
|
||||
## Mechanics
|
||||
|
||||
@@ -56,3 +59,4 @@ Recipient only. The sender is unchanged.
|
||||
- the old queue is deleted after the `ACK` that returns `OK`.
|
||||
- The same with a recipient restart before the `ACK`.
|
||||
- Old server stopped: the old queue is deleted by the bound.
|
||||
- Downgrade: `received_qend` is cleared, other switch statuses are kept.
|
||||
|
||||
@@ -0,0 +1,52 @@
|
||||
# Delayed AUTH error responses
|
||||
|
||||
## Decisions
|
||||
|
||||
- Responses that include `ERR AUTH` are sent at the next multiple of the delay after the start time.
|
||||
- Delayed response sets:
|
||||
|
||||
| Source | Responses sent together | Start time |
|
||||
|---|---|---|
|
||||
| `receive`, failed verification | verification and parsing errors of one received block | block receipt |
|
||||
| `client`, command processing | responses and messages of one batch | batch read from `rcvQ` |
|
||||
| `RFWD`, forwarded command | the `RRES` of that command | start of forwarded command processing |
|
||||
|
||||
- A thread created by `forkClient` writes the responses to the send queue.
|
||||
- Delay 0: the responses are written to the send queue directly.
|
||||
- `authDelayExceeded`: incremented when processing took longer than the delay.
|
||||
- Prometheus counter `simplex_smp_auth_delay_exceeded`.
|
||||
- Not saved in the stats backup.
|
||||
- Not in the daily stats log.
|
||||
- Configuration:
|
||||
|
||||
| Item | Value |
|
||||
|---|---|
|
||||
| INI section | `TRANSPORT` |
|
||||
| INI key | `auth_error_delay_ms` |
|
||||
| default | 50 |
|
||||
| `ServerConfig` field | `authErrorDelay`, microseconds |
|
||||
| test servers | 20 ms |
|
||||
|
||||
- AUTH timing test: elapsed time of 5 requests, test servers' delay.
|
||||
- Out of scope: NTF and XFTP servers.
|
||||
|
||||
## Mechanics
|
||||
|
||||
- `Server.hs`:
|
||||
- `isAuthError`: response is `ERR AUTH`.
|
||||
- `sendResponses`: responses with `ERR AUTH` to `sendAfterDelay`, others to the send queue.
|
||||
- `sendAfterDelay`: writes responses to the send queue at the next multiple of the delay.
|
||||
- `receive`: block receipt time from the `rcvActiveAt` reading.
|
||||
- `client`: batch time.
|
||||
- `processForwardedCommand`: start time.
|
||||
- `Server/Env/STM.hs`: `authErrorDelay` field, `defaultAuthErrorDelayMs`.
|
||||
- `Server/Stats.hs`: `authDelayExceeded` in `ServerStats` and `ServerStatsData`.
|
||||
- `Server/Prometheus.hs`: `simplex_smp_auth_delay_exceeded`.
|
||||
- `Server/Main.hs`: INI value.
|
||||
- `Server/Main/Init.hs`: INI template line.
|
||||
- `simplexmq.cabal`: `timeit` removed from the test suite.
|
||||
- `tests/SMPClient.hs`: `authErrorDelay = 20000`.
|
||||
- `tests/ServerTests.hs`:
|
||||
- delayed AUTH for wrong key, absent queue, absent link and suspended queue; immediate `SOK`.
|
||||
- AUTH timing test measures elapsed time.
|
||||
- `tests/SMPProxyTests.hs`: delayed AUTH to forwarded `SEND` and `LGET`.
|
||||
Executable
+9
@@ -0,0 +1,9 @@
|
||||
#!/bin/sh
|
||||
set -eu
|
||||
|
||||
version=$(awk '/^version:/ {print $2}' simplexmq.cabal)
|
||||
for dir in "$@"; do
|
||||
if [ -d "$dir/build" ]; then
|
||||
find "$dir/build" -mindepth 3 -maxdepth 3 -type d -name 'simplexmq-*' ! -name "simplexmq-$version" -exec rm -rf {} +
|
||||
fi
|
||||
done
|
||||
Executable
+27
@@ -0,0 +1,27 @@
|
||||
#!/bin/sh
|
||||
set -eu
|
||||
|
||||
command=$1
|
||||
hashes=$2
|
||||
|
||||
sources() {
|
||||
git ls-files -z '*.hs' '*.hsc'
|
||||
}
|
||||
|
||||
case "$command" in
|
||||
record)
|
||||
sources | xargs -0 sha256sum > "$hashes"
|
||||
;;
|
||||
restore)
|
||||
sources | xargs -0 touch
|
||||
while read -r hash file; do
|
||||
if [ -f "$file" ] && [ "$(sha256sum "$file" | cut -d' ' -f1)" = "$hash" ]; then
|
||||
touch -d 2000-01-01 "$file"
|
||||
fi
|
||||
done < "$hashes"
|
||||
;;
|
||||
*)
|
||||
echo "usage: $0 record|restore <hashes file>" >&2
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
+25
-4
@@ -1,7 +1,7 @@
|
||||
cabal-version: 3.0
|
||||
|
||||
name: simplexmq
|
||||
version: 7.1.0.10
|
||||
version: 7.1.0.11
|
||||
synopsis: SimpleXMQ message broker
|
||||
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
|
||||
<./docs/Simplex-Messaging-Client.html client> and
|
||||
@@ -31,6 +31,11 @@ extra-source-files:
|
||||
cbits/blst/**/*.asm
|
||||
cbits/libbbs/**/*.c
|
||||
cbits/libbbs/**/*.h
|
||||
cbits/libsecp256k1/**/*.c
|
||||
cbits/libsecp256k1/**/*.h
|
||||
src/Simplex/Messaging/Crypto/BIP39/english.txt
|
||||
tests/fixtures/bip39-vectors.json
|
||||
tests/fixtures/bip-0032.mediawiki
|
||||
apps/common/Web/static/index.html
|
||||
apps/common/Web/static/link.html
|
||||
apps/common/Web/static/media/apk_icon.png
|
||||
@@ -135,7 +140,12 @@ library
|
||||
Simplex.Messaging.Crypto.Lazy
|
||||
Simplex.Messaging.Crypto.Ratchet
|
||||
Simplex.Messaging.Crypto.BBS
|
||||
Simplex.Messaging.Crypto.BIP32
|
||||
Simplex.Messaging.Crypto.BIP39
|
||||
Simplex.Messaging.Crypto.BIP39.English
|
||||
Simplex.Messaging.Crypto.BIP44
|
||||
Simplex.Messaging.Crypto.Entitlement
|
||||
Simplex.Messaging.Crypto.Secp256k1
|
||||
Simplex.Messaging.Crypto.SNTRUP761
|
||||
Simplex.Messaging.Crypto.SNTRUP761.Bindings
|
||||
Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
|
||||
@@ -144,6 +154,9 @@ library
|
||||
Simplex.Messaging.Crypto.ShortLink
|
||||
Simplex.Messaging.Encoding
|
||||
Simplex.Messaging.Encoding.String
|
||||
Simplex.Messaging.Eth.Address
|
||||
Simplex.Messaging.Eth.RLP
|
||||
Simplex.Messaging.Eth.Transaction
|
||||
Simplex.Messaging.Names.Record
|
||||
Simplex.Messaging.Notifications.Client
|
||||
Simplex.Messaging.Notifications.Protocol
|
||||
@@ -196,6 +209,7 @@ library
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status
|
||||
else
|
||||
exposed-modules:
|
||||
Simplex.Messaging.Agent.Store.SQLite
|
||||
@@ -253,6 +267,7 @@ library
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status
|
||||
Simplex.Messaging.Agent.Store.SQLite.Util
|
||||
if flag(client_postgres) || flag(server_postgres)
|
||||
exposed-modules:
|
||||
@@ -331,7 +346,8 @@ library
|
||||
cbits/blst/src
|
||||
cbits/libbbs/include
|
||||
cbits/libbbs/src
|
||||
cc-options: -D__BLST_PORTABLE__
|
||||
-- libsecp256k1's only -D flag enables its recovery module: every other setting has an #ifndef default that matches the checked-in tables
|
||||
cc-options: -D__BLST_PORTABLE__ -DENABLE_MODULE_RECOVERY=1
|
||||
if flag(commoncrypto)
|
||||
cc-options: -DBBS_CRYPTO_CC
|
||||
frameworks: Security
|
||||
@@ -345,6 +361,9 @@ library
|
||||
cbits/libbbs/src/compat-string.c
|
||||
cbits/libbbs/src/sha256.c
|
||||
cbits/libbbs/src/shake256.c
|
||||
cbits/libsecp256k1/src/secp256k1.c
|
||||
cbits/libsecp256k1/src/precomputed_ecmult.c
|
||||
cbits/libsecp256k1/src/precomputed_ecmult_gen.c
|
||||
asm-sources:
|
||||
cbits/blst/build/assembly.S
|
||||
extra-libraries:
|
||||
@@ -372,6 +391,7 @@ library
|
||||
, cryptostore ==0.3.*
|
||||
, data-default ==0.7.*
|
||||
, directory ==1.3.*
|
||||
, file-embed >=0.0.10 && <0.1
|
||||
, filepath ==1.4.*
|
||||
, hourglass ==0.2.*
|
||||
, http-types ==0.12.*
|
||||
@@ -395,6 +415,7 @@ library
|
||||
, transformers ==0.6.*
|
||||
, unliftio ==0.2.*
|
||||
, unliftio-core ==0.2.*
|
||||
, wide-word ==0.1.6.*
|
||||
, yaml ==0.11.*
|
||||
, zstd ==0.1.3.*
|
||||
default-language: Haskell2010
|
||||
@@ -549,6 +570,7 @@ test-suite simplexmq-test
|
||||
CoreTests.CryptoFileTests
|
||||
CoreTests.CryptoTests
|
||||
CoreTests.EncodingTests
|
||||
CoreTests.EthCryptoTests
|
||||
CoreTests.MsgStoreTests
|
||||
CoreTests.RetryIntervalTests
|
||||
CoreTests.SOCKSSettings
|
||||
@@ -600,7 +622,7 @@ test-suite simplexmq-test
|
||||
default-extensions:
|
||||
StrictData
|
||||
-- add -fhpc to ghc-options to run tests with coverage
|
||||
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
|
||||
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts "-with-rtsopts=-A64M -N1"
|
||||
build-depends:
|
||||
base
|
||||
, aeson
|
||||
@@ -638,7 +660,6 @@ test-suite simplexmq-test
|
||||
, stm
|
||||
, text
|
||||
, time
|
||||
, timeit ==2.0.*
|
||||
, tls >=1.9.0 && <1.10
|
||||
, transformers
|
||||
, unliftio
|
||||
|
||||
+120
-55
@@ -63,7 +63,10 @@ module Simplex.Messaging.Agent
|
||||
createConnection,
|
||||
prepareConnectionLink,
|
||||
createConnectionForLink,
|
||||
prepareInvitationLink,
|
||||
createInvitationForLink,
|
||||
setConnShortLink,
|
||||
prepareConnShortLink,
|
||||
deleteConnShortLink,
|
||||
getConnShortLink,
|
||||
resolveSimplexName,
|
||||
@@ -439,22 +442,39 @@ createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::: newCo
|
||||
-- Caller provides root signing key pair and link entity ID.
|
||||
-- Returns the created link and internal params.
|
||||
-- The link address is fully determined at this point.
|
||||
prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams)
|
||||
prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)))
|
||||
prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ =
|
||||
withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_
|
||||
{-# INLINE prepareConnectionLink #-}
|
||||
|
||||
-- | Create connection for prepared link (single network call).
|
||||
-- Validates that server response matches the prepared link.
|
||||
createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AE ConnId
|
||||
createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) -> UserConnLinkData 'CMContact -> SubscriptionMode -> AE ConnId
|
||||
createConnectionForLink c nm userId enableNtfs = withAgentEnv c .:: createConnectionForLink' c nm userId enableNtfs
|
||||
{-# INLINE createConnectionForLink #-}
|
||||
|
||||
-- | Prepare one-time invitation link (no network call).
|
||||
-- Returns the invitation and internal params with the link key.
|
||||
-- The link ID is assigned by the server when the connection is created.
|
||||
prepareInvitationLink :: AgentClient -> UserId -> CR.InitialKeys -> Maybe SMPServerWithAuth -> AE (ConnectionRequestUri 'CMInvitation, PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448))
|
||||
prepareInvitationLink c userId pqInitKeys srv_ = withAgentEnv c $ prepareInvitationLink' c userId pqInitKeys srv_
|
||||
{-# INLINE prepareInvitationLink #-}
|
||||
|
||||
-- | Create connection for prepared invitation link (single network call).
|
||||
-- Returns the created link with the link ID assigned by the server.
|
||||
createInvitationForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> ConnectionRequestUri 'CMInvitation -> PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448) -> UserConnLinkData 'CMInvitation -> SubscriptionMode -> AE (ConnId, CreatedConnLink 'CMInvitation)
|
||||
createInvitationForLink c nm userId enableNtfs = withAgentEnv c .:: createInvitationForLink' c nm userId enableNtfs
|
||||
{-# INLINE createInvitationForLink #-}
|
||||
|
||||
-- | Create or update user's contact connection short link
|
||||
setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> Maybe CR.InitialKeys -> AE (ConnShortLink c)
|
||||
setConnShortLink c = withAgentEnv c .:::. setConnShortLink' c
|
||||
{-# INLINE setConnShortLink #-}
|
||||
|
||||
prepareConnShortLink :: AgentClient -> ConnId -> Maybe CRClientData -> AE (ConnShortLink 'CMContact)
|
||||
prepareConnShortLink c = withAgentEnv c .: prepareConnShortLink' c
|
||||
{-# INLINE prepareConnShortLink #-}
|
||||
|
||||
deleteConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AE ()
|
||||
deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c
|
||||
{-# INLINE deleteConnShortLink #-}
|
||||
@@ -1035,30 +1055,20 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey
|
||||
|
||||
-- | Prepare connection link for contact mode (no network, no database).
|
||||
-- Caller provides root signing key pair and link entity ID.
|
||||
prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams)
|
||||
prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do
|
||||
g <- asks random
|
||||
plpSrvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
|
||||
when checkNotices $ checkClientNotices c plpSrvWithAuth
|
||||
AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
|
||||
plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
|
||||
plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
|
||||
prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)))
|
||||
prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do
|
||||
srvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
|
||||
when checkNotices $ checkClientNotices c srvWithAuth
|
||||
addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys pqInitKeys else pure Nothing
|
||||
let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
|
||||
qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact)
|
||||
connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) (fst <$> addrKeys_)
|
||||
(plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq (Just linkEntityId)
|
||||
ccLink = CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey
|
||||
params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys = pqInitKeys, plpAddressKeys = snd <$> addrKeys_}
|
||||
pure (ccLink, params)
|
||||
(connReq, params@PreparedLinkParams {plpLinkKey}) <-
|
||||
prepareLinkParams rootKey (Just linkEntityId) clientData pqInitKeys srvWithAuth QMContact (`CRContactUri` (fst <$> addrKeys_)) (snd <$> addrKeys_)
|
||||
pure (CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey, params)
|
||||
|
||||
-- | Create connection for prepared link (single network call).
|
||||
createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AM ConnId
|
||||
createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys, plpAddressKeys} userLinkData subMode = do
|
||||
createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) -> UserConnLinkData 'CMContact -> SubscriptionMode -> AM ConnId
|
||||
createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) params@PreparedLinkParams {plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpRatchetKeys} userLinkData subMode = do
|
||||
g <- asks random
|
||||
AgentConfig {smpAgentVRange} <- asks config
|
||||
connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption plpInitKeys)
|
||||
mapM_ (storeAddressRatchetKeys c connId) plpAddressKeys
|
||||
let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} addrKeys_ = connReq
|
||||
userLinkData' = case addrKeys_ of
|
||||
Just arKeys -> let UserContactLinkData ucd = userLinkData in UserContactLinkData ucd {ratchetKeys = Just arKeys}
|
||||
@@ -1066,13 +1076,54 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP
|
||||
md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData'
|
||||
linkData = (plpSignedFixedData, md)
|
||||
qd <- encryptContactLinkData g plpRootPrivKey plpLinkKey sndId linkData
|
||||
(_, qUri) <-
|
||||
createRcvQueue c nm userId connId plpSrvWithAuth enableNtfs subMode (Just plpNonce) qd plpQueueE2EKeys
|
||||
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
|
||||
(connId, _, qUri) <- createLinkQueue c nm userId enableNtfs SCMContact params subMode qd $ \connId -> mapM_ (storeAddressRatchetKeys c connId) plpRatchetKeys
|
||||
let SMPQueueUri _ SMPQueueAddress {senderId = actualSndId} = qUri
|
||||
unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch"
|
||||
pure connId
|
||||
|
||||
-- | Prepare one-time invitation link (no network, no database).
|
||||
prepareInvitationLink' :: AgentClient -> UserId -> CR.InitialKeys -> Maybe SMPServerWithAuth -> AM (ConnectionRequestUri 'CMInvitation, PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448))
|
||||
prepareInvitationLink' c userId pqInitKeys srv_ = do
|
||||
g <- asks random
|
||||
srvWithAuth <- maybe (getSMPServer c userId) pure srv_
|
||||
e2eVR <- asks $ e2eEncryptVRange . config
|
||||
rootKey <- atomically $ C.generateKeyPair g
|
||||
(pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption True pqInitKeys)
|
||||
prepareLinkParams rootKey Nothing Nothing pqInitKeys srvWithAuth QMMessaging (`CRInvitationUri` toVersionRangeT e2eRcvParams e2eVR) pks
|
||||
|
||||
-- | Create connection for prepared invitation link (single network call).
|
||||
createInvitationForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> ConnectionRequestUri 'CMInvitation -> PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448) -> UserConnLinkData 'CMInvitation -> SubscriptionMode -> AM (ConnId, CreatedConnLink 'CMInvitation)
|
||||
createInvitationForLink' c nm userId enableNtfs connReq params@PreparedLinkParams {plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpInitKeys, plpRatchetKeys} userLinkData subMode = do
|
||||
g <- asks random
|
||||
AgentConfig {smpAgentVRange} <- asks config
|
||||
let CRInvitationUri ConnReqUriData {crSmpQueues = qUri@(SMPQueueUri _ SMPQueueAddress {senderId = sndId}) :| _} _ = connReq
|
||||
md = SL.encodeSignUserData SCMInvitation plpRootPrivKey smpAgentVRange userLinkData
|
||||
srvData <- liftError id $ SL.encryptLinkData g (SL.invShortLinkKdf plpLinkKey) (plpSignedFixedData, md)
|
||||
let qd = CQRMessaging $ Just CQRData {linkKey = plpLinkKey, privSigKey = plpRootPrivKey, srvReq = (sndId, srvData)}
|
||||
(connId, rq, qUri') <- createLinkQueue c nm userId enableNtfs SCMInvitation params subMode qd $ \connId -> withStore' c $ \db -> createRatchetX3dhKeys db connId plpRatchetKeys
|
||||
(connId,) <$> connReqWithShortLink plpInitKeys qUri connReq qUri' rq
|
||||
|
||||
-- | Generate queue keys and sign fixed link data (no network, no database).
|
||||
prepareLinkParams :: ConnectionModeI c => C.KeyPairEd25519 -> Maybe ByteString -> Maybe CRClientData -> CR.InitialKeys -> SMPServerWithAuth -> QueueMode -> (ConnReqUriData -> ConnectionRequestUri c) -> k -> AM (ConnectionRequestUri c, PreparedLinkParams k)
|
||||
prepareLinkParams rootKey@(_, plpRootPrivKey) linkEntityId clientData plpInitKeys plpSrvWithAuth@(ProtoServerWithAuth srv _) qm mkConnReq plpRatchetKeys = do
|
||||
g <- asks random
|
||||
AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
|
||||
plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
|
||||
plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
|
||||
let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
|
||||
qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just qm)
|
||||
connReq = mkConnReq $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
|
||||
(plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq linkEntityId
|
||||
pure (connReq, PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys, plpRatchetKeys})
|
||||
|
||||
-- | Create connection and its queue with link data; the connection is deleted when either step fails.
|
||||
createLinkQueue :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> SConnectionMode c -> PreparedLinkParams k -> SubscriptionMode -> ClntQueueReqData -> (ConnId -> AM ()) -> AM (ConnId, RcvQueue, SMPQueueUri)
|
||||
createLinkQueue c nm userId enableNtfs cMode PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpSrvWithAuth, plpInitKeys} subMode qd storeKeys = do
|
||||
connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption plpInitKeys)
|
||||
uncurry (connId,,)
|
||||
<$> (storeKeys connId >> createRcvQueue c nm userId connId plpSrvWithAuth enableNtfs subMode (Just plpNonce) qd plpQueueE2EKeys)
|
||||
`catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
|
||||
|
||||
generateAddressRatchetKeys :: CR.InitialKeys -> AM (AddressRatchetKeys, (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448))
|
||||
generateAddressRatchetKeys pqInitKeys = do
|
||||
g <- asks random
|
||||
@@ -1197,7 +1248,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ =
|
||||
prepareContactLinkData ConnData {} rq@RcvQueue {shortLink} (UserContactLinkData ucd) = do
|
||||
liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink ucd
|
||||
g <- asks random
|
||||
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
|
||||
AgentConfig {smpAgentVRange} <- asks config
|
||||
-- rotate makes fresh keys from InitialKeys; otherwise keep current keys or create based on InitialKeys if there are no ratchet keys
|
||||
let currKeys = currentAddressRatchetKeys c connId
|
||||
ratchetKeys <- case pqKeys_ of
|
||||
@@ -1207,32 +1258,47 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ =
|
||||
Nothing -> currKeys
|
||||
let ud = UserContactLinkData ucd {ratchetKeys}
|
||||
cslContact = CSLContact SLSServer CCTContact (qServer rq)
|
||||
case shortLink of
|
||||
Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
|
||||
(ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}, k) <- case shortLink of
|
||||
Just creds@ShortLinkCreds {shortLinkId, shortLinkKey} -> do
|
||||
let (linkId, k) = SL.contactShortLinkKdf shortLinkKey
|
||||
unless (shortLinkId == linkId) $ throwE $ INTERNAL "setConnShortLink: link ID is not derived from link"
|
||||
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud
|
||||
pure (rq, linkId, cslContact shortLinkKey, (linkEncFixedData, d))
|
||||
Nothing -> do
|
||||
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
|
||||
let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
|
||||
connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) ratchetKeys
|
||||
(linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud
|
||||
(linkId, k) = SL.contactShortLinkKdf linkKey
|
||||
srvData <- liftError id $ SL.encryptLinkData g k linkData
|
||||
let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData)
|
||||
withStore' c $ \db -> updateShortLinkCreds db rq slCreds
|
||||
pure (rq, linkId, cslContact linkKey, srvData)
|
||||
prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
|
||||
prepareInvLinkData rq@RcvQueue {shortLink} ud = case shortLink of
|
||||
Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
|
||||
g <- asks random
|
||||
AgentConfig {smpAgentVRange} <- asks config
|
||||
let k = SL.invShortLinkKdf shortLinkKey
|
||||
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange ud
|
||||
let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey
|
||||
pure (rq, shortLinkId, sl, (linkEncFixedData, d))
|
||||
Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation"
|
||||
pure (creds, k)
|
||||
Nothing -> newContactLinkCreds c rq clientData
|
||||
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud
|
||||
pure (rq, shortLinkId, cslContact shortLinkKey, (linkEncFixedData, d))
|
||||
|
||||
newContactLinkCreds :: AgentClient -> RcvQueue -> Maybe CRClientData -> AM (ShortLinkCreds, C.SbKey)
|
||||
newContactLinkCreds c rq clientData = do
|
||||
g <- asks random
|
||||
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
|
||||
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
|
||||
let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
|
||||
connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) Nothing
|
||||
(linkKey, fixedData) = SL.encodeSignFixedData sigKeys smpAgentVRange connReq Nothing
|
||||
(linkId, k) = SL.contactShortLinkKdf linkKey
|
||||
encFixedData <- liftError id $ SL.encryptFixedData g k fixedData
|
||||
let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing encFixedData
|
||||
withStore' c $ \db -> updateShortLinkCreds db rq slCreds
|
||||
pure (slCreds, k)
|
||||
|
||||
prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
|
||||
prepareInvLinkData rq@RcvQueue {shortLink} ud = case shortLink of
|
||||
Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
|
||||
g <- asks random
|
||||
AgentConfig {smpAgentVRange} <- asks config
|
||||
let k = SL.invShortLinkKdf shortLinkKey
|
||||
d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange ud
|
||||
let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey
|
||||
pure (rq, shortLinkId, sl, (linkEncFixedData, d))
|
||||
Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation"
|
||||
|
||||
prepareConnShortLink' :: AgentClient -> ConnId -> Maybe CRClientData -> AM (ConnShortLink 'CMContact)
|
||||
prepareConnShortLink' c connId clientData =
|
||||
withConnLock c connId "prepareConnShortLink" $
|
||||
withStore c (`getConn` connId) >>= \case
|
||||
SomeConn _ (ContactConnection _ rq@RcvQueue {shortLink}) ->
|
||||
CSLContact SLSServer CCTContact (qServer rq) . shortLinkKey <$> maybe (fst <$> newContactLinkCreds c rq clientData) pure shortLink
|
||||
_ -> throwE $ CMD PROHIBITED "prepareConnShortLink: not contact address"
|
||||
|
||||
deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM ()
|
||||
deleteConnShortLink' c nm connId cMode =
|
||||
@@ -1443,11 +1509,11 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do
|
||||
pure (connId', CRBRatchet $ ratchetVerifyCodes ratchetState)
|
||||
|
||||
newConnToAcceptDR :: AgentClient -> UserId -> ConnId -> DRInvitation -> Bool -> AM ConnData
|
||||
newConnToAcceptDR c userId connId DRInvitation {agentVersion, pqSupport} enableNtfs = do
|
||||
newConnToAcceptDR c userId connId DRInvitation {ratchetState, agentVersion, pqSupport} enableNtfs = do
|
||||
g <- asks random
|
||||
let cData = ConnData {userId, connId, connAgentVersion = agentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport, serviceRequestExpiresAt = Nothing}
|
||||
connId' <- withStore c $ \db -> createNewConn db g cData SCMInvitation
|
||||
pure (cData {connId = connId'} :: ConnData)
|
||||
withStore c $ \db ->
|
||||
createNewConn db g cData SCMInvitation $>>= \connId' -> Right (cData {connId = connId'} :: ConnData) <$ createRatchet db connId' ratchetState
|
||||
|
||||
joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
|
||||
joinConn c nm userId connId enableNtfs cReq cInfo pqSupport subMode = do
|
||||
@@ -1505,9 +1571,8 @@ startJoinInvitationDR c userId ConnData {connId} DRInvitation {ratchetState, rep
|
||||
qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange
|
||||
(q, _) <- lift $ newSndQueue userId connId qInfo Nothing
|
||||
withStore c $ \db -> runExceptT $ do
|
||||
liftIO $ lockConnForUpdate db connId
|
||||
liftIO $ createRatchet db connId ratchetState
|
||||
ExceptT $ updateNewConnSnd db connId q
|
||||
sq <- ExceptT $ updateNewConnSnd db connId q
|
||||
sq <$ liftIO (createRatchet db connId ratchetState)
|
||||
|
||||
connRequestAgentVersion :: AgentClient -> ConnectionRequestUri c -> IO (Maybe VersionSMPA)
|
||||
connRequestAgentVersion c cReq = withAgentEnv' c $ case cReq of
|
||||
|
||||
@@ -246,7 +246,6 @@ import Simplex.Messaging.Crypto.Ratchet
|
||||
RcvE2ERatchetParams,
|
||||
RcvE2ERatchetParamsUri,
|
||||
SndE2ERatchetParams,
|
||||
RcvE2EPrivRatchetParams,
|
||||
pattern PQSupportOff,
|
||||
pattern PQSupportOn,
|
||||
)
|
||||
@@ -1627,7 +1626,7 @@ newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
|
||||
instance ToField LinkKey where toField (LinkKey s) = toField $ Binary s
|
||||
|
||||
-- | Parameters for creating a connection with a prepared link.
|
||||
data PreparedLinkParams = PreparedLinkParams
|
||||
data PreparedLinkParams k = PreparedLinkParams
|
||||
{ -- | Correlation ID / determines sender ID
|
||||
plpNonce :: C.CbNonce,
|
||||
-- | Queue E2EE DH key pair
|
||||
@@ -1642,8 +1641,8 @@ data PreparedLinkParams = PreparedLinkParams
|
||||
plpSrvWithAuth :: SMPServerWithAuth,
|
||||
-- | Initial PQ keys
|
||||
plpInitKeys :: InitialKeys,
|
||||
-- | Contact address double ratchet keys
|
||||
plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448)
|
||||
-- | Contact address double ratchet keys or invitation X3DH keys
|
||||
plpRatchetKeys :: k
|
||||
}
|
||||
|
||||
instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode
|
||||
|
||||
@@ -17,6 +17,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rp
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Text, Maybe Text)]
|
||||
@@ -33,7 +34,8 @@ schemaMigrations =
|
||||
("20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
|
||||
("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
|
||||
("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
|
||||
("20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes)
|
||||
("20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes),
|
||||
("20261008_rcv_switch_status", m20261008_rcv_switch_status, Just down_m20261008_rcv_switch_status)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
m20261008_rcv_switch_status :: Text
|
||||
m20261008_rcv_switch_status =
|
||||
[r|
|
||||
CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
|
||||
|]
|
||||
|
||||
down_m20261008_rcv_switch_status :: Text
|
||||
down_m20261008_rcv_switch_status =
|
||||
[r|
|
||||
UPDATE rcv_queues SET switch_status = NULL WHERE switch_status = 'received_qend';
|
||||
DROP INDEX idx_rcv_queues_switch_status;
|
||||
|]
|
||||
@@ -1233,6 +1233,10 @@ CREATE UNIQUE INDEX idx_rcv_queues_ntf ON smp_agent_test_protocol_schema.rcv_que
|
||||
|
||||
|
||||
|
||||
CREATE INDEX idx_rcv_queues_switch_status ON smp_agent_test_protocol_schema.rcv_queues USING btree (switch_status);
|
||||
|
||||
|
||||
|
||||
CREATE INDEX idx_rcv_queues_to_subscribe ON smp_agent_test_protocol_schema.rcv_queues USING btree (to_subscribe);
|
||||
|
||||
|
||||
|
||||
@@ -54,6 +54,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entit
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -107,7 +108,8 @@ schemaMigrations =
|
||||
("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
|
||||
("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
|
||||
("m20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes),
|
||||
("m20261005_commands_autoincrement", m20261005_commands_autoincrement, Just down_m20261005_commands_autoincrement)
|
||||
("m20261005_commands_autoincrement", m20261005_commands_autoincrement, Just down_m20261005_commands_autoincrement),
|
||||
("m20261008_rcv_switch_status", m20261008_rcv_switch_status, Just down_m20261008_rcv_switch_status)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,19 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20261008_rcv_switch_status :: Query
|
||||
m20261008_rcv_switch_status =
|
||||
[sql|
|
||||
CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
|
||||
|]
|
||||
|
||||
down_m20261008_rcv_switch_status :: Query
|
||||
down_m20261008_rcv_switch_status =
|
||||
[sql|
|
||||
UPDATE rcv_queues SET switch_status = NULL WHERE switch_status = 'received_qend';
|
||||
DROP INDEX idx_rcv_queues_switch_status;
|
||||
|]
|
||||
@@ -645,6 +645,7 @@ CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_h
|
||||
conn_id,
|
||||
processed_ratchet_key_hash_id
|
||||
);
|
||||
CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
|
||||
CREATE TRIGGER tr_rcv_queue_insert
|
||||
AFTER INSERT ON rcv_queues
|
||||
FOR EACH ROW
|
||||
|
||||
@@ -179,12 +179,14 @@ module Simplex.Messaging.Crypto
|
||||
|
||||
-- * pseudo-random bytes
|
||||
randomBytes,
|
||||
randomBytes',
|
||||
|
||||
-- * digests
|
||||
sha256Hash,
|
||||
sha512Hash,
|
||||
sha3_256,
|
||||
sha3_384,
|
||||
keccak256,
|
||||
md5Hash,
|
||||
|
||||
-- * Message padding / un-padding
|
||||
@@ -224,7 +226,7 @@ import Crypto.Cipher.AES (AES256)
|
||||
import qualified Crypto.Cipher.Types as AES
|
||||
import qualified Crypto.Cipher.XSalsa as XSalsa
|
||||
import qualified Crypto.Error as CE
|
||||
import Crypto.Hash (Digest, MD5, SHA3_256, SHA3_384, SHA256 (..), SHA512 (..), hash, hashDigestSize)
|
||||
import Crypto.Hash (Digest, Keccak_256, MD5, SHA3_256, SHA3_384, SHA256 (..), SHA512 (..), hash, hashDigestSize)
|
||||
import qualified Crypto.KDF.HKDF as H
|
||||
import qualified Crypto.MAC.Poly1305 as Poly1305
|
||||
import qualified Crypto.PubKey.Curve25519 as X25519
|
||||
@@ -239,7 +241,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.Bifunctor (bimap, first)
|
||||
import Data.Bits (xor)
|
||||
import Data.ByteArray (ByteArrayAccess)
|
||||
import Data.ByteArray (ByteArray, ByteArrayAccess)
|
||||
import qualified Data.ByteArray as BA
|
||||
import Data.ByteString.Base64 (decode)
|
||||
import qualified Data.ByteString.Base64.URL as U
|
||||
@@ -1049,6 +1051,11 @@ sha3_384 :: ByteString -> ByteString
|
||||
sha3_384 = BA.convert . (hash :: ByteString -> Digest SHA3_384)
|
||||
{-# INLINE sha3_384 #-}
|
||||
|
||||
-- | Keccak-256, the hash Ethereum uses. Not SHA3-256: they differ in the padding byte and produce entirely different digests.
|
||||
keccak256 :: ByteString -> ByteString
|
||||
keccak256 = BA.convert . (hash :: ByteString -> Digest Keccak_256)
|
||||
{-# INLINE keccak256 #-}
|
||||
|
||||
md5Hash :: ByteString -> ByteString
|
||||
md5Hash = BA.convert . (hash :: ByteString -> Digest MD5)
|
||||
|
||||
@@ -1434,7 +1441,12 @@ randomCbNonce :: TVar ChaChaDRG -> STM CbNonce
|
||||
randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
|
||||
|
||||
randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
|
||||
randomBytes n gVar = stateTVar gVar $ randomBytesGenerate n
|
||||
randomBytes = randomBytes'
|
||||
{-# INLINE randomBytes #-}
|
||||
|
||||
randomBytes' :: ByteArray a => Int -> TVar ChaChaDRG -> STM a
|
||||
randomBytes' n gVar = stateTVar gVar $ randomBytesGenerate n
|
||||
{-# INLINE randomBytes' #-}
|
||||
|
||||
reverseNonce :: CbNonceI n => n -> CbNonce
|
||||
reverseNonce = CryptoBoxNonce . B.reverse . unCbNonce
|
||||
|
||||
@@ -0,0 +1,101 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | BIP-32 HD derivation over secp256k1, private only: we hold the seed, so CKDpub, xpub and fingerprints are not implemented. An invalid master or child key is recomputed as SLIP-0010 specifies, up to two times.
|
||||
module Simplex.Messaging.Crypto.BIP32
|
||||
( ExtendedKey,
|
||||
xkKey,
|
||||
xkChainCode,
|
||||
masterKey,
|
||||
derivePath,
|
||||
derivePath_,
|
||||
renderPath,
|
||||
hardened,
|
||||
isHardened,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.STM (TVar)
|
||||
import Control.Monad (foldM)
|
||||
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
|
||||
import qualified Crypto.Hash as H
|
||||
import qualified Crypto.MAC.HMAC as HMAC
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Bits ((.|.))
|
||||
import Data.ByteArray (ScrubbedBytes)
|
||||
import qualified Data.ByteArray as BA
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.List (intercalate)
|
||||
import Data.Word (Word32)
|
||||
import qualified Simplex.Messaging.Crypto.Secp256k1 as S
|
||||
import Simplex.Messaging.Encoding (smpEncode)
|
||||
|
||||
data ExtendedKey = ExtendedKey
|
||||
{ xkKey :: S.Secp256k1PrivateKey,
|
||||
xkChainCode :: ScrubbedBytes
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
hardenedOffset :: Word32
|
||||
hardenedOffset = 0x80000000
|
||||
|
||||
hardened :: Word32 -> Word32
|
||||
hardened = (.|. hardenedOffset)
|
||||
|
||||
isHardened :: Word32 -> Bool
|
||||
isHardened i = i >= hardenedOffset
|
||||
|
||||
masterKey :: ScrubbedBytes -> Either String ExtendedKey
|
||||
masterKey seed
|
||||
| seedLen < 16 || seedLen > 64 = Left $ "seed: expected 16 to 64 bytes, got " <> show seedLen
|
||||
| otherwise = go attempts seed
|
||||
where
|
||||
seedLen = BA.length seed
|
||||
go :: Int -> ScrubbedBytes -> Either String ExtendedKey
|
||||
go 0 _ = Left derivationFailed
|
||||
go n s = case S.mkPrivateKey il of
|
||||
Right k -> Right ExtendedKey {xkKey = k, xkChainCode = ir}
|
||||
Left _ -> go (n - 1) i
|
||||
where
|
||||
i = hmacSHA512 "Bitcoin seed" s
|
||||
(il, ir) = BA.splitAt 32 i
|
||||
|
||||
deriveChild :: S.Secp256k1Context -> ExtendedKey -> Word32 -> IO (Either String ExtendedKey)
|
||||
deriveChild ctx ExtendedKey {xkKey, xkChainCode} i = do
|
||||
dat <-
|
||||
if isHardened i
|
||||
then pure $ BA.cons 0 (S.unPrivateKey xkKey)
|
||||
else BA.convert <$> (S.serializePublicKey S.Compressed =<< S.secp256k1PublicKey_ ctx xkKey)
|
||||
go attempts dat
|
||||
where
|
||||
go :: Int -> ScrubbedBytes -> IO (Either String ExtendedKey)
|
||||
go 0 _ = pure $ Left derivationFailed
|
||||
go n dat = do
|
||||
let (il, ir) = BA.splitAt 32 $ hmacSHA512 xkChainCode (dat <> BA.convert (smpEncode i))
|
||||
S.privateKeyTweakAdd xkKey il >>= \case
|
||||
Just k -> pure $ Right ExtendedKey {xkKey = k, xkChainCode = ir}
|
||||
Nothing -> go (n - 1) $ BA.cons 1 ir
|
||||
|
||||
derivePath :: TVar ChaChaDRG -> ExtendedKey -> [Word32] -> IO (Either String ExtendedKey)
|
||||
derivePath g xk path = S.withContext g $ \ctx -> derivePath_ ctx xk path
|
||||
|
||||
derivePath_ :: S.Secp256k1Context -> ExtendedKey -> [Word32] -> IO (Either String ExtendedKey)
|
||||
derivePath_ ctx xk = runExceptT . foldM (\k -> ExceptT . deriveChild ctx k) xk
|
||||
|
||||
attempts :: Int
|
||||
attempts = 3
|
||||
|
||||
derivationFailed :: String
|
||||
derivationFailed = "derivation failed after " <> show attempts <> " attempts"
|
||||
|
||||
renderPath :: [Word32] -> ByteString
|
||||
renderPath is = BC.pack $ intercalate "/" ("m" : map component is)
|
||||
where
|
||||
component i
|
||||
| isHardened i = show (i - hardenedOffset) <> "'"
|
||||
| otherwise = show i
|
||||
|
||||
hmacSHA512 :: ScrubbedBytes -> ScrubbedBytes -> ScrubbedBytes
|
||||
hmacSHA512 key msg = BA.convert (HMAC.hmac key msg :: HMAC.HMAC H.SHA512)
|
||||
@@ -0,0 +1,149 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | BIP-39 mnemonics, English only: every word is ASCII, any Unicode space character separates words, and full NFKD normalization is not applied; a passphrase is bytes the caller normalizes.
|
||||
module Simplex.Messaging.Crypto.BIP39
|
||||
( WalletEntropy,
|
||||
unEntropy,
|
||||
EntropyStrength (..),
|
||||
mkEntropy,
|
||||
randomEntropy,
|
||||
parsePhrase,
|
||||
entropyPhrase,
|
||||
entropySeed,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Crypto.Hash (Digest, SHA256, SHA512 (..), hash)
|
||||
import qualified Crypto.KDF.PBKDF2 as PBKDF2
|
||||
import Crypto.Number.Serialize (i2ospOf_, os2ip)
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import qualified Data.Attoparsec.Text as A
|
||||
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
|
||||
import Data.ByteArray (ScrubbedBytes)
|
||||
import qualified Data.ByteArray as BA
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.Char (isSpace)
|
||||
import Data.IntMap.Strict (IntMap)
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Data.List (foldl')
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.BIP39.English (englishWordList)
|
||||
|
||||
-- | 16, 20, 24, 28 or 32 bytes of entropy: a valid BIP-39 phrase in another encoding.
|
||||
newtype WalletEntropy = WalletEntropy ScrubbedBytes
|
||||
deriving (Eq, Show)
|
||||
|
||||
unEntropy :: WalletEntropy -> ScrubbedBytes
|
||||
unEntropy (WalletEntropy ent) = ent
|
||||
|
||||
data EntropyStrength = ES128 | ES160 | ES192 | ES224 | ES256
|
||||
deriving (Eq, Show, Bounded, Enum)
|
||||
|
||||
newtype Mnemonic = Mnemonic [Int]
|
||||
deriving (Eq)
|
||||
|
||||
strengthBytes :: EntropyStrength -> Int
|
||||
strengthBytes = \case
|
||||
ES128 -> 16
|
||||
ES160 -> 20
|
||||
ES192 -> 24
|
||||
ES224 -> 28
|
||||
ES256 -> 32
|
||||
|
||||
wordCount :: Int -> Int
|
||||
wordCount entBytes = (entBits + entBits `div` 32) `div` 11
|
||||
where
|
||||
entBits = entBytes * 8
|
||||
|
||||
seedSize :: Int
|
||||
seedSize = 64
|
||||
|
||||
validEntropySizes :: [Int]
|
||||
validEntropySizes = map strengthBytes [minBound .. maxBound]
|
||||
|
||||
validWordCounts :: [Int]
|
||||
validWordCounts = map wordCount validEntropySizes
|
||||
|
||||
wordByIndex :: IntMap ByteString
|
||||
wordByIndex = IM.fromList $ zip [0 ..] englishWordList
|
||||
|
||||
indexByWord :: Map ByteString Int
|
||||
indexByWord = M.fromList $ zip englishWordList [0 ..]
|
||||
|
||||
mkEntropy :: ScrubbedBytes -> Either String WalletEntropy
|
||||
mkEntropy ent
|
||||
| entLen `elem` validEntropySizes = Right $ WalletEntropy ent
|
||||
| otherwise = Left $ "entropy: expected 16, 20, 24, 28 or 32 bytes, got " <> show entLen
|
||||
where
|
||||
entLen = BA.length ent
|
||||
|
||||
instance ToField WalletEntropy where toField (WalletEntropy ent) = toField $ Binary (BA.convert ent :: ByteString)
|
||||
|
||||
instance FromField WalletEntropy where fromField = blobFieldDecoder $ mkEntropy . BA.convert
|
||||
|
||||
randomEntropy :: EntropyStrength -> TVar ChaChaDRG -> STM WalletEntropy
|
||||
randomEntropy s = fmap WalletEntropy . C.randomBytes' (strengthBytes s)
|
||||
|
||||
-- | The words joined by single spaces, the PBKDF2 password BIP-39 specifies.
|
||||
entropyPhrase :: WalletEntropy -> ByteString
|
||||
entropyPhrase = BC.unwords . mnemonicWords . entropyToMnemonic
|
||||
|
||||
-- | Indexes are in @[0, 2047]@: they are masked to 11 bits or looked up in the wordlist.
|
||||
mnemonicWords :: Mnemonic -> [ByteString]
|
||||
mnemonicWords (Mnemonic idxs) = map (wordByIndex IM.!) idxs
|
||||
|
||||
entropyToMnemonic :: WalletEntropy -> Mnemonic
|
||||
entropyToMnemonic (WalletEntropy ent) =
|
||||
Mnemonic [fromIntegral ((combined `shiftR` (11 * (n - 1 - i))) .&. 0x7FF) | i <- [0 .. n - 1]]
|
||||
where
|
||||
entBits = BA.length ent * 8
|
||||
csBits = entBits `div` 32
|
||||
-- csBits is at most 8 (256/32), so the first checksum byte always suffices.
|
||||
csByte = BA.index (hash ent :: Digest SHA256) 0
|
||||
combined = os2ip ent `shiftL` csBits .|. fromIntegral (csByte `shiftR` (8 - csBits))
|
||||
n = (entBits + csBits) `div` 11
|
||||
|
||||
mnemonicToEntropy :: Mnemonic -> WalletEntropy
|
||||
mnemonicToEntropy (Mnemonic idxs) = WalletEntropy $ i2ospOf_ (entBits `div` 8) (combined `shiftR` csBits)
|
||||
where
|
||||
totalBits = length idxs * 11
|
||||
entBits = totalBits * 32 `div` 33
|
||||
csBits = totalBits - entBits
|
||||
combined = foldl' (\acc i -> acc `shiftL` 11 .|. fromIntegral i) (0 :: Integer) idxs
|
||||
|
||||
parsePhrase :: Text -> Either String WalletEntropy
|
||||
parsePhrase = A.parseOnly (phraseP <* A.endOfInput)
|
||||
|
||||
phraseP :: A.Parser WalletEntropy
|
||||
phraseP = do
|
||||
ws <- A.skipSpace *> (wordP `A.sepBy'` A.takeWhile1 isSpace) <* A.skipSpace
|
||||
let n = length ws
|
||||
if n `notElem` validWordCounts
|
||||
then fail $ "mnemonic: expected 12, 15, 18, 21 or 24 words, got " <> show n
|
||||
else do
|
||||
m <- Mnemonic <$> traverse lookupWord ws
|
||||
let ent = mnemonicToEntropy m
|
||||
-- recomputing the checksum bits from the decoded entropy rejects wrong checksum bits
|
||||
if entropyToMnemonic ent == m
|
||||
then pure ent
|
||||
else fail "mnemonic: checksum mismatch"
|
||||
where
|
||||
wordP = T.toLower <$> A.takeWhile1 (not . isSpace)
|
||||
lookupWord w = maybe (fail "mnemonic: not in wordlist") pure $ M.lookup (encodeUtf8 w) indexByWord
|
||||
|
||||
entropySeed :: WalletEntropy -> ByteString -> ScrubbedBytes
|
||||
entropySeed ent passphrase =
|
||||
PBKDF2.generate
|
||||
(PBKDF2.prfHMAC SHA512)
|
||||
PBKDF2.Parameters {PBKDF2.iterCounts = 2048, PBKDF2.outputLength = seedSize}
|
||||
(entropyPhrase ent)
|
||||
("mnemonic" <> passphrase)
|
||||
@@ -0,0 +1,11 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
-- | The BIP-39 English wordlist, embedded verbatim from <https://github.com/bitcoin/bips/blob/master/bip-0039/english.txt>, pinned by a checksum test.
|
||||
module Simplex.Messaging.Crypto.BIP39.English (englishWordList) where
|
||||
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.FileEmbed (embedFile)
|
||||
|
||||
englishWordList :: [ByteString]
|
||||
englishWordList = BC.words $(embedFile "src/Simplex/Messaging/Crypto/BIP39/english.txt")
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,62 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
-- | BIP-44 paths, @m/44'/coin'/account'/0/0@: one account per key, at the hardened account level.
|
||||
module Simplex.Messaging.Crypto.BIP44
|
||||
( CoinType (..),
|
||||
AccountIndex,
|
||||
mkAccountIndex,
|
||||
unAccountIndex,
|
||||
bip44Path,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (FromJSON (..), ToJSON)
|
||||
import Data.Word (Word32)
|
||||
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
|
||||
import Simplex.Messaging.Crypto.BIP32 (hardened, isHardened)
|
||||
import Simplex.Messaging.Util ((<$?>))
|
||||
|
||||
#if defined(dbPostgres)
|
||||
import Database.PostgreSQL.Simple.FromField (ResultError (..), returnError)
|
||||
#else
|
||||
import Database.SQLite.Simple (ResultError (..))
|
||||
import Database.SQLite.Simple.FromField (returnError)
|
||||
#endif
|
||||
|
||||
-- | SLIP-44 coin types.
|
||||
data CoinType = Ethereum
|
||||
deriving (Eq, Show)
|
||||
|
||||
coinIndex :: CoinType -> Word32
|
||||
coinIndex = \case
|
||||
Ethereum -> 60
|
||||
|
||||
-- | Below 2^31, so it can be hardened without colliding with another index.
|
||||
newtype AccountIndex = AccountIndex Word32
|
||||
deriving (Eq, Ord, Show)
|
||||
deriving newtype (ToJSON, ToField)
|
||||
|
||||
unAccountIndex :: AccountIndex -> Word32
|
||||
unAccountIndex (AccountIndex i) = i
|
||||
|
||||
mkAccountIndex :: Word32 -> Either String AccountIndex
|
||||
mkAccountIndex i
|
||||
| isHardened i = Left "account index at or above 2^31"
|
||||
| otherwise = Right $ AccountIndex i
|
||||
|
||||
instance FromJSON AccountIndex where
|
||||
parseJSON v = mkAccountIndex <$?> parseJSON v
|
||||
|
||||
#if defined(dbPostgres)
|
||||
instance FromField AccountIndex where
|
||||
fromField f dat = fromField f dat >>= either (returnError ConversionFailed f) pure . mkAccountIndex
|
||||
#else
|
||||
instance FromField AccountIndex where
|
||||
fromField f = fromField f >>= either (returnError ConversionFailed f) pure . mkAccountIndex
|
||||
#endif
|
||||
|
||||
bip44Path :: CoinType -> AccountIndex -> [Word32]
|
||||
bip44Path coin (AccountIndex account) = [hardened 44, hardened (coinIndex coin), hardened account, 0, 0]
|
||||
@@ -0,0 +1,195 @@
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
-- | FFI bindings to libsecp256k1.
|
||||
module Simplex.Messaging.Crypto.Secp256k1
|
||||
( Secp256k1PrivateKey,
|
||||
Secp256k1PublicKey,
|
||||
Secp256k1Context,
|
||||
PubKeyFormat (..),
|
||||
RecoverableSignature (..),
|
||||
mkPrivateKey,
|
||||
unPrivateKey,
|
||||
withContext,
|
||||
secp256k1PublicKey,
|
||||
secp256k1PublicKey_,
|
||||
serializePublicKey,
|
||||
privateKeyTweakAdd,
|
||||
signRecoverable,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Control.Exception (bracket, throwIO)
|
||||
import Control.Monad (void, when)
|
||||
import Crypto.Number.Serialize (i2ospOf_)
|
||||
import qualified Crypto.PubKey.ECC.Types as ECT
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.ByteArray (ScrubbedBytes)
|
||||
import qualified Data.ByteArray as BA
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import Foreign hiding (void)
|
||||
import Foreign.C
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
-- Sizes
|
||||
|
||||
privateKeySize :: Int
|
||||
privateKeySize = 32
|
||||
|
||||
compressedSize :: Int
|
||||
compressedSize = 33
|
||||
|
||||
uncompressedSize :: Int
|
||||
uncompressedSize = 65
|
||||
|
||||
-- | Internal size of @secp256k1_pubkey@ (opaque, not a serialization).
|
||||
pubKeyInternalSize :: Int
|
||||
pubKeyInternalSize = 64
|
||||
|
||||
-- | Internal size of @secp256k1_ecdsa_recoverable_signature@.
|
||||
recSigInternalSize :: Int
|
||||
recSigInternalSize = 65
|
||||
|
||||
compactSigSize :: Int
|
||||
compactSigSize = 64
|
||||
|
||||
digestSize :: Int
|
||||
digestSize = 32
|
||||
|
||||
-- Types
|
||||
|
||||
newtype Secp256k1PrivateKey = Secp256k1PrivateKey ScrubbedBytes
|
||||
deriving (Eq)
|
||||
|
||||
-- | A public key in libsecp256k1's opaque 64-byte form; 'serializePublicKey' returns the SEC1 bytes.
|
||||
newtype Secp256k1PublicKey = Secp256k1PublicKey ByteString
|
||||
|
||||
newtype Secp256k1Context = Secp256k1Context (Ptr Ctx)
|
||||
|
||||
data PubKeyFormat = Compressed | Uncompressed
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | @r@ and @s@, 32 bytes big-endian each, and the recovery id, EIP-1559's @yParity@.
|
||||
data RecoverableSignature = RecoverableSignature
|
||||
{ rsR :: ByteString,
|
||||
rsS :: ByteString,
|
||||
rsRecId :: Word8
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- FFI
|
||||
|
||||
data Ctx
|
||||
|
||||
data PubKeyRaw
|
||||
|
||||
data RecSigRaw
|
||||
|
||||
foreign import ccall "secp256k1_context_create"
|
||||
c_context_create :: CUInt -> IO (Ptr Ctx)
|
||||
|
||||
foreign import ccall "secp256k1_context_destroy"
|
||||
c_context_destroy :: Ptr Ctx -> IO ()
|
||||
|
||||
foreign import ccall "secp256k1_context_randomize"
|
||||
c_context_randomize :: Ptr Ctx -> Ptr Word8 -> IO CInt
|
||||
|
||||
foreign import ccall "&secp256k1_context_static"
|
||||
c_context_static :: Ptr (Ptr Ctx)
|
||||
|
||||
foreign import ccall "secp256k1_ec_pubkey_create"
|
||||
c_ec_pubkey_create :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> IO CInt
|
||||
|
||||
foreign import ccall "secp256k1_ec_pubkey_serialize"
|
||||
c_ec_pubkey_serialize :: Ptr Ctx -> Ptr Word8 -> Ptr CSize -> Ptr PubKeyRaw -> CUInt -> IO CInt
|
||||
|
||||
foreign import ccall "secp256k1_ec_seckey_tweak_add"
|
||||
c_ec_seckey_tweak_add :: Ptr Ctx -> Ptr Word8 -> Ptr Word8 -> IO CInt
|
||||
|
||||
foreign import ccall "secp256k1_ecdsa_sign_recoverable"
|
||||
c_ecdsa_sign_recoverable :: Ptr Ctx -> Ptr RecSigRaw -> Ptr Word8 -> Ptr Word8 -> Ptr () -> Ptr () -> IO CInt
|
||||
|
||||
foreign import ccall "secp256k1_ecdsa_recoverable_signature_serialize_compact"
|
||||
c_ecdsa_recoverable_signature_serialize_compact :: Ptr Ctx -> Ptr Word8 -> Ptr CInt -> Ptr RecSigRaw -> IO CInt
|
||||
|
||||
-- SECP256K1_CONTEXT_NONE = SECP256K1_FLAGS_TYPE_CONTEXT
|
||||
contextNone :: CUInt
|
||||
contextNone = 1
|
||||
|
||||
staticContext :: Ptr Ctx
|
||||
staticContext = unsafePerformIO $ peek c_context_static
|
||||
{-# NOINLINE staticContext #-}
|
||||
|
||||
withContext :: TVar ChaChaDRG -> (Secp256k1Context -> IO a) -> IO a
|
||||
withContext g f = bracket (c_context_create contextNone) c_context_destroy $ \ctx -> do
|
||||
seed :: ScrubbedBytes <- atomically $ C.randomBytes' 32 g
|
||||
rc <- BA.withByteArray seed $ c_context_randomize ctx
|
||||
when (rc /= 1) $ throwIO (userError "secp256k1_context_randomize failed")
|
||||
f $ Secp256k1Context ctx
|
||||
|
||||
-- Public API
|
||||
|
||||
-- | Reject zero and anything at or above the group order, which is what makes 'secp256k1PublicKey' total.
|
||||
mkPrivateKey :: ScrubbedBytes -> Either String Secp256k1PrivateKey
|
||||
mkPrivateKey bs
|
||||
| BA.length bs /= privateKeySize = Left $ "private key: expected 32 bytes, got " <> show (BA.length bs)
|
||||
| BA.all (== 0) bs || bs >= groupOrder = Left "private key: not in [1, n-1]"
|
||||
| otherwise = Right $ Secp256k1PrivateKey bs
|
||||
|
||||
-- | Compared as bytes: both are 32 bytes big-endian, and 'ScrubbedBytes' compares lexicographically.
|
||||
groupOrder :: ScrubbedBytes
|
||||
groupOrder = i2ospOf_ privateKeySize $ ECT.ecc_n $ ECT.common_curve $ ECT.getCurveByName ECT.SEC_p256k1
|
||||
|
||||
unPrivateKey :: Secp256k1PrivateKey -> ScrubbedBytes
|
||||
unPrivateKey (Secp256k1PrivateKey bs) = bs
|
||||
|
||||
secp256k1PublicKey :: TVar ChaChaDRG -> Secp256k1PrivateKey -> IO Secp256k1PublicKey
|
||||
secp256k1PublicKey g k = withContext g (`secp256k1PublicKey_` k)
|
||||
|
||||
secp256k1PublicKey_ :: Secp256k1Context -> Secp256k1PrivateKey -> IO Secp256k1PublicKey
|
||||
secp256k1PublicKey_ (Secp256k1Context ctx) (Secp256k1PrivateKey sk) = do
|
||||
(rc, pk) <- BA.allocRet pubKeyInternalSize $ \pkPtr -> BA.withByteArray sk $ c_ec_pubkey_create ctx pkPtr
|
||||
when (rc /= 1) $ throwIO (userError "secp256k1_ec_pubkey_create failed on a validated key")
|
||||
pure $ Secp256k1PublicKey pk
|
||||
|
||||
serializePublicKey :: PubKeyFormat -> Secp256k1PublicKey -> IO ByteString
|
||||
serializePublicKey fmt (Secp256k1PublicKey pk) =
|
||||
BA.alloc outLen $ \outPtr ->
|
||||
with (fromIntegral outLen) $ \lenPtr ->
|
||||
BA.withByteArray pk $ \pkPtr ->
|
||||
void $ c_ec_pubkey_serialize staticContext outPtr lenPtr pkPtr flag
|
||||
where
|
||||
-- SECP256K1_EC_COMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION | SECP256K1_FLAGS_BIT_COMPRESSION, SECP256K1_EC_UNCOMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION
|
||||
(flag, outLen) = case fmt of
|
||||
Compressed -> (2 .|. 256, compressedSize)
|
||||
Uncompressed -> (2, uncompressedSize)
|
||||
|
||||
-- | @sk + tweak mod n@, as BIP-32 child derivation requires. 'Nothing' when the tweak is not 32 bytes or not below n, or when the result is zero.
|
||||
privateKeyTweakAdd :: Secp256k1PrivateKey -> ScrubbedBytes -> IO (Maybe Secp256k1PrivateKey)
|
||||
privateKeyTweakAdd (Secp256k1PrivateKey sk) tweak
|
||||
| BA.length tweak /= privateKeySize = pure Nothing
|
||||
| otherwise =
|
||||
BA.withByteArray tweak $ \twPtr -> do
|
||||
(rc, sk') <- BA.copyRet sk $ \skPtr -> c_ec_seckey_tweak_add staticContext skPtr twPtr
|
||||
pure $ if rc == 1 then Just (Secp256k1PrivateKey sk') else Nothing
|
||||
|
||||
-- | Signs a 32-byte digest, deterministically (RFC 6979) and always low-@s@, as EIP-2 requires.
|
||||
signRecoverable :: TVar ChaChaDRG -> Secp256k1PrivateKey -> ByteString -> IO (Either String RecoverableSignature)
|
||||
signRecoverable g (Secp256k1PrivateKey sk) digest
|
||||
| B.length digest /= digestSize = pure $ Left $ "digest: expected 32 bytes, got " <> show (B.length digest)
|
||||
| otherwise = withContext g $ \(Secp256k1Context ctx) ->
|
||||
allocaBytes recSigInternalSize $ \sigPtr -> do
|
||||
rc <- BA.withByteArray digest $ \msgPtr -> BA.withByteArray sk $ \skPtr -> c_ecdsa_sign_recoverable ctx sigPtr msgPtr skPtr nullPtr nullPtr
|
||||
if rc /= 1
|
||||
then pure $ Left "secp256k1_ecdsa_sign_recoverable failed on a validated key"
|
||||
else do
|
||||
(recId, compact) <- BA.allocRet compactSigSize $ \outPtr ->
|
||||
alloca $ \recIdPtr -> do
|
||||
void $ c_ecdsa_recoverable_signature_serialize_compact ctx outPtr recIdPtr sigPtr
|
||||
peek recIdPtr
|
||||
let (rsR, rsS) = B.splitAt (compactSigSize `div` 2) compact
|
||||
pure $ Right RecoverableSignature {rsR, rsS, rsRecId = fromIntegral recId}
|
||||
@@ -17,6 +17,7 @@ module Simplex.Messaging.Crypto.ShortLink
|
||||
encodeSignUserData,
|
||||
newOwnerAuth,
|
||||
encryptLinkData,
|
||||
encryptFixedData,
|
||||
encryptUserData,
|
||||
decryptLinkData,
|
||||
)
|
||||
@@ -84,9 +85,10 @@ newOwnerAuth g ownerId signingKey = do
|
||||
pure (ownerPrivKey, OwnerAuth {ownerId, ownerKey, authOwnerSig})
|
||||
|
||||
encryptLinkData :: TVar ChaChaDRG -> C.SbKey -> (ByteString, ByteString) -> ExceptT AgentErrorType IO QueueLinkData
|
||||
encryptLinkData g k = bimapM (encrypt fixedDataPaddedLength) (encrypt userDataPaddedLength)
|
||||
where
|
||||
encrypt len = encryptData g k len
|
||||
encryptLinkData g k = bimapM (encryptFixedData g k) (encryptUserData g k)
|
||||
|
||||
encryptFixedData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
|
||||
encryptFixedData g k s = encryptData g k fixedDataPaddedLength s
|
||||
|
||||
encryptUserData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
|
||||
encryptUserData g k s = encryptData g k userDataPaddedLength s
|
||||
|
||||
@@ -0,0 +1,78 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Simplex.Messaging.Eth.Address
|
||||
( Address,
|
||||
unAddress,
|
||||
addressFromPublicKey,
|
||||
addressFromPrivateKey,
|
||||
deriveAddress,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative (optional)
|
||||
import Control.Concurrent.STM (TVar)
|
||||
import Control.Monad (unless, when, (<=<))
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.Bits (shiftR, (.&.))
|
||||
import qualified Data.ByteArray.Encoding as BAE
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.Char (isHexDigit, isLower, isUpper, toUpper)
|
||||
import Data.Word (Word32)
|
||||
import Simplex.Messaging.Crypto (keccak256)
|
||||
import Simplex.Messaging.Crypto.BIP32 (ExtendedKey, derivePath_, xkKey)
|
||||
import qualified Simplex.Messaging.Crypto.Secp256k1 as S
|
||||
import Simplex.Messaging.Encoding.String
|
||||
|
||||
newtype Address = Address ByteString
|
||||
deriving (Eq, Show)
|
||||
deriving (ToJSON, FromJSON) via (StrJSON "Address" Address)
|
||||
|
||||
instance StrEncoding Address where
|
||||
strEncode = checksumAddress
|
||||
strP = do
|
||||
_ <- optional $ A.string "0x"
|
||||
body <- A.takeWhile isHexDigit
|
||||
unless (B.length body == addressSize * 2) $ fail $ "address: expected 40 hex digits, got " <> show (B.length body)
|
||||
a <- Address <$> either fail pure (BAE.convertFromBase BAE.Base16 body)
|
||||
when (mixedCase body && checksumAddress a /= "0x" <> body) $ fail "address: EIP-55 checksum mismatch"
|
||||
pure a
|
||||
where
|
||||
mixedCase s = BC.any isUpper s && BC.any isLower s
|
||||
|
||||
addressSize :: Int
|
||||
addressSize = 20
|
||||
|
||||
unAddress :: Address -> ByteString
|
||||
unAddress (Address bs) = bs
|
||||
|
||||
-- | The last 20 bytes of @keccak256@ of the uncompressed public key with its @0x04@ SEC1 prefix removed.
|
||||
addressFromPublicKey :: S.Secp256k1PublicKey -> IO Address
|
||||
addressFromPublicKey pk = Address . B.drop 12 . keccak256 . B.drop 1 <$> S.serializePublicKey S.Uncompressed pk
|
||||
|
||||
addressFromPrivateKey :: TVar ChaChaDRG -> S.Secp256k1PrivateKey -> IO Address
|
||||
addressFromPrivateKey g k = S.withContext g (`addressFromPrivateKey_` k)
|
||||
|
||||
addressFromPrivateKey_ :: S.Secp256k1Context -> S.Secp256k1PrivateKey -> IO Address
|
||||
addressFromPrivateKey_ ctx = addressFromPublicKey <=< S.secp256k1PublicKey_ ctx
|
||||
|
||||
deriveAddress :: TVar ChaChaDRG -> ExtendedKey -> [Word32] -> IO (Either String (ExtendedKey, Address))
|
||||
deriveAddress g xk path = S.withContext g $ \ctx ->
|
||||
derivePath_ ctx xk path >>= mapM (\k -> (k,) <$> addressFromPrivateKey_ ctx (xkKey k))
|
||||
|
||||
-- | EIP-55: @0x@ and 40 hex digits whose case encodes a checksum over the lowercase hex form.
|
||||
checksumAddress :: Address -> ByteString
|
||||
checksumAddress (Address bs) = "0x" <> BC.pack (zipWith adjust [0 ..] (BC.unpack lowerHex))
|
||||
where
|
||||
lowerHex = BAE.convertToBase BAE.Base16 bs
|
||||
hashed = keccak256 lowerHex
|
||||
adjust i c = if isLower c && nibbleAt i >= 8 then toUpper c else c
|
||||
nibbleAt i =
|
||||
let byte = B.index hashed (i `div` 2)
|
||||
in if even i then byte `shiftR` 4 else byte .&. 0x0F
|
||||
@@ -0,0 +1,34 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
-- | Recursive Length Prefix, the encoding of Ethereum transactions.
|
||||
module Simplex.Messaging.Eth.RLP
|
||||
( RLPItem (..),
|
||||
rlpEncode,
|
||||
scalarItem,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Word (Word32)
|
||||
import Simplex.Messaging.Encoding (smpEncode)
|
||||
|
||||
data RLPItem = RLPBytes ByteString | RLPList [RLPItem]
|
||||
|
||||
rlpEncode :: RLPItem -> ByteString
|
||||
rlpEncode = \case
|
||||
RLPBytes b
|
||||
| B.length b == 1 && B.head b < 0x80 -> b
|
||||
| otherwise -> lengthPrefixed 0x80 b
|
||||
RLPList items -> lengthPrefixed 0xc0 $ B.concat $ map rlpEncode items
|
||||
where
|
||||
lengthPrefixed offset payload
|
||||
| len < 56 = B.cons (offset + fromIntegral len) payload
|
||||
| otherwise = B.cons (offset + 55 + fromIntegral (B.length lenBytes)) lenBytes <> payload
|
||||
where
|
||||
len = B.length payload
|
||||
lenBytes = B.dropWhile (== 0) $ smpEncode (fromIntegral len :: Word32)
|
||||
|
||||
-- | Big-endian with no leading zeros, and zero as the empty string.
|
||||
scalarItem :: ByteString -> RLPItem
|
||||
scalarItem = RLPBytes . B.dropWhile (== 0)
|
||||
@@ -0,0 +1,58 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
|
||||
-- | EIP-1559 (type 2) transactions with an empty access list, signed for @eth_sendRawTransaction@.
|
||||
module Simplex.Messaging.Eth.Transaction
|
||||
( Eip1559Tx (..),
|
||||
signEip1559Tx,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.STM (TVar)
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Bits (shiftR)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.WideWord.Word128 (Word128 (..))
|
||||
import Data.WideWord.Word256 (Word256 (..))
|
||||
import Data.Word (Word32, Word64)
|
||||
import Simplex.Messaging.Crypto (keccak256)
|
||||
import Simplex.Messaging.Crypto.Secp256k1 (RecoverableSignature (..), Secp256k1PrivateKey, signRecoverable)
|
||||
import Simplex.Messaging.Encoding (smpEncode)
|
||||
import Simplex.Messaging.Eth.Address (Address, unAddress)
|
||||
import Simplex.Messaging.Eth.RLP
|
||||
import Simplex.Messaging.Util ((<$$>))
|
||||
|
||||
-- | Each width is the narrowest that both geth and reth accept.
|
||||
data Eip1559Tx = Eip1559Tx
|
||||
{ txChainId :: Word64,
|
||||
txNonce :: Word64,
|
||||
txMaxPriorityFeePerGas :: Word128,
|
||||
txMaxFeePerGas :: Word128,
|
||||
txGasLimit :: Word64,
|
||||
txTo :: Address,
|
||||
txValue :: Word256,
|
||||
txData :: ByteString
|
||||
}
|
||||
|
||||
-- | @0x02 || rlp([chainId, nonce, maxPriorityFeePerGas, maxFeePerGas, gasLimit, to, value, data, accessList, yParity, r, s])@, signing @keccak256@ of the same without the last three.
|
||||
signEip1559Tx :: TVar ChaChaDRG -> Secp256k1PrivateKey -> Eip1559Tx -> IO (Either String ByteString)
|
||||
signEip1559Tx g sk Eip1559Tx {txChainId, txNonce, txMaxPriorityFeePerGas, txMaxFeePerGas, txGasLimit, txTo, txValue, txData} =
|
||||
signed <$$> signRecoverable g sk (keccak256 $ typed fields)
|
||||
where
|
||||
signed RecoverableSignature {rsR, rsS, rsRecId} = typed $ fields <> [scalarItem (B.singleton rsRecId), scalarItem rsR, scalarItem rsS]
|
||||
fields =
|
||||
[ w64 txChainId,
|
||||
w64 txNonce,
|
||||
w128 txMaxPriorityFeePerGas,
|
||||
w128 txMaxFeePerGas,
|
||||
w64 txGasLimit,
|
||||
RLPBytes $ unAddress txTo,
|
||||
w256 txValue,
|
||||
RLPBytes txData,
|
||||
RLPList []
|
||||
]
|
||||
w64 = scalarItem . be64
|
||||
w128 (Word128 hi lo) = scalarItem $ be64 hi <> be64 lo
|
||||
w256 (Word256 a3 a2 a1 a0) = scalarItem $ be64 a3 <> be64 a2 <> be64 a1 <> be64 a0
|
||||
be64 n = smpEncode (fromIntegral (n `shiftR` 32) :: Word32) <> smpEncode (fromIntegral n :: Word32)
|
||||
typed items = B.cons 0x02 $ rlpEncode $ RLPList items
|
||||
@@ -1,5 +1,6 @@
|
||||
|
||||
|
||||
|
||||
SET statement_timeout = 0;
|
||||
SET lock_timeout = 0;
|
||||
SET idle_in_transaction_session_timeout = 0;
|
||||
@@ -312,3 +313,4 @@ ALTER TABLE ONLY ntf_server.subscriptions
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1145,14 +1145,16 @@ cancelSub s = case subThread s of
|
||||
type VerifiedTransmissionOrError s = Either (Transmission BrokerMsg) (VerifiedTransmission s)
|
||||
|
||||
receive :: forall c s. (Transport c, MsgStoreClass s) => THandleSMP c 'TServer -> s -> Client s -> M s ()
|
||||
receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, sndQ, rcvActiveAt} = do
|
||||
receive h@THandle {params = THandleParams {thAuth, sessionId}} ms c@Client {rcvQ, rcvActiveAt} = do
|
||||
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
|
||||
sa <- asks serverActive
|
||||
stats <- asks serverStats
|
||||
authDelay <- asks $ authErrorDelay . config
|
||||
liftIO $ forever $ do
|
||||
ts <- tGetServer h
|
||||
unlessM (readTVarIO sa) $ throwIO $ userError "server stopped"
|
||||
atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime
|
||||
receivedAt <- getSystemTime
|
||||
atomically $ writeTVar rcvActiveAt $! receivedAt
|
||||
let (es, ts') = partitionEithers $ L.toList ts
|
||||
errs = map (second ERR) es
|
||||
errs' <- case ts' of
|
||||
@@ -1168,7 +1170,7 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
|
||||
mapM_ (atomically . writeTBQueue rcvQ) $ L.nonEmpty cmds
|
||||
pure $ errs ++ errs'
|
||||
[] -> pure errs
|
||||
mapM_ (atomically . writeTBQueue sndQ . (,[])) $ L.nonEmpty errs'
|
||||
mapM_ (sendResponses c stats authDelay receivedAt . (,[])) $ L.nonEmpty errs'
|
||||
where
|
||||
sameParty :: SParty p -> SignedTransmission Cmd -> Bool
|
||||
sameParty p (_, _, (_, _, Cmd p' _)) = isJust $ testEquality p p'
|
||||
@@ -1191,6 +1193,27 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
|
||||
GET -> incStat $ msgGetAuth stats
|
||||
_ -> pure ()
|
||||
|
||||
isAuthError :: Transmission BrokerMsg -> Bool
|
||||
isAuthError (_, _, r) = case r of
|
||||
ERR AUTH -> True
|
||||
_ -> False
|
||||
|
||||
sendResponses :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO ()
|
||||
sendResponses c@Client {sndQ} stats authDelay since rs@(ts, _)
|
||||
| any isAuthError ts = sendAfterDelay c stats authDelay since rs
|
||||
| otherwise = atomically $ writeTBQueue sndQ rs
|
||||
|
||||
sendAfterDelay :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO ()
|
||||
sendAfterDelay c@Client {sndQ, clientTHParams = THandleParams {sessionId}} stats delay since rs
|
||||
| delay > 0 = do
|
||||
elapsed <- subtract (microseconds since) . microseconds <$> getSystemTime
|
||||
when (elapsed >= delay) $ incStat $ authDelayExceeded stats
|
||||
forkClient c (B.unpack $ "client $" <> encode sessionId <> " auth") $ threadDelay' (delay - elapsed `mod` delay) >> write
|
||||
| otherwise = write
|
||||
where
|
||||
write = atomically $ writeTBQueue sndQ rs
|
||||
microseconds (MkSystemTime s ns) = s * 1000000 + fromIntegral (ns `div` 1000)
|
||||
|
||||
send :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> IO ()
|
||||
send th c@Client {sndQ, msgQ, clientTHParams = THandleParams {sessionId}} = do
|
||||
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
|
||||
@@ -1374,15 +1397,18 @@ client
|
||||
ms
|
||||
clnt@Client {clientId, rcvQ, sndQ, msgQ, clientTHParams = thParams'@THandleParams {sessionId}, procThreads} = do
|
||||
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
|
||||
stats <- asks serverStats
|
||||
authDelay <- asks $ authErrorDelay . config
|
||||
let clntServiceId = (\THClientService {serviceId} -> serviceId) <$> (peerClientService =<< thAuth thParams')
|
||||
process batchSubs t acc@(rs, msgs) =
|
||||
(maybe acc (\(!r, !msg_) -> (r : rs, maybe msgs (: msgs) msg_)))
|
||||
<$> processCommand clntServiceId batchSubs t
|
||||
forever $ do
|
||||
batch <- atomically (readTBQueue rcvQ)
|
||||
processedAt <- liftIO getSystemTime
|
||||
batchSubs <- prepareBatchSubs clntServiceId batch
|
||||
foldrM (process batchSubs) ([], []) batch
|
||||
>>= \(rs_, msgs) -> mapM_ (atomically . writeTBQueue sndQ . (,msgs)) (L.nonEmpty rs_)
|
||||
>>= \(rs_, msgs) -> mapM_ (liftIO . sendResponses clnt stats authDelay processedAt . (,msgs)) (L.nonEmpty rs_)
|
||||
where
|
||||
prepareBatchSubs ::
|
||||
Maybe ServiceId ->
|
||||
@@ -2119,6 +2145,7 @@ client
|
||||
|
||||
processForwardedCommand :: EncFwdTransmission -> M s (Maybe BrokerMsg)
|
||||
processForwardedCommand (EncFwdTransmission s) = fmap (either (Just . ERR) id) . runExceptT $ do
|
||||
startedAt <- liftIO getSystemTime
|
||||
THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams')
|
||||
sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret'
|
||||
proxyNonce <- liftEitherWith (const CRYPTO) $ C.cbNonce $ bs corrId
|
||||
@@ -2162,7 +2189,11 @@ client
|
||||
_ -> Just . maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing (Right (M.empty, M.empty, M.empty)) t'')
|
||||
stats <- asks serverStats
|
||||
incStat $ pMsgFwdsRecv stats
|
||||
traverse encodeResp r_
|
||||
traverse encodeResp r_ >>= \case
|
||||
Just rres | any isAuthError r_ -> do
|
||||
authDelay <- asks $ authErrorDelay . config
|
||||
Nothing <$ liftIO (sendAfterDelay clnt stats authDelay startedAt ([(corrId, NoEntity, rres)], []))
|
||||
rres_ -> pure rres_
|
||||
where
|
||||
rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmissionOrError ErrorType Cmd -> M s (VerifiedTransmissionOrError s)
|
||||
rejectOrVerify clntThAuth = \case
|
||||
|
||||
@@ -68,6 +68,7 @@ module Simplex.Messaging.Server.Env.STM
|
||||
defaultInactiveClientExpiration,
|
||||
defaultProxyClientConcurrency,
|
||||
defaultNameResolverConcurrency,
|
||||
defaultAuthErrorDelayMs,
|
||||
defaultMaxJournalMsgCount,
|
||||
defaultMaxJournalStateLines,
|
||||
defaultIdleQueueInterval,
|
||||
@@ -187,6 +188,7 @@ data ServerConfig s = ServerConfig
|
||||
ntfDeliveryInterval :: Int,
|
||||
-- | interval between sending pending END events to unsubscribed clients, seconds
|
||||
pendingENDInterval :: Int,
|
||||
authErrorDelay :: Int64,
|
||||
smpCredentials :: ServerCredentials,
|
||||
httpCredentials :: Maybe ServerCredentials,
|
||||
-- | SMP client-server protocol version range
|
||||
@@ -255,6 +257,9 @@ defaultProxyClientConcurrency = 32
|
||||
defaultNameResolverConcurrency :: Int
|
||||
defaultNameResolverConcurrency = 1000
|
||||
|
||||
defaultAuthErrorDelayMs :: Int64
|
||||
defaultAuthErrorDelayMs = 50
|
||||
|
||||
journalMsgStoreDepth :: Int
|
||||
journalMsgStoreDepth = 5
|
||||
|
||||
|
||||
@@ -580,6 +580,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
|
||||
prometheusMetricsFile = combine logPath "smp-server-metrics.txt",
|
||||
pendingENDInterval = 15000000, -- 15 seconds
|
||||
ntfDeliveryInterval = 1500000, -- 1.5 second
|
||||
authErrorDelay = 1000 * readIniDefault defaultAuthErrorDelayMs "TRANSPORT" "auth_error_delay_ms" ini,
|
||||
smpServerVRange = supportedServerSMPRelayVRange,
|
||||
transportConfig =
|
||||
mkTransportServerConfig
|
||||
|
||||
@@ -130,7 +130,9 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
|
||||
<> ("host = " <> T.pack host <> "\n")
|
||||
<> ("port = " <> defaultServerPorts <> "\n")
|
||||
<> "log_tls_errors = off\n\n\
|
||||
\# Use `websockets = 443` to run websockets server in addition to plain TLS.\n\
|
||||
\# Minimum time to respond with AUTH error, milliseconds.\n"
|
||||
<> ("# auth_error_delay_ms = " <> tshow defaultAuthErrorDelayMs <> "\n\n")
|
||||
<> "# Use `websockets = 443` to run websockets server in addition to plain TLS.\n\
|
||||
\# This option is deprecated and should be used for testing only.\n\
|
||||
\# , port 443 should be specified in port above\n\
|
||||
\websockets = off\n"
|
||||
|
||||
@@ -126,6 +126,7 @@ prometheusMetrics sm rtm ts =
|
||||
_ntfServices,
|
||||
_rcvServicesSubMsg,
|
||||
_rcvServicesSubDuplicate,
|
||||
_authDelayExceeded,
|
||||
_qCount,
|
||||
_msgCount,
|
||||
_ntfCount,
|
||||
@@ -192,6 +193,10 @@ prometheusMetrics sm rtm ts =
|
||||
\# HELP simplex_smp_queues_notify_monthly Monthly active queues with notifications.\n\
|
||||
\# TYPE simplex_smp_queues_notify_monthly gauge\n\
|
||||
\simplex_smp_queues_notify_monthly " <> mstr (monthCount psNtf) <> "\n# monthCountNtf\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_auth_delay_exceeded Responses with AUTH errors sent without delay, as processing took longer than the delay.\n\
|
||||
\# TYPE simplex_smp_auth_delay_exceeded counter\n\
|
||||
\simplex_smp_auth_delay_exceeded " <> mshow _authDelayExceeded <> "\n# authDelayExceeded\n\
|
||||
\\n"
|
||||
subscriptions =
|
||||
"# Subscriptions\n\
|
||||
|
||||
@@ -128,6 +128,7 @@ data ServerStats = ServerStats
|
||||
ntfServices :: ServiceStats,
|
||||
rcvServicesSubMsg :: IORef Int,
|
||||
rcvServicesSubDuplicate :: IORef Int,
|
||||
authDelayExceeded :: IORef Int,
|
||||
qCount :: IORef Int,
|
||||
msgCount :: IORef Int,
|
||||
ntfCount :: IORef Int,
|
||||
@@ -190,6 +191,7 @@ data ServerStatsData = ServerStatsData
|
||||
_rcvServices :: ServiceStatsData,
|
||||
_rcvServicesSubMsg :: Int,
|
||||
_rcvServicesSubDuplicate :: Int,
|
||||
_authDelayExceeded :: Int,
|
||||
_qCount :: Int,
|
||||
_msgCount :: Int,
|
||||
_ntfCount :: Int,
|
||||
@@ -254,6 +256,7 @@ newServerStats ts = do
|
||||
ntfServices <- newServiceStats
|
||||
rcvServicesSubMsg <- newIORef 0
|
||||
rcvServicesSubDuplicate <- newIORef 0
|
||||
authDelayExceeded <- newIORef 0
|
||||
qCount <- newIORef 0
|
||||
msgCount <- newIORef 0
|
||||
ntfCount <- newIORef 0
|
||||
@@ -315,6 +318,7 @@ newServerStats ts = do
|
||||
ntfServices,
|
||||
rcvServicesSubMsg,
|
||||
rcvServicesSubDuplicate,
|
||||
authDelayExceeded,
|
||||
qCount,
|
||||
msgCount,
|
||||
ntfCount,
|
||||
@@ -378,6 +382,7 @@ getServerStatsData s = do
|
||||
_ntfServices <- getServiceStatsData $ ntfServices s
|
||||
_rcvServicesSubMsg <- readIORef $ rcvServicesSubMsg s
|
||||
_rcvServicesSubDuplicate <- readIORef $ rcvServicesSubDuplicate s
|
||||
_authDelayExceeded <- readIORef $ authDelayExceeded s
|
||||
_qCount <- readIORef $ qCount s
|
||||
_msgCount <- readIORef $ msgCount s
|
||||
_ntfCount <- readIORef $ ntfCount s
|
||||
@@ -439,6 +444,7 @@ getServerStatsData s = do
|
||||
_ntfServices,
|
||||
_rcvServicesSubMsg,
|
||||
_rcvServicesSubDuplicate,
|
||||
_authDelayExceeded,
|
||||
_qCount,
|
||||
_msgCount,
|
||||
_ntfCount,
|
||||
@@ -503,6 +509,7 @@ setServerStats s d = do
|
||||
setServiceStats (ntfServices s) $! _ntfServices d
|
||||
writeIORef (rcvServicesSubMsg s) $! _rcvServicesSubMsg d
|
||||
writeIORef (rcvServicesSubDuplicate s) $! _rcvServicesSubDuplicate d
|
||||
writeIORef (authDelayExceeded s) $! _authDelayExceeded d
|
||||
writeIORef (qCount s) $! _qCount d
|
||||
writeIORef (msgCount s) $! _msgCount d
|
||||
writeIORef (ntfCount s) $! _ntfCount d
|
||||
@@ -705,6 +712,7 @@ instance StrEncoding ServerStatsData where
|
||||
_ntfServices,
|
||||
_rcvServicesSubMsg = 0,
|
||||
_rcvServicesSubDuplicate = 0,
|
||||
_authDelayExceeded = 0,
|
||||
_qCount,
|
||||
_msgCount = 0,
|
||||
_ntfCount = 0,
|
||||
|
||||
@@ -92,7 +92,7 @@ import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), Env (..), InitialAg
|
||||
import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
|
||||
import qualified Simplex.Messaging.Agent.Protocol as A
|
||||
import Simplex.Messaging.Agent.Store (Connection' (..), SomeConn' (..), StoredRcvQueue (..))
|
||||
import Simplex.Messaging.Agent.Store.AgentStore (deleteRatchetKeyHashesExpired, getConn, getRatchetX3dhKeys)
|
||||
import Simplex.Messaging.Agent.Store.AgentStore (deleteRatchetKeyHashesExpired, getConn, getConnIds, getRatchetX3dhKeys)
|
||||
import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
|
||||
import Simplex.Messaging.Agent.Store.Interface
|
||||
import qualified Simplex.Messaging.Agent.Store.DB as DB
|
||||
@@ -371,6 +371,10 @@ functionalAPITests ps = do
|
||||
testAddDRViaSetConnShortLink ps
|
||||
it "should resume DR accept after a transient failure (reuse the send queue and ratchet)" $
|
||||
testAcceptContactDRResumeAfterOffline ps
|
||||
it "should store the ratchet when DR accept is prepared" $
|
||||
withSmpServer ps $ testAcceptContactDRPrepared False
|
||||
it "should create the ratchet at DR accept when the prepared connection has none" $
|
||||
withSmpServer ps $ testAcceptContactDRPrepared True
|
||||
it "should support rejecting contact request" $
|
||||
withSmpServer ps testRejectContactRequest
|
||||
it "should communicate rejection reason via double ratchet" $
|
||||
@@ -421,6 +425,10 @@ functionalAPITests ps = do
|
||||
it "should connect via added contact short link after restart" $ testAddContactShortLinkRestart ps
|
||||
it "should create and get short links with the old contact queues" $ testOldContactQueueShortLink ps
|
||||
it "should connect via prepared connection link" $ testPrepareCreateConnectionLink ps
|
||||
it "should connect via prepared invitation link" $ testPrepareCreateInvitationLink ps
|
||||
it "should not create connection for prepared invitation link with too large data" $ testPrepareInvitationLinkTooLarge ps
|
||||
it "should not create connection for prepared contact link with too large data" $ testPrepareContactLinkTooLarge ps
|
||||
it "should connect via short link prepared for existing contact connection" $ testPrepareConnShortLink ps
|
||||
describe "Message delivery" $ do
|
||||
describe "update connection agent version on received messages" $ do
|
||||
it "should increase if compatible, shouldn'ps decrease" $
|
||||
@@ -1241,6 +1249,30 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do
|
||||
("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
|
||||
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
|
||||
|
||||
testAcceptContactDRPrepared :: HasCallStack => Bool -> IO ()
|
||||
testAcceptContactDRPrepared ratchetDeleted =
|
||||
withAgentClients2 $ \alice bob -> runRight_ $ do
|
||||
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
|
||||
pqEnc = PQEncryption $ pqConnectionMode IKPQOn PQSupportOn
|
||||
(_, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe
|
||||
(aliceId, CRBRatchet codes) <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
|
||||
void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" (CRBRatchet reqCodes) _) <- get alice
|
||||
(bobId, CRBRatchet acceptCodes) <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
liftIO $ do
|
||||
reqCodes `shouldBe` codes
|
||||
acceptCodes `shouldBe` codes
|
||||
if ratchetDeleted
|
||||
then do
|
||||
liftIO $ withTransaction (store $ agentEnv alice) (`DB.execute_` "DELETE FROM ratchets")
|
||||
Left (CONN NOT_FOUND _) <- tryError $ getConnectionVerifyCodes alice bobId
|
||||
pure ()
|
||||
else getConnectionVerifyCodes alice bobId >>= liftIO . (`shouldBe` codes)
|
||||
void $ acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
|
||||
allowConfirmGreet alice bobId bob aliceId confId IKPQOn pqEnc
|
||||
getConnectionVerifyCodes alice bobId >>= liftIO . (`shouldBe` codes)
|
||||
|
||||
runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
|
||||
runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
|
||||
(_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
|
||||
@@ -2055,6 +2087,64 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
|
||||
get b ##> ("", bId, CON)
|
||||
exchangeGreetings a aId b bId
|
||||
|
||||
testPrepareCreateInvitationLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
|
||||
testPrepareCreateInvitationLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
|
||||
let userData = UserLinkData "test user data"
|
||||
runRight_ $ do
|
||||
(preparedReq, preparedParams@PreparedLinkParams {plpLinkKey}) <- A.prepareInvitationLink a 1 CR.IKPQOn Nothing
|
||||
(bId, CCLink connReq (Just shortLink@(CSLInvitation _ _ _ linkKey))) <- A.createInvitationForLink a NRMInteractive 1 True preparedReq preparedParams (UserInvLinkData userData) SMSubscribe
|
||||
liftIO $ linkKey `shouldBe` plpLinkKey
|
||||
(_, connData', connReq') <- getConnShortLink b 1 shortLink
|
||||
liftIO $ connReq' `shouldBe` preparedReq
|
||||
liftIO $ connReq `shouldNotBe` preparedReq
|
||||
liftIO $ linkUserData connData' `shouldBe` userData
|
||||
testJoinConn_ False True a bId b connReq
|
||||
|
||||
testPrepareInvitationLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
|
||||
testPrepareInvitationLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
|
||||
runRight_ $ do
|
||||
(preparedReq, preparedParams) <- A.prepareInvitationLink a 1 CR.IKPQOn Nothing
|
||||
Left (A.CMD LARGE _) <- tryError $ A.createInvitationForLink a NRMInteractive 1 True preparedReq preparedParams (UserInvLinkData $ UserLinkData $ B.replicate 14000 'a') SMSubscribe
|
||||
pure ()
|
||||
withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
|
||||
|
||||
testPrepareContactLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
|
||||
testPrepareContactLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
|
||||
let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData $ B.replicate 14000 'a', ratchetKeys = Nothing}
|
||||
g <- C.newRandom
|
||||
rootKey <- atomically $ C.generateKeyPair g
|
||||
linkEntId <- atomically $ C.randomBytes 32 g
|
||||
runRight_ $ do
|
||||
(ccLink, preparedParams) <- A.prepareConnectionLink a 1 rootKey linkEntId True Nothing CR.IKPQOn True Nothing
|
||||
Left (A.CMD LARGE _) <- tryError $ A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe
|
||||
pure ()
|
||||
withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
|
||||
|
||||
testPrepareConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
|
||||
testPrepareConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
|
||||
let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
|
||||
runRight_ $ do
|
||||
(contactId, CCLink _ Nothing) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMSubscribe
|
||||
shortLink <- A.prepareConnShortLink a contactId Nothing
|
||||
shortLink' <- A.prepareConnShortLink a contactId Nothing
|
||||
liftIO $ shortLink' `shouldBe` shortLink
|
||||
shortLink'' <- A.setConnShortLink a NRMInteractive contactId SCMContact (UserContactLinkData userCtData) Nothing False Nothing
|
||||
liftIO $ shortLink'' `shouldBe` shortLink
|
||||
(_, ContactLinkData _ userCtData', connReq) <- getConnShortLink b 1 shortLink
|
||||
liftIO $ userCtData' `shouldBe` userCtData
|
||||
(aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
|
||||
liftIO $ sndSecure `shouldBe` False
|
||||
("", _, REQ invId _ "bob's connInfo") <- get a
|
||||
(bId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
sndSecure' <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sndSecure' `shouldBe` True
|
||||
("", _, CONF confId _ "alice's connInfo") <- get b
|
||||
allowConnection b aId confId "bob's connInfo"
|
||||
get a ##> ("", bId, INFO "bob's connInfo")
|
||||
get a ##> ("", bId, CON)
|
||||
get b ##> ("", aId, CON)
|
||||
exchangeGreetings a bId b aId
|
||||
|
||||
connReqWithKeys :: BinaryConnectionRequestUri m -> Maybe AddressRatchetKeys -> ConnectionRequestUri m
|
||||
connReqWithKeys cr rk = case cr of
|
||||
BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams
|
||||
@@ -4962,9 +5052,9 @@ testServerQueueInfo = do
|
||||
get bob =##> \case ("", c, Msg' mId PQEncOn "hello 4") -> c == aliceId && mId == msgId4; _ -> False
|
||||
ackMessage bob aliceId msgId4 Nothing
|
||||
liftIO $ threadDelay 200000
|
||||
Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
|
||||
get alice ##> ("", bobId, QCONT)
|
||||
get alice ##> ("", bobId, SENT msgId5)
|
||||
Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
|
||||
liftIO $ threadDelay 200000
|
||||
Just _srvMsgId <- checkQ bob aliceId True (Just QNoSub) 1 (Just MTMessage)
|
||||
get bob =##> \case ("", c, Msg' mId PQEncOn "hello: quota exceeded") -> c == aliceId && mId == msgId5 + 1; _ -> False
|
||||
|
||||
@@ -49,6 +49,7 @@ schemaDumpTest = do
|
||||
it "should NOT create user record for new database" testUsersMigrationNew
|
||||
it "should create user record for old database" testUsersMigrationOld
|
||||
it "should remove duplicate ratchet key hashes before adding unique index" testRatchetKeyHashesUniqueMigration
|
||||
it "should clear received_qend switch status on downgrade" testRcvSwitchStatusDowngrade
|
||||
|
||||
testVerifySchemaDump :: IO ()
|
||||
testVerifySchemaDump = do
|
||||
@@ -129,6 +130,21 @@ testRatchetKeyHashesUniqueMigration = do
|
||||
`shouldReturn` [Only (1 :: Int), Only 3, Only 4]
|
||||
closeDBStore st'
|
||||
|
||||
testRcvSwitchStatusDowngrade :: IO ()
|
||||
testRcvSwitchStatusDowngrade = do
|
||||
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCError Nothing)
|
||||
withTransaction' st $ \db -> do
|
||||
SQL.execute_ db "INSERT INTO users (user_id) VALUES (1)"
|
||||
SQL.execute_ db "INSERT INTO connections (conn_id, conn_mode, user_id) VALUES (x'01', 'INV', 1)"
|
||||
SQL.execute_ db "INSERT INTO servers (host, port, key_hash) VALUES ('localhost', '5001', x'00')"
|
||||
SQL.execute_ db "INSERT INTO rcv_queues (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, snd_id, status, rcv_queue_id, rcv_primary, switch_status) VALUES ('localhost', '5001', x'01', x'01', x'00', x'00', x'00', x'01', 'active', 1, 0, 'received_qend'), ('localhost', '5001', x'02', x'01', x'00', x'00', x'00', x'02', 'active', 2, 1, 'sending_qadd')"
|
||||
closeDBStore st
|
||||
let beforeRcvSwitchStatus = takeWhile (("m20261008_rcv_switch_status" /=) . name) appMigrations
|
||||
Right st' <- createDBStore (DBOpts testDB [] "" False True TQOff) beforeRcvSwitchStatus (MigrationConfig MCYesUpDown Nothing)
|
||||
withTransaction' st' (`SQL.query_` "SELECT switch_status FROM rcv_queues ORDER BY rcv_queue_id")
|
||||
`shouldReturn` [Only (Nothing :: Maybe Text), Only (Just "sending_qadd")]
|
||||
closeDBStore st'
|
||||
|
||||
skipComparisonForDownMigrations :: [String]
|
||||
skipComparisonForDownMigrations =
|
||||
[ -- on down migration idx_messages_internal_snd_id_ts index moves down to the end of the file
|
||||
|
||||
@@ -0,0 +1,370 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module CoreTests.EthCryptoTests (ethCryptoTests) where
|
||||
|
||||
import Control.Concurrent.STM (TVar, atomically)
|
||||
import Control.Monad (forM_)
|
||||
import Crypto.Number.Serialize (i2osp)
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteArray as BA
|
||||
import qualified Data.ByteArray.Encoding as BAE
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.Char (toLower)
|
||||
import Data.Either (isLeft, isRight)
|
||||
import Data.FileEmbed (embedFile)
|
||||
import Data.List (elemIndex, foldl', nub)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromJust, isNothing, listToMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Word (Word32)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import qualified Simplex.Messaging.Crypto.BIP32 as B32
|
||||
import qualified Simplex.Messaging.Crypto.BIP39 as B39
|
||||
import Simplex.Messaging.Crypto.BIP39.English (englishWordList)
|
||||
import Simplex.Messaging.Crypto.BIP44
|
||||
import qualified Simplex.Messaging.Crypto.Secp256k1 as S
|
||||
import Simplex.Messaging.Encoding.String (strDecode, strEncode)
|
||||
import Simplex.Messaging.Eth.Address
|
||||
import Simplex.Messaging.Eth.RLP
|
||||
import Simplex.Messaging.Eth.Transaction
|
||||
import Simplex.Messaging.Util ((<$$>))
|
||||
import Test.Hspec hiding (fit, it)
|
||||
import Util
|
||||
|
||||
ethCryptoTests :: Spec
|
||||
ethCryptoTests = do
|
||||
g <- runIO C.newRandom
|
||||
describe "Keccak-256" keccakTests
|
||||
describe "secp256k1" $ secp256k1Tests g
|
||||
describe "BIP-39" $ bip39Tests g
|
||||
describe "BIP-32" $ bip32Tests g
|
||||
describe "BIP-44 derivation" $ derivationTests g
|
||||
describe "EIP-55 addresses" eip55Tests
|
||||
describe "RLP" rlpTests
|
||||
describe "recoverable signing" $ signingTests g
|
||||
describe "EIP-1559 transactions" $ transactionTests g
|
||||
|
||||
-- helpers
|
||||
|
||||
hx :: BA.ByteArray a => ByteString -> a
|
||||
hx s = either (const $ error $ "bad hex literal: " <> BC.unpack s) id $ BAE.convertFromBase BAE.Base16 s
|
||||
|
||||
toHex :: BA.ByteArrayAccess a => a -> ByteString
|
||||
toHex = BAE.convertToBase BAE.Base16
|
||||
|
||||
right :: Either String a -> a
|
||||
right = either (error . ("unexpected Left: " <>)) id
|
||||
|
||||
xkHex :: B32.ExtendedKey -> (ByteString, ByteString)
|
||||
xkHex xk = (toHex . S.unPrivateKey $ B32.xkKey xk, toHex $ B32.xkChainCode xk)
|
||||
|
||||
-- | Key and chain code of a base58check @xprv@: 4 version, 1 depth, 4 fingerprint, 4 child, 32 chain code, 0x00 and 32 key bytes, 4 checksum.
|
||||
xprvHex :: ByteString -> (ByteString, ByteString)
|
||||
xprvHex s
|
||||
| B.length payload /= 78 || B.index payload 45 /= 0 || checksum /= B.take 4 (C.sha256Hash $ C.sha256Hash payload) = error $ "bad xprv: " <> BC.unpack s
|
||||
| otherwise = (toHex $ B.drop 46 payload, toHex $ B.take 32 $ B.drop 13 payload)
|
||||
where
|
||||
(payload, checksum) = B.splitAt 78 $ base58Decode s
|
||||
|
||||
base58Decode :: ByteString -> ByteString
|
||||
base58Decode s = B.replicate (B.length zeros) 0 <> i2osp n
|
||||
where
|
||||
(zeros, digits) = BC.span (== '1') s
|
||||
n = foldl' (\acc c -> acc * 58 + fromIntegral (digit c)) (0 :: Integer) (BC.unpack digits)
|
||||
digit c = fromJust $ elemIndex c "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
|
||||
|
||||
-- fixtures
|
||||
|
||||
-- https://github.com/trezor/python-mnemonic/blob/master/vectors.json
|
||||
bip39VectorsFile :: ByteString
|
||||
bip39VectorsFile = $(embedFile "tests/fixtures/bip39-vectors.json")
|
||||
|
||||
-- https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki
|
||||
bip32SpecFile :: ByteString
|
||||
bip32SpecFile = $(embedFile "tests/fixtures/bip-0032.mediawiki")
|
||||
|
||||
-- | Entropy, phrase, seed with the passphrase @TREZOR@, and master @xprv@ for each English vector.
|
||||
bip39Vectors :: [(ByteString, ByteString, ByteString, ByteString)]
|
||||
bip39Vectors = map row $ (right (J.eitherDecodeStrict bip39VectorsFile) :: M.Map Text [[Text]]) M.! "english"
|
||||
where
|
||||
row [ent, phrase, seed, xprv] = (encodeUtf8 ent, encodeUtf8 phrase, encodeUtf8 seed, encodeUtf8 xprv)
|
||||
row r = error $ "unexpected vector: " <> show r
|
||||
|
||||
bip32Sections :: [(ByteString, [ByteString])]
|
||||
bip32Sections = go $ dropWhile (not . isVector) (BC.lines bip32SpecFile)
|
||||
where
|
||||
isVector = B.isPrefixOf "===Test vector"
|
||||
go (h : rest) | isVector h = let (body, rest') = break (B.isPrefixOf "==") rest in (h, body) : go rest'
|
||||
go _ = []
|
||||
|
||||
-- | Vectors 1 to 4: name, seed, and the chains with their @xprv@. Vector 5 has no seed.
|
||||
bip32Vectors :: [(String, ByteString, [(String, [Word32], ByteString)])]
|
||||
bip32Vectors = [(BC.unpack $ BC.filter (/= '=') h, seed, chains body) | (h, body) <- bip32Sections, Just seed <- [listToMaybe $ prefixed "Seed (hex): " body]]
|
||||
where
|
||||
chains (l : ls) | Just c <- B.stripPrefix "* Chain " l, Just prv <- listToMaybe $ prefixed "** ext prv: " (take 2 ls) = (T.unpack $ chain c, path $ chain c, prv) : chains ls
|
||||
chains (_ : ls) = chains ls
|
||||
chains [] = []
|
||||
chain = T.replace "<sub>H</sub>" "'" . decodeLatin1
|
||||
path = map component . drop 1 . T.splitOn "/"
|
||||
component s = maybe (index s) (B32.hardened . index) $ T.stripSuffix "'" s
|
||||
index = read . T.unpack
|
||||
|
||||
-- | The vector 5 keys outside @[1, n-1]@; its other entries are malformed serializations, which this library does not parse.
|
||||
bip32InvalidKeys :: [(String, ByteString)]
|
||||
bip32InvalidKeys =
|
||||
[ (BC.unpack reason, xprv)
|
||||
| (h, body) <- bip32Sections,
|
||||
h == "===Test vector 5===",
|
||||
e <- prefixed "* " body,
|
||||
let (xprv, rest) = BC.break (== ' ') e
|
||||
reason = BC.takeWhile (/= ')') $ B.drop 2 rest,
|
||||
"private key" `B.isPrefixOf` reason
|
||||
]
|
||||
|
||||
prefixed :: ByteString -> [ByteString] -> [ByteString]
|
||||
prefixed p = foldr (\l acc -> maybe acc (: acc) $ B.stripPrefix p l) []
|
||||
|
||||
keccakTests :: Spec
|
||||
keccakTests = do
|
||||
it "hashes the empty string" $
|
||||
toHex (C.keccak256 "") `shouldBe` "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470"
|
||||
it "hashes abc" $
|
||||
toHex (C.keccak256 "abc") `shouldBe` "4e03657aea45a94fc7d47ba826c8d667c0d1e6e33a64a036ec44f58fa12d6c45"
|
||||
|
||||
secp256k1Tests :: TVar ChaChaDRG -> Spec
|
||||
secp256k1Tests g = do
|
||||
it "derives the known address for a known key" $
|
||||
(strEncode <$> addressFromPrivateKey g testKey) `shouldReturn` "0x2c7536E3605D9C16a7a3D7b1898e529396a65c23"
|
||||
it "serializes a public key in both SEC1 forms" $ do
|
||||
pk <- S.secp256k1PublicKey g testKey
|
||||
comp <- S.serializePublicKey S.Compressed pk
|
||||
uncomp <- S.serializePublicKey S.Uncompressed pk
|
||||
B.length comp `shouldBe` 33
|
||||
B.length uncomp `shouldBe` 65
|
||||
B.head uncomp `shouldBe` 0x04
|
||||
-- both forms contain the same x coordinate, and the compressed prefix encodes the parity of y
|
||||
B.take 32 (B.drop 1 uncomp) `shouldBe` B.drop 1 comp
|
||||
B.head comp `shouldBe` (if odd (B.last uncomp) then 0x03 else 0x02)
|
||||
forM_ bip32InvalidKeys $ \(reason, xprv) ->
|
||||
it ("rejects the BIP-32 vector 5 " <> reason) $
|
||||
isLeft (S.mkPrivateKey (hx . fst $ xprvHex xprv)) `shouldBe` True
|
||||
it "rejects a short private key" $
|
||||
isLeft (S.mkPrivateKey (BA.replicate 31 1)) `shouldBe` True
|
||||
it "adds a tweak to a private key" $
|
||||
(fmap (toHex . S.unPrivateKey) <$> S.privateKeyTweakAdd testKey (BA.replicate 31 0 <> BA.singleton 1))
|
||||
`shouldReturn` Just "4c0883a69102937d6231471b5dbb6204fe5129617082792ae468d01a3f362319"
|
||||
it "returns Nothing for a tweak that makes the key zero" $
|
||||
(isNothing <$> S.privateKeyTweakAdd testKey (hx "b3f77c596efd6c829dceb8e4a2449df9bc5db3853ec62710db698e7291001e29"))
|
||||
`shouldReturn` True
|
||||
it "returns Nothing for a tweak that is not 32 bytes" $
|
||||
(isNothing <$> S.privateKeyTweakAdd testKey (BA.replicate 31 1)) `shouldReturn` True
|
||||
where
|
||||
testKey = right $ S.mkPrivateKey (hx "4c0883a69102937d6231471b5dbb6204fe5129617082792ae468d01a3f362318")
|
||||
|
||||
bip39Tests :: TVar ChaChaDRG -> Spec
|
||||
bip39Tests g = do
|
||||
describe "official English vectors" $
|
||||
forM_ (zip [0 :: Int ..] bip39Vectors) $ \(i, (entHex, phrase, seedHex, xprv)) ->
|
||||
it ("vector " <> show i) $ do
|
||||
let ent = right $ B39.mkEntropy (hx entHex)
|
||||
seed = B39.entropySeed ent "TREZOR"
|
||||
B39.entropyPhrase ent `shouldBe` phrase
|
||||
B39.parsePhrase (decodeLatin1 phrase) `shouldBe` Right ent
|
||||
toHex seed `shouldBe` seedHex
|
||||
xkHex (right $ B32.masterKey seed) `shouldBe` xprvHex xprv
|
||||
it "embeds the upstream wordlist, unchanged" $
|
||||
-- sha256 of bitcoin/bips/bip-0039/english.txt
|
||||
C.sha256Hash (BC.unlines englishWordList)
|
||||
`shouldBe` hx "2f5eed53a4727b4bf8880d8f3f199efc90e58503646d9ff8eff3a2ed3b24dbda"
|
||||
it "embeds the upstream test vectors, unchanged" $ do
|
||||
C.sha256Hash bip39VectorsFile `shouldBe` hx "fa3b937b7cff9c9b8ecd3aa011faeb8d6dd67993174b72326e83f4de8fdb30f8"
|
||||
length bip39Vectors `shouldBe` 24
|
||||
it "rejects a bad checksum" $
|
||||
B39.parsePhrase "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon"
|
||||
`shouldSatisfy` isLeft
|
||||
it "rejects a word outside the list" $
|
||||
B39.parsePhrase "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon simplex"
|
||||
`shouldSatisfy` isLeft
|
||||
it "rejects an empty phrase, counting the words" $
|
||||
B39.parsePhrase "" `shouldBe` Left "Failed reading: mnemonic: expected 12, 15, 18, 21 or 24 words, got 0"
|
||||
it "rejects a word with trailing punctuation, naming it" $
|
||||
B39.parsePhrase "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about."
|
||||
`shouldBe` Left "Failed reading: mnemonic: not in wordlist"
|
||||
it "rejects a wrong word count" $
|
||||
B39.parsePhrase "abandon abandon about" `shouldSatisfy` isLeft
|
||||
it "accepts a capitalised phrase and normalises it" $
|
||||
(B39.entropyPhrase <$> B39.parsePhrase "Abandon ABANDON abandon abandon abandon abandon abandon abandon abandon abandon abandon About")
|
||||
`shouldBe` Right canonicalPhrase
|
||||
it "accepts extra whitespace" $
|
||||
B39.parsePhrase " abandon\tabandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about "
|
||||
`shouldBe` Right canonicalEntropy
|
||||
it "accepts Unicode whitespace between words" $ do
|
||||
let spaced sep = T.intercalate sep . T.words $ decodeLatin1 canonicalPhrase
|
||||
B39.parsePhrase (spaced "\x00A0") `shouldBe` Right canonicalEntropy
|
||||
B39.parsePhrase (spaced "\x3000") `shouldBe` Right canonicalEntropy
|
||||
it "rejects an invalid entropy size" $
|
||||
B39.mkEntropy (BA.replicate 17 0) `shouldSatisfy` isLeft
|
||||
it "generates entropy whose phrase parses back" $
|
||||
forM_ (zip [minBound .. maxBound] [12, 15, 18, 21, 24]) $ \(s, n) -> do
|
||||
ent <- atomically $ B39.randomEntropy s g
|
||||
length (BC.words $ B39.entropyPhrase ent) `shouldBe` n
|
||||
B39.parsePhrase (decodeLatin1 $ B39.entropyPhrase ent) `shouldBe` Right ent
|
||||
|
||||
canonicalPhrase :: ByteString
|
||||
canonicalPhrase = "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about"
|
||||
|
||||
canonicalEntropy :: B39.WalletEntropy
|
||||
canonicalEntropy = right $ B39.parsePhrase (decodeLatin1 canonicalPhrase)
|
||||
|
||||
bip32Tests :: TVar ChaChaDRG -> Spec
|
||||
bip32Tests g = do
|
||||
it "embeds the upstream specification, unchanged" $ do
|
||||
C.sha256Hash bip32SpecFile `shouldBe` hx "e5e00a8289db2f681052cf24a745320afc225e66b25d1e489a7c884d2fc7f11f"
|
||||
map (\(name, _, chains) -> (name, length chains)) bip32Vectors `shouldBe` [("Test vector 1", 6), ("Test vector 2", 6), ("Test vector 3", 2), ("Test vector 4", 3)]
|
||||
map fst bip32InvalidKeys `shouldBe` ["private key 0 not in 1..n-1", "private key n not in 1..n-1"]
|
||||
forM_ bip32Vectors $ \(name, seedHex, chains) ->
|
||||
describe name $
|
||||
forM_ chains $ \(chain, path, xprv) ->
|
||||
it chain $ do
|
||||
xk <- right <$> B32.derivePath g (right $ B32.masterKey (hx seedHex)) path
|
||||
xkHex xk `shouldBe` xprvHex xprv
|
||||
it "rejects a seed shorter than 16 bytes" $
|
||||
isLeft (B32.masterKey (BA.replicate 15 1)) `shouldBe` True
|
||||
it "rejects a seed longer than 64 bytes" $
|
||||
isLeft (B32.masterKey (BA.replicate 65 1)) `shouldBe` True
|
||||
it "renders a path" $
|
||||
B32.renderPath [B32.hardened 44, B32.hardened 60, B32.hardened 0, 0, 0] `shouldBe` "m/44'/60'/0'/0/0"
|
||||
|
||||
canonicalMaster :: B32.ExtendedKey
|
||||
canonicalMaster = right $ B32.masterKey (B39.entropySeed canonicalEntropy "")
|
||||
|
||||
derivationTests :: TVar ChaChaDRG -> Spec
|
||||
derivationTests g = do
|
||||
it "derives the standard BIP-39 seed" $
|
||||
toHex seed
|
||||
`shouldBe` "5eb00bbddcf069084889a8ab9155568165f5c453ccb85e70811aaed6f6da5fc19a5ac40b389cd370d086206dec8aa6c43daea6690f20ad3d8d48b2d2ce9e38e4"
|
||||
forM_ [(0, "0x9858EfFD232B4033E47d90003D41EC34EcaEda94"), (1, "0x78839F6054d7ed13918bAe0473BA31b1Ca9D7265"), (2, "0x07B5FdfEB4E11826D233403Fe8Db0611CCF4c231")] $ \(i, a) ->
|
||||
it ("derives the account " <> show i <> " address") $
|
||||
(strEncode <$> addrAt i) `shouldReturn` a
|
||||
it "derives distinct addresses for accounts 0 to 4" $
|
||||
mapM addrAt [0 .. 4] >>= (`shouldSatisfy` \as -> length as == length (nub as))
|
||||
it "derives an account key together with its address" $ do
|
||||
let path = bip44Path Ethereum $ account 0
|
||||
(xk, a) <- right <$> deriveAddress g canonicalMaster path
|
||||
xk' <- right <$> B32.derivePath g canonicalMaster path
|
||||
xkHex xk `shouldBe` xkHex xk'
|
||||
addressFromPrivateKey g (B32.xkKey xk) `shouldReturn` a
|
||||
it "renders the Ethereum path of an account" $
|
||||
B32.renderPath (bip44Path Ethereum $ account 7) `shouldBe` "m/44'/60'/7'/0/0"
|
||||
it "rejects an account index at or above 2^31" $ do
|
||||
mkAccountIndex 0x7fffffff `shouldSatisfy` isRight
|
||||
mkAccountIndex 0x80000000 `shouldSatisfy` isLeft
|
||||
where
|
||||
seed = B39.entropySeed canonicalEntropy ""
|
||||
account = right . mkAccountIndex
|
||||
addrAt i = snd . right <$> deriveAddress g canonicalMaster (bip44Path Ethereum $ account i)
|
||||
|
||||
eip55Tests :: Spec
|
||||
eip55Tests = do
|
||||
describe "spec vectors round-trip" $
|
||||
forM_ specAddresses $ \a ->
|
||||
it (BC.unpack a) $
|
||||
strEncode (right $ strDecode @Address a) `shouldBe` a
|
||||
it "accepts an all-lowercase address" $
|
||||
strDecode @Address "0x5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight
|
||||
it "accepts an all-uppercase address" $
|
||||
strDecode @Address "0x5AAEB6053F3E94C9B9A09F33669435E7EF1BEAED" `shouldSatisfy` isRight
|
||||
it "accepts an address without the 0x prefix" $
|
||||
strDecode @Address "5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight
|
||||
it "rejects a bad EIP-55 checksum" $
|
||||
strDecode @Address "0x5aAeb6053f3E94C9b9A09f33669435E7Ef1BeAed" `shouldSatisfy` isLeft
|
||||
it "rejects the wrong length" $
|
||||
strDecode @Address "0x5aAeb6053F3E94C9b9A09f33669435E7Ef1BeAe" `shouldSatisfy` isLeft
|
||||
it "rejects non-hex characters" $
|
||||
strDecode @Address "0xZaAeb6053F3E94C9b9A09f33669435E7Ef1BeAed"
|
||||
`shouldBe` Left "Failed reading: address: expected 40 hex digits, got 0"
|
||||
it "round-trips every byte value through the checksummed form" $
|
||||
forM_ everyByteAddresses $ \a ->
|
||||
strDecode (strEncode a) `shouldBe` Right a
|
||||
it "round-trips every byte value through the lowercase form" $
|
||||
forM_ everyByteAddresses $ \a ->
|
||||
strDecode (BC.map toLower (strEncode a)) `shouldBe` Right a
|
||||
where
|
||||
-- 13 x 20 = 260 bytes, so every value 0x00..0xff appears at least once
|
||||
everyByteAddresses =
|
||||
[ right . strDecode @Address . ("0x" <>) . toHex . B.pack $
|
||||
[fromIntegral ((i * 20 + j) `mod` 256) | j <- [0 .. 19 :: Int]]
|
||||
| i <- [0 .. 12 :: Int]
|
||||
]
|
||||
specAddresses =
|
||||
[ "0x52908400098527886E0F7030069857D2E4169EE7",
|
||||
"0x8617E340B3D01FA5F11F306F4090FD50E238070D",
|
||||
"0xde709f2102306220921060314715629080e2fb77",
|
||||
"0x27b1fdb04752bbc536007a920d24acb045561c26",
|
||||
"0x5aAeb6053F3E94C9b9A09f33669435E7Ef1BeAed",
|
||||
"0xfB6916095ca1df60bB79Ce92cE3Ea74c37c5d359",
|
||||
"0xdbF03B407c01E7cD3CBea99509d93f8DDDC8C6FB",
|
||||
"0xD1220A0cf47c7B9Be7A2E6BA89F429762e7b9aDb"
|
||||
]
|
||||
|
||||
rlpTests :: Spec
|
||||
rlpTests = do
|
||||
forM_ rlpVectors $ \(name, item, expected) ->
|
||||
it ("encodes " <> name) $ toHex (rlpEncode item) `shouldBe` expected
|
||||
it "encodes scalars without leading zeros" $ do
|
||||
toHex (rlpEncode $ scalarItem $ B.replicate 32 0) `shouldBe` "80"
|
||||
toHex (rlpEncode $ scalarItem $ hx "000f") `shouldBe` "0f"
|
||||
toHex (rlpEncode $ scalarItem $ hx "000400") `shouldBe` "820400"
|
||||
where
|
||||
rlpVectors =
|
||||
[ ("the empty string", RLPBytes "", "80"),
|
||||
("the empty list", RLPList [], "c0"),
|
||||
("dog", RLPBytes "dog", "83646f67"),
|
||||
("[cat, dog]", RLPList [RLPBytes "cat", RLPBytes "dog"], "c88363617483646f67"),
|
||||
("the set-theoretic three", RLPList [RLPList [], RLPList [RLPList []], RLPList [RLPList [], RLPList [RLPList []]]], "c7c0c1c0c3c0c1c0"),
|
||||
("a 56-byte string", RLPBytes (B.replicate 56 0x61), "b838" <> B.concat (replicate 56 "61"))
|
||||
]
|
||||
|
||||
-- expected signatures and transactions are viem's for the same key and inputs
|
||||
signingTests :: TVar ChaChaDRG -> Spec
|
||||
signingTests g = do
|
||||
it "derives the EIP-155 example address" $
|
||||
(strEncode <$> addressFromPrivateKey g txKey) `shouldReturn` "0x9d8A62f656a8d1615C1294fd71e9CFb3E4855A4F"
|
||||
it "signs a digest as viem does" $
|
||||
S.signRecoverable g txKey (C.keccak256 "simplex")
|
||||
`shouldReturn` Right
|
||||
S.RecoverableSignature
|
||||
{ S.rsR = hx "8d5aa94d4288fb8297dd9ff2c9cc5026b09b5305ace1f0b48a864ab116f2d3b0",
|
||||
S.rsS = hx "3eb3b2c117d918736df192c69cef499294f2a070aff74c2bf69776a179b7cdb1",
|
||||
S.rsRecId = 1
|
||||
}
|
||||
it "refuses a digest that is not 32 bytes" $
|
||||
(isLeft <$> S.signRecoverable g txKey "digest") `shouldReturn` True
|
||||
|
||||
transactionTests :: TVar ChaChaDRG -> Spec
|
||||
transactionTests g = do
|
||||
it "signs a contract call as viem does" $
|
||||
(toHex <$$> signEip1559Tx g txKey contractCall)
|
||||
`shouldReturn` Right "02f89383aa36a709843b9aca008506fc23ac00830186a094353535353535353535353535353535353535353580a4f14fcbc81111111111111111111111111111111111111111111111111111111111111111c001a08be78ee2e58a62763be161e3c4440c74c3b6ae56d667b143554e12239a6328e5a0790d86c0398a5295d981d12f4abc10d61b58917b7b7fd21215f7686457aafc19"
|
||||
it "signs a value transfer with zero fields as viem does" $
|
||||
(toHex <$$> signEip1559Tx g txKey transfer)
|
||||
`shouldReturn` Right "02f86a01808001825208943535353535353535353535353535353535353535880de0b6b3a764000080c001a0d04dbcdcfa4c64fe9deb8f0fea4d7a1f07407e80fd2b066b8f6d58a9baf6af0ba074c14688697464225bbe29301db1df7f0c1b9484a52eaf76162524baba2f2791"
|
||||
it "encodes every word of fields wider than 64 bits" $
|
||||
(B.isInfixOf wideFields . toHex <$$> signEip1559Tx g txKey wide)
|
||||
`shouldReturn` Right True
|
||||
where
|
||||
to = right $ strDecode "0x3535353535353535353535353535353535353535"
|
||||
contractCall = Eip1559Tx {txChainId = 11155111, txNonce = 9, txMaxPriorityFeePerGas = 1000000000, txMaxFeePerGas = 30000000000, txGasLimit = 100000, txTo = to, txValue = 0, txData = hx "f14fcbc8" <> B.replicate 32 0x11}
|
||||
transfer = Eip1559Tx {txChainId = 1, txNonce = 0, txMaxPriorityFeePerGas = 0, txMaxFeePerGas = 1, txGasLimit = 21000, txTo = to, txValue = 1000000000000000000, txData = ""}
|
||||
wide = Eip1559Tx {txChainId = maxBound, txNonce = maxBound - 1, txMaxPriorityFeePerGas = 0x10000000000000000000000007, txMaxFeePerGas = 0x80000000000000010000000000000003, txGasLimit = 0x10000000001, txTo = to, txValue = 0x8000000000000001000000000000000100000000000000010000000000000009, txData = ""}
|
||||
wideFields = "88ffffffffffffffff88fffffffffffffffe8d10000000000000000000000007908000000000000001000000000000000386010000000001943535353535353535353535353535353535353535a0800000000000000100000000000000010000000000000001000000000000000980c0"
|
||||
|
||||
txKey :: S.Secp256k1PrivateKey
|
||||
txKey = right $ S.mkPrivateKey $ BA.replicate 32 0x46
|
||||
@@ -15,6 +15,7 @@ import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
|
||||
import Simplex.Messaging.Util (ifM, whenM)
|
||||
import System.Directory (doesFileExist, removeFile)
|
||||
import System.Info (os)
|
||||
import System.Process (readCreateProcess, shell)
|
||||
import Test.Hspec hiding (fit, it)
|
||||
import Util
|
||||
@@ -57,14 +58,13 @@ postgresSchemaDumpTest migrations skipComparisonForDownMigrations testDBOpts@DBO
|
||||
|
||||
getSchema :: FilePath -> IO String
|
||||
getSchema schemaPath = do
|
||||
ci <- envCI
|
||||
let cmd =
|
||||
("pg_dump " <> B.unpack connstr <> " --schema " <> B.unpack testDBSchema)
|
||||
<> " --schema-only --no-owner --no-privileges --no-acl --no-subscriptions --no-tablespaces > "
|
||||
<> schemaPath
|
||||
void $ readCreateProcess (shell cmd) ""
|
||||
threadDelay 20000
|
||||
let sed = (if ci then "sed -i" else "sed -i ''")
|
||||
let sed = (if os == "linux" then "sed -i" else "sed -i ''")
|
||||
void $ readCreateProcess (shell $ sed <> " '/^--/d; /^\\\\restrict/d; /^\\\\unrestrict/d' " <> schemaPath) ""
|
||||
sch <- readFile schemaPath
|
||||
sch `deepseq` pure sch
|
||||
|
||||
@@ -263,6 +263,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
|
||||
prometheusMetricsFile = testPrometheusMetricsFile,
|
||||
pendingENDInterval = 500000,
|
||||
ntfDeliveryInterval = 200000,
|
||||
authErrorDelay = 20000,
|
||||
smpCredentials =
|
||||
ServerCredentials
|
||||
{ caCertificateFile = Just "tests/fixtures/ca.crt",
|
||||
|
||||
+16
-1
@@ -26,7 +26,7 @@ import qualified Data.List.NonEmpty as L
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import SMPAgentClient
|
||||
import SMPClient
|
||||
import ServerTests (decryptMsgV3, sendRecv)
|
||||
import ServerTests (decryptMsgV3, responseTime, sendRecv)
|
||||
import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
|
||||
import qualified Simplex.Messaging.Agent as A
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..))
|
||||
@@ -77,6 +77,8 @@ smpProxyTests = do
|
||||
testChangedFwdVersion
|
||||
it "proxy rejects forwarded correlation ID that is not 24 bytes" $ \_ ->
|
||||
testFwdCorrIdSize
|
||||
it "relay delays AUTH errors to forwarded commands" $ \_ ->
|
||||
testForwardedAuthErrorDelay
|
||||
describe "deliver message via SMP proxy" $ do
|
||||
let srv1 = SMPServer testHost testPort testKeyHash
|
||||
srv2 = SMPServer testHost2 testPort2 testKeyHash
|
||||
@@ -490,6 +492,19 @@ testFwdCorrIdSize =
|
||||
(_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId sessId, SMP.PFWD currentClientSMPRelayVersion cmdPubKey (SMP.EncTransmission ""))
|
||||
reply `shouldBe` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
|
||||
|
||||
testForwardedAuthErrorDelay :: IO ()
|
||||
testForwardedAuthErrorDelay =
|
||||
withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
|
||||
withSmpServerConfigOn (transport @TLS) (updateCfg cfgJ2 $ \cfg_ -> cfg_ {authErrorDelay = 500000}) testPort2 $ \_ -> do
|
||||
g <- C.newRandom
|
||||
ts <- getCurrentTime
|
||||
pc <- either (fail . show) pure =<< getProtocolClient g NRMInteractive (1, testSMPServer, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ())
|
||||
sess <- runExceptT' $ connectSMPProxiedRelay pc NRMInteractive testSMPServer2 Nothing
|
||||
(sendTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxySMPMessage pc NRMInteractive sess Nothing (SMP.EntityId "1234") noMsgFlags "hello"
|
||||
(getLinkTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxyGetSMPQueueLink pc NRMInteractive sess (SMP.EntityId "1234")
|
||||
sendTime `shouldSatisfy` (>= 0.5)
|
||||
getLinkTime `shouldSatisfy` (>= 0.5)
|
||||
|
||||
-- Shared "phase 2" of the reconnection tests: start a healthy relay, confirm it is reachable
|
||||
-- directly (PING, not via the proxy) so a proxy failure can only mean the proxy didn't reconnect,
|
||||
-- let any stored connection error expire, then require the proxy to establish the session (PKEY).
|
||||
|
||||
+49
-21
@@ -36,6 +36,7 @@ import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.List (isPrefixOf)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.String (IsString (..))
|
||||
import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)
|
||||
import Text.Read (readMaybe)
|
||||
import Data.Type.Equality
|
||||
import qualified Data.X509.Validation as XV
|
||||
@@ -58,7 +59,6 @@ import Simplex.Messaging.Transport.Credentials
|
||||
import Simplex.Messaging.Util (whenM)
|
||||
import System.Directory (doesDirectoryExist, doesFileExist, removeDirectoryRecursive, removeFile)
|
||||
import System.IO (IOMode (..), withFile)
|
||||
import System.TimeIt (timeItT)
|
||||
import System.Timeout
|
||||
import Test.HUnit
|
||||
import Test.Hspec hiding (fit, it)
|
||||
@@ -97,6 +97,7 @@ serverTests = do
|
||||
describe "Restore messages (old / v2)" testRestoreExpireMessages
|
||||
describe "Save prometheus metrics" testPrometheusMetrics
|
||||
describe "Timing of AUTH error" testTiming
|
||||
describe "Delay of AUTH error" testAuthErrorDelay
|
||||
describe "Message notifications" $ do
|
||||
testMessageNotifications
|
||||
testMessageServiceNotifications
|
||||
@@ -904,7 +905,7 @@ testServiceSubsTotalCount =
|
||||
_ -> pure Nothing
|
||||
]
|
||||
threadDelay 1500000
|
||||
readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric m `shouldBe` Just 2
|
||||
B.readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric (B.unpack m) `shouldBe` Just 2
|
||||
|
||||
-- Phase 2: associate 1 more queue via SUB, reconnect with SUBS 3, check metric = 3
|
||||
(rPub3, rKey3) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
@@ -934,7 +935,7 @@ testServiceSubsTotalCount =
|
||||
_ -> pure Nothing
|
||||
]
|
||||
threadDelay 1500000
|
||||
readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric m `shouldBe` Just 3
|
||||
B.readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric (B.unpack m) `shouldBe` Just 3
|
||||
|
||||
readServiceSubsMetric :: String -> Maybe Int
|
||||
readServiceSubsMetric content =
|
||||
@@ -1274,21 +1275,21 @@ testTiming =
|
||||
smpTest2Cfg (cfgMS msType) supportedServerSMPRelayVRange t $ \rh sh ->
|
||||
testSameTiming rh sh tst msType
|
||||
where
|
||||
testName :: (C.AuthAlg, C.AuthAlg, Int) -> String
|
||||
testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, _) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg]
|
||||
timingTests :: [(C.AuthAlg, C.AuthAlg, Int)]
|
||||
testName :: (C.AuthAlg, C.AuthAlg) -> String
|
||||
testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg]
|
||||
timingTests :: [(C.AuthAlg, C.AuthAlg)]
|
||||
timingTests =
|
||||
[ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519, 200), -- correct key type
|
||||
-- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448, 150),
|
||||
-- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519, 200),
|
||||
(C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519, 200),
|
||||
(C.AuthAlg C.SEd448, C.AuthAlg C.SEd448, 150), -- correct key type
|
||||
(C.AuthAlg C.SEd448, C.AuthAlg C.SX25519, 200),
|
||||
(C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519, 200),
|
||||
(C.AuthAlg C.SX25519, C.AuthAlg C.SEd448, 150),
|
||||
(C.AuthAlg C.SX25519, C.AuthAlg C.SX25519, 200) -- correct key type
|
||||
[ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519), -- correct key type
|
||||
-- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448),
|
||||
-- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519),
|
||||
(C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519),
|
||||
(C.AuthAlg C.SEd448, C.AuthAlg C.SEd448), -- correct key type
|
||||
(C.AuthAlg C.SEd448, C.AuthAlg C.SX25519),
|
||||
(C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519),
|
||||
(C.AuthAlg C.SX25519, C.AuthAlg C.SEd448),
|
||||
(C.AuthAlg C.SX25519, C.AuthAlg C.SX25519) -- correct key type
|
||||
]
|
||||
timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
|
||||
timeRepeat = fmap fst . responseTime . replicateM_ 5
|
||||
similarTime t1 t2 msType
|
||||
| t1 <= t2 = abs (1 - t1 / t2) < diff
|
||||
| otherwise = similarTime t2 t1 msType
|
||||
@@ -1297,8 +1298,8 @@ testTiming =
|
||||
diff = case msType of
|
||||
ASType SQSPostgres _ -> 0.45
|
||||
_ -> 0.3
|
||||
testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg, Int) -> AStoreType -> Expectation
|
||||
testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) msType = do
|
||||
testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg) -> AStoreType -> Expectation
|
||||
testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) msType = do
|
||||
g <- C.newRandom
|
||||
(rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
|
||||
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
|
||||
@@ -1325,16 +1326,16 @@ testTiming =
|
||||
runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> EntityId -> Command p -> IO ()
|
||||
runTimingTest h badKey qId cmd = do
|
||||
threadDelay 100000
|
||||
_ <- timeRepeat n $ do
|
||||
_ <- timeRepeat $ do
|
||||
-- "warm up" the server
|
||||
Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
|
||||
return ()
|
||||
threadDelay 100000
|
||||
timeWrongKey <- timeRepeat n $ do
|
||||
timeWrongKey <- timeRepeat $ do
|
||||
Resp "cdabcdabcdabcdabcdabcdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdabcdabcdabcdabcdabcdab", qId, cmd)
|
||||
return ()
|
||||
threadDelay 100000
|
||||
timeNoQueue <- timeRepeat n $ do
|
||||
timeNoQueue <- timeRepeat $ do
|
||||
Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
|
||||
return ()
|
||||
let ok = similarTime timeNoQueue timeWrongKey msType
|
||||
@@ -1347,6 +1348,33 @@ testTiming =
|
||||
]
|
||||
ok `shouldBe` True
|
||||
|
||||
testAuthErrorDelay :: SpecWith (ASrvTransport, AStoreType)
|
||||
testAuthErrorDelay =
|
||||
it "should send AUTH errors after the delay and other responses without it" $ \(ATransport t, msType) ->
|
||||
smpTest2Cfg (updateCfg (cfgMS msType) $ \cfg' -> cfg' {authErrorDelay = 500000}) supportedClientSMPRelayVRange t $ \rh sh -> do
|
||||
g <- C.newRandom
|
||||
(rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
|
||||
Resp "1" NoEntity (Ids rId sId _) <- signSendRecv rh rKey ("1", NoEntity, New rPub dhPub)
|
||||
(_, badKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(wrongKeyTime, Resp "2" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("2", rId, SUB)
|
||||
(noQueueTime, Resp "3" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("3", EntityId "1234", SUB)
|
||||
(noLinkTime, Resp "4" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "4", EntityId "1234", LGET)
|
||||
(subTime, Resp "5" _ (SOK Nothing)) <- responseTime $ signSendRecv rh rKey ("5", rId, SUB)
|
||||
Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, OFF)
|
||||
(suspendedTime, Resp "7" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "7", sId, _SEND "hello")
|
||||
wrongKeyTime `shouldSatisfy` (>= 0.5)
|
||||
noQueueTime `shouldSatisfy` (>= 0.5)
|
||||
suspendedTime `shouldSatisfy` (>= 0.5)
|
||||
noLinkTime `shouldSatisfy` (>= 0.5)
|
||||
subTime `shouldSatisfy` (< 0.5)
|
||||
|
||||
responseTime :: IO a -> IO (NominalDiffTime, a)
|
||||
responseTime action = do
|
||||
t <- getCurrentTime
|
||||
r <- action
|
||||
(,r) . (`diffUTCTime` t) <$> getCurrentTime
|
||||
|
||||
testMessageNotifications :: SpecWith (ASrvTransport, AStoreType)
|
||||
testMessageNotifications =
|
||||
it "should create simplex connection, subscribe notifier and deliver notifications" $ \(ATransport t, msType) -> do
|
||||
|
||||
@@ -11,6 +11,7 @@ import CoreTests.BatchingTests
|
||||
import CoreTests.CryptoFileTests
|
||||
import CoreTests.CryptoTests
|
||||
import CoreTests.EncodingTests
|
||||
import CoreTests.EthCryptoTests
|
||||
import CoreTests.MsgStoreTests
|
||||
import CoreTests.RetryIntervalTests
|
||||
import CoreTests.SOCKSSettings
|
||||
@@ -87,6 +88,7 @@ main = do
|
||||
describe "Encoding tests" encodingTests
|
||||
describe "Version range" versionRangeTests
|
||||
describe "Encryption tests" cryptoTests
|
||||
describe "Ethereum crypto tests" ethCryptoTests
|
||||
describe "Encrypted files tests" cryptoFileTests
|
||||
describe "Message store tests" msgStoreTests
|
||||
describe "Retry interval tests" retryIntervalTests
|
||||
|
||||
+1
-1
@@ -56,7 +56,7 @@ instance Example a => Example (TestWrapper a) where
|
||||
ci <- envCI
|
||||
runTest `E.catches` [E.Handler (onTestFailure ci), E.Handler (onTestException ci)]
|
||||
where
|
||||
tt = 120
|
||||
tt = 300
|
||||
runTest =
|
||||
timeout (tt * 1000000) (evaluateExample action params hooks state) `finally` callCommand "sync" >>= \case
|
||||
Just r -> pure r
|
||||
|
||||
Vendored
+315
@@ -0,0 +1,315 @@
|
||||
RECENT CHANGES:
|
||||
* (16 Apr 2013) Added private derivation for i ≥ 0x80000000 (less risk of parent private key leakage)
|
||||
* (30 Apr 2013) Switched from multiplication by I<sub>L</sub> to addition of I<sub>L</sub> (faster, easier implementation)
|
||||
* (25 May 2013) Added test vectors
|
||||
* (15 Jan 2014) Rename keys with index ≥ 0x80000000 to hardened keys, and add explicit conversion functions.
|
||||
* (24 Feb 2017) Added test vectors for hardened derivation with leading zeros
|
||||
* (4 Nov 2020) Added new test vectors for hardened derivation with leading zeros
|
||||
|
||||
<pre>
|
||||
BIP: 32
|
||||
Layer: Applications
|
||||
Title: Hierarchical Deterministic Wallets
|
||||
Authors: Pieter Wuille <[email protected]>
|
||||
Status: Deployed
|
||||
Type: Informational
|
||||
Assigned: 2012-02-11
|
||||
License: BSD-2-Clause
|
||||
</pre>
|
||||
|
||||
==Abstract==
|
||||
|
||||
This document describes hierarchical deterministic wallets (or "HD Wallets"): wallets which can be shared partially or entirely with different systems, each with or without the ability to spend coins.
|
||||
|
||||
The specification is intended to set a standard for deterministic wallets that can be interchanged between different clients. Although the wallets described here have many features, not all are required by supporting clients.
|
||||
|
||||
The specification consists of two parts. In the first part, a system for deriving a tree of keypairs from a single seed is presented. The second part demonstrates how to build a wallet structure on top of such a tree.
|
||||
|
||||
==Copyright==
|
||||
|
||||
This BIP is licensed under the 2-clause BSD license.
|
||||
|
||||
==Motivation==
|
||||
|
||||
The Bitcoin reference client uses randomly generated keys. In order to avoid the necessity for a backup after every transaction, (by default) 100 keys are cached in a pool of reserve keys. Still, these wallets are not intended to be shared and used on several systems simultaneously. They support hiding their private keys by using the wallet encrypt feature and not sharing the password, but such "neutered" wallets lose the power to generate public keys as well.
|
||||
|
||||
Deterministic wallets do not require such frequent backups, and elliptic curve mathematics permit schemes where one can calculate the public keys without revealing the private keys. This permits for example a webshop business to let its webserver generate fresh addresses (public key hashes) for each order or for each customer, without giving the webserver access to the corresponding private keys (which are required for spending the received funds).
|
||||
|
||||
However, deterministic wallets typically consist of a single "chain" of keypairs. The fact that there is only one chain means that sharing a wallet happens on an all-or-nothing basis. However, in some cases one only wants some (public) keys to be shared and recoverable. In the example of a webshop, the webserver does not need access to all public keys of the merchant's wallet; only to those addresses which are used to receive customers' payments, and not for example the change addresses that are generated when the merchant spends money. Hierarchical deterministic wallets allow such selective sharing by supporting multiple keypair chains, derived from a single root.
|
||||
|
||||
==Specification: Key derivation==
|
||||
|
||||
===Conventions===
|
||||
|
||||
In the rest of this text we will assume the public key cryptography used in Bitcoin, namely elliptic curve cryptography using the field and curve parameters defined by secp256k1 (http://www.secg.org/sec2-v2.pdf). Variables below are either:
|
||||
* Integers modulo the order of the curve (referred to as n).
|
||||
* Coordinates of points on the curve.
|
||||
* Byte sequences.
|
||||
|
||||
Addition (+) of two coordinate pair is defined as application of the EC group operation.
|
||||
Concatenation (||) is the operation of appending one byte sequence onto another.
|
||||
|
||||
As standard conversion functions, we assume:
|
||||
* point(p): returns the coordinate pair resulting from EC point multiplication (repeated application of the EC group operation) of the secp256k1 base point with the integer p (i.e., the operation used to compute a public key from a private key).
|
||||
* ser<sub>32</sub>(i): serialize a 32-bit unsigned integer i as a 4-byte sequence, most significant byte first.
|
||||
* ser<sub>256</sub>(p): serializes the integer p as a 32-byte sequence, most significant byte first.
|
||||
* ser<sub>P</sub>(P): serializes the coordinate pair P = (x,y) (i.e., the public key) as a byte sequence using [https://www.secg.org/sec1-v2.pdf SEC1]'s compressed form: (0x02 or 0x03) || ser<sub>256</sub>(x), where the header byte depends on the parity of the omitted y coordinate.
|
||||
* parse<sub>256</sub>(p): interprets a 32-byte sequence as a 256-bit number, most significant byte first.
|
||||
|
||||
|
||||
===Extended keys===
|
||||
|
||||
In what follows, we will define a function that derives a number of child keys from a parent key. In order to prevent these from depending solely on the key itself, we extend both private and public keys first with an extra 256 bits of entropy. This extension, called the chain code, is identical for corresponding private and public keys, and consists of 32 bytes.
|
||||
|
||||
We represent an extended private key as (k, c), with k the normal private key, and c the chain code. An extended public key is represented as (K, c), with K = point(k) and c the chain code.
|
||||
|
||||
Each extended key has 2<sup>31</sup> normal child keys, and 2<sup>31</sup> hardened child keys. Each of these child keys has an index. The normal child keys use indices 0 through 2<sup>31</sup>-1. The hardened child keys use indices 2<sup>31</sup> through 2<sup>32</sup>-1. To ease notation for hardened key indices, a number i<sub>H</sub> represents i+2<sup>31</sup>.
|
||||
|
||||
===Child key derivation (CKD) functions===
|
||||
|
||||
Given a parent extended key and an index i, it is possible to compute the corresponding child extended key. The algorithm to do so depends on whether the child is a hardened key or not (or, equivalently, whether i ≥ 2<sup>31</sup>), and whether we're talking about private or public keys.
|
||||
|
||||
====Private parent key → private child key====
|
||||
|
||||
The function CKDpriv((k<sub>par</sub>, c<sub>par</sub>), i) → (k<sub>i</sub>, c<sub>i</sub>) computes a child extended private key from the parent extended private key:
|
||||
* Check whether i ≥ 2<sup>31</sup> (whether the child is a hardened key).
|
||||
** If so (hardened child): let I = HMAC-SHA512(Key = c<sub>par</sub>, Data = 0x00 || ser<sub>256</sub>(k<sub>par</sub>) || ser<sub>32</sub>(i)). (Note: The 0x00 pads the private key to make it 33 bytes long.)
|
||||
** If not (normal child): let I = HMAC-SHA512(Key = c<sub>par</sub>, Data = ser<sub>P</sub>(point(k<sub>par</sub>)) || ser<sub>32</sub>(i)).
|
||||
* Split I into two 32-byte sequences, I<sub>L</sub> and I<sub>R</sub>.
|
||||
* The returned child key k<sub>i</sub> is parse<sub>256</sub>(I<sub>L</sub>) + k<sub>par</sub> (mod n).
|
||||
* The returned chain code c<sub>i</sub> is I<sub>R</sub>.
|
||||
* In case parse<sub>256</sub>(I<sub>L</sub>) ≥ n or k<sub>i</sub> = 0, the resulting key is invalid, and one should proceed with the next value for i. (Note: this has probability lower than 1 in 2<sup>127</sup>.)
|
||||
|
||||
The HMAC-SHA512 function is specified in [http://tools.ietf.org/html/rfc4231 RFC 4231].
|
||||
|
||||
====Public parent key → public child key====
|
||||
|
||||
The function CKDpub((K<sub>par</sub>, c<sub>par</sub>), i) → (K<sub>i</sub>, c<sub>i</sub>) computes a child extended public key from the parent extended public key. It is only defined for non-hardened child keys.
|
||||
* Check whether i ≥ 2<sup>31</sup> (whether the child is a hardened key).
|
||||
** If so (hardened child): return failure
|
||||
** If not (normal child): let I = HMAC-SHA512(Key = c<sub>par</sub>, Data = ser<sub>P</sub>(K<sub>par</sub>) || ser<sub>32</sub>(i)).
|
||||
* Split I into two 32-byte sequences, I<sub>L</sub> and I<sub>R</sub>.
|
||||
* The returned child key K<sub>i</sub> is point(parse<sub>256</sub>(I<sub>L</sub>)) + K<sub>par</sub>.
|
||||
* The returned chain code c<sub>i</sub> is I<sub>R</sub>.
|
||||
* In case parse<sub>256</sub>(I<sub>L</sub>) ≥ n or K<sub>i</sub> is the point at infinity, the resulting key is invalid, and one should proceed with the next value for i.
|
||||
|
||||
====Private parent key → public child key====
|
||||
|
||||
The function N((k, c)) → (K, c) computes the extended public key corresponding to an extended private key (the "neutered" version, as it removes the ability to sign transactions).
|
||||
* The returned key K is point(k).
|
||||
* The returned chain code c is just the passed chain code.
|
||||
|
||||
To compute the public child key of a parent private key:
|
||||
* N(CKDpriv((k<sub>par</sub>, c<sub>par</sub>), i)) (works always).
|
||||
* CKDpub(N(k<sub>par</sub>, c<sub>par</sub>), i) (works only for non-hardened child keys).
|
||||
The fact that they are equivalent is what makes non-hardened keys useful (one can derive child public keys of a given parent key without knowing any private key), and also what distinguishes them from hardened keys. The reason for not always using non-hardened keys (which are more useful) is security; see further below for more information.
|
||||
|
||||
====Public parent key → private child key====
|
||||
|
||||
This is not possible.
|
||||
|
||||
===The key tree===
|
||||
|
||||
The next step is cascading several CKD constructions to build a tree. We start with one root, the master extended key m. By evaluating CKDpriv(m,i) for several values of i, we get a number of level-1 derived nodes. As each of these is again an extended key, CKDpriv can be applied to those as well.
|
||||
|
||||
To shorten notation, we will write CKDpriv(CKDpriv(CKDpriv(m,3<sub>H</sub>),2),5) as m/3<sub>H</sub>/2/5. Equivalently for public keys, we write CKDpub(CKDpub(CKDpub(M,3),2),5) as M/3/2/5. This results in the following identities:
|
||||
* N(m/a/b/c) = N(m/a/b)/c = N(m/a)/b/c = N(m)/a/b/c = M/a/b/c.
|
||||
* N(m/a<sub>H</sub>/b/c) = N(m/a<sub>H</sub>/b)/c = N(m/a<sub>H</sub>)/b/c.
|
||||
However, N(m/a<sub>H</sub>) cannot be rewritten as N(m)/a<sub>H</sub>, as the latter is not possible.
|
||||
|
||||
Each leaf node in the tree corresponds to an actual key, while the internal nodes correspond to the collections of keys that descend from them. The chain codes of the leaf nodes are ignored, and only their embedded private or public key is relevant. Because of this construction, knowing an extended private key allows reconstruction of all descendant private keys and public keys, and knowing an extended public key allows reconstruction of all descendant non-hardened public keys.
|
||||
|
||||
===Key identifiers===
|
||||
|
||||
Extended keys can be identified by the Hash160 (RIPEMD160 after SHA256) of the serialized ECDSA public key K, ignoring the chain code. This corresponds exactly to the data used in traditional Bitcoin addresses. It is not advised to represent this data in base58 format though, as it may be interpreted as an address that way (and wallet software is not required to accept payment to the chain key itself).
|
||||
|
||||
The first 32 bits of the identifier are called the key fingerprint.
|
||||
|
||||
===Serialization format===
|
||||
|
||||
Extended public and private keys are serialized as follows:
|
||||
* 4 bytes: version bytes (mainnet: 0x0488B21E public, 0x0488ADE4 private; testnet: 0x043587CF public, 0x04358394 private)
|
||||
* 1 byte: depth: 0x00 for master nodes, 0x01 for level-1 derived keys, ....
|
||||
* 4 bytes: the fingerprint of the parent's key (0x00000000 if master key)
|
||||
* 4 bytes: child number. This is ser<sub>32</sub>(i) for i in x<sub>i</sub> = x<sub>par</sub>/i, with x<sub>i</sub> the key being serialized. (0x00000000 if master key)
|
||||
* 32 bytes: the chain code
|
||||
* 33 bytes: the public key or private key data (ser<sub>P</sub>(K) for public keys, 0x00 || ser<sub>256</sub>(k) for private keys)
|
||||
|
||||
This 78 byte structure can be encoded like other Bitcoin data in Base58, by first adding 32 checksum bits (derived from the double SHA-256 checksum), and then converting to the Base58 representation. This results in a Base58-encoded string of exactly 111 characters. Because of the choice of the version bytes, the Base58 representation will start with "xprv" or "xpub" on mainnet, "tprv" or "tpub" on testnet.
|
||||
|
||||
Note that the fingerprint of the parent only serves as a fast way to detect parent and child nodes in software, and software must be willing to deal with collisions. Internally, the full 160-bit identifier could be used.
|
||||
|
||||
When importing a serialized extended public key, implementations must verify whether the X coordinate in the public key data corresponds to a point on the curve. If not, the extended public key is invalid.
|
||||
|
||||
===Master key generation===
|
||||
|
||||
The total number of possible extended keypairs is almost 2<sup>512</sup>, but the produced keys are only 256 bits long, and offer about half of that in terms of security. Therefore, master keys are not generated directly, but instead from a potentially short seed value.
|
||||
|
||||
* Generate a seed byte sequence S of a chosen length (between 128 and 512 bits; 256 bits is advised) from a (P)RNG.
|
||||
* Calculate I = HMAC-SHA512(Key = "Bitcoin seed", Data = S)
|
||||
* Split I into two 32-byte sequences, I<sub>L</sub> and I<sub>R</sub>.
|
||||
* Use parse<sub>256</sub>(I<sub>L</sub>) as master secret key, and I<sub>R</sub> as master chain code.
|
||||
In case parse<sub>256</sub>(I<sub>L</sub>) is 0 or parse<sub>256</sub>(I<sub>L</sub>) ≥ n, the master key is invalid.
|
||||
|
||||
<img src=bip-0032/derivation.png></img>
|
||||
|
||||
==Specification: Wallet structure==
|
||||
|
||||
The previous sections specified key trees and their nodes. The next step is imposing a wallet structure on this tree. The layout defined in this section is a default only, though clients are encouraged to mimic it for compatibility, even if not all features are supported.
|
||||
|
||||
===The default wallet layout===
|
||||
|
||||
An HDW is organized as several 'accounts'. Accounts are numbered, the default account ("") being number 0. Clients are not required to support more than one account - if not, they only use the default account.
|
||||
|
||||
Each account is composed of two keypair chains: an internal and an external one. The external keychain is used to generate new public addresses, while the internal keychain is used for all other operations (change addresses, generation addresses, ..., anything that doesn't need to be communicated). Clients that do not support separate keychains for these should use the external one for everything.
|
||||
* m/i<sub>H</sub>/0/k corresponds to the k'th keypair of the external chain of account number i of the HDW derived from master m.
|
||||
* m/i<sub>H</sub>/1/k corresponds to the k'th keypair of the internal chain of account number i of the HDW derived from master m.
|
||||
|
||||
===Use cases===
|
||||
|
||||
====Full wallet sharing: m====
|
||||
|
||||
In cases where two systems need to access a single shared wallet, and both need to be able to perform spendings, one needs to share the master private extended key. Nodes can keep a pool of N look-ahead keys cached for external chains, to watch for incoming payments. The look-ahead for internal chains can be very small, as no gaps are to be expected here. An extra look-ahead could be active for the first unused account's chains - triggering the creation of a new account when used. Note that the name of the account will still need to be entered manually and cannot be synchronized via the block chain.
|
||||
|
||||
====Audits: N(m/*)====
|
||||
|
||||
In case an auditor needs full access to the list of incoming and outgoing payments, one can share all account public extended keys. This will allow the auditor to see all transactions from and to the wallet, in all accounts, but not a single secret key.
|
||||
|
||||
====Per-office balances: m/i<sub>H</sub>====
|
||||
|
||||
When a business has several independent offices, they can all use wallets derived from a single master. This will allow the headquarters to maintain a super-wallet that sees all incoming and outgoing transactions of all offices, and even permit moving money between the offices.
|
||||
|
||||
====Recurrent business-to-business transactions: N(m/i<sub>H</sub>/0)====
|
||||
|
||||
In case two business partners often transfer money, one can use the extended public key for the external chain of a specific account (M/i h/0) as a sort of "super address", allowing frequent transactions that cannot (easily) be associated, but without needing to request a new address for each payment.
|
||||
Such a mechanism could also be used by mining pool operators as a variable payout address.
|
||||
|
||||
====Unsecure money receiver: N(m/i<sub>H</sub>/0)====
|
||||
|
||||
When an unsecure webserver is used to run an e-commerce site, it needs to know public addresses that are used to receive payments. The webserver only needs to know the public extended key of the external chain of a single account. This means someone illegally obtaining access to the webserver can at most see all incoming payments but will not be able to steal the money, will not (trivially) be able to distinguish outgoing transactions, nor be able to see payments received by other webservers if there are several.
|
||||
|
||||
==Compatibility==
|
||||
|
||||
To comply with this standard, a client must at least be able to import an extended public or private key, to give access to its direct descendants as wallet keys. The wallet structure (master/account/chain/subchain) presented in the second part of the specification is advisory only, but is suggested as a minimal structure for easy compatibility - even when no separate accounts or distinction between internal and external chains is made. However, implementations may deviate from it for specific needs; more complex applications may call for a more complex tree structure.
|
||||
|
||||
==Security==
|
||||
|
||||
In addition to the expectations from the EC public-key cryptography itself:
|
||||
* Given a public key K, an attacker cannot find the corresponding private key more efficiently than by solving the EC discrete logarithm problem (assumed to require 2<sup>128</sup> group operations).
|
||||
the intended security properties of this standard are:
|
||||
* Given a child extended private key (k<sub>i</sub>,c<sub>i</sub>) and the integer i, an attacker cannot find the parent private key k<sub>par</sub> more efficiently than a 2<sup>256</sup> brute force of HMAC-SHA512.
|
||||
* Given any number (2 ≤ N ≤ 2<sup>32</sup>-1) of (index, extended private key) tuples (i<sub>j</sub>,(k<sub>i<sub>j</sub></sub>,c<sub>i<sub>j</sub></sub>)), with distinct i<sub>j</sub>'s, determining whether they are derived from a common parent extended private key (i.e., whether there exists a (k<sub>par</sub>,c<sub>par</sub>) such that for each j in (0..N-1) CKDpriv((k<sub>par</sub>,c<sub>par</sub>),i<sub>j</sub>)=(k<sub>i<sub>j</sub></sub>,c<sub>i<sub>j</sub></sub>)), cannot be done more efficiently than a 2<sup>256</sup> brute force of HMAC-SHA512.
|
||||
Note however that the following properties do not exist:
|
||||
* Given a parent extended public key (K<sub>par</sub>,c<sub>par</sub>) and a child public key (K<sub>i</sub>), it is hard to find i.
|
||||
* Given a parent extended public key (K<sub>par</sub>,c<sub>par</sub>) and a non-hardened child private key (k<sub>i</sub>), it is hard to find k<sub>par</sub>.
|
||||
|
||||
===Implications===
|
||||
|
||||
Private and public keys must be kept safe as usual. Leaking a private key means access to coins - leaking a public key can mean loss of privacy.
|
||||
|
||||
Somewhat more care must be taken regarding extended keys, as these correspond to an entire (sub)tree of keys.
|
||||
|
||||
One weakness that may not be immediately obvious, is that knowledge of a parent extended public key plus any non-hardened private key descending from it is equivalent to knowing the parent extended private key (and thus every private and public key descending from it). This means that extended public keys must be treated more carefully than regular public keys.
|
||||
It is also the reason for the existence of hardened keys, and why they are used for the account level in the tree. This way, a leak of account-specific (or below) private keys never risks compromising the master or other accounts.
|
||||
|
||||
|
||||
==Test Vectors==
|
||||
|
||||
===Test vector 1===
|
||||
|
||||
Seed (hex): 000102030405060708090a0b0c0d0e0f
|
||||
* Chain m
|
||||
** ext pub: xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8
|
||||
** ext prv: xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi
|
||||
* Chain m/0<sub>H</sub>
|
||||
** ext pub: xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw
|
||||
** ext prv: xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7
|
||||
* Chain m/0<sub>H</sub>/1
|
||||
** ext pub: xpub6ASuArnXKPbfEwhqN6e3mwBcDTgzisQN1wXN9BJcM47sSikHjJf3UFHKkNAWbWMiGj7Wf5uMash7SyYq527Hqck2AxYysAA7xmALppuCkwQ
|
||||
** ext prv: xprv9wTYmMFdV23N2TdNG573QoEsfRrWKQgWeibmLntzniatZvR9BmLnvSxqu53Kw1UmYPxLgboyZQaXwTCg8MSY3H2EU4pWcQDnRnrVA1xe8fs
|
||||
* Chain m/0<sub>H</sub>/1/2<sub>H</sub>
|
||||
** ext pub: xpub6D4BDPcP2GT577Vvch3R8wDkScZWzQzMMUm3PWbmWvVJrZwQY4VUNgqFJPMM3No2dFDFGTsxxpG5uJh7n7epu4trkrX7x7DogT5Uv6fcLW5
|
||||
** ext prv: xprv9z4pot5VBttmtdRTWfWQmoH1taj2axGVzFqSb8C9xaxKymcFzXBDptWmT7FwuEzG3ryjH4ktypQSAewRiNMjANTtpgP4mLTj34bhnZX7UiM
|
||||
* Chain m/0<sub>H</sub>/1/2<sub>H</sub>/2
|
||||
** ext pub: xpub6FHa3pjLCk84BayeJxFW2SP4XRrFd1JYnxeLeU8EqN3vDfZmbqBqaGJAyiLjTAwm6ZLRQUMv1ZACTj37sR62cfN7fe5JnJ7dh8zL4fiyLHV
|
||||
** ext prv: xprvA2JDeKCSNNZky6uBCviVfJSKyQ1mDYahRjijr5idH2WwLsEd4Hsb2Tyh8RfQMuPh7f7RtyzTtdrbdqqsunu5Mm3wDvUAKRHSC34sJ7in334
|
||||
* Chain m/0<sub>H</sub>/1/2<sub>H</sub>/2/1000000000
|
||||
** ext pub: xpub6H1LXWLaKsWFhvm6RVpEL9P4KfRZSW7abD2ttkWP3SSQvnyA8FSVqNTEcYFgJS2UaFcxupHiYkro49S8yGasTvXEYBVPamhGW6cFJodrTHy
|
||||
** ext prv: xprvA41z7zogVVwxVSgdKUHDy1SKmdb533PjDz7J6N6mV6uS3ze1ai8FHa8kmHScGpWmj4WggLyQjgPie1rFSruoUihUZREPSL39UNdE3BBDu76
|
||||
|
||||
===Test vector 2===
|
||||
|
||||
Seed (hex): fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542
|
||||
* Chain m
|
||||
** ext pub: xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB
|
||||
** ext prv: xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U
|
||||
* Chain m/0
|
||||
** ext pub: xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH
|
||||
** ext prv: xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt
|
||||
* Chain m/0/2147483647<sub>H</sub>
|
||||
** ext pub: xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a
|
||||
** ext prv: xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9
|
||||
* Chain m/0/2147483647<sub>H</sub>/1
|
||||
** ext pub: xpub6DF8uhdarytz3FWdA8TvFSvvAh8dP3283MY7p2V4SeE2wyWmG5mg5EwVvmdMVCQcoNJxGoWaU9DCWh89LojfZ537wTfunKau47EL2dhHKon
|
||||
** ext prv: xprv9zFnWC6h2cLgpmSA46vutJzBcfJ8yaJGg8cX1e5StJh45BBciYTRXSd25UEPVuesF9yog62tGAQtHjXajPPdbRCHuWS6T8XA2ECKADdw4Ef
|
||||
* Chain m/0/2147483647<sub>H</sub>/1/2147483646<sub>H</sub>
|
||||
** ext pub: xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL
|
||||
** ext prv: xprvA1RpRA33e1JQ7ifknakTFpgNXPmW2YvmhqLQYMmrj4xJXXWYpDPS3xz7iAxn8L39njGVyuoseXzU6rcxFLJ8HFsTjSyQbLYnMpCqE2VbFWc
|
||||
* Chain m/0/2147483647<sub>H</sub>/1/2147483646<sub>H</sub>/2
|
||||
** ext pub: xpub6FnCn6nSzZAw5Tw7cgR9bi15UV96gLZhjDstkXXxvCLsUXBGXPdSnLFbdpq8p9HmGsApME5hQTZ3emM2rnY5agb9rXpVGyy3bdW6EEgAtqt
|
||||
** ext prv: xprvA2nrNbFZABcdryreWet9Ea4LvTJcGsqrMzxHx98MMrotbir7yrKCEXw7nadnHM8Dq38EGfSh6dqA9QWTyefMLEcBYJUuekgW4BYPJcr9E7j
|
||||
|
||||
===Test vector 3===
|
||||
|
||||
These vectors test for the retention of leading zeros. See [https://github.com/bitpay/bitcore-lib/issues/47 bitpay/bitcore-lib#47] and [https://github.com/iancoleman/bip39/issues/58 iancoleman/bip39#58] for more information.
|
||||
|
||||
Seed (hex): 4b381541583be4423346c643850da4b320e46a87ae3d2a4e6da11eba819cd4acba45d239319ac14f863b8d5ab5a0d0c64d2e8a1e7d1457df2e5a3c51c73235be
|
||||
* Chain m
|
||||
** ext pub: xpub661MyMwAqRbcEZVB4dScxMAdx6d4nFc9nvyvH3v4gJL378CSRZiYmhRoP7mBy6gSPSCYk6SzXPTf3ND1cZAceL7SfJ1Z3GC8vBgp2epUt13
|
||||
** ext prv: xprv9s21ZrQH143K25QhxbucbDDuQ4naNntJRi4KUfWT7xo4EKsHt2QJDu7KXp1A3u7Bi1j8ph3EGsZ9Xvz9dGuVrtHHs7pXeTzjuxBrCmmhgC6
|
||||
* Chain m/0<sub>H</sub>
|
||||
** ext pub: xpub68NZiKmJWnxxS6aaHmn81bvJeTESw724CRDs6HbuccFQN9Ku14VQrADWgqbhhTHBaohPX4CjNLf9fq9MYo6oDaPPLPxSb7gwQN3ih19Zm4Y
|
||||
** ext prv: xprv9uPDJpEQgRQfDcW7BkF7eTya6RPxXeJCqCJGHuCJ4GiRVLzkTXBAJMu2qaMWPrS7AANYqdq6vcBcBUdJCVVFceUvJFjaPdGZ2y9WACViL4L
|
||||
|
||||
===Test vector 4===
|
||||
|
||||
These vectors test for the retention of leading zeros. See [https://github.com/btcsuite/btcutil/issues/172 btcsuite/btcutil#172] for more information.
|
||||
|
||||
Seed (hex): 3ddd5602285899a946114506157c7997e5444528f3003f6134712147db19b678
|
||||
* Chain m
|
||||
** ext pub: xpub661MyMwAqRbcGczjuMoRm6dXaLDEhW1u34gKenbeYqAix21mdUKJyuyu5F1rzYGVxyL6tmgBUAEPrEz92mBXjByMRiJdba9wpnN37RLLAXa
|
||||
** ext prv: xprv9s21ZrQH143K48vGoLGRPxgo2JNkJ3J3fqkirQC2zVdk5Dgd5w14S7fRDyHH4dWNHUgkvsvNDCkvAwcSHNAQwhwgNMgZhLtQC63zxwhQmRv
|
||||
* Chain m/0<sub>H</sub>
|
||||
** ext pub: xpub69AUMk3qDBi3uW1sXgjCmVjJ2G6WQoYSnNHyzkmdCHEhSZ4tBok37xfFEqHd2AddP56Tqp4o56AePAgCjYdvpW2PU2jbUPFKsav5ut6Ch1m
|
||||
** ext prv: xprv9vB7xEWwNp9kh1wQRfCCQMnZUEG21LpbR9NPCNN1dwhiZkjjeGRnaALmPXCX7SgjFTiCTT6bXes17boXtjq3xLpcDjzEuGLQBM5ohqkao9G
|
||||
* Chain m/0<sub>H</sub>/1<sub>H</sub>
|
||||
** ext pub: xpub6BJA1jSqiukeaesWfxe6sNK9CCGaujFFSJLomWHprUL9DePQ4JDkM5d88n49sMGJxrhpjazuXYWdMf17C9T5XnxkopaeS7jGk1GyyVziaMt
|
||||
** ext prv: xprv9xJocDuwtYCMNAo3Zw76WENQeAS6WGXQ55RCy7tDJ8oALr4FWkuVoHJeHVAcAqiZLE7Je3vZJHxspZdFHfnBEjHqU5hG1Jaj32dVoS6XLT1
|
||||
|
||||
===Test vector 5===
|
||||
|
||||
These vectors test that invalid extended keys are recognized as invalid.
|
||||
|
||||
* xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6LBpB85b3D2yc8sfvZU521AAwdZafEz7mnzBBsz4wKY5fTtTQBm (pubkey version / prvkey mismatch)
|
||||
* xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFGTQQD3dC4H2D5GBj7vWvSQaaBv5cxi9gafk7NF3pnBju6dwKvH (prvkey version / pubkey mismatch)
|
||||
* xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6Txnt3siSujt9RCVYsx4qHZGc62TG4McvMGcAUjeuwZdduYEvFn (invalid pubkey prefix 04)
|
||||
* xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFGpWnsj83BHtEy5Zt8CcDr1UiRXuWCmTQLxEK9vbz5gPstX92JQ (invalid prvkey prefix 04)
|
||||
* xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6N8ZMMXctdiCjxTNq964yKkwrkBJJwpzZS4HS2fxvyYUA4q2Xe4 (invalid pubkey prefix 01)
|
||||
* xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFAzHGBP2UuGCqWLTAPLcMtD9y5gkZ6Eq3Rjuahrv17fEQ3Qen6J (invalid prvkey prefix 01)
|
||||
* xprv9s2SPatNQ9Vc6GTbVMFPFo7jsaZySyzk7L8n2uqKXJen3KUmvQNTuLh3fhZMBoG3G4ZW1N2kZuHEPY53qmbZzCHshoQnNf4GvELZfqTUrcv (zero depth with non-zero parent fingerprint)
|
||||
* xpub661no6RGEX3uJkY4bNnPcw4URcQTrSibUZ4NqJEw5eBkv7ovTwgiT91XX27VbEXGENhYRCf7hyEbWrR3FewATdCEebj6znwMfQkhRYHRLpJ (zero depth with non-zero parent fingerprint)
|
||||
* xprv9s21ZrQH4r4TsiLvyLXqM9P7k1K3EYhA1kkD6xuquB5i39AU8KF42acDyL3qsDbU9NmZn6MsGSUYZEsuoePmjzsB3eFKSUEh3Gu1N3cqVUN (zero depth with non-zero index)
|
||||
* xpub661MyMwAuDcm6CRQ5N4qiHKrJ39Xe1R1NyfouMKTTWcguwVcfrZJaNvhpebzGerh7gucBvzEQWRugZDuDXjNDRmXzSZe4c7mnTK97pTvGS8 (zero depth with non-zero index)
|
||||
* DMwo58pR1QLEFihHiXPVykYB6fJmsTeHvyTp7hRThAtCX8CvYzgPcn8XnmdfHGMQzT7ayAmfo4z3gY5KfbrZWZ6St24UVf2Qgo6oujFktLHdHY4 (unknown extended key version)
|
||||
* DMwo58pR1QLEFihHiXPVykYB6fJmsTeHvyTp7hRThAtCX8CvYzgPcn8XnmdfHPmHJiEDXkTiJTVV9rHEBUem2mwVbbNfvT2MTcAqj3nesx8uBf9 (unknown extended key version)
|
||||
* xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzF93Y5wvzdUayhgkkFoicQZcP3y52uPPxFnfoLZB21Teqt1VvEHx (private key 0 not in 1..n-1)
|
||||
* xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFAzHGBP2UuGCqWLTAPLcMtD5SDKr24z3aiUvKr9bJpdrcLg1y3G (private key n not in 1..n-1)
|
||||
* xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6Q5JXayek4PRsn35jii4veMimro1xefsM58PgBMrvdYre8QyULY (invalid pubkey 020000000000000000000000000000000000000000000000000000000000000007)
|
||||
* xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHL (invalid checksum)
|
||||
|
||||
==Acknowledgements==
|
||||
|
||||
* Gregory Maxwell for the original idea of type-2 deterministic wallets, and many discussions about it.
|
||||
* Alan Reiner for the implementation of this scheme in Armory, and the suggestions that followed from that.
|
||||
* Eric Lombrozo for reviewing and revising this BIP.
|
||||
* Mike Caldwell for the version bytes to obtain human-recognizable Base58 strings.
|
||||
Vendored
+1754
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user