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 | |
parent | d2e220c86325b55e22409b1a7da12b06a8052e76 (diff) |
Use monotonic counter for SecretsCache priority.
-rw-r--r-- | dht/src/Network/Tox/Handshake.hs | 2 | ||||
-rw-r--r-- | tox-crypto/src/Crypto/Tox.hs | 21 |
2 files changed, 15 insertions, 8 deletions
diff --git a/dht/src/Network/Tox/Handshake.hs b/dht/src/Network/Tox/Handshake.hs index 40bbbaf3..1ed93d8c 100644 --- a/dht/src/Network/Tox/Handshake.hs +++ b/dht/src/Network/Tox/Handshake.hs | |||
@@ -120,7 +120,7 @@ encodeHandshake :: POSIXTime | |||
120 | -> STM (Handshake Encrypted) | 120 | -> STM (Handshake Encrypted) |
121 | encodeHandshake timestamp crypto me them otherCookie myhandshakeData = do | 121 | encodeHandshake timestamp crypto me them otherCookie myhandshakeData = do |
122 | n24 <- transportNewNonce crypto | 122 | n24 <- transportNewNonce crypto |
123 | state <- ($ n24) <$> lookupNonceFunctionSTM timestamp crypto me them | 123 | state <- ($ n24) <$> lookupNonceFunctionSTM crypto me them |
124 | return Handshake { handshakeCookie = otherCookie | 124 | return Handshake { handshakeCookie = otherCookie |
125 | , handshakeNonce = n24 | 125 | , handshakeNonce = n24 |
126 | , handshakeData = encrypt state $ encodePlain myhandshakeData | 126 | , handshakeData = encrypt state $ encodePlain myhandshakeData |
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 |