\section{Box}

\begin{code}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE Trustworthy                #-}
module Network.Tox.Crypto.Box
  ( PlainText (..)
  , CipherText
  , cipherText
  , unCipherText
  , decode
  , encode
  , decrypt, decryptR
  , encrypt, encryptR
  ) where

import           Control.Applicative               ((<$>), (<*>))
import qualified Crypto.Saltine.Core.Box           as Sodium (boxAfterNM,
                                                              boxOpenAfterNM)
import qualified Crypto.Saltine.Internal.ByteSizes as ByteSizes
import           Data.Binary                       (Binary, get, put)
import           Data.Binary.Get                   (Decoder (..), pushChunk,
                                                    runGetIncremental)
import           Data.Binary.Put                   (runPut)
import           Data.ByteString                   (ByteString)
import qualified Data.ByteString                   as ByteString
import qualified Data.ByteString.Base16            as Base16
import qualified Data.ByteString.Lazy              as LazyByteString
import           Data.MessagePack                  (MessagePack (..))
import           Data.Typeable                     (Typeable)
import           GHC.Generics                      (Generic)
import           Network.MessagePack.Rpc           (Doc (..))
import qualified Network.MessagePack.Rpc           as Rpc
import           Test.QuickCheck.Arbitrary         (Arbitrary, arbitrary)
import           Text.Read                         (readPrec)

import           Network.Tox.Crypto.Key            (CombinedKey, Key (..),
                                                    Nonce)


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


\end{code}

The Tox protocol differentiates between two types of text: Plain Text and
Cipher Text.  Cipher Text may be transmitted over untrusted data channels.
Plain Text can be Sensitive or Non Sensitive.  Sensitive Plain Text must be
transformed into Cipher Text using the encryption function before it can be
transmitted over untrusted data channels.

\begin{code}


newtype PlainText = PlainText { unPlainText :: ByteString }
  deriving (Eq, Binary, Generic, Typeable)

instance MessagePack PlainText

instance Show PlainText where
  show = show . Base16.encode . unPlainText

instance Read PlainText where
  readPrec = PlainText . fst . Base16.decode <$> readPrec


newtype CipherText = CipherText { unCipherText :: ByteString }
  deriving (Eq, Typeable)

cipherText :: Monad m => ByteString -> m CipherText
cipherText bs
  | ByteString.length bs >= ByteSizes.boxMac = return $ CipherText bs
  | otherwise                                = fail "ciphertext is too short"

instance Binary CipherText where
  put = put . unCipherText
  get = get >>= cipherText

instance MessagePack CipherText where
  toObject = toObject . unCipherText
  fromObject x = do
    bs <- fromObject x
    cipherText bs

instance Show CipherText where
  show = show . Base16.encode . unCipherText

instance Read CipherText where
  readPrec = fst . Base16.decode <$> readPrec >>= cipherText


encode :: Binary a => a -> PlainText
encode =
  PlainText . LazyByteString.toStrict . runPut . put


decode :: (Monad m, Binary a) => PlainText -> m a
decode (PlainText bytes) =
  finish $ pushChunk (runGetIncremental get) bytes
  where
    finish = \case
      Done _ _ output -> return output
      Fail _ _ msg    -> fail msg
      Partial f       -> finish $ f Nothing


\end{code}

The encryption function takes a Combined Key, a Nonce, and a Plain Text, and
returns a Cipher Text.  It uses \texttt{crypto\_box\_afternm} to perform the
encryption.  The meaning of the sentence "encrypting with a secret key, a
public key, and a nonce" is: compute a combined key from the secret key and the
public key and then use the encryption function for the transformation.

\begin{code}

encrypt :: CombinedKey -> Nonce -> PlainText -> CipherText
encrypt (Key ck) (Key nonce) (PlainText bytes) =
  CipherText $ Sodium.boxAfterNM ck nonce bytes

encryptR :: Rpc.Rpc (CombinedKey -> Nonce -> PlainText -> Rpc.Returns CipherText)
encryptR =
  Rpc.stubs "Box.encrypt"
    (Arg "key" $ Arg "nonce" $ Arg "plain" $ Ret "encrypted")
    encrypt

\end{code}

The decryption function takes a Combined Key, a Nonce, and a Cipher Text, and
returns either a Plain Text or an error.  It uses
\texttt{crypto\_box\_open\_afternm} from the NaCl library.  Since the cipher is
symmetric, the encryption function can also perform decryption, but will not
perform message authentication, so the implementation must be careful to use
the correct functions.

\begin{code}

decrypt :: CombinedKey -> Nonce -> CipherText -> Maybe PlainText
decrypt (Key ck) (Key nonce) (CipherText bytes) =
  PlainText <$> Sodium.boxOpenAfterNM ck nonce bytes

decryptR :: Rpc.Rpc (CombinedKey -> Nonce -> CipherText -> Rpc.Returns (Maybe PlainText))
decryptR =
  Rpc.stubs "Box.decrypt"
    (Arg "key" $ Arg "nonce" $ Arg "encrypted" $ Ret "plain")
    decrypt

\end{code}

\texttt{crypto\_box} uses xsalsa20 symmetric encryption and poly1305
authentication.

The create and handle request functions are the encrypt and decrypt functions
for a type of DHT packets used to send data directly to other DHT nodes.  To be
honest they should probably be in the DHT module but they seem to fit better
here.  TODO: What exactly are these functions?


\begin{code}


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


instance Arbitrary PlainText where
  arbitrary = PlainText . ByteString.pack <$> arbitrary


instance Arbitrary CipherText where
  arbitrary = encrypt <$> arbitrary <*> arbitrary <*> arbitrary

\end{code}