\section{Box}

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

import           Control.Monad.Validate      (MonadValidate (..))
import qualified Crypto.Saltine.Core.Box     as Sodium (boxAfterNM,
                                                        boxOpenAfterNM)
import qualified Crypto.Saltine.Internal.Box as Sodium
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            (DecodeError, MessagePack (..))
import           Data.Typeable               (Typeable)
import           GHC.Generics                (Generic)
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 { PlainText -> ByteString
unPlainText :: ByteString }
  deriving (PlainText -> PlainText -> Bool
(PlainText -> PlainText -> Bool)
-> (PlainText -> PlainText -> Bool) -> Eq PlainText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlainText -> PlainText -> Bool
$c/= :: PlainText -> PlainText -> Bool
== :: PlainText -> PlainText -> Bool
$c== :: PlainText -> PlainText -> Bool
Eq, Get PlainText
[PlainText] -> Put
PlainText -> Put
(PlainText -> Put)
-> Get PlainText -> ([PlainText] -> Put) -> Binary PlainText
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [PlainText] -> Put
$cputList :: [PlainText] -> Put
get :: Get PlainText
$cget :: Get PlainText
put :: PlainText -> Put
$cput :: PlainText -> Put
Binary, (forall x. PlainText -> Rep PlainText x)
-> (forall x. Rep PlainText x -> PlainText) -> Generic PlainText
forall x. Rep PlainText x -> PlainText
forall x. PlainText -> Rep PlainText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlainText x -> PlainText
$cfrom :: forall x. PlainText -> Rep PlainText x
Generic, Typeable)

instance MessagePack PlainText

instance Show PlainText where
  show :: PlainText -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (PlainText -> ByteString) -> PlainText -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (PlainText -> ByteString) -> PlainText -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlainText -> ByteString
unPlainText

instance Read PlainText where
  readPrec :: ReadPrec PlainText
readPrec = do
    ByteString
text <- ReadPrec ByteString
forall a. Read a => ReadPrec a
readPrec
    case ByteString -> Either String ByteString
Base16.decode ByteString
text of
      Left String
err -> String -> ReadPrec PlainText
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
      Right ByteString
ok -> PlainText -> ReadPrec PlainText
forall (m :: * -> *) a. Monad m => a -> m a
return (PlainText -> ReadPrec PlainText)
-> PlainText -> ReadPrec PlainText
forall a b. (a -> b) -> a -> b
$ ByteString -> PlainText
PlainText ByteString
ok


newtype CipherText = CipherText { CipherText -> ByteString
unCipherText :: ByteString }
  deriving (CipherText -> CipherText -> Bool
(CipherText -> CipherText -> Bool)
-> (CipherText -> CipherText -> Bool) -> Eq CipherText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CipherText -> CipherText -> Bool
$c/= :: CipherText -> CipherText -> Bool
== :: CipherText -> CipherText -> Bool
$c== :: CipherText -> CipherText -> Bool
Eq, Typeable)

cipherText :: MonadValidate DecodeError m => ByteString -> m CipherText
cipherText :: ByteString -> m CipherText
cipherText ByteString
bs
  | ByteString -> Int
ByteString.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
Sodium.box_macbytes = CipherText -> m CipherText
forall (m :: * -> *) a. Monad m => a -> m a
return (CipherText -> m CipherText) -> CipherText -> m CipherText
forall a b. (a -> b) -> a -> b
$ ByteString -> CipherText
CipherText ByteString
bs
  | Bool
otherwise                                   = DecodeError -> m CipherText
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute DecodeError
"ciphertext is too short"

instance Binary CipherText where
  put :: CipherText -> Put
put = ByteString -> Put
forall t. Binary t => t -> Put
put (ByteString -> Put)
-> (CipherText -> ByteString) -> CipherText -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherText -> ByteString
unCipherText
  get :: Get CipherText
get = Get ByteString
forall t. Binary t => Get t
get 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
cipherText

instance MessagePack CipherText where
  toObject :: Config -> CipherText -> Object
toObject Config
cfg = Config -> ByteString -> Object
forall a. MessagePack a => Config -> a -> Object
toObject Config
cfg (ByteString -> Object)
-> (CipherText -> ByteString) -> CipherText -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherText -> ByteString
unCipherText
  fromObjectWith :: Config -> Object -> m CipherText
fromObjectWith Config
cfg Object
x = do
    ByteString
bs <- Config -> Object -> m ByteString
forall a (m :: * -> *).
(MessagePack a, Applicative m, Monad m,
 MonadValidate DecodeError m) =>
Config -> Object -> m a
fromObjectWith Config
cfg Object
x
    ByteString -> m CipherText
forall (m :: * -> *).
MonadValidate DecodeError m =>
ByteString -> m CipherText
cipherText ByteString
bs

instance Show CipherText where
  show :: CipherText -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (CipherText -> ByteString) -> CipherText -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (CipherText -> ByteString) -> CipherText -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherText -> ByteString
unCipherText

instance Read CipherText where
  readPrec :: ReadPrec CipherText
readPrec = do
    ByteString
text <- ReadPrec ByteString
forall a. Read a => ReadPrec a
readPrec
    case ByteString -> Either String ByteString
Base16.decode ByteString
text of
      Left String
err -> String -> ReadPrec CipherText
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
      Right ByteString
ok -> ByteString -> ReadPrec CipherText
forall (m :: * -> *).
MonadValidate DecodeError m =>
ByteString -> m CipherText
cipherText ByteString
ok


encode :: Binary a => a -> PlainText
encode :: a -> PlainText
encode =
  ByteString -> PlainText
PlainText (ByteString -> PlainText) -> (a -> ByteString) -> a -> PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LazyByteString.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall t. Binary t => t -> Put
put


decode :: (MonadFail m, Binary a) => PlainText -> m a
decode :: PlainText -> m a
decode (PlainText ByteString
bytes) =
  Decoder a -> m a
forall a. Decoder a -> m a
finish (Decoder a -> m a) -> Decoder a -> m a
forall a b. (a -> b) -> a -> b
$ Decoder a -> ByteString -> Decoder a
forall a. Decoder a -> ByteString -> Decoder a
pushChunk (Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
forall t. Binary t => Get t
get) ByteString
bytes
  where
    finish :: Decoder a -> m a
finish = \case
      Done ByteString
_ ByteOffset
_ a
output -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
output
      Fail ByteString
_ ByteOffset
_ String
msg    -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
      Partial Maybe ByteString -> Decoder a
f       -> Decoder a -> m a
finish (Decoder a -> m a) -> Decoder a -> m a
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Decoder a
f Maybe ByteString
forall a. Maybe a
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 :: CombinedKey -> Nonce -> PlainText -> CipherText
encrypt (Key CombinedKey
ck) (Key Nonce
nonce) (PlainText ByteString
bytes) =
  ByteString -> CipherText
CipherText (ByteString -> CipherText) -> ByteString -> CipherText
forall a b. (a -> b) -> a -> b
$ CombinedKey -> Nonce -> ByteString -> ByteString
Sodium.boxAfterNM CombinedKey
ck Nonce
nonce ByteString
bytes

\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 :: CombinedKey -> Nonce -> CipherText -> Maybe PlainText
decrypt (Key CombinedKey
ck) (Key Nonce
nonce) (CipherText ByteString
bytes) =
  ByteString -> PlainText
PlainText (ByteString -> PlainText) -> Maybe ByteString -> Maybe PlainText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CombinedKey -> Nonce -> ByteString -> Maybe ByteString
Sodium.boxOpenAfterNM CombinedKey
ck Nonce
nonce ByteString
bytes

\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 :: Gen PlainText
arbitrary = ByteString -> PlainText
PlainText (ByteString -> PlainText)
-> ([Word8] -> ByteString) -> [Word8] -> PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
ByteString.pack ([Word8] -> PlainText) -> Gen [Word8] -> Gen PlainText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary


instance Arbitrary CipherText where
  arbitrary :: Gen CipherText
arbitrary = CombinedKey -> Nonce -> PlainText -> CipherText
encrypt (CombinedKey -> Nonce -> PlainText -> CipherText)
-> Gen CombinedKey -> Gen (Nonce -> PlainText -> CipherText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CombinedKey
forall a. Arbitrary a => Gen a
arbitrary Gen (Nonce -> PlainText -> CipherText)
-> Gen Nonce -> Gen (PlainText -> CipherText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary Gen (PlainText -> CipherText) -> Gen PlainText -> Gen CipherText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PlainText
forall a. Arbitrary a => Gen a
arbitrary

\end{code}