\subsection{Nonce}

A random nonce is generated using the cryptographically secure random number
generator from the NaCl library \texttt{randombytes}.

A nonce is incremented by interpreting it as a Big Endian number and adding 1.
If the nonce has the maximum value, the value after the increment is 0.

Most parts of the protocol use random nonces.  This prevents new nonces from
being associated with previous nonces.  If many different packets could be tied
together due to how the nonces were generated, it might for example lead to
tying DHT and onion announce packets together.  This would introduce a flaw in
the system as non friends could tie some people's DHT keys and long term keys
together.

\begin{code}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE StrictData #-}
module Network.Tox.Crypto.Nonce where

import qualified Crypto.Saltine.Class    as Sodium (decode, encode, nudge)
import qualified Crypto.Saltine.Core.Box as Sodium (newNonce)
import qualified Data.ByteString         as ByteString

import           Network.Tox.Crypto.Key


newNonce :: IO Nonce
newNonce :: IO Nonce
newNonce = Nonce -> Nonce
forall a. a -> Key a
Key (Nonce -> Nonce) -> IO Nonce -> IO Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Nonce
Sodium.newNonce


reverseNonce :: Nonce -> Nonce
reverseNonce :: Nonce -> Nonce
reverseNonce (Key Nonce
nonce) =
  let Just Nonce
reversed = ByteString -> Maybe Nonce
forall a. IsEncoding a => ByteString -> Maybe a
Sodium.decode (ByteString -> Maybe Nonce) -> ByteString -> Maybe Nonce
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
ByteString.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Nonce -> ByteString
forall a. IsEncoding a => a -> ByteString
Sodium.encode Nonce
nonce in
  Nonce -> Nonce
forall a. a -> Key a
Key Nonce
reversed


nudge :: Nonce -> Nonce
nudge :: Nonce -> Nonce
nudge =
  Nonce -> Nonce
forall a. a -> Key a
Key (Nonce -> Nonce) -> (Nonce -> Nonce) -> Nonce -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> Nonce
forall n. IsNonce n => n -> n
Sodium.nudge (Nonce -> Nonce) -> (Nonce -> Nonce) -> Nonce -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> Nonce
forall a. Key a -> a
unKey


increment :: Nonce -> Nonce
increment :: Nonce -> Nonce
increment =
  Nonce -> Nonce
reverseNonce (Nonce -> Nonce) -> (Nonce -> Nonce) -> Nonce -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> Nonce
nudge (Nonce -> Nonce) -> (Nonce -> Nonce) -> Nonce -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> Nonce
reverseNonce

\end{code}