Fixed Tox decryption.

1 files changed, 112 insertions, 13 deletions

diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs
index 5003f3a4..9d60d066 100644
--- a/src/Network/DatagramServer/Tox.hs
+++ b/src/Network/DatagramServer/Tox.hs
@@ -51,6 +51,10 @@ import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
 import qualified Data.ByteArray as BA
 import Data.ByteArray ( Bytes, convert )
 import Data.Monoid
+import System.Endian
+import qualified Data.ByteString.Base16 as Base16
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Char8 as C8
 
 
 type Key32   = Word256 -- 32 byte key
@@ -119,9 +123,14 @@ data Message a = Message
     , msgNonce   :: TransactionID Message
     , msgPayload :: a
     }
- deriving (Show, Generic, Functor, Foldable, Traversable)
+ deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
 
-deriving instance Show (NodeId Message) -- TODO: print as hex
+instance Show (NodeId Message) where
+    showsPrec d pubkey s =
+        "NodeId \"" ++ C8.unpack (Base16.encode $ convert pubkey) ++ '"':s
+
+instance Show (TransactionID Message) where
+    showsPrec d nonce = mappend "TID " . quoted (mappend $ bin2hex nonce)
 
 isQuery :: Message a -> Bool
 isQuery (Message { msgType = SendNodes })                  = False
@@ -231,13 +240,26 @@ data ToxCipherContext = ToxCipherContext
 
 data Ciphered = Ciphered { cipheredMAC :: Poly1305.Auth
                          , cipheredBytes :: ByteString }
+ deriving Eq
+
+quoted shows s = '"':shows ('"':s)
+
+bin2hex :: ByteArrayAccess bs => bs -> String
+bin2hex = C8.unpack . Base16.encode . convert
+
+instance Show Ciphered where
+    showsPrec d (Ciphered (Poly1305.Auth mac) bytes) =
+        mappend  "Ciphered (Auth "
+        . quoted (mappend $ bin2hex mac)
+        . (") " ++)
+        . quoted (mappend $ bin2hex bytes)
 
 getMessage :: Get (Message Ciphered)
 getMessage = do
         typ <- get
         nid <- get
         tid <- get
-        mac <- Poly1305.Auth . convert <$> getBytes 2
+        mac <- Poly1305.Auth . convert <$> getBytes 16
         cnt <- remaining
         bs <- getBytes cnt
         return Message { msgType = typ
@@ -254,11 +276,19 @@ putMessage (Message {..}) = do
         putByteString (convert mac)
         putByteString bs
 
+-- XXX: assumes ByteArray is little-endian
 id2key :: NodeId Message -> PublicKey
 id2key recipient = case publicKey recipient of
     CryptoPassed key -> key
     CryptoFailed e   -> error ("id2key: "++show e)
 
+-- XXX: S.decode is Big-endian
+-- TODO: implement ByteArray instance, avoid S.decode
+key2id :: PublicKey -> NodeId Message
+key2id pk = case S.decode (BA.convert pk) of
+                Left _ -> error "key2id"
+                Right nid -> nid
+
 
 zeros32 :: Bytes
 zeros32 = BA.replicate 32 0
@@ -305,6 +335,11 @@ encipherAndHash hash crypt m = Ciphered a c
 
 decipherAndAuth :: Poly1305.State -> XSalsa.State -> Ciphered -> Either String ByteString
 decipherAndAuth hash crypt (Ciphered mac c)
+    {-
+    | C8.length m /= C8.length c = Left $ "Unequal lengths: "++show (C8.length m, C8.length c)
+    -- | C8.length c /= 40          = Left $ "Unexpected c length: " ++ show (C8.length c, bin2hex c)
+    | otherwise                  = Right m
+    -}
     | (a == mac) = Right m
     | otherwise  = Left "decipherAndAuth: auth fail"
   where
@@ -340,14 +375,16 @@ curve25519 = CurveFP (CurvePrime prime curvecommon)
 
 instance Envelope Message where
     newtype TransactionID Message = TID Nonce24
-        deriving (Eq,Ord,Show,Serialize) -- Read
+        deriving (Eq,Ord) -- Read
 
     newtype NodeId Message = NodeId Word256
-        deriving (Serialize, Eq, Ord, Bits, FiniteBits)
+        deriving (Eq, Ord, Bits, FiniteBits)
 
     type QueryMethod Message = MessageType
 
     newtype QueryExtra Message = QueryNonce { qryNonce :: Nonce8 }
+        deriving (Eq, Ord, Show)
+
     newtype ResponseExtra Message = ResponseNonce { rspNonce :: Nonce8 }
 
     data PacketDestination Message = ToxAddr { toxID :: NodeId Message
@@ -381,23 +418,83 @@ instance Envelope Message where
              $ S.decode $ Char8.pack (take 24 $ show cnt ++ repeat ' ')
 
 
+{-
+instance Serialize (TransactionID Message) where
+    get = do
+        lo <- getWord64le
+        mid <- getWord64le
+        hi <- getWord64le
+        return $ TID (LargeKey lo
+                     (LargeKey mid hi))
+
+    put (TID (LargeKey lo (LargeKey mid hi))) = do
+        putWord64le lo
+        putWord64le mid
+        putWord64le hi
+
+instance Serialize (NodeId Message) where
+    get = do
+        lo <- getWord64le
+        mid <- getWord64le
+        hi <- getWord64le
+        highest <- getWord64le
+        return $ NodeId (LargeKey lo
+                        (LargeKey mid
+                        (LargeKey hi highest)))
+    put (NodeId (LargeKey lo (LargeKey mid (LargeKey hi highest)))) = do
+        putWord64le lo
+        putWord64le mid
+        putWord64le hi
+        putWord64le highest
+
+-}
+
+instance Serialize (TransactionID Message) where
+    get = do
+        hi <- getWord64be
+        mid <- getWord64be
+        lo <- getWord64be
+        return $ TID (LargeKey lo
+                     (LargeKey mid hi))
+
+    put (TID (LargeKey lo (LargeKey mid hi))) = do
+        putWord64be hi
+        putWord64be mid
+        putWord64be lo
+
+instance Serialize (NodeId Message) where
+    get = do
+        highest <- getWord64be
+        hi <- getWord64be
+        mid <- getWord64be
+        lo <- getWord64be
+        return $ NodeId (LargeKey lo
+                        (LargeKey mid
+                        (LargeKey hi highest)))
+    put (NodeId (LargeKey lo (LargeKey mid (LargeKey hi highest)))) = do
+        putWord64be highest
+        putWord64be hi
+        putWord64be mid
+        putWord64be lo
+
+
 staticAssert isLittleEndian -- assumed by 'withWord64Ptr'
 
 with3Word64Ptr :: Nonce24 -> (Ptr Word64 -> IO a) -> IO a
 with3Word64Ptr (LargeKey wlo (LargeKey wmid whi)) kont =
     allocaBytes (sizeOf wlo * 3) $ \p -> do
-        pokeElemOff p 0 wlo
-        pokeElemOff p 1 wmid
-        pokeElemOff p 2 whi
+        pokeElemOff p 2 $ toBE64 wlo
+        pokeElemOff p 1 $ toBE64 wmid
+        pokeElemOff p 0 $ toBE64 whi
         kont p
 
 with4Word64Ptr :: Key32 -> (Ptr Word64 -> IO a) -> IO a
 with4Word64Ptr (LargeKey wlo (LargeKey wmid (LargeKey whi whighest))) kont =
     allocaBytes (sizeOf wlo * 4) $ \p -> do
-        pokeElemOff p 0 wlo
-        pokeElemOff p 1 wmid
-        pokeElemOff p 2 whi
-        pokeElemOff p 3 whighest
+        pokeElemOff p 3 $ toBE64 wlo
+        pokeElemOff p 2 $ toBE64 wmid
+        pokeElemOff p 1 $ toBE64 whi
+        pokeElemOff p 0 $ toBE64 whighest
         kont p
 
 
@@ -440,13 +537,15 @@ instance WireFormat ByteString Message where
 
     initializeServerState _ _ = do
         k <- generateSecretKey
+        {-
         nid <- withByteArray (toPublic k) $ \p -> do
             wlo     <- peekElemOff p 0
             wmid    <- peekElemOff p 1
             whi     <- peekElemOff p 2
             whigest <- peekElemOff p 3
             return $ LargeKey wlo (LargeKey wmid (LargeKey whi whigest))
-        return (NodeId nid, ToxCipherContext k)
+        -}
+        return (key2id $ toPublic k, ToxCipherContext k)
 
 
 instance Read (NodeId Message) where readsPrec d s = map (\(w,xs) -> (NodeId w, xs)) $ decodeHex s