First successful TCP relay mediated chat link!

1 files changed, 24 insertions, 11 deletions

diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs
index d6f747d9..86fc71f4 100644
--- a/dht/src/Data/Tox/Onion.hs
+++ b/dht/src/Data/Tox/Onion.hs
@@ -63,6 +63,8 @@ import Data.Word64Map (fitsInInt)
 import Data.Bits (shiftR,shiftL)
 import qualified Rank2
 import Util (sameAddress)
+import Text.XXD
+import qualified Data.ByteArray as BA
 
 type HandleLo a = Arrival String SockAddr ByteString -> IO a
 
@@ -583,6 +585,7 @@ handleOnionRequest :: forall a proxy n.
                       , KnownPeanoNat n
                       , Sized (ReturnPath n)
                       , Typeable n
+                      , Typeable (ThreeMinus (S n))
                       ) => proxy n -> TransportCrypto -> (forall x. x -> Addressed x) -> UDPTransport -> IO a -> OnionRequest n -> IO a
 handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = do
     let n = peanoVal rpath
@@ -615,7 +618,7 @@ peelSymmetric :: Serialize (Addressed (ReturnPath n))
 peelSymmetric sym (ReturnPath nonce e) = decryptSymmetric sym nonce e >>= decodePlain
 
 
-peelOnion :: Serialize (Addressed (Forwarding n t))
+peelOnion :: ( Typeable n, Typeable t, Serialize (Addressed (Forwarding n t)))
               => TransportCrypto
               -> Nonce24
               -> Forwarding (S n) t
@@ -766,11 +769,10 @@ data OnionData
 
 instance Sized OnionData where
     size = VarSize $ \case
-        OnionDHTPublicKey dhtpk -> case size of
+        OnionDHTPublicKey dhtpk -> 1 + case size of
             ConstSize n -> n -- Override because OnionData probably
                              -- should be treated as variable sized.
             VarSize f   -> f dhtpk
-        -- FIXME: inconsitantly, we have to add in the tag byte for this case.
         OnionFriendRequest req -> 1 + case size of
             ConstSize n -> n
             VarSize f   -> f req
@@ -824,9 +826,15 @@ decrypt crypto msg addr = do
                        -> (IO ∘ Either String ∘ Identity) a
         decipher = (\n -> decipher1 crypto skey n . left (senderkey addr))
     foo <- sequenceMessage $ transcode decipher msg
-    return $ do
-        msg <- sequenceMessage foo
-        Right (msg, addr)
+    let result = do
+            msg <- sequenceMessage foo
+            Right (msg, addr)
+    case msg of
+        OnionToRouteResponse {} -> case result of
+            Left e  -> dput XOnion $ "Error decrypting data-to-route response: " ++ e
+            Right m -> dput XOnion $ "Decrypted data-to-route response: " ++ show (fst m)
+        _ -> return ()
+    return result
 
 senderkey :: OnionDestination r -> t -> (PublicKey, t)
 senderkey addr e = (onionKey addr, e)
@@ -838,7 +846,12 @@ aliasKey crypto (OnionDestination {}) = (onionAliasSecret &&& onionAliasPublic)
 dhtKey :: TransportCrypto -> (SecretKey,PublicKey)
 dhtKey crypto = (transportSecret &&& transportPublic) crypto
 
-decryptMessage :: Serialize x =>
+decodePlainVerbose :: (Typeable a, Serialize a) => Plain Serialize a -> Either String a
+decodePlainVerbose p =
+    left (\e -> unlines (unwords [e , show $ typeRep p] : xxd2 0 (BA.convert p :: ByteString)))
+        $ decodePlain p
+
+decryptMessage :: (Typeable x, Serialize x) =>
                   TransportCrypto
                   -> (SecretKey,PublicKey)
                   -> Nonce24
@@ -847,7 +860,7 @@ decryptMessage :: Serialize x =>
                   -> IO ((Either String ∘ Identity) x)
 decryptMessage crypto (sk,pk) n arg = do
     let (sender,e) = either id (senderKey &&& asymmData) arg
-        plain      = Composed . fmap Identity . (>>= decodePlain)
+        plain      = Composed . fmap Identity . (>>= decodePlainVerbose)
     secret <- lookupSharedSecret crypto sk sender n
     return $ plain $ ToxCrypto.decrypt secret e
 
@@ -998,15 +1011,15 @@ parseDataToRoute crypto (OnionToRouteResponse dta, od) = do
                                 (Right dta) -- using Asymm{senderKey} as remote key
   let eOuter = fmap runIdentity $ uncomposed omsg0
 
-      anyRight [] f     = return $ Left "parseDataToRoute: no user key"
-      anyRight (x:xs) f = f x >>= either (const $ anyRight xs f) (return . Right)
+      anyRight []     e f = return $ Left $ "parseDataToRoute: " ++ e
+      anyRight (x:xs) e f = f x >>= either (\e2 -> anyRight xs e2 f) (return . Right)
 
   -- TODO: We don't currently have a way to look up which user key we
   -- announced using along this onion route.  Therefore, for now, we will
   -- try all our user keys to see if any can decrypt the packet.
   eInner <- case eOuter of
     Left e    -> return $ Left e
-    Right dtr -> anyRight ks $ \(sk,pk) -> do
+    Right dtr -> anyRight ks "no user key" $ \(sk,pk) -> do
         omsg0 <- decryptMessage crypto
                                  (sk,pk)
                                  (asymmNonce dta)