Unverified: data to route response packet sending.

1 files changed, 20 insertions, 12 deletions

diff --git a/ToxMessage.hs b/ToxMessage.hs
index 56758e48..c77f1ad7 100644
--- a/ToxMessage.hs
+++ b/ToxMessage.hs
@@ -220,14 +220,6 @@ data Packet where
 
     OnionRequest3 :: ByteString -> Symmetric -> Packet -- 0x82
 
-    -- TODO:
-    --   Announce has a return path appended to it.
-    --   We'll need a type-level natural to indicate how may bytes to
-    --   get in the ImplicitAssymetric data.  (Or we could force the size
-    --   of the return path).
-    --
-    --   If the return path is non empty, we should respond with OnionResponse3
-    --   rather than AnnounceResponse directly.
     Announce :: Aliased Assymetric -> ReturnPath 3 -> Packet --0x83
     AnnounceResponse :: Nonce8 -> UnclaimedAssymetric -> Packet -- 0x84
 
@@ -256,8 +248,9 @@ pattern OnionRequest1Type = PacketKind 129 -- 0x81     Onion Request 1
 pattern OnionRequest2Type = PacketKind 130 -- 0x82     Onion Request 2
 pattern AnnounceType  = PacketKind 131 -- 0x83     Announce Request
 pattern AnnounceResponseType = PacketKind 132 -- 0x84     Announce Response
--- 0x85     Onion Data Request (data to route request packet)
--- 0x86     Onion Data Response (data to route response packet)
+
+pattern DataRequestType = PacketKind 133 -- 0x85     Onion Data Request (data to route request packet)
+pattern DataResponseType = PacketKind 134 -- 0x86     Onion Data Response (data to route response packet)
 -- 0x8c     Onion Response 3
 -- 0x8d     Onion Response 2
 pattern OnionResponse3Type = PacketKind 140 -- 0x8c     Onion Response 3
@@ -291,7 +284,10 @@ instance Show PacketKind where
     showsPrec d OnionRequest0Type = mappend "OnionRequest0"
     showsPrec d OnionResponse1Type = mappend "OnionResponse1"
     showsPrec d OnionResponse3Type = mappend "OnionResponse3"
-    showsPrec d AnnounceType = mappend "AnnounceType"
+    showsPrec d AnnounceType = mappend "Announce"
+    showsPrec d AnnounceResponseType = mappend "AnnounceResponse"
+    showsPrec d DataRequestType = mappend "DataRequestType"
+    showsPrec d DataResponseType = mappend "DataResponseType"
     showsPrec d (PacketKind x) = mappend "PacketKind " . showsPrec (d+1) x
 
 pktKind :: Packet -> PacketKind
@@ -356,6 +352,7 @@ pktKind OnionResponse3   {} = PacketKind 0x8c
 data PacketClass =
     AssymetricClass (Assymetric -> Packet) (Packet -> Assymetric)
     | forall n. OnionPacket n => AliasedClass ((Aliased Assymetric,ReturnPath n) -> Packet) (Packet -> (Aliased Assymetric,ReturnPath n))
+    | forall n. OnionPacket n => ToRouteClass ((PubKey,(Aliased Assymetric,ReturnPath n)) -> Packet) (Packet -> (PubKey,(Aliased Assymetric,ReturnPath n)))
     | forall n. OnionPacket n => OnionClass ((Packet,ReturnPath n) -> Packet) (Packet -> (Packet,ReturnPath n))
     | NoncedUnclaimedClass (Nonce8 -> UnclaimedAssymetric -> Packet)
                            (Packet -> (Nonce8, UnclaimedAssymetric))
@@ -383,13 +380,16 @@ pktClass (PacketKind 4) = AssymetricClass SendNodes (\(SendNodes a) -> a)
 
 pktClass (PacketKind 0x18) = AssymetricClass CookieRequest (\(CookieRequest a) -> a)
 pktClass (PacketKind 0x80) = AssymetricClass OnionRequest0 (\(OnionRequest0 a) -> a)
--- pktClass (PacketKind 0x86) = AssymetricClass (DataToRouteResponse . Aliased) (\(DataToRouteResponse (Aliased a)) -> a)
+pktClass (PacketKind 0x86) = AssymetricClass (DataToRouteResponse . Aliased) (\(DataToRouteResponse (Aliased a)) -> a)
 
 pktClass (PacketKind 0x83) = AliasedClass (uncurry Announce) (\(Announce a r)-> (a,r))
 pktClass (PacketKind 0x84) = NoncedUnclaimedClass AnnounceResponse (\(AnnounceResponse n8 uncl)-> (n8,uncl))
 
 pktClass (PacketKind 0x8c) = OnionClass (uncurry OnionResponse3 . swap) (\(OnionResponse3 r a)-> (a,r))
 
+pktClass DataRequestType = ToRouteClass (\(k,(a,r))-> DataToRoute k a r)
+                                        (\(DataToRoute k a r) -> (k,(a,r)))
+
 pktClass _ = Unclassified
 
 
@@ -408,6 +408,13 @@ getPacket = do
             r <- get
             trace ("PARSED "++show typ) $ return ()
             return $ toPacket (a,r)
+        ToRouteClass toPacket _      -> do
+            trace ("R-PARSE "++show typ) $ return ()
+            cnt <- remaining
+            (pub,a) <- isolate (cnt - 59*3) get
+            r <- get
+            trace ("R-PARSED "++show typ) $ return ()
+            return $ toPacket (pub,(a,r))
         OnionClass      toPacket _      -> do
             trace ("ONION-PARSE "++show typ) $ return ()
             p <- get
@@ -421,6 +428,7 @@ putPacket p = do
     case pktClass (pktKind p) of
         AssymetricClass _ fromPacket      -> put $ fromPacket p
         AliasedClass    _ fromPacket      -> put $ fromPacket p
+        ToRouteClass    _ fromPacket      -> put $ fromPacket p
         OnionClass      _ fromPacket      -> put $ swap $ fromPacket p
         NoncedUnclaimedClass _ fromPacket -> put $ fromPacket p -- putting a pair.
         Unclassified -> fail $ "todo: serialize packet "++show (pktKind p)