2 files changed, 61 insertions, 13 deletions

diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs
index 8c4ec928..bcf8b9af 100644
--- a/src/Network/DatagramServer.hs
+++ b/src/Network/DatagramServer.hs
@@ -569,8 +569,10 @@ listener mgr@Manager{..} hs p = do
     (bs, addr) <- liftIO $ do
       handle exceptions $ BS.recvFrom sock (optMaxMsgSize options)
     case parsePacket (msgProxy p) bs >>= \r -> (,) r <$> decodeHeaders ctx r of
-      Left  e       -> -- XXX: Send parse failure message?
+      Left  e       -> do
+                       -- XXX: Send parse failure message?
                        --      liftIO \$ sendMessage sock addr $ encodeHeaders ctx (unknownMessage e)
+                       logMsg 'W' "listener" (T.pack $ show e)
                        return () -- Without transaction id, error message isn't very useful.
       Right (raw,m) ->
         case envelopeClass m of
diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs
index 85ee269c..5003f3a4 100644
--- a/src/Network/DatagramServer/Tox.hs
+++ b/src/Network/DatagramServer/Tox.hs
@@ -34,7 +34,9 @@ import qualified Network.DatagramServer.Types as Envelope (NodeId)
 import Crypto.PubKey.ECC.Types
 import Crypto.PubKey.Curve25519
 import Crypto.ECC.Class
-import qualified Crypto.Cipher.XSalsa as Salsa20
+import qualified Crypto.Cipher.Salsa as Salsa
+import qualified Crypto.Cipher.XSalsa as XSalsa
+import qualified Crypto.MAC.Poly1305  as Poly1305
 import Data.LargeWord
 import Foreign.Ptr
 import Foreign.Storable
@@ -42,10 +44,13 @@ import Foreign.Marshal.Alloc
 import Data.Typeable
 import StaticAssert
 import Crypto.Error.Types
+import qualified Crypto.Error as Cryptonite
 import Data.Hashable
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
-import Data.ByteArray (convert)
+import qualified Data.ByteArray as BA
+import Data.ByteArray ( Bytes, convert )
+import Data.Monoid
 
 
 type Key32   = Word256 -- 32 byte key
@@ -224,26 +229,29 @@ data ToxCipherContext = ToxCipherContext
     { dhtSecretKey :: SecretKey
     }
 
-newtype Ciphered = Ciphered { cipheredBytes :: ByteString }
+data Ciphered = Ciphered { cipheredMAC :: Poly1305.Auth
+                         , cipheredBytes :: ByteString }
 
 getMessage :: Get (Message Ciphered)
 getMessage = do
         typ <- get
         nid <- get
         tid <- get
+        mac <- Poly1305.Auth . convert <$> getBytes 2
         cnt <- remaining
         bs <- getBytes cnt
         return Message { msgType = typ
                        , msgClient = nid
                        , msgNonce = tid
-                       , msgPayload = Ciphered bs }
+                       , msgPayload = Ciphered mac bs }
 
 putMessage :: Message Ciphered -> Put
 putMessage (Message {..}) = do
         put msgType
         put msgClient
         put msgNonce
-        let Ciphered bs = msgPayload
+        let Ciphered (Poly1305.Auth mac) bs = msgPayload
+        putByteString (convert mac)
         putByteString bs
 
 id2key :: NodeId Message -> PublicKey
@@ -251,20 +259,58 @@ id2key recipient = case publicKey recipient of
     CryptoPassed key -> key
     CryptoFailed e   -> error ("id2key: "++show e)
 
-lookupSecret :: ToxCipherContext -> NodeId Message -> TransactionID Message -> Salsa20.State
-lookupSecret ctx recipient nonce = Salsa20.initialize 20 key nonce
+
+zeros32 :: Bytes
+zeros32 = BA.replicate 32 0
+
+zeros24 :: Bytes
+zeros24 = BA.take 24 zeros32
+
+hsalsa20 k n = a <> b
  where
-    key = ecdh (Proxy :: Proxy Curve_X25519) (dhtSecretKey ctx) (id2key recipient) -- ByteArrayAccess b => b
+    Salsa.State st = XSalsa.initialize 20 k n
+    (_, as) = BA.splitAt 4 st
+    (a, xs) = BA.splitAt 16 as
+    (_, bs) = BA.splitAt 24 xs
+    (b, _ ) = BA.splitAt 16 bs
+
+lookupSecret :: ToxCipherContext -> NodeId Message -> TransactionID Message -> (Poly1305.State, XSalsa.State)
+lookupSecret ctx recipient nonce = (hash, crypt)
+ where
+    -- diffie helman
+    shared = ecdh (Proxy :: Proxy Curve_X25519) (dhtSecretKey ctx) (id2key recipient) -- ByteArrayAccess b => b
+    -- shared secret XSalsa key
+    k = hsalsa20 shared zeros24
+    -- cipher state
+    st0 = XSalsa.initialize 20 k nonce
+    -- Poly1305 key
+    (rs, crypt) = XSalsa.combine st0 zeros32
+    Cryptonite.CryptoPassed hash = Poly1305.initialize rs -- TODO: Pattern fail?
 
 decipher :: ToxCipherContext -> Message Ciphered -> Either String (Message ByteString)
-decipher ctx ciphered = Right (fst . Salsa20.combine st . cipheredBytes <$> ciphered)
+decipher ctx ciphered = mapM (decipherAndAuth hash crypt) ciphered
  where
-    st = lookupSecret ctx (msgClient ciphered) (msgNonce ciphered)
+    (hash, crypt) = lookupSecret ctx (msgClient ciphered) (msgNonce ciphered)
 
 encipher :: ToxCipherContext -> NodeId Message -> Message ByteString -> Message Ciphered
-encipher ctx recipient plain = Ciphered . fst . Salsa20.combine st <$> plain
+encipher ctx recipient plain = encipherAndHash hash crypt <$> plain
  where
-    st = lookupSecret ctx recipient (msgNonce plain)
+    (hash, crypt) = lookupSecret ctx recipient (msgNonce plain)
+
+encipherAndHash :: Poly1305.State -> XSalsa.State -> ByteString -> Ciphered
+encipherAndHash hash crypt m = Ciphered a c
+  where
+    c = fst . XSalsa.combine crypt $ m
+    a = Poly1305.finalize . Poly1305.update hash $ c
+
+decipherAndAuth :: Poly1305.State -> XSalsa.State -> Ciphered -> Either String ByteString
+decipherAndAuth hash crypt (Ciphered mac c)
+    | (a == mac) = Right m
+    | otherwise  = Left "decipherAndAuth: auth fail"
+  where
+    m = fst . XSalsa.combine crypt $ c
+    a = Poly1305.finalize . Poly1305.update hash $ c
+
 
 -- see rfc7748
 --