diff options
author | Joe Crayne <joe@jerkface.net> | 2020-01-24 22:23:39 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-25 19:18:12 -0500 |
commit | bc93745f7591b3b079d660ca98715911495fceeb (patch) | |
tree | c871a6ad1f02ab072d63607f966787908e6fed7d /tox-crypto | |
parent | d2e220c86325b55e22409b1a7da12b06a8052e76 (diff) |
Use monotonic counter for SecretsCache priority.
Diffstat (limited to 'tox-crypto')
-rw-r--r-- | tox-crypto/src/Crypto/Tox.hs | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/tox-crypto/src/Crypto/Tox.hs b/tox-crypto/src/Crypto/Tox.hs index 602ead0a..aea684ec 100644 --- a/tox-crypto/src/Crypto/Tox.hs +++ b/tox-crypto/src/Crypto/Tox.hs | |||
@@ -41,6 +41,7 @@ module Crypto.Tox | |||
41 | , decodePlain | 41 | , decodePlain |
42 | -- , computeSharedSecret | 42 | -- , computeSharedSecret |
43 | , lookupSharedSecret | 43 | , lookupSharedSecret |
44 | , lookupSharedSecretSTM | ||
44 | , lookupNonceFunction | 45 | , lookupNonceFunction |
45 | , lookupNonceFunctionSTM | 46 | , lookupNonceFunctionSTM |
46 | , Payload(..) | 47 | , Payload(..) |
@@ -369,11 +370,14 @@ lookupSharedSecret :: TransportCrypto -> SecretKey -> PublicKey -> Nonce24 -> IO | |||
369 | lookupSharedSecret crypto sk recipient nonce | 370 | lookupSharedSecret crypto sk recipient nonce |
370 | = ($ nonce) <$> lookupNonceFunction crypto sk recipient | 371 | = ($ nonce) <$> lookupNonceFunction crypto sk recipient |
371 | 372 | ||
373 | lookupSharedSecretSTM :: TransportCrypto -> SecretKey -> PublicKey -> Nonce24 -> STM State | ||
374 | lookupSharedSecretSTM crypto sk recipient nonce | ||
375 | = ($ nonce) <$> lookupNonceFunctionSTM crypto sk recipient | ||
376 | |||
372 | {-# INLINE lookupNonceFunction #-} | 377 | {-# INLINE lookupNonceFunction #-} |
373 | lookupNonceFunction :: TransportCrypto -> SecretKey -> PublicKey -> IO (Nonce24 -> State) | 378 | lookupNonceFunction :: TransportCrypto -> SecretKey -> PublicKey -> IO (Nonce24 -> State) |
374 | lookupNonceFunction c@(TransportCrypto{secretsCache}) sk recipient = do | 379 | lookupNonceFunction c@(TransportCrypto{secretsCache}) sk recipient = do |
375 | now <- getPOSIXTime | 380 | atomically $ lookupNonceFunctionSTM c sk recipient |
376 | atomically $ lookupNonceFunctionSTM now c sk recipient | ||
377 | 381 | ||
378 | -- | Dummy, used to indicate computeSharedSecret failure. This is a way to provide | 382 | -- | Dummy, used to indicate computeSharedSecret failure. This is a way to provide |
379 | -- the old non-failing interface compatibly. | 383 | -- the old non-failing interface compatibly. |
@@ -389,8 +393,10 @@ dummyState = State hash xsalsa | |||
389 | -- of the transaction fails, we may end up forgoing a computation that could have been cached. | 393 | -- of the transaction fails, we may end up forgoing a computation that could have been cached. |
390 | -- Use with care. In most circumstances you probably want 'lookupNonceFunction'. It also commits | 394 | -- Use with care. In most circumstances you probably want 'lookupNonceFunction'. It also commits |
391 | -- us to using TVars to store the cache. | 395 | -- us to using TVars to store the cache. |
392 | lookupNonceFunctionSTM :: POSIXTime -> TransportCrypto -> SecretKey -> PublicKey -> STM (Nonce24 -> State) | 396 | lookupNonceFunctionSTM :: TransportCrypto -> SecretKey -> PublicKey -> STM (Nonce24 -> State) |
393 | lookupNonceFunctionSTM now TransportCrypto{secretsCache} sk recipient = do | 397 | lookupNonceFunctionSTM TransportCrypto{secretsCache} sk recipient = do |
398 | now <- readTVar $ secretsTime secretsCache | ||
399 | writeTVar (secretsTime secretsCache) $! now + 1 | ||
394 | mm <- readTVar $ sharedSecret secretsCache | 400 | mm <- readTVar $ sharedSecret secretsCache |
395 | case MM.lookup' recipient mm of | 401 | case MM.lookup' recipient mm of |
396 | Nothing -> case computeSharedSecret sk recipient of | 402 | Nothing -> case computeSharedSecret sk recipient of |
@@ -579,12 +585,13 @@ putAliasedAsymm (Asymm key nonce dta) = put nonce >> putPublicKey key >> put dta | |||
579 | 585 | ||
580 | data SecretsCache = SecretsCache | 586 | data SecretsCache = SecretsCache |
581 | { sharedSecret :: TVar (MinMaxPSQ' PublicKey | 587 | { sharedSecret :: TVar (MinMaxPSQ' PublicKey |
582 | (Down POSIXTime) | 588 | (Down Word64) |
583 | (MinMaxPSQ' SecretKey (Down POSIXTime) (Nonce24 -> State))) | 589 | (MinMaxPSQ' SecretKey (Down Word64) (Nonce24 -> State))) |
590 | , secretsTime :: TVar Word64 | ||
584 | } | 591 | } |
585 | 592 | ||
586 | newSecretsCache :: IO SecretsCache | 593 | newSecretsCache :: IO SecretsCache |
587 | newSecretsCache = atomically (SecretsCache <$> newTVar MM.empty) | 594 | newSecretsCache = atomically (SecretsCache <$> newTVar MM.empty <*> newTVar 0) |
588 | 595 | ||
589 | 596 | ||
590 | newtype SymmetricKey = SymmetricKey ByteString | 597 | newtype SymmetricKey = SymmetricKey ByteString |