\section{DHT Packet}

The DHT Packet contains the sender's DHT Public Key, an encryption Nonce, and
an encrypted payload.  The payload is encrypted with the DHT secret key of the
sender, the DHT public key of the receiver, and the nonce that is sent along
with the packet.  DHT Packets are sent inside Protocol Packets with a varying
Packet Kind.

\begin{tabular}{l|l|l}
  Length             & Type        & \href{#protocol-packet}{Contents} \\
  \hline
  \texttt{32}        & Public Key  & Sender DHT Public Key \\
  \texttt{24}        & Nonce       & Random nonce \\
  \texttt{[16,]}     & Bytes       & Encrypted payload \\
\end{tabular}

The encrypted payload is at least 16 bytes long, because the encryption
includes a \href{https://en.wikipedia.org/wiki/Message_authentication_code}{MAC}
of 16 bytes.  A 16 byte payload would thus be the empty message.  The DHT
protocol never actually sends empty messages, so in reality the minimum size is
27 bytes for the \href{#ping-service}{Ping Packet}.

\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE StrictData         #-}
module Network.Tox.DHT.DhtPacket where

import           Data.Binary                (Binary, get, put)
import           Data.Binary.Get            (getRemainingLazyByteString)
import           Data.Binary.Put            (putByteString, runPut)
import qualified Data.ByteString.Lazy       as LazyByteString
import           Data.MessagePack           (MessagePack)
import           Data.Typeable              (Typeable)
import           GHC.Generics               (Generic)
import           Network.Tox.Crypto.Box     (CipherText, PlainText (..),
                                             unCipherText)
import qualified Network.Tox.Crypto.Box     as Box
import           Network.Tox.Crypto.Key     (Nonce, PublicKey)
import           Network.Tox.Crypto.Keyed   (Keyed)
import qualified Network.Tox.Crypto.Keyed   as Keyed
import           Network.Tox.Crypto.KeyPair (KeyPair (..))
import           Test.QuickCheck.Arbitrary  (Arbitrary, arbitrary)



{-------------------------------------------------------------------------------
 -
 - :: Implementation.
 -
 ------------------------------------------------------------------------------}


data DhtPacket = DhtPacket
  { DhtPacket -> PublicKey
senderPublicKey  :: PublicKey
  , DhtPacket -> Nonce
encryptionNonce  :: Nonce
  , DhtPacket -> CipherText
encryptedPayload :: CipherText
  }
  deriving (DhtPacket -> DhtPacket -> Bool
(DhtPacket -> DhtPacket -> Bool)
-> (DhtPacket -> DhtPacket -> Bool) -> Eq DhtPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DhtPacket -> DhtPacket -> Bool
$c/= :: DhtPacket -> DhtPacket -> Bool
== :: DhtPacket -> DhtPacket -> Bool
$c== :: DhtPacket -> DhtPacket -> Bool
Eq, ReadPrec [DhtPacket]
ReadPrec DhtPacket
Int -> ReadS DhtPacket
ReadS [DhtPacket]
(Int -> ReadS DhtPacket)
-> ReadS [DhtPacket]
-> ReadPrec DhtPacket
-> ReadPrec [DhtPacket]
-> Read DhtPacket
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DhtPacket]
$creadListPrec :: ReadPrec [DhtPacket]
readPrec :: ReadPrec DhtPacket
$creadPrec :: ReadPrec DhtPacket
readList :: ReadS [DhtPacket]
$creadList :: ReadS [DhtPacket]
readsPrec :: Int -> ReadS DhtPacket
$creadsPrec :: Int -> ReadS DhtPacket
Read, Int -> DhtPacket -> ShowS
[DhtPacket] -> ShowS
DhtPacket -> String
(Int -> DhtPacket -> ShowS)
-> (DhtPacket -> String)
-> ([DhtPacket] -> ShowS)
-> Show DhtPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DhtPacket] -> ShowS
$cshowList :: [DhtPacket] -> ShowS
show :: DhtPacket -> String
$cshow :: DhtPacket -> String
showsPrec :: Int -> DhtPacket -> ShowS
$cshowsPrec :: Int -> DhtPacket -> ShowS
Show, (forall x. DhtPacket -> Rep DhtPacket x)
-> (forall x. Rep DhtPacket x -> DhtPacket) -> Generic DhtPacket
forall x. Rep DhtPacket x -> DhtPacket
forall x. DhtPacket -> Rep DhtPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DhtPacket x -> DhtPacket
$cfrom :: forall x. DhtPacket -> Rep DhtPacket x
Generic, Typeable)

instance MessagePack DhtPacket


instance Binary DhtPacket where
  put :: DhtPacket -> Put
put DhtPacket
packet = do
    PublicKey -> Put
forall t. Binary t => t -> Put
put (PublicKey -> Put) -> PublicKey -> Put
forall a b. (a -> b) -> a -> b
$ DhtPacket -> PublicKey
senderPublicKey DhtPacket
packet
    Nonce -> Put
forall t. Binary t => t -> Put
put (Nonce -> Put) -> Nonce -> Put
forall a b. (a -> b) -> a -> b
$ DhtPacket -> Nonce
encryptionNonce DhtPacket
packet
    ByteString -> Put
putByteString (ByteString -> Put)
-> (DhtPacket -> ByteString) -> DhtPacket -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherText -> ByteString
unCipherText (CipherText -> ByteString)
-> (DhtPacket -> CipherText) -> DhtPacket -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhtPacket -> CipherText
encryptedPayload (DhtPacket -> Put) -> DhtPacket -> Put
forall a b. (a -> b) -> a -> b
$ DhtPacket
packet

  get :: Get DhtPacket
get =
    PublicKey -> Nonce -> CipherText -> DhtPacket
DhtPacket (PublicKey -> Nonce -> CipherText -> DhtPacket)
-> Get PublicKey -> Get (Nonce -> CipherText -> DhtPacket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PublicKey
forall t. Binary t => Get t
get Get (Nonce -> CipherText -> DhtPacket)
-> Get Nonce -> Get (CipherText -> DhtPacket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Nonce
forall t. Binary t => Get t
get Get (CipherText -> DhtPacket) -> Get CipherText -> Get DhtPacket
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ByteString
LazyByteString.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString Get ByteString -> (ByteString -> Get CipherText) -> Get CipherText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get CipherText
forall (m :: * -> *).
MonadValidate DecodeError m =>
ByteString -> m CipherText
Box.cipherText)


encrypt :: KeyPair -> PublicKey -> Nonce -> PlainText -> DhtPacket
encrypt :: KeyPair -> PublicKey -> Nonce -> PlainText -> DhtPacket
encrypt = (((NullKeyed DhtPacket -> DhtPacket
forall a. NullKeyed a -> a
Keyed.runNullKeyed (NullKeyed DhtPacket -> DhtPacket)
-> (PlainText -> NullKeyed DhtPacket) -> PlainText -> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((PlainText -> NullKeyed DhtPacket) -> PlainText -> DhtPacket)
-> (Nonce -> PlainText -> NullKeyed DhtPacket)
-> Nonce
-> PlainText
-> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Nonce -> PlainText -> NullKeyed DhtPacket)
 -> Nonce -> PlainText -> DhtPacket)
-> (PublicKey -> Nonce -> PlainText -> NullKeyed DhtPacket)
-> PublicKey
-> Nonce
-> PlainText
-> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((PublicKey -> Nonce -> PlainText -> NullKeyed DhtPacket)
 -> PublicKey -> Nonce -> PlainText -> DhtPacket)
-> (KeyPair
    -> PublicKey -> Nonce -> PlainText -> NullKeyed DhtPacket)
-> KeyPair
-> PublicKey
-> Nonce
-> PlainText
-> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PublicKey -> Nonce -> PlainText -> NullKeyed DhtPacket
forall (m :: * -> *).
Keyed m =>
KeyPair -> PublicKey -> Nonce -> PlainText -> m DhtPacket
encryptKeyed

encryptKeyed :: Keyed m => KeyPair -> PublicKey -> Nonce -> PlainText -> m DhtPacket
encryptKeyed :: KeyPair -> PublicKey -> Nonce -> PlainText -> m DhtPacket
encryptKeyed (KeyPair SecretKey
senderSecretKey PublicKey
senderPublicKey') PublicKey
receiverPublicKey Nonce
nonce PlainText
plainText =
  (\CombinedKey
combinedKey -> PublicKey -> Nonce -> CipherText -> DhtPacket
DhtPacket PublicKey
senderPublicKey' Nonce
nonce (CipherText -> DhtPacket) -> CipherText -> DhtPacket
forall a b. (a -> b) -> a -> b
$
    CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
combinedKey Nonce
nonce PlainText
plainText) (CombinedKey -> DhtPacket) -> m CombinedKey -> m DhtPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
Keyed.getCombinedKey SecretKey
senderSecretKey PublicKey
receiverPublicKey


encode :: Binary payload => KeyPair -> PublicKey -> Nonce -> payload -> DhtPacket
encode :: KeyPair -> PublicKey -> Nonce -> payload -> DhtPacket
encode = (((NullKeyed DhtPacket -> DhtPacket
forall a. NullKeyed a -> a
Keyed.runNullKeyed (NullKeyed DhtPacket -> DhtPacket)
-> (payload -> NullKeyed DhtPacket) -> payload -> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((payload -> NullKeyed DhtPacket) -> payload -> DhtPacket)
-> (Nonce -> payload -> NullKeyed DhtPacket)
-> Nonce
-> payload
-> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Nonce -> payload -> NullKeyed DhtPacket)
 -> Nonce -> payload -> DhtPacket)
-> (PublicKey -> Nonce -> payload -> NullKeyed DhtPacket)
-> PublicKey
-> Nonce
-> payload
-> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((PublicKey -> Nonce -> payload -> NullKeyed DhtPacket)
 -> PublicKey -> Nonce -> payload -> DhtPacket)
-> (KeyPair
    -> PublicKey -> Nonce -> payload -> NullKeyed DhtPacket)
-> KeyPair
-> PublicKey
-> Nonce
-> payload
-> DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PublicKey -> Nonce -> payload -> NullKeyed DhtPacket
forall payload (m :: * -> *).
(Binary payload, Keyed m) =>
KeyPair -> PublicKey -> Nonce -> payload -> m DhtPacket
encodeKeyed

encodeKeyed :: (Binary payload, Keyed m) => KeyPair -> PublicKey -> Nonce -> payload -> m DhtPacket
encodeKeyed :: KeyPair -> PublicKey -> Nonce -> payload -> m DhtPacket
encodeKeyed KeyPair
keyPair PublicKey
receiverPublicKey Nonce
nonce =
  KeyPair -> PublicKey -> Nonce -> PlainText -> m DhtPacket
forall (m :: * -> *).
Keyed m =>
KeyPair -> PublicKey -> Nonce -> PlainText -> m DhtPacket
encryptKeyed KeyPair
keyPair PublicKey
receiverPublicKey Nonce
nonce
  (PlainText -> m DhtPacket)
-> (payload -> PlainText) -> payload -> m DhtPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PlainText
PlainText
  (ByteString -> PlainText)
-> (payload -> ByteString) -> payload -> PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LazyByteString.toStrict
  (ByteString -> ByteString)
-> (payload -> ByteString) -> payload -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut
  (Put -> ByteString) -> (payload -> Put) -> payload -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. payload -> Put
forall t. Binary t => t -> Put
put


decrypt :: KeyPair -> DhtPacket -> Maybe PlainText
decrypt :: KeyPair -> DhtPacket -> Maybe PlainText
decrypt = (NullKeyed (Maybe PlainText) -> Maybe PlainText
forall a. NullKeyed a -> a
Keyed.runNullKeyed (NullKeyed (Maybe PlainText) -> Maybe PlainText)
-> (DhtPacket -> NullKeyed (Maybe PlainText))
-> DhtPacket
-> Maybe PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((DhtPacket -> NullKeyed (Maybe PlainText))
 -> DhtPacket -> Maybe PlainText)
-> (KeyPair -> DhtPacket -> NullKeyed (Maybe PlainText))
-> KeyPair
-> DhtPacket
-> Maybe PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> DhtPacket -> NullKeyed (Maybe PlainText)
forall (m :: * -> *).
Keyed m =>
KeyPair -> DhtPacket -> m (Maybe PlainText)
decryptKeyed

decryptKeyed :: Keyed m => KeyPair -> DhtPacket -> m (Maybe PlainText)
decryptKeyed :: KeyPair -> DhtPacket -> m (Maybe PlainText)
decryptKeyed (KeyPair SecretKey
receiverSecretKey PublicKey
_) DhtPacket { PublicKey
senderPublicKey :: PublicKey
senderPublicKey :: DhtPacket -> PublicKey
senderPublicKey, Nonce
encryptionNonce :: Nonce
encryptionNonce :: DhtPacket -> Nonce
encryptionNonce, CipherText
encryptedPayload :: CipherText
encryptedPayload :: DhtPacket -> CipherText
encryptedPayload } =
  (\CombinedKey
combinedKey -> CombinedKey -> Nonce -> CipherText -> Maybe PlainText
Box.decrypt CombinedKey
combinedKey Nonce
encryptionNonce CipherText
encryptedPayload) (CombinedKey -> Maybe PlainText)
-> m CombinedKey -> m (Maybe PlainText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
Keyed.getCombinedKey SecretKey
receiverSecretKey PublicKey
senderPublicKey


decode :: Binary payload => KeyPair -> DhtPacket -> Maybe payload
decode :: KeyPair -> DhtPacket -> Maybe payload
decode = (NullKeyed (Maybe payload) -> Maybe payload
forall a. NullKeyed a -> a
Keyed.runNullKeyed (NullKeyed (Maybe payload) -> Maybe payload)
-> (DhtPacket -> NullKeyed (Maybe payload))
-> DhtPacket
-> Maybe payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((DhtPacket -> NullKeyed (Maybe payload))
 -> DhtPacket -> Maybe payload)
-> (KeyPair -> DhtPacket -> NullKeyed (Maybe payload))
-> KeyPair
-> DhtPacket
-> Maybe payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> DhtPacket -> NullKeyed (Maybe payload)
forall payload (m :: * -> *).
(Binary payload, Keyed m) =>
KeyPair -> DhtPacket -> m (Maybe payload)
decodeKeyed

decodeKeyed :: (Binary payload, Keyed m) => KeyPair -> DhtPacket -> m (Maybe payload)
decodeKeyed :: KeyPair -> DhtPacket -> m (Maybe payload)
decodeKeyed KeyPair
keyPair DhtPacket
packet = (Maybe PlainText -> (PlainText -> Maybe payload) -> Maybe payload
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PlainText -> Maybe payload
forall (m :: * -> *) a. (MonadFail m, Binary a) => PlainText -> m a
Box.decode) (Maybe PlainText -> Maybe payload)
-> m (Maybe PlainText) -> m (Maybe payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyPair -> DhtPacket -> m (Maybe PlainText)
forall (m :: * -> *).
Keyed m =>
KeyPair -> DhtPacket -> m (Maybe PlainText)
decryptKeyed KeyPair
keyPair DhtPacket
packet


{-------------------------------------------------------------------------------
 -
 - :: Tests.
 -
 ------------------------------------------------------------------------------}


instance Arbitrary DhtPacket where
  arbitrary :: Gen DhtPacket
arbitrary =
    PublicKey -> Nonce -> CipherText -> DhtPacket
DhtPacket (PublicKey -> Nonce -> CipherText -> DhtPacket)
-> Gen PublicKey -> Gen (Nonce -> CipherText -> DhtPacket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PublicKey
forall a. Arbitrary a => Gen a
arbitrary Gen (Nonce -> CipherText -> DhtPacket)
-> Gen Nonce -> Gen (CipherText -> DhtPacket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary Gen (CipherText -> DhtPacket) -> Gen CipherText -> Gen DhtPacket
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen CipherText
forall a. Arbitrary a => Gen a
arbitrary
\end{code}