\begin{code}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE StrictData         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Tox.Transport.SecureSession where

import           Control.Monad.State            (MonadState, get, gets, modify)
import           Data.Binary               (Binary)
import qualified Data.Binary               as Binary
import qualified Data.Binary.Get           as Get
import qualified Data.Binary.Put           as Put
import qualified Data.ByteString           as BS
import qualified Data.ByteString.Lazy      as LBS
import           Data.Word                 (Word64, Word16)
import           Data.Int                  (Int16)
import           GHC.Generics              (Generic)

import           Tox.Crypto.Core.Key            (PublicKey, Nonce, CombinedKey, Key(..), unKey)
import           Tox.Crypto.Core.KeyPair        (KeyPair(..))
import qualified Tox.Crypto.Core.KeyPair        as KeyPair
import           Tox.Crypto.Core.Box            (CipherText)
import qualified Tox.Crypto.Core.Box            as Box
import qualified Tox.Crypto.Core.Nonce          as Nonce
import qualified Tox.Crypto.Core.Hash           as Hash
import           Tox.Crypto.Core.Keyed          (Keyed(..))
import           Tox.Core.Time                  (Timestamp(..), timestampToMicroseconds)
import qualified Tox.Core.Time                  as Time
import           Tox.Core.Timed                 (Timed(..))
import           Tox.Crypto.Core.MonadRandomBytes (MonadRandomBytes (..), randomNonce, randomWord64)
import qualified Tox.Network.Core.PacketKind       as PacketKind
import           Tox.Network.Core.Packet           (Packet (..))
import           Tox.Network.Core.NodeInfo         (NodeInfo(..))
import qualified Tox.Network.Core.NodeInfo         as NodeInfo
import           Tox.Network.Core.Networked        (Networked (..))
import           Tox.Network.Core.TransportProtocol (TransportProtocol(UDP))

import qualified System.Clock                  as Clock
import qualified Crypto.Saltine.Class          as Sodium
\end{code}

\chapter{Net crypto}

The Tox transport protocol is what Tox uses to establish and send data securely
to friends and provides encryption, ordered delivery, and perfect forward
secrecy.  It is a UDP protocol but it is also used when 2 friends connect over
TCP relays.

The reason the protocol for connections to friends over TCP relays and direct
UDP is the same is for simplicity and so the connection can switch between both
without the peers needing to disconnect and reconnect.  For example two Tox
friends might first connect over TCP and a few seconds later switch to UDP when
a direct UDP connection becomes possible.  The opening up of the UDP route or
'hole punching' is done by the DHT module and the opening up of a relayed TCP
connection is done by the \texttt{TCP\_connection} module.  The Tox transport
protocol has the job of connecting two peers (tox friends) safely once a route
or communications link between both is found.  Direct UDP is preferred over TCP
because it is direct and isn't limited by possibly congested TCP relays.  Also,
a peer can only connect to another using the Tox transport protocol if they
know the real public key and DHT public key of the peer they want to connect
to.  However, both the DHT and TCP connection modules require this information
in order to find and open the route to the peer which means we assume this
information is known by toxcore and has been passed to \texttt{net\_crypto} when
the \texttt{net\_crypto} connection was created.

Because this protocol has to work over UDP it must account for possible packet
loss, packets arriving in the wrong order and has to implement some kind of
congestion control.  This is implemented above the level at which the packets
are encrypted.  This prevents a malicious TCP relay from disrupting the
connection by modifying the packets that go through it.  The packet loss
prevention makes it work very well on TCP relays that we assume may go down at
any time as the connection will stay strong even if there is need to switch to
another TCP relay which will cause some packet loss.

Before sending the actual handshake packet the peer must obtain a cookie.  This
cookie step serves as a way for the receiving peer to confirm that the peer
initiating the connection can receive the responses in order to prevent certain
types of DoS attacks.

The peer receiving a cookie request packet must not allocate any resources to
the connection.  They will simply respond to the packet with a cookie response
packet containing the cookie that the requesting peer must then use in the
handshake to initiate the actual connection.

The cookie response must be sent back using the exact same link the cookie
request packet was sent from.  The reason for this is that if it is sent back
using another link, the other link might not work and the peer will not be
expecting responses from another link.  For example, if a request is sent from
UDP with ip port X, it must be sent back by UDP to ip port X.  If it was
received from a TCP OOB packet it must be sent back by a TCP OOB packet via the
same relay with the destination being the peer who sent the request.  If it was
received from an established TCP relay connection it must be sent back via that
same exact connection.

When a cookie request is received, the peer must not use the information in the
request packet for anything, he must not store it, he must only create a cookie
and cookie response from it, then send the created cookie response packet and
forget them.  The reason for this is to prevent possible attacks.  For example
if a peer would allocate long term memory for each cookie request packet
received then a simple packet flood would be enough to achieve an effective
denial of service attack by making the program run out of memory.

cookie request packet (145 bytes):

\begin{verbatim}
[uint8_t 24]
[Sender's DHT Public key (32 bytes)]
[Random nonce (24 bytes)]
[Encrypted message containing:
    [Sender's real public key (32 bytes)]
    [padding (32 bytes)]
    [uint64_t echo id (must be sent back untouched in cookie response)]
]
\end{verbatim}

Encrypted message is encrypted with sender's DHT private key, receiver's DHT
public key and the nonce.

\begin{code}
-- | Cookie Request Packet (0x18 / 24).
data CookieRequest = CookieRequest
  { CookieRequest -> PublicKey
crSenderDhtPk      :: PublicKey
  , CookieRequest -> Nonce
crNonce            :: Nonce
  , CookieRequest -> CipherText
crEncryptedMessage :: CipherText -- ^ Decrypts to crInnerMessage
  } deriving (CookieRequest -> CookieRequest -> Bool
(CookieRequest -> CookieRequest -> Bool)
-> (CookieRequest -> CookieRequest -> Bool) -> Eq CookieRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieRequest -> CookieRequest -> Bool
$c/= :: CookieRequest -> CookieRequest -> Bool
== :: CookieRequest -> CookieRequest -> Bool
$c== :: CookieRequest -> CookieRequest -> Bool
Eq, Int -> CookieRequest -> ShowS
[CookieRequest] -> ShowS
CookieRequest -> String
(Int -> CookieRequest -> ShowS)
-> (CookieRequest -> String)
-> ([CookieRequest] -> ShowS)
-> Show CookieRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieRequest] -> ShowS
$cshowList :: [CookieRequest] -> ShowS
show :: CookieRequest -> String
$cshow :: CookieRequest -> String
showsPrec :: Int -> CookieRequest -> ShowS
$cshowsPrec :: Int -> CookieRequest -> ShowS
Show, (forall x. CookieRequest -> Rep CookieRequest x)
-> (forall x. Rep CookieRequest x -> CookieRequest)
-> Generic CookieRequest
forall x. Rep CookieRequest x -> CookieRequest
forall x. CookieRequest -> Rep CookieRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CookieRequest x -> CookieRequest
$cfrom :: forall x. CookieRequest -> Rep CookieRequest x
Generic)

instance Binary CookieRequest where
  put :: CookieRequest -> Put
put CookieRequest
cr = do
    PublicKey -> Put
forall t. Binary t => t -> Put
Binary.put (PublicKey -> Put) -> PublicKey -> Put
forall a b. (a -> b) -> a -> b
$ CookieRequest -> PublicKey
crSenderDhtPk CookieRequest
cr
    Nonce -> Put
forall t. Binary t => t -> Put
Binary.put (Nonce -> Put) -> Nonce -> Put
forall a b. (a -> b) -> a -> b
$ CookieRequest -> Nonce
crNonce CookieRequest
cr
    CipherText -> Put
forall t. Binary t => t -> Put
Binary.put (CipherText -> Put) -> CipherText -> Put
forall a b. (a -> b) -> a -> b
$ CookieRequest -> CipherText
crEncryptedMessage CookieRequest
cr
  get :: Get CookieRequest
get = PublicKey -> Nonce -> CipherText -> CookieRequest
CookieRequest (PublicKey -> Nonce -> CipherText -> CookieRequest)
-> Get PublicKey -> Get (Nonce -> CipherText -> CookieRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PublicKey
forall t. Binary t => Get t
Binary.get Get (Nonce -> CipherText -> CookieRequest)
-> Get Nonce -> Get (CipherText -> CookieRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Nonce
forall t. Binary t => Get t
Binary.get Get (CipherText -> CookieRequest)
-> Get CipherText -> Get CookieRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get CipherText
forall t. Binary t => Get t
Binary.get

-- | Inner message of a Cookie Request.
data CookieRequestInner = CookieRequestInner
  { CookieRequestInner -> PublicKey
criSenderRealPk :: PublicKey
  , CookieRequestInner -> ByteString
criPadding      :: BS.ByteString -- ^ 32 bytes
  , CookieRequestInner -> Word64
criEchoId       :: Word64
  } deriving (CookieRequestInner -> CookieRequestInner -> Bool
(CookieRequestInner -> CookieRequestInner -> Bool)
-> (CookieRequestInner -> CookieRequestInner -> Bool)
-> Eq CookieRequestInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieRequestInner -> CookieRequestInner -> Bool
$c/= :: CookieRequestInner -> CookieRequestInner -> Bool
== :: CookieRequestInner -> CookieRequestInner -> Bool
$c== :: CookieRequestInner -> CookieRequestInner -> Bool
Eq, Int -> CookieRequestInner -> ShowS
[CookieRequestInner] -> ShowS
CookieRequestInner -> String
(Int -> CookieRequestInner -> ShowS)
-> (CookieRequestInner -> String)
-> ([CookieRequestInner] -> ShowS)
-> Show CookieRequestInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieRequestInner] -> ShowS
$cshowList :: [CookieRequestInner] -> ShowS
show :: CookieRequestInner -> String
$cshow :: CookieRequestInner -> String
showsPrec :: Int -> CookieRequestInner -> ShowS
$cshowsPrec :: Int -> CookieRequestInner -> ShowS
Show, (forall x. CookieRequestInner -> Rep CookieRequestInner x)
-> (forall x. Rep CookieRequestInner x -> CookieRequestInner)
-> Generic CookieRequestInner
forall x. Rep CookieRequestInner x -> CookieRequestInner
forall x. CookieRequestInner -> Rep CookieRequestInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CookieRequestInner x -> CookieRequestInner
$cfrom :: forall x. CookieRequestInner -> Rep CookieRequestInner x
Generic)

instance Binary CookieRequestInner where
  put :: CookieRequestInner -> Put
put CookieRequestInner
cri = do
    PublicKey -> Put
forall t. Binary t => t -> Put
Binary.put (PublicKey -> Put) -> PublicKey -> Put
forall a b. (a -> b) -> a -> b
$ CookieRequestInner -> PublicKey
criSenderRealPk CookieRequestInner
cri
    ByteString -> Put
Put.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ CookieRequestInner -> ByteString
criPadding CookieRequestInner
cri
    Word64 -> Put
Put.putWord64be (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ CookieRequestInner -> Word64
criEchoId CookieRequestInner
cri
  get :: Get CookieRequestInner
get = PublicKey -> ByteString -> Word64 -> CookieRequestInner
CookieRequestInner (PublicKey -> ByteString -> Word64 -> CookieRequestInner)
-> Get PublicKey
-> Get (ByteString -> Word64 -> CookieRequestInner)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PublicKey
forall t. Binary t => Get t
Binary.get Get (ByteString -> Word64 -> CookieRequestInner)
-> Get ByteString -> Get (Word64 -> CookieRequestInner)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
Get.getByteString Int
32 Get (Word64 -> CookieRequestInner)
-> Get Word64 -> Get CookieRequestInner
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
Get.getWord64be
\end{code}

The packet id for cookie request packets is 24.  The request contains the DHT
public key of the sender which is the key used (The DHT private key) (along
with the DHT public key of the receiver) to encrypt the encrypted part of the
cookie packet and a nonce also used to encrypt the encrypted part of the
packet.  Padding is used to maintain backwards-compatibility with previous
versions of the protocol.  The echo id in the cookie request must be sent back
untouched in the cookie response.  This echo id is how the peer sending the
request can be sure that the response received was a response to the packet
that he sent.

The reason for sending the DHT public key and real public key in the cookie
request is that both are contained in the cookie sent back in the response.

Toxcore currently sends 1 cookie request packet every second 8 times before it
kills the connection if there are no responses.

cookie response packet (161 bytes):

\begin{verbatim}
[uint8_t 25]
[Random nonce (24 bytes)]
[Encrypted message containing:
    [Cookie]
    [uint64_t echo id (that was sent in the request)]
]
\end{verbatim}

Encrypted message is encrypted with the exact same symmetric key as the cookie
request packet it responds to but with a different nonce.

\begin{code}
-- | Cookie Response Packet (0x19 / 25).
data CookieResponse = CookieResponse
  { CookieResponse -> Nonce
rsNonce            :: Nonce
  , CookieResponse -> CipherText
rsEncryptedMessage :: CipherText -- ^ Decrypts to rsInnerMessage
  } deriving (CookieResponse -> CookieResponse -> Bool
(CookieResponse -> CookieResponse -> Bool)
-> (CookieResponse -> CookieResponse -> Bool) -> Eq CookieResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieResponse -> CookieResponse -> Bool
$c/= :: CookieResponse -> CookieResponse -> Bool
== :: CookieResponse -> CookieResponse -> Bool
$c== :: CookieResponse -> CookieResponse -> Bool
Eq, Int -> CookieResponse -> ShowS
[CookieResponse] -> ShowS
CookieResponse -> String
(Int -> CookieResponse -> ShowS)
-> (CookieResponse -> String)
-> ([CookieResponse] -> ShowS)
-> Show CookieResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieResponse] -> ShowS
$cshowList :: [CookieResponse] -> ShowS
show :: CookieResponse -> String
$cshow :: CookieResponse -> String
showsPrec :: Int -> CookieResponse -> ShowS
$cshowsPrec :: Int -> CookieResponse -> ShowS
Show, (forall x. CookieResponse -> Rep CookieResponse x)
-> (forall x. Rep CookieResponse x -> CookieResponse)
-> Generic CookieResponse
forall x. Rep CookieResponse x -> CookieResponse
forall x. CookieResponse -> Rep CookieResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CookieResponse x -> CookieResponse
$cfrom :: forall x. CookieResponse -> Rep CookieResponse x
Generic)

instance Binary CookieResponse where
  put :: CookieResponse -> Put
put CookieResponse
rs = do
    Nonce -> Put
forall t. Binary t => t -> Put
Binary.put (Nonce -> Put) -> Nonce -> Put
forall a b. (a -> b) -> a -> b
$ CookieResponse -> Nonce
rsNonce CookieResponse
rs
    CipherText -> Put
forall t. Binary t => t -> Put
Binary.put (CipherText -> Put) -> CipherText -> Put
forall a b. (a -> b) -> a -> b
$ CookieResponse -> CipherText
rsEncryptedMessage CookieResponse
rs
  get :: Get CookieResponse
get = Nonce -> CipherText -> CookieResponse
CookieResponse (Nonce -> CipherText -> CookieResponse)
-> Get Nonce -> Get (CipherText -> CookieResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nonce
forall t. Binary t => Get t
Binary.get Get (CipherText -> CookieResponse)
-> Get CipherText -> Get CookieResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get CipherText
forall t. Binary t => Get t
Binary.get

-- | Inner message of a Cookie Response.
data CookieResponseInner = CookieResponseInner
  { CookieResponseInner -> Cookie
rsiCookie :: Cookie
  , CookieResponseInner -> Word64
rsiEchoId :: Word64
  } deriving (CookieResponseInner -> CookieResponseInner -> Bool
(CookieResponseInner -> CookieResponseInner -> Bool)
-> (CookieResponseInner -> CookieResponseInner -> Bool)
-> Eq CookieResponseInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieResponseInner -> CookieResponseInner -> Bool
$c/= :: CookieResponseInner -> CookieResponseInner -> Bool
== :: CookieResponseInner -> CookieResponseInner -> Bool
$c== :: CookieResponseInner -> CookieResponseInner -> Bool
Eq, Int -> CookieResponseInner -> ShowS
[CookieResponseInner] -> ShowS
CookieResponseInner -> String
(Int -> CookieResponseInner -> ShowS)
-> (CookieResponseInner -> String)
-> ([CookieResponseInner] -> ShowS)
-> Show CookieResponseInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieResponseInner] -> ShowS
$cshowList :: [CookieResponseInner] -> ShowS
show :: CookieResponseInner -> String
$cshow :: CookieResponseInner -> String
showsPrec :: Int -> CookieResponseInner -> ShowS
$cshowsPrec :: Int -> CookieResponseInner -> ShowS
Show, (forall x. CookieResponseInner -> Rep CookieResponseInner x)
-> (forall x. Rep CookieResponseInner x -> CookieResponseInner)
-> Generic CookieResponseInner
forall x. Rep CookieResponseInner x -> CookieResponseInner
forall x. CookieResponseInner -> Rep CookieResponseInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CookieResponseInner x -> CookieResponseInner
$cfrom :: forall x. CookieResponseInner -> Rep CookieResponseInner x
Generic)

instance Binary CookieResponseInner where
  put :: CookieResponseInner -> Put
put CookieResponseInner
rsi = do
    Cookie -> Put
forall t. Binary t => t -> Put
Binary.put (Cookie -> Put) -> Cookie -> Put
forall a b. (a -> b) -> a -> b
$ CookieResponseInner -> Cookie
rsiCookie CookieResponseInner
rsi
    Word64 -> Put
Put.putWord64be (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ CookieResponseInner -> Word64
rsiEchoId CookieResponseInner
rsi
  get :: Get CookieResponseInner
get = Cookie -> Word64 -> CookieResponseInner
CookieResponseInner (Cookie -> Word64 -> CookieResponseInner)
-> Get Cookie -> Get (Word64 -> CookieResponseInner)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Cookie
forall t. Binary t => Get t
Binary.get Get (Word64 -> CookieResponseInner)
-> Get Word64 -> Get CookieResponseInner
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
Get.getWord64be
\end{code}

The packet id for cookie request packets is 25.  The response contains a nonce
and an encrypted part encrypted with the nonce.  The encrypted part is
encrypted with the same key used to decrypt the encrypted part of the request
meaning the expensive shared key generation needs to be called only once in
order to handle and respond to a cookie request packet with a cookie response.

The Cookie (see below) and the echo id that was sent in the request are the
contents of the encrypted part.

The Cookie should be (112 bytes):

\begin{verbatim}
[nonce]
[encrypted data:
    [uint64_t time]
    [Sender's real public key (32 bytes)]
    [Sender's DHT public key (32 bytes)]
]
\end{verbatim}

The cookie is a 112 byte piece of data that is created and sent to the
requester as part of the cookie response packet.  A peer who wants to connect
to another must obtain a cookie packet from the peer they are trying to connect
to.  The only way to send a valid handshake packet to another peer is to first
obtain a cookie from them.

\begin{code}
-- | Cookie structure (112 bytes).
data Cookie = Cookie
  { Cookie -> Nonce
cookieNonce            :: Nonce
  , Cookie -> CipherText
cookieEncryptedPayload :: CipherText -- ^ Decrypts to cookieInner
  } deriving (Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c== :: Cookie -> Cookie -> Bool
Eq, Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cookie] -> ShowS
$cshowList :: [Cookie] -> ShowS
show :: Cookie -> String
$cshow :: Cookie -> String
showsPrec :: Int -> Cookie -> ShowS
$cshowsPrec :: Int -> Cookie -> ShowS
Show, (forall x. Cookie -> Rep Cookie x)
-> (forall x. Rep Cookie x -> Cookie) -> Generic Cookie
forall x. Rep Cookie x -> Cookie
forall x. Cookie -> Rep Cookie x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cookie x -> Cookie
$cfrom :: forall x. Cookie -> Rep Cookie x
Generic)

instance Binary Cookie where
  put :: Cookie -> Put
put Cookie
c = do
    Nonce -> Put
forall t. Binary t => t -> Put
Binary.put (Nonce -> Put) -> Nonce -> Put
forall a b. (a -> b) -> a -> b
$ Cookie -> Nonce
cookieNonce Cookie
c
    CipherText -> Put
forall t. Binary t => t -> Put
Binary.put (CipherText -> Put) -> CipherText -> Put
forall a b. (a -> b) -> a -> b
$ Cookie -> CipherText
cookieEncryptedPayload Cookie
c
  get :: Get Cookie
get = Nonce -> CipherText -> Cookie
Cookie (Nonce -> CipherText -> Cookie)
-> Get Nonce -> Get (CipherText -> Cookie)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nonce
forall t. Binary t => Get t
Binary.get Get (CipherText -> Cookie) -> Get CipherText -> Get Cookie
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get CipherText
forall t. Binary t => Get t
Binary.get

-- | Inner payload of a Cookie.
data CookieInner = CookieInner
  { CookieInner -> Word64
ciTime        :: Word64
  , CookieInner -> PublicKey
ciSenderRealPk :: PublicKey
  , CookieInner -> PublicKey
ciSenderDhtPk  :: PublicKey
  } deriving (CookieInner -> CookieInner -> Bool
(CookieInner -> CookieInner -> Bool)
-> (CookieInner -> CookieInner -> Bool) -> Eq CookieInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieInner -> CookieInner -> Bool
$c/= :: CookieInner -> CookieInner -> Bool
== :: CookieInner -> CookieInner -> Bool
$c== :: CookieInner -> CookieInner -> Bool
Eq, Int -> CookieInner -> ShowS
[CookieInner] -> ShowS
CookieInner -> String
(Int -> CookieInner -> ShowS)
-> (CookieInner -> String)
-> ([CookieInner] -> ShowS)
-> Show CookieInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieInner] -> ShowS
$cshowList :: [CookieInner] -> ShowS
show :: CookieInner -> String
$cshow :: CookieInner -> String
showsPrec :: Int -> CookieInner -> ShowS
$cshowsPrec :: Int -> CookieInner -> ShowS
Show, (forall x. CookieInner -> Rep CookieInner x)
-> (forall x. Rep CookieInner x -> CookieInner)
-> Generic CookieInner
forall x. Rep CookieInner x -> CookieInner
forall x. CookieInner -> Rep CookieInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CookieInner x -> CookieInner
$cfrom :: forall x. CookieInner -> Rep CookieInner x
Generic)

instance Binary CookieInner where
  put :: CookieInner -> Put
put CookieInner
ci = do
    Word64 -> Put
Put.putWord64be (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ CookieInner -> Word64
ciTime CookieInner
ci
    PublicKey -> Put
forall t. Binary t => t -> Put
Binary.put (PublicKey -> Put) -> PublicKey -> Put
forall a b. (a -> b) -> a -> b
$ CookieInner -> PublicKey
ciSenderRealPk CookieInner
ci
    PublicKey -> Put
forall t. Binary t => t -> Put
Binary.put (PublicKey -> Put) -> PublicKey -> Put
forall a b. (a -> b) -> a -> b
$ CookieInner -> PublicKey
ciSenderDhtPk CookieInner
ci
  get :: Get CookieInner
get = Word64 -> PublicKey -> PublicKey -> CookieInner
CookieInner (Word64 -> PublicKey -> PublicKey -> CookieInner)
-> Get Word64 -> Get (PublicKey -> PublicKey -> CookieInner)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
Get.getWord64be Get (PublicKey -> PublicKey -> CookieInner)
-> Get PublicKey -> Get (PublicKey -> CookieInner)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get PublicKey
forall t. Binary t => Get t
Binary.get Get (PublicKey -> CookieInner) -> Get PublicKey -> Get CookieInner
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get PublicKey
forall t. Binary t => Get t
Binary.get
\end{code}

The cookie contains information that will both prove to the receiver of the
handshake that the peer has received a cookie response and contains encrypted
info that tell the receiver of the handshake packet enough info to both decrypt
and validate the handshake packet and accept the connection.

When toxcore is started it generates a symmetric encryption key that it uses to
encrypt and decrypt all cookie packets (using NaCl authenticated encryption
exactly like encryption everywhere else in toxcore).  Only the instance of
toxcore that create the packets knows the encryption key meaning any cookie it
successfully decrypts and validates were created by it.

The time variable in the cookie is used to prevent cookie packets that are too
old from being used.  Toxcore has a time out of 15 seconds for cookie packets.
If a cookie packet is used more than 15 seconds after it is created toxcore
will see it as invalid.

When responding to a cookie request packet the sender's real public key is the
known key sent by the peer in the encrypted part of the cookie request packet
and the senders DHT public key is the key used to encrypt the encrypted part of
the cookie request packet.

When generating a cookie to put inside the encrypted part of the handshake: One
of the requirements to connect successfully to someone else is that we know
their DHT public key and their real long term public key meaning there is
enough information to construct the cookie.

Handshake packet:

\begin{verbatim}
[uint8_t 26]
[Cookie]
[nonce (24 bytes)]
[Encrypted message containing:
    [24 bytes base nonce]
    [session public key of the peer (32 bytes)]
    [sha512 hash of the entire Cookie sitting outside the encrypted part]
    [Other Cookie (used by the other to respond to the handshake packet)]
]
\end{verbatim}

\begin{code}
-- | Handshake Packet (0x1a / 26).
data Handshake = Handshake
  { Handshake -> Cookie
hCookie          :: Cookie
  , Handshake -> Nonce
hNonce           :: Nonce
  , Handshake -> CipherText
hEncryptedMessage :: CipherText -- ^ Decrypts to hInnerMessage
  } deriving (Handshake -> Handshake -> Bool
(Handshake -> Handshake -> Bool)
-> (Handshake -> Handshake -> Bool) -> Eq Handshake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Handshake -> Handshake -> Bool
$c/= :: Handshake -> Handshake -> Bool
== :: Handshake -> Handshake -> Bool
$c== :: Handshake -> Handshake -> Bool
Eq, Int -> Handshake -> ShowS
[Handshake] -> ShowS
Handshake -> String
(Int -> Handshake -> ShowS)
-> (Handshake -> String)
-> ([Handshake] -> ShowS)
-> Show Handshake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Handshake] -> ShowS
$cshowList :: [Handshake] -> ShowS
show :: Handshake -> String
$cshow :: Handshake -> String
showsPrec :: Int -> Handshake -> ShowS
$cshowsPrec :: Int -> Handshake -> ShowS
Show, (forall x. Handshake -> Rep Handshake x)
-> (forall x. Rep Handshake x -> Handshake) -> Generic Handshake
forall x. Rep Handshake x -> Handshake
forall x. Handshake -> Rep Handshake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Handshake x -> Handshake
$cfrom :: forall x. Handshake -> Rep Handshake x
Generic)

instance Binary Handshake where
  put :: Handshake -> Put
put Handshake
h = do
    Cookie -> Put
forall t. Binary t => t -> Put
Binary.put (Cookie -> Put) -> Cookie -> Put
forall a b. (a -> b) -> a -> b
$ Handshake -> Cookie
hCookie Handshake
h
    Nonce -> Put
forall t. Binary t => t -> Put
Binary.put (Nonce -> Put) -> Nonce -> Put
forall a b. (a -> b) -> a -> b
$ Handshake -> Nonce
hNonce Handshake
h
    CipherText -> Put
forall t. Binary t => t -> Put
Binary.put (CipherText -> Put) -> CipherText -> Put
forall a b. (a -> b) -> a -> b
$ Handshake -> CipherText
hEncryptedMessage Handshake
h
  get :: Get Handshake
get = Cookie -> Nonce -> CipherText -> Handshake
Handshake (Cookie -> Nonce -> CipherText -> Handshake)
-> Get Cookie -> Get (Nonce -> CipherText -> Handshake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Cookie
forall t. Binary t => Get t
Binary.get Get (Nonce -> CipherText -> Handshake)
-> Get Nonce -> Get (CipherText -> Handshake)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Nonce
forall t. Binary t => Get t
Binary.get Get (CipherText -> Handshake) -> Get CipherText -> Get Handshake
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get CipherText
forall t. Binary t => Get t
Binary.get

-- | Inner message of a Handshake.
data HandshakeInner = HandshakeInner
  { HandshakeInner -> Nonce
hiBaseNonce   :: Nonce
  , HandshakeInner -> PublicKey
hiSessionPk   :: PublicKey
  , HandshakeInner -> ByteString
hiCookieHash  :: BS.ByteString -- ^ 64 bytes (SHA512)
  , HandshakeInner -> Cookie
hiOtherCookie :: Cookie
  } deriving (HandshakeInner -> HandshakeInner -> Bool
(HandshakeInner -> HandshakeInner -> Bool)
-> (HandshakeInner -> HandshakeInner -> Bool) -> Eq HandshakeInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandshakeInner -> HandshakeInner -> Bool
$c/= :: HandshakeInner -> HandshakeInner -> Bool
== :: HandshakeInner -> HandshakeInner -> Bool
$c== :: HandshakeInner -> HandshakeInner -> Bool
Eq, Int -> HandshakeInner -> ShowS
[HandshakeInner] -> ShowS
HandshakeInner -> String
(Int -> HandshakeInner -> ShowS)
-> (HandshakeInner -> String)
-> ([HandshakeInner] -> ShowS)
-> Show HandshakeInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeInner] -> ShowS
$cshowList :: [HandshakeInner] -> ShowS
show :: HandshakeInner -> String
$cshow :: HandshakeInner -> String
showsPrec :: Int -> HandshakeInner -> ShowS
$cshowsPrec :: Int -> HandshakeInner -> ShowS
Show, (forall x. HandshakeInner -> Rep HandshakeInner x)
-> (forall x. Rep HandshakeInner x -> HandshakeInner)
-> Generic HandshakeInner
forall x. Rep HandshakeInner x -> HandshakeInner
forall x. HandshakeInner -> Rep HandshakeInner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HandshakeInner x -> HandshakeInner
$cfrom :: forall x. HandshakeInner -> Rep HandshakeInner x
Generic)

instance Binary HandshakeInner where
  put :: HandshakeInner -> Put
put HandshakeInner
hi = do
    Nonce -> Put
forall t. Binary t => t -> Put
Binary.put (Nonce -> Put) -> Nonce -> Put
forall a b. (a -> b) -> a -> b
$ HandshakeInner -> Nonce
hiBaseNonce HandshakeInner
hi
    PublicKey -> Put
forall t. Binary t => t -> Put
Binary.put (PublicKey -> Put) -> PublicKey -> Put
forall a b. (a -> b) -> a -> b
$ HandshakeInner -> PublicKey
hiSessionPk HandshakeInner
hi
    ByteString -> Put
Put.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ HandshakeInner -> ByteString
hiCookieHash HandshakeInner
hi
    Cookie -> Put
forall t. Binary t => t -> Put
Binary.put (Cookie -> Put) -> Cookie -> Put
forall a b. (a -> b) -> a -> b
$ HandshakeInner -> Cookie
hiOtherCookie HandshakeInner
hi
  get :: Get HandshakeInner
get = Nonce -> PublicKey -> ByteString -> Cookie -> HandshakeInner
HandshakeInner (Nonce -> PublicKey -> ByteString -> Cookie -> HandshakeInner)
-> Get Nonce
-> Get (PublicKey -> ByteString -> Cookie -> HandshakeInner)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nonce
forall t. Binary t => Get t
Binary.get Get (PublicKey -> ByteString -> Cookie -> HandshakeInner)
-> Get PublicKey -> Get (ByteString -> Cookie -> HandshakeInner)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get PublicKey
forall t. Binary t => Get t
Binary.get Get (ByteString -> Cookie -> HandshakeInner)
-> Get ByteString -> Get (Cookie -> HandshakeInner)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
Get.getByteString Int
64 Get (Cookie -> HandshakeInner) -> Get Cookie -> Get HandshakeInner
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Cookie
forall t. Binary t => Get t
Binary.get
\end{code}

The packet id for handshake packets is 26.  The cookie is a cookie obtained by
sending a cookie request packet to the peer and getting a cookie response
packet with a cookie in it.  It may also be obtained in the handshake packet by
a peer receiving a handshake packet (Other Cookie).

The nonce is a nonce used to encrypt the encrypted part of the handshake
packet.  The encrypted part of the handshake packet is encrypted with the long
term keys of both peers.  This is to prevent impersonation.

Inside the encrypted part of the handshake packet there is a 'base nonce' and a
session public key.  The 'base nonce' is a nonce that the other should use to
encrypt each data packet, adding + 1 to it for each data packet sent.  (first
packet is 'base nonce' + 0, next is 'base nonce' + 1, etc.  Note that for
mathematical operations the nonce is considered to be a 24 byte number in big
endian format).  The session key is the temporary connection public key that
the peer has generated for this connection and it sending to the other.  This
session key is used so that the connection has perfect forward secrecy.  It is
important to save the private key counterpart of the session public key sent in
the handshake, the public key received by the other and both the received and
sent base nonces as they are used to encrypt/decrypt the data packets.

The hash of the cookie in the encrypted part is used to make sure that an
attacker has not taken an older valid handshake packet and then replaced the
cookie packet inside with a newer one which would be bad as they could replay
it and might be able to make a mess.

The 'Other Cookie' is a valid cookie that we put in the handshake so that the
other can respond with a valid handshake without having to make a cookie
request to obtain one.

The handshake packet is sent by both sides of the connection.  If a peer
receives a handshake it will check if the cookie is valid, if the encrypted
section decrypts and validates, if the cookie hash is valid, if long term
public key belongs to a known friend.  If all these are true then the
connection is considered 'Accepted' but not 'Confirmed'.

If there is no existing connection to the peer identified by the long term
public key to set to 'Accepted', one will be created with that status.  If a
connection to such peer with a not yet 'Accepted' status to exists, this
connection is set to accepted.  If a connection with a 'Confirmed' status
exists for this peer, the handshake packet will be ignored and discarded (The
reason for discarding it is that we do not want slightly late handshake packets
to kill the connection) except if the DHT public key in the cookie contained in
the handshake packet is different from the known DHT public key of the peer.
If this happens the connection will be immediately killed because it means it
is no longer valid and a new connection will be created immediately with the
'Accepted' status.

Sometimes toxcore might receive the DHT public key of the peer first with a
handshake packet so it is important that this case is handled and that the
implementation passes the DHT public key to the other modules (DHT,
\texttt{TCP\_connection}) because this does happen.

Handshake packets must be created only once during the connection but must be
sent in intervals until we are sure the other received them.  This happens when
a valid encrypted data packet is received and decrypted.

The states of a connection:

\begin{enumerate}
  \item Not accepted: Send handshake packets.

  \item Accepted: A handshake packet has been received from the other peer but
    no encrypted packets: continue (or start) sending handshake packets because
    the peer can't know if the other has received them.

  \item Confirmed: A valid encrypted packet has been received from the other
    peer: Connection is fully established: stop sending handshake packets.
\end{enumerate}

Toxcore sends handshake packets every second 8 times and times out the
connection if the connection does not get confirmed (no encrypted packet is
received) within this time.

Perfect handshake scenario:

\begin{verbatim}
Peer 1                Peer 2
Cookie request   ->
                      <- Cookie response
Handshake packet ->
                      * accepts connection
                      <- Handshake packet
*accepts connection
Encrypted packet ->   <- Encrypted packet
*confirms connection  *confirms connection
       Connection successful.
Encrypted packets -> <- Encrypted packets

More realistic handshake scenario:
Peer 1                Peer 2
Cookie request   ->   *packet lost*
Cookie request   ->
                      <- Cookie response
                      *Peer 2 randomly starts new connection to peer 1
                      <- Cookie request
Cookie response  ->
Handshake packet ->   <- Handshake packet
*accepts connection   * accepts connection
Encrypted packet ->   <- Encrypted packet
*confirms connection  *confirms connection
       Connection successful.
Encrypted packets -> <- Encrypted packets
\end{verbatim}

The reason why the handshake is like this is because of certain design
requirements:

\begin{enumerate}
  \item The handshake must not leak the long term public keys of the peers to a
     possible attacker who would be looking at the packets but each peer must know
     for sure that they are connecting to the right peer and not an impostor.
  \item A connection must be able of being established if only one of the peers has
     the information necessary to initiate a connection (DHT public key of the
     peer and a link to the peer).
  \item If both peers initiate a connection to each other at the same time the
     connection must succeed without issues.
  \item There must be perfect forward secrecy.
  \item Must be resistant to any possible attacks.
\end{enumerate}

Due to how it is designed only one connection is possible at a time between 2
peers.

Encrypted packets:

\begin{tabular}{l|l}
  Length             & Contents \\
  \hline
  \texttt{1}         & \texttt{uint8\_t} (0x1b) \\
  \texttt{2}         & \texttt{uint16\_t} The last 2 bytes of the nonce used to encrypt this \\
  variable           & Payload \\
\end{tabular}

\begin{code}
-- | Encrypted Packet (0x1b / 27).
data CryptoDataPacket = CryptoDataPacket
  { CryptoDataPacket -> Word16
cdNonceShort :: Word16 -- ^ Last 2 bytes of the nonce
  , CryptoDataPacket -> CipherText
cdPayload    :: CipherText
  } deriving (CryptoDataPacket -> CryptoDataPacket -> Bool
(CryptoDataPacket -> CryptoDataPacket -> Bool)
-> (CryptoDataPacket -> CryptoDataPacket -> Bool)
-> Eq CryptoDataPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CryptoDataPacket -> CryptoDataPacket -> Bool
$c/= :: CryptoDataPacket -> CryptoDataPacket -> Bool
== :: CryptoDataPacket -> CryptoDataPacket -> Bool
$c== :: CryptoDataPacket -> CryptoDataPacket -> Bool
Eq, Int -> CryptoDataPacket -> ShowS
[CryptoDataPacket] -> ShowS
CryptoDataPacket -> String
(Int -> CryptoDataPacket -> ShowS)
-> (CryptoDataPacket -> String)
-> ([CryptoDataPacket] -> ShowS)
-> Show CryptoDataPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CryptoDataPacket] -> ShowS
$cshowList :: [CryptoDataPacket] -> ShowS
show :: CryptoDataPacket -> String
$cshow :: CryptoDataPacket -> String
showsPrec :: Int -> CryptoDataPacket -> ShowS
$cshowsPrec :: Int -> CryptoDataPacket -> ShowS
Show, (forall x. CryptoDataPacket -> Rep CryptoDataPacket x)
-> (forall x. Rep CryptoDataPacket x -> CryptoDataPacket)
-> Generic CryptoDataPacket
forall x. Rep CryptoDataPacket x -> CryptoDataPacket
forall x. CryptoDataPacket -> Rep CryptoDataPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CryptoDataPacket x -> CryptoDataPacket
$cfrom :: forall x. CryptoDataPacket -> Rep CryptoDataPacket x
Generic)

instance Binary CryptoDataPacket where
  put :: CryptoDataPacket -> Put
put CryptoDataPacket
cd = do
    Word16 -> Put
Put.putWord16be (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ CryptoDataPacket -> Word16
cdNonceShort CryptoDataPacket
cd
    CipherText -> Put
forall t. Binary t => t -> Put
Binary.put (CipherText -> Put) -> CipherText -> Put
forall a b. (a -> b) -> a -> b
$ CryptoDataPacket -> CipherText
cdPayload CryptoDataPacket
cd
  get :: Get CryptoDataPacket
get = Word16 -> CipherText -> CryptoDataPacket
CryptoDataPacket (Word16 -> CipherText -> CryptoDataPacket)
-> Get Word16 -> Get (CipherText -> CryptoDataPacket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16be Get (CipherText -> CryptoDataPacket)
-> Get CipherText -> Get CryptoDataPacket
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get CipherText
forall t. Binary t => Get t
Binary.get
\end{code}

The payload is encrypted with the session key and 'base nonce' set by the
receiver in their handshake + packet number (starting at 0, big endian math).

The packet id for encrypted packets is 27.  Encrypted packets are the packets
used to send data to the other peer in the connection.  Since these packets can
be sent over UDP the implementation must assume that they can arrive out of
order or even not arrive at all.

To get the key used to encrypt/decrypt each packet in the connection a peer
takes the session public key received in the handshake and the private key
counterpart of the key it sent it the handshake and generates a shared key from
it.  This shared key will be identical for both peers.  It is important to note
that connection keys must be wiped when the connection is killed.

To create an encrypted packet to be sent to the other peer, the data is
encrypted with the shared key for this connection and the base nonce that the
other peer sent in the handshake packet with the total number of encrypted
packets sent in the connection added to it ('base nonce' + 0 for the first
encrypted data packet sent, 'base nonce' + 1 for the second, etc.  Note that
the nonce is treated as a big endian number for mathematical operations like
additions).  The 2 byte (\texttt{uint16\_t}) number at the beginning of the
encrypted packet is the last 2 bytes of this 24 byte nonce.

To decrypt a received encrypted packet, the nonce the packet was encrypted with
is calculated using the base nonce that the peer sent to the other and the 2
byte number at the beginning of the packet.  First we assume that packets will
most likely arrive out of order and that some will be lost but that packet loss
and out of orderness will never be enough to make the 2 byte number need an
extra byte.  The packet is decrypted using the shared key for the connection
and the calculated nonce.

Toxcore uses the following method to calculate the nonce for each packet:

\begin{enumerate}
  \item \texttt{diff} = (2 byte number on the packet) - (last 2 bytes of the current saved
     base nonce) NOTE: treat the 3 variables as 16 bit unsigned ints, the result
     is expected to sometimes roll over.
  \item copy \texttt{saved\_base\_nonce} to \texttt{temp\_nonce}.
  \item \texttt{temp\_nonce = temp\_nonce + diff}.  \texttt{temp\_nonce} is the correct nonce that
     can be used to decrypt the packet.
  \item \texttt{DATA\_NUM\_THRESHOLD} = (1/3 of the maximum number that can be stored in an
     unsigned 2 bit integer)
  \item if decryption succeeds and \texttt{diff > (DATA\_NUM\_THRESHOLD * 2)} then:
    \begin{itemize}
      \item \texttt{saved\_base\_nonce = saved\_base\_nonce + DATA\_NUM\_THRESHOLD}
    \end{itemize}
\end{enumerate}

\begin{code}
{-------------------------------------------------------------------------------
 -
 - :: State Definitions.
 -
 ------------------------------------------------------------------------------}

data HandshakeStatus
  = SessionCookieSent Word64 -- ^ Echo ID
  | SessionHandshakeSent Cookie
  | SessionHandshakeAccepted Cookie -- ^ Received handshake from peer
  | SessionConfirmed -- ^ Received data packet, session established
  deriving (HandshakeStatus -> HandshakeStatus -> Bool
(HandshakeStatus -> HandshakeStatus -> Bool)
-> (HandshakeStatus -> HandshakeStatus -> Bool)
-> Eq HandshakeStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandshakeStatus -> HandshakeStatus -> Bool
$c/= :: HandshakeStatus -> HandshakeStatus -> Bool
== :: HandshakeStatus -> HandshakeStatus -> Bool
$c== :: HandshakeStatus -> HandshakeStatus -> Bool
Eq, Int -> HandshakeStatus -> ShowS
[HandshakeStatus] -> ShowS
HandshakeStatus -> String
(Int -> HandshakeStatus -> ShowS)
-> (HandshakeStatus -> String)
-> ([HandshakeStatus] -> ShowS)
-> Show HandshakeStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeStatus] -> ShowS
$cshowList :: [HandshakeStatus] -> ShowS
show :: HandshakeStatus -> String
$cshow :: HandshakeStatus -> String
showsPrec :: Int -> HandshakeStatus -> ShowS
$cshowsPrec :: Int -> HandshakeStatus -> ShowS
Show, (forall x. HandshakeStatus -> Rep HandshakeStatus x)
-> (forall x. Rep HandshakeStatus x -> HandshakeStatus)
-> Generic HandshakeStatus
forall x. Rep HandshakeStatus x -> HandshakeStatus
forall x. HandshakeStatus -> Rep HandshakeStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HandshakeStatus x -> HandshakeStatus
$cfrom :: forall x. HandshakeStatus -> Rep HandshakeStatus x
Generic)

data SecureSessionState = SecureSessionState
  { SecureSessionState -> KeyPair
ssOurRealKeyPair      :: KeyPair
  , SecureSessionState -> PublicKey
ssPeerRealPk          :: PublicKey
  , SecureSessionState -> KeyPair
ssOurDhtKeyPair       :: KeyPair
  , SecureSessionState -> PublicKey
ssPeerDhtPk           :: PublicKey
  , SecureSessionState -> NodeInfo
ssPeerNodeInfo        :: NodeInfo
  , SecureSessionState -> Maybe HandshakeStatus
ssStatus              :: Maybe HandshakeStatus
  , SecureSessionState -> KeyPair
ssOurSessionKeyPair   :: KeyPair
  , SecureSessionState -> Maybe PublicKey
ssPeerSessionPk       :: Maybe PublicKey
  , SecureSessionState -> Maybe CombinedKey
ssSharedKey           :: Maybe CombinedKey
  , SecureSessionState -> Nonce
ssOurBaseNonce        :: Nonce
  , SecureSessionState -> Maybe Nonce
ssPeerBaseNonce       :: Maybe Nonce
  , SecureSessionState -> Word64
ssSentPackets         :: Word64
  , SecureSessionState -> Word64
ssRecvPackets         :: Word64
  , SecureSessionState -> Maybe Timestamp
ssLastAttempt         :: Maybe Timestamp
  , SecureSessionState -> Int
ssRetryCount          :: Int
  } deriving (SecureSessionState -> SecureSessionState -> Bool
(SecureSessionState -> SecureSessionState -> Bool)
-> (SecureSessionState -> SecureSessionState -> Bool)
-> Eq SecureSessionState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecureSessionState -> SecureSessionState -> Bool
$c/= :: SecureSessionState -> SecureSessionState -> Bool
== :: SecureSessionState -> SecureSessionState -> Bool
$c== :: SecureSessionState -> SecureSessionState -> Bool
Eq, Int -> SecureSessionState -> ShowS
[SecureSessionState] -> ShowS
SecureSessionState -> String
(Int -> SecureSessionState -> ShowS)
-> (SecureSessionState -> String)
-> ([SecureSessionState] -> ShowS)
-> Show SecureSessionState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecureSessionState] -> ShowS
$cshowList :: [SecureSessionState] -> ShowS
show :: SecureSessionState -> String
$cshow :: SecureSessionState -> String
showsPrec :: Int -> SecureSessionState -> ShowS
$cshowsPrec :: Int -> SecureSessionState -> ShowS
Show, (forall x. SecureSessionState -> Rep SecureSessionState x)
-> (forall x. Rep SecureSessionState x -> SecureSessionState)
-> Generic SecureSessionState
forall x. Rep SecureSessionState x -> SecureSessionState
forall x. SecureSessionState -> Rep SecureSessionState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SecureSessionState x -> SecureSessionState
$cfrom :: forall x. SecureSessionState -> Rep SecureSessionState x
Generic)


{-------------------------------------------------------------------------------
 -
 - :: Cookie Logic.
 -
 ------------------------------------------------------------------------------}

-- | Create a Cookie for a peer.
createCookie :: MonadRandomBytes m => CombinedKey -> Word64 -> PublicKey -> PublicKey -> m Cookie
createCookie :: CombinedKey -> Word64 -> PublicKey -> PublicKey -> m Cookie
createCookie CombinedKey
cookieKey Word64
time PublicKey
peerRealPk PublicKey
peerDhtPk = do
  Nonce
nonce <- m Nonce
forall (m :: * -> *). MonadRandomBytes m => m Nonce
randomNonce
  let inner :: CookieInner
inner = Word64 -> PublicKey -> PublicKey -> CookieInner
CookieInner Word64
time PublicKey
peerRealPk PublicKey
peerDhtPk
      plain :: PlainText
plain = CookieInner -> PlainText
forall a. Binary a => a -> PlainText
Box.encode CookieInner
inner
      encrypted :: CipherText
encrypted = CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
cookieKey Nonce
nonce PlainText
plain
  Cookie -> m Cookie
forall (m :: * -> *) a. Monad m => a -> m a
return (Cookie -> m Cookie) -> Cookie -> m Cookie
forall a b. (a -> b) -> a -> b
$ Nonce -> CipherText -> Cookie
Cookie Nonce
nonce CipherText
encrypted

-- | Decrypt and validate a Cookie.
decryptCookie :: CombinedKey -> Cookie -> Maybe CookieInner
decryptCookie :: CombinedKey -> Cookie -> Maybe CookieInner
decryptCookie CombinedKey
cookieKey (Cookie Nonce
nonce CipherText
encrypted) =
  CombinedKey -> Nonce -> CipherText -> Maybe PlainText
Box.decrypt CombinedKey
cookieKey Nonce
nonce CipherText
encrypted Maybe PlainText
-> (PlainText -> Maybe CookieInner) -> Maybe CookieInner
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PlainText -> Maybe CookieInner
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode


{-------------------------------------------------------------------------------
 -
 - :: CryptoData Packet Logic.
 -
 ------------------------------------------------------------------------------}

-- | Threshold for base nonce rotation (1/3 of 65536).
dataNumThreshold :: Word16
dataNumThreshold :: Word16
dataNumThreshold = Word16
21845

-- | Calculate the full nonce for a received packet.
calculateNonce :: Nonce -> Word16 -> Nonce
calculateNonce :: Nonce -> Word16 -> Nonce
calculateNonce Nonce
baseNonce Word16
shortNonce =
  let
    n :: Integer
n = Nonce -> Integer
Nonce.nonceToInteger Nonce
baseNonce
    baseShort :: Word16
baseShort = Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
65536)
    diff :: Word16
diff = Word16
shortNonce Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
baseShort
    -- treat diff as signed 16-bit to handle wrap around
    n' :: Integer
n' = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
diff :: Int16)
  in
    Integer -> Nonce
Nonce.integerToNonce Integer
n'

-- | Update the base nonce after successful decryption if necessary.
updateBaseNonce :: Nonce -> Word16 -> Nonce
updateBaseNonce :: Nonce -> Word16 -> Nonce
updateBaseNonce Nonce
baseNonce Word16
shortNonce =
  let
    n :: Integer
n = Nonce -> Integer
Nonce.nonceToInteger Nonce
baseNonce
    baseShort :: Word16
baseShort = Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
65536)
    diff :: Word16
diff = Word16
shortNonce Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
baseShort
  in
    if Word16
diff Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
dataNumThreshold Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
2
    then Integer -> Nonce
Nonce.integerToNonce (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataNumThreshold)
    else Nonce
baseNonce


{-------------------------------------------------------------------------------
 -
 - :: Cryptographic Helpers.
 -
 ------------------------------------------------------------------------------}

getDhtSharedKey :: Keyed m => SecureSessionState -> m CombinedKey
getDhtSharedKey :: SecureSessionState -> m CombinedKey
getDhtSharedKey SecureSessionState
ss = SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
getCombinedKey (KeyPair -> SecretKey
KeyPair.secretKey (KeyPair -> SecretKey) -> KeyPair -> SecretKey
forall a b. (a -> b) -> a -> b
$ SecureSessionState -> KeyPair
ssOurDhtKeyPair SecureSessionState
ss) (SecureSessionState -> PublicKey
ssPeerDhtPk SecureSessionState
ss)

getRealSharedKey :: Keyed m => SecureSessionState -> m CombinedKey
getRealSharedKey :: SecureSessionState -> m CombinedKey
getRealSharedKey SecureSessionState
ss = SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
getCombinedKey (KeyPair -> SecretKey
KeyPair.secretKey (KeyPair -> SecretKey) -> KeyPair -> SecretKey
forall a b. (a -> b) -> a -> b
$ SecureSessionState -> KeyPair
ssOurRealKeyPair SecureSessionState
ss) (SecureSessionState -> PublicKey
ssPeerRealPk SecureSessionState
ss)

getSessionSharedKey :: Keyed m => SecureSessionState -> m CombinedKey
getSessionSharedKey :: SecureSessionState -> m CombinedKey
getSessionSharedKey SecureSessionState
ss = case SecureSessionState -> Maybe PublicKey
ssPeerSessionPk SecureSessionState
ss of
  Maybe PublicKey
Nothing -> String -> m CombinedKey
forall a. HasCallStack => String -> a
error String
"getSessionSharedKey: peer session pk not set"
  Just PublicKey
pk -> SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
getCombinedKey (KeyPair -> SecretKey
KeyPair.secretKey (KeyPair -> SecretKey) -> KeyPair -> SecretKey
forall a b. (a -> b) -> a -> b
$ SecureSessionState -> KeyPair
ssOurSessionKeyPair SecureSessionState
ss) PublicKey
pk


{-------------------------------------------------------------------------------
 -
 - :: Session Handlers.
 -
 ------------------------------------------------------------------------------}

-- | Initial state for a new session.
-- | Initial state for a new session.
initSession :: MonadRandomBytes m => KeyPair -> PublicKey -> KeyPair -> PublicKey -> NodeInfo -> m SecureSessionState
initSession :: KeyPair
-> PublicKey
-> KeyPair
-> PublicKey
-> NodeInfo
-> m SecureSessionState
initSession KeyPair
ourRealKp PublicKey
peerRealPk KeyPair
ourDhtKp PublicKey
peerDhtPk NodeInfo
peerNode = do
  KeyPair
ourSessionKp <- m KeyPair
forall (m :: * -> *). MonadRandomBytes m => m KeyPair
newKeyPair
  Nonce
ourBaseNonce <- m Nonce
forall (m :: * -> *). MonadRandomBytes m => m Nonce
randomNonce
  SecureSessionState -> m SecureSessionState
forall (m :: * -> *) a. Monad m => a -> m a
return SecureSessionState :: KeyPair
-> PublicKey
-> KeyPair
-> PublicKey
-> NodeInfo
-> Maybe HandshakeStatus
-> KeyPair
-> Maybe PublicKey
-> Maybe CombinedKey
-> Nonce
-> Maybe Nonce
-> Word64
-> Word64
-> Maybe Timestamp
-> Int
-> SecureSessionState
SecureSessionState
    { ssOurRealKeyPair :: KeyPair
ssOurRealKeyPair    = KeyPair
ourRealKp
    , ssPeerRealPk :: PublicKey
ssPeerRealPk        = PublicKey
peerRealPk
    , ssOurDhtKeyPair :: KeyPair
ssOurDhtKeyPair     = KeyPair
ourDhtKp
    , ssPeerDhtPk :: PublicKey
ssPeerDhtPk         = PublicKey
peerDhtPk
    , ssPeerNodeInfo :: NodeInfo
ssPeerNodeInfo      = NodeInfo
peerNode
    , ssStatus :: Maybe HandshakeStatus
ssStatus            = Maybe HandshakeStatus
forall a. Maybe a
Nothing
    , ssOurSessionKeyPair :: KeyPair
ssOurSessionKeyPair = KeyPair
ourSessionKp
    , ssPeerSessionPk :: Maybe PublicKey
ssPeerSessionPk     = Maybe PublicKey
forall a. Maybe a
Nothing
    , ssSharedKey :: Maybe CombinedKey
ssSharedKey         = Maybe CombinedKey
forall a. Maybe a
Nothing
    , ssOurBaseNonce :: Nonce
ssOurBaseNonce      = Nonce
ourBaseNonce
    , ssPeerBaseNonce :: Maybe Nonce
ssPeerBaseNonce     = Maybe Nonce
forall a. Maybe a
Nothing
    , ssSentPackets :: Word64
ssSentPackets       = Word64
0
    , ssRecvPackets :: Word64
ssRecvPackets       = Word64
0
    , ssLastAttempt :: Maybe Timestamp
ssLastAttempt       = Maybe Timestamp
forall a. Maybe a
Nothing
    , ssRetryCount :: Int
ssRetryCount        = Int
0
    }

sendCookieRequest :: (MonadState SecureSessionState m, Timed m, MonadRandomBytes m, Keyed m, Networked m)
                  => m ()
sendCookieRequest :: m ()
sendCookieRequest = do
  SecureSessionState
ss <- m SecureSessionState
forall s (m :: * -> *). MonadState s m => m s
get
  Nonce
nonce <- m Nonce
forall (m :: * -> *). MonadRandomBytes m => m Nonce
randomNonce
  Word64
echoId <- m Word64
forall (m :: * -> *). MonadRandomBytes m => m Word64
randomWord64
  CombinedKey
dhtSharedKey <- SecureSessionState -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecureSessionState -> m CombinedKey
getDhtSharedKey SecureSessionState
ss

  let cri :: CookieRequestInner
cri = PublicKey -> ByteString -> Word64 -> CookieRequestInner
CookieRequestInner (KeyPair -> PublicKey
KeyPair.publicKey (KeyPair -> PublicKey) -> KeyPair -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecureSessionState -> KeyPair
ssOurRealKeyPair SecureSessionState
ss) (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0) Word64
echoId
      plain :: PlainText
plain = CookieRequestInner -> PlainText
forall a. Binary a => a -> PlainText
Box.encode CookieRequestInner
cri
      encrypted :: CipherText
encrypted = CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
dhtSharedKey Nonce
nonce PlainText
plain
      cr :: CookieRequest
cr = PublicKey -> Nonce -> CipherText -> CookieRequest
CookieRequest (KeyPair -> PublicKey
KeyPair.publicKey (KeyPair -> PublicKey) -> KeyPair -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecureSessionState -> KeyPair
ssOurDhtKeyPair SecureSessionState
ss) Nonce
nonce CipherText
encrypted
      pkt :: Packet ByteString
pkt = PacketKind -> ByteString -> Packet ByteString
forall payload. PacketKind -> payload -> Packet payload
Packet PacketKind
PacketKind.CookieRequest (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CookieRequest -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode CookieRequest
cr)

  NodeInfo -> Packet ByteString -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket (SecureSessionState -> NodeInfo
ssPeerNodeInfo SecureSessionState
ss) Packet ByteString
pkt
  (SecureSessionState -> SecureSessionState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecureSessionState -> SecureSessionState) -> m ())
-> (SecureSessionState -> SecureSessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SecureSessionState
s -> SecureSessionState
s { ssStatus :: Maybe HandshakeStatus
ssStatus = HandshakeStatus -> Maybe HandshakeStatus
forall a. a -> Maybe a
Just (Word64 -> HandshakeStatus
SessionCookieSent Word64
echoId) }

-- | Handle an incoming packet for this session.
handlePacket :: (Timed m, MonadRandomBytes m, Keyed m, Networked m, MonadState SecureSessionState m)
             => CombinedKey -> NodeInfo -> Packet BS.ByteString -> m ()
handlePacket :: CombinedKey -> NodeInfo -> Packet ByteString -> m ()
handlePacket CombinedKey
ck NodeInfo
from (Packet PacketKind
kind ByteString
payload) = case PacketKind
kind of
  PacketKind
PacketKind.CookieResponse -> NodeInfo -> ByteString -> m ()
forall (m :: * -> *).
(MonadState SecureSessionState m, Timed m, MonadRandomBytes m,
 Keyed m, Networked m) =>
NodeInfo -> ByteString -> m ()
handleCookieResponse NodeInfo
from ByteString
payload
  PacketKind
PacketKind.CryptoHandshake -> CombinedKey -> NodeInfo -> ByteString -> m ()
forall (m :: * -> *).
(MonadState SecureSessionState m, Timed m, MonadRandomBytes m,
 Keyed m, Networked m) =>
CombinedKey -> NodeInfo -> ByteString -> m ()
handleHandshake CombinedKey
ck NodeInfo
from ByteString
payload
  PacketKind
PacketKind.CryptoData -> NodeInfo -> ByteString -> m ()
forall (m :: * -> *).
(MonadState SecureSessionState m, Timed m, MonadRandomBytes m,
 Keyed m, Networked m) =>
NodeInfo -> ByteString -> m ()
handleCryptoData NodeInfo
from ByteString
payload
  PacketKind
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Handle a CookieRequest (Server side).
handleCookieRequest :: (Timed m, MonadRandomBytes m, Keyed m, Networked m)
                    => CombinedKey -> KeyPair -> NodeInfo -> BS.ByteString -> m ()
handleCookieRequest :: CombinedKey -> KeyPair -> NodeInfo -> ByteString -> m ()
handleCookieRequest CombinedKey
cookieKey KeyPair
ourDhtKp NodeInfo
from ByteString
payload = do
  case PlainText -> Maybe CookieRequest
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode (ByteString -> PlainText
Box.PlainText ByteString
payload) of
    Maybe CookieRequest
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (CookieRequest
cr :: CookieRequest) -> do
      Timestamp
now <- m Timestamp
forall (m :: * -> *). Timed m => m Timestamp
askTime
      let timeInt :: Word64
timeInt = Timestamp -> Word64
timestampToMicroseconds Timestamp
now

      CombinedKey
sharedKey <- SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
getCombinedKey (KeyPair -> SecretKey
KeyPair.secretKey KeyPair
ourDhtKp) (CookieRequest -> PublicKey
crSenderDhtPk CookieRequest
cr)
      case CombinedKey -> Nonce -> CipherText -> Maybe PlainText
Box.decrypt CombinedKey
sharedKey (CookieRequest -> Nonce
crNonce CookieRequest
cr) (CookieRequest -> CipherText
crEncryptedMessage CookieRequest
cr) of
        Maybe PlainText
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PlainText
plain -> case PlainText -> Maybe CookieRequestInner
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode PlainText
plain of
          Maybe CookieRequestInner
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (CookieRequestInner
cri :: CookieRequestInner) -> do
            Cookie
cookie <- CombinedKey -> Word64 -> PublicKey -> PublicKey -> m Cookie
forall (m :: * -> *).
MonadRandomBytes m =>
CombinedKey -> Word64 -> PublicKey -> PublicKey -> m Cookie
createCookie CombinedKey
cookieKey Word64
timeInt (CookieRequestInner -> PublicKey
criSenderRealPk CookieRequestInner
cri) (CookieRequest -> PublicKey
crSenderDhtPk CookieRequest
cr)
            Nonce
nonce <- m Nonce
forall (m :: * -> *). MonadRandomBytes m => m Nonce
randomNonce

            let rsi :: CookieResponseInner
rsi = Cookie -> Word64 -> CookieResponseInner
CookieResponseInner Cookie
cookie (CookieRequestInner -> Word64
criEchoId CookieRequestInner
cri)
                plainR :: PlainText
plainR = CookieResponseInner -> PlainText
forall a. Binary a => a -> PlainText
Box.encode CookieResponseInner
rsi
                encryptedR :: CipherText
encryptedR = CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
sharedKey Nonce
nonce PlainText
plainR
                rs :: CookieResponse
rs = Nonce -> CipherText -> CookieResponse
CookieResponse Nonce
nonce CipherText
encryptedR
                pkt :: Packet ByteString
pkt = PacketKind -> ByteString -> Packet ByteString
forall payload. PacketKind -> payload -> Packet payload
Packet PacketKind
PacketKind.CookieResponse (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CookieResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode CookieResponse
rs)

            NodeInfo -> Packet ByteString -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket NodeInfo
from Packet ByteString
pkt

handleCookieResponse :: (MonadState SecureSessionState m, Timed m, MonadRandomBytes m, Keyed m, Networked m)
                     => NodeInfo -> BS.ByteString -> m ()
handleCookieResponse :: NodeInfo -> ByteString -> m ()
handleCookieResponse NodeInfo
_from ByteString
payload = do
  SecureSessionState
ss <- m SecureSessionState
forall s (m :: * -> *). MonadState s m => m s
get
  case PlainText -> Maybe CookieResponse
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode (ByteString -> PlainText
Box.PlainText ByteString
payload) of
    Maybe CookieResponse
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (CookieResponse
rs :: CookieResponse) -> do
      CombinedKey
sharedKey <- SecureSessionState -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecureSessionState -> m CombinedKey
getDhtSharedKey SecureSessionState
ss
      case CombinedKey -> Nonce -> CipherText -> Maybe PlainText
Box.decrypt CombinedKey
sharedKey (CookieResponse -> Nonce
rsNonce CookieResponse
rs) (CookieResponse -> CipherText
rsEncryptedMessage CookieResponse
rs) of
        Maybe PlainText
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PlainText
plain -> case PlainText -> Maybe CookieResponseInner
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode PlainText
plain of
          Maybe CookieResponseInner
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (CookieResponseInner
rsi :: CookieResponseInner) -> do
            case SecureSessionState -> Maybe HandshakeStatus
ssStatus SecureSessionState
ss of
              Just (SessionCookieSent Word64
echoId) | Word64
echoId Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== CookieResponseInner -> Word64
rsiEchoId CookieResponseInner
rsi -> do
                (SecureSessionState -> SecureSessionState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecureSessionState -> SecureSessionState) -> m ())
-> (SecureSessionState -> SecureSessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SecureSessionState
s -> SecureSessionState
s { ssStatus :: Maybe HandshakeStatus
ssStatus = HandshakeStatus -> Maybe HandshakeStatus
forall a. a -> Maybe a
Just (Cookie -> HandshakeStatus
SessionHandshakeSent (CookieResponseInner -> Cookie
rsiCookie CookieResponseInner
rsi)) }
                Cookie -> m ()
forall (m :: * -> *).
(MonadState SecureSessionState m, Timed m, MonadRandomBytes m,
 Keyed m, Networked m) =>
Cookie -> m ()
sendHandshake (CookieResponseInner -> Cookie
rsiCookie CookieResponseInner
rsi)
              Maybe HandshakeStatus
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

sendHandshake :: (MonadState SecureSessionState m, Timed m, MonadRandomBytes m, Keyed m, Networked m)
              => Cookie -> m ()
sendHandshake :: Cookie -> m ()
sendHandshake Cookie
cookie = do
  SecureSessionState
ss <- m SecureSessionState
forall s (m :: * -> *). MonadState s m => m s
get
  Nonce
nonce <- m Nonce
forall (m :: * -> *). MonadRandomBytes m => m Nonce
randomNonce
  CombinedKey
realSharedKey <- SecureSessionState -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecureSessionState -> m CombinedKey
getRealSharedKey SecureSessionState
ss

  let cookieBytes :: ByteString
cookieBytes = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Cookie -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode Cookie
cookie
      cookieHash :: ByteString
cookieHash = ByteString -> ByteString
Hash.hash ByteString
cookieBytes
      hi :: HandshakeInner
hi = Nonce -> PublicKey -> ByteString -> Cookie -> HandshakeInner
HandshakeInner (SecureSessionState -> Nonce
ssOurBaseNonce SecureSessionState
ss) (KeyPair -> PublicKey
KeyPair.publicKey (KeyPair -> PublicKey) -> KeyPair -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecureSessionState -> KeyPair
ssOurSessionKeyPair SecureSessionState
ss) ByteString
cookieHash Cookie
cookie -- FIXME: hiOtherCookie
      plain :: PlainText
plain = HandshakeInner -> PlainText
forall a. Binary a => a -> PlainText
Box.encode HandshakeInner
hi
      encrypted :: CipherText
encrypted = CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
realSharedKey Nonce
nonce PlainText
plain
      h :: Handshake
h = Cookie -> Nonce -> CipherText -> Handshake
Handshake Cookie
cookie Nonce
nonce CipherText
encrypted
      pkt :: Packet ByteString
pkt = PacketKind -> ByteString -> Packet ByteString
forall payload. PacketKind -> payload -> Packet payload
Packet PacketKind
PacketKind.CryptoHandshake (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Handshake -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode Handshake
h)

  NodeInfo -> Packet ByteString -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket (SecureSessionState -> NodeInfo
ssPeerNodeInfo SecureSessionState
ss) Packet ByteString
pkt

handleHandshake :: (MonadState SecureSessionState m, Timed m, MonadRandomBytes m, Keyed m, Networked m)
                => CombinedKey -> NodeInfo -> BS.ByteString -> m ()
handleHandshake :: CombinedKey -> NodeInfo -> ByteString -> m ()
handleHandshake CombinedKey
cookieK NodeInfo
from ByteString
payload = do
  SecureSessionState
ss <- m SecureSessionState
forall s (m :: * -> *). MonadState s m => m s
get
  case PlainText -> Maybe Handshake
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode (ByteString -> PlainText
Box.PlainText ByteString
payload) of
    Maybe Handshake
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Handshake
h :: Handshake) -> do
      -- 1. Validate our Cookie
      Timestamp
now <- m Timestamp
forall (m :: * -> *). Timed m => m Timestamp
askTime
      case CombinedKey -> Cookie -> Maybe CookieInner
decryptCookie CombinedKey
cookieK (Handshake -> Cookie
hCookie Handshake
h) of
        Maybe CookieInner
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Not our cookie
        Just CookieInner
ci -> do
          let ciTimestamp :: Timestamp
ciTimestamp = TimeSpec -> Timestamp
Timestamp (TimeSpec -> Timestamp) -> TimeSpec -> Timestamp
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> TimeSpec
Clock.TimeSpec (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ CookieInner -> Word64
ciTime CookieInner
ci Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
1000000) (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ (CookieInner -> Word64
ciTime CookieInner
ci Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
1000000) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000)
              age :: TimeDiff
age = Timestamp
now Timestamp -> Timestamp -> TimeDiff
`Time.diffTime` Timestamp
ciTimestamp

          if TimeDiff
age TimeDiff -> TimeDiff -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> TimeDiff
Time.seconds Integer
15
          then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Expired
          else do
            -- 2. Decrypt Handshake
            CombinedKey
realSharedKey <- SecureSessionState -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecureSessionState -> m CombinedKey
getRealSharedKey SecureSessionState
ss
            case CombinedKey -> Nonce -> CipherText -> Maybe PlainText
Box.decrypt CombinedKey
realSharedKey (Handshake -> Nonce
hNonce Handshake
h) (Handshake -> CipherText
hEncryptedMessage Handshake
h) of
              Maybe PlainText
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just PlainText
plain -> case PlainText -> Maybe HandshakeInner
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode PlainText
plain of
                Maybe HandshakeInner
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just (HandshakeInner
hi :: HandshakeInner) -> do
                  -- Mobility: update peer address if it changed
                  (SecureSessionState -> SecureSessionState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecureSessionState -> SecureSessionState) -> m ())
-> (SecureSessionState -> SecureSessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SecureSessionState
s -> SecureSessionState
s { ssPeerNodeInfo :: NodeInfo
ssPeerNodeInfo = NodeInfo
from }

                  CombinedKey
sharedKey <- SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
getCombinedKey (KeyPair -> SecretKey
KeyPair.secretKey (KeyPair -> SecretKey) -> KeyPair -> SecretKey
forall a b. (a -> b) -> a -> b
$ SecureSessionState -> KeyPair
ssOurSessionKeyPair SecureSessionState
ss) (HandshakeInner -> PublicKey
hiSessionPk HandshakeInner
hi)

                  (SecureSessionState -> SecureSessionState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecureSessionState -> SecureSessionState) -> m ())
-> (SecureSessionState -> SecureSessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SecureSessionState
s -> SecureSessionState
s
                    { ssPeerSessionPk :: Maybe PublicKey
ssPeerSessionPk = PublicKey -> Maybe PublicKey
forall a. a -> Maybe a
Just (HandshakeInner -> PublicKey
hiSessionPk HandshakeInner
hi)
                    , ssPeerBaseNonce :: Maybe Nonce
ssPeerBaseNonce = Nonce -> Maybe Nonce
forall a. a -> Maybe a
Just (HandshakeInner -> Nonce
hiBaseNonce HandshakeInner
hi)
                    , ssSharedKey :: Maybe CombinedKey
ssSharedKey     = CombinedKey -> Maybe CombinedKey
forall a. a -> Maybe a
Just CombinedKey
sharedKey
                    , ssStatus :: Maybe HandshakeStatus
ssStatus        = HandshakeStatus -> Maybe HandshakeStatus
forall a. a -> Maybe a
Just (Cookie -> HandshakeStatus
SessionHandshakeAccepted (Handshake -> Cookie
hCookie Handshake
h))
                    }

                  case SecureSessionState -> Maybe HandshakeStatus
ssStatus SecureSessionState
ss of
                    Just (SessionHandshakeSent Cookie
_) -> Cookie -> m ()
forall (m :: * -> *).
(MonadState SecureSessionState m, Timed m, MonadRandomBytes m,
 Keyed m, Networked m) =>
Cookie -> m ()
sendHandshake (HandshakeInner -> Cookie
hiOtherCookie HandshakeInner
hi)
                    Maybe HandshakeStatus
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

sendCryptoData :: (MonadState SecureSessionState m, Timed m, MonadRandomBytes m, Keyed m, Networked m)
               => Box.PlainText -> m ()
sendCryptoData :: PlainText -> m ()
sendCryptoData PlainText
plain = do
  SecureSessionState
ss <- m SecureSessionState
forall s (m :: * -> *). MonadState s m => m s
get
  case (SecureSessionState -> Maybe CombinedKey
ssSharedKey SecureSessionState
ss, SecureSessionState -> Maybe Nonce
ssPeerBaseNonce SecureSessionState
ss) of
    (Just CombinedKey
sharedKey, Just Nonce
_) -> do
      let n :: Nonce
n = SecureSessionState -> Nonce
ssOurBaseNonce SecureSessionState
ss
          nonceInt :: Integer
nonceInt = Nonce -> Integer
Nonce.nonceToInteger Nonce
n
          fullNonce :: Nonce
fullNonce = Integer -> Nonce
Nonce.integerToNonce (Integer
nonceInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (SecureSessionState -> Word64
ssSentPackets SecureSessionState
ss))
          shortNonce :: Word16
shortNonce = Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nonce -> Integer
Nonce.nonceToInteger Nonce
fullNonce Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
65536)
          encrypted :: CipherText
encrypted = CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
sharedKey Nonce
fullNonce PlainText
plain
          cd :: CryptoDataPacket
cd = Word16 -> CipherText -> CryptoDataPacket
CryptoDataPacket Word16
shortNonce CipherText
encrypted
          pkt :: Packet ByteString
pkt = PacketKind -> ByteString -> Packet ByteString
forall payload. PacketKind -> payload -> Packet payload
Packet PacketKind
PacketKind.CryptoData (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CryptoDataPacket -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode CryptoDataPacket
cd)

      NodeInfo -> Packet ByteString -> m ()
forall (m :: * -> *) payload.
(Networked m, Binary payload, Show payload) =>
NodeInfo -> Packet payload -> m ()
sendPacket (SecureSessionState -> NodeInfo
ssPeerNodeInfo SecureSessionState
ss) Packet ByteString
pkt
      (SecureSessionState -> SecureSessionState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecureSessionState -> SecureSessionState) -> m ())
-> (SecureSessionState -> SecureSessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SecureSessionState
s -> SecureSessionState
s { ssSentPackets :: Word64
ssSentPackets = SecureSessionState -> Word64
ssSentPackets SecureSessionState
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1 }
    (Maybe CombinedKey, Maybe Nonce)
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleCryptoData :: (MonadState SecureSessionState m, Timed m, MonadRandomBytes m, Keyed m, Networked m)
                 => NodeInfo -> BS.ByteString -> m ()
handleCryptoData :: NodeInfo -> ByteString -> m ()
handleCryptoData NodeInfo
from ByteString
payload = do
  SecureSessionState
ss <- m SecureSessionState
forall s (m :: * -> *). MonadState s m => m s
get
  case (SecureSessionState -> Maybe CombinedKey
ssSharedKey SecureSessionState
ss, SecureSessionState -> Maybe Nonce
ssPeerBaseNonce SecureSessionState
ss) of
    (Just CombinedKey
sharedKey, Just Nonce
peerBaseNonce) -> do
      case PlainText -> Maybe CryptoDataPacket
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode (ByteString -> PlainText
Box.PlainText ByteString
payload) of
        Maybe CryptoDataPacket
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (CryptoDataPacket
cd :: CryptoDataPacket) -> do
          let nonce :: Nonce
nonce = Nonce -> Word16 -> Nonce
calculateNonce Nonce
peerBaseNonce (CryptoDataPacket -> Word16
cdNonceShort CryptoDataPacket
cd)
          case CombinedKey -> Nonce -> CipherText -> Maybe PlainText
Box.decrypt CombinedKey
sharedKey Nonce
nonce (CryptoDataPacket -> CipherText
cdPayload CryptoDataPacket
cd) of
            Maybe PlainText
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just PlainText
_plain -> do
              (SecureSessionState -> SecureSessionState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecureSessionState -> SecureSessionState) -> m ())
-> (SecureSessionState -> SecureSessionState) -> m ()
forall a b. (a -> b) -> a -> b
$ \SecureSessionState
s -> SecureSessionState
s
                { ssStatus :: Maybe HandshakeStatus
ssStatus = HandshakeStatus -> Maybe HandshakeStatus
forall a. a -> Maybe a
Just HandshakeStatus
SessionConfirmed
                , ssRecvPackets :: Word64
ssRecvPackets = SecureSessionState -> Word64
ssRecvPackets SecureSessionState
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
                , ssPeerBaseNonce :: Maybe Nonce
ssPeerBaseNonce = Nonce -> Maybe Nonce
forall a. a -> Maybe a
Just (Nonce -> Word16 -> Nonce
updateBaseNonce Nonce
peerBaseNonce (CryptoDataPacket -> Word16
cdNonceShort CryptoDataPacket
cd))
                , ssPeerNodeInfo :: NodeInfo
ssPeerNodeInfo = NodeInfo
from -- Update for mobility
                }
              -- TODO: pass plain upwards
              () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Maybe CombinedKey, Maybe Nonce)
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
\end{code}

First it takes the difference between the 2 byte number on the packet and the
last.  Because the 3 values are unsigned 16 bit ints and rollover is part of
the math something like diff = (10 - 65536) means diff is equal to 11.

Then it copies the saved base nonce to a temp nonce buffer.

Then it adds diff to the nonce (the nonce is in big endian format).

After if decryption was successful it checks if diff was bigger than 2/3 of the
value that can be contained in a 16 bit unsigned int and increases the saved
base nonce by 1/3 of the maximum value if it succeeded.

This is only one of many ways that the nonce for each encrypted packet can be
calculated.

Encrypted packets that cannot be decrypted are simply dropped.

The reason for exchanging base nonces is because since the key for encrypting
packets is the same for received and sent packets there must be a cryptographic
way to make it impossible for someone to do an attack where they would replay
packets back to the sender and the sender would think that those packets came
from the other peer.