More Tox stuff.

3 files changed, 355 insertions, 65 deletions

diff --git a/Mainline.hs b/Mainline.hs
index 8ff13390..291a196f 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -589,7 +589,7 @@ newClient addr = do
         client = Client
             { clientNet           = net
             , clientDispatcher    = dispatch
-            , clientErrorReporter = printErrors stderr
+            , clientErrorReporter = ignoreErrors -- printErrors stderr
             , clientPending       = map_var
             , clientAddress       = \maddr -> atomically $ do
                 let var = case flip prefer4or6 Nothing <$> maddr of
diff --git a/Tox.hs b/Tox.hs
index 6969e652..253c83e7 100644
--- a/Tox.hs
+++ b/Tox.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE DeriveTraversable          #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns             #-}
 {-# LANGUAGE PatternSynonyms            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TupleSections              #-}
@@ -67,6 +68,8 @@ import Text.Read
 import Kademlia
 import Network.BitTorrent.DHT.Search          (Search (..))
 import Text.Printf
+import qualified Crypto.Cipher.ChaChaPoly1305 as Symmetric
+import Data.Bitraversable (bisequence)
 
 newtype NodeId = NodeId ByteString
  deriving (Eq,Ord,ByteArrayAccess, Bits, Hashable)
@@ -127,17 +130,17 @@ instance FromJSON NodeInfo where
         guard (B.length bs == 32)
         return $ NodeInfo (NodeId bs) ip (fromIntegral (portnum :: Word16))
 
+getIP :: Word8 -> S.Get IP
+getIP 0x02 = IPv4 <$> S.get
+getIP 0x0a = IPv6 <$> S.get
+getIP 0x82 = IPv4 <$> S.get -- TODO: TCP
+getIP 0x8a = IPv6 <$> S.get -- TODO: TCP
+getIP x    = fail ("unsupported address family ("++show x++")")
 
 instance S.Serialize NodeInfo where
     get = do
         addrfam <- S.get :: S.Get Word8
-        ip <- case addrfam of
-            0x02 -> IPv4 <$> S.get
-            0x0a -> IPv6 <$> S.get
-            0x82 -> IPv4 <$> S.get -- TODO: TCP
-            0x8a -> IPv6 <$> S.get -- TODO: TCP
-            -- "Failed reading: unsupported address family (118)\nEmpty call stack\n" 0x76
-            x   -> fail ("unsupported address family ("++show x++")")
+        ip <- getIP addrfam
         port <- S.get :: S.Get PortNumber
         nid <- S.get
         return $ NodeInfo nid ip port
@@ -243,11 +246,11 @@ pattern OnionRequest2 = MessageType 130 -- 0x82     Onion Request 2
 pattern AnnounceType  = MessageType 131 -- 0x83     Announce Request
 
 -- 0x84     Announce Response
--- 0x85     Onion Data Request
--- 0x86     Onion Data Response
+-- 0x85     Onion Data Request (data to route request packet)
+-- 0x86     Onion Data Response (data to route response packet)
 -- 0x8c     Onion Response 3
 -- 0x8d     Onion Response 2
--- 0x8e     Onion Response 1
+pattern OnionResponse1 = MessageType 142 -- 0x8e     Onion Response 1
 -- 0xf0     Bootstrap Info
 
 --  TODO Fix these fails...
@@ -264,6 +267,10 @@ instance Show Method where
     showsPrec d PongType        = mappend "PongType"
     showsPrec d GetNodesType    = mappend "GetNodesType"
     showsPrec d SendNodesType   = mappend "SendNodesType"
+    showsPrec d DHTRequestType  = mappend "DHTRequestType"
+    showsPrec d OnionRequest0   = mappend "OnionRequest0"
+    showsPrec d OnionResponse1  = mappend "OnionResponse1"
+    showsPrec d AnnounceType    = mappend "AnnounceType"
     showsPrec d (MessageType x) = mappend "MessageType " . showsPrec (d+1) x
 
 newtype Nonce8 = Nonce8 Word64
@@ -295,38 +302,71 @@ quoted shows s = '"':shows ('"':s)
 bin2hex :: ByteArrayAccess bs => bs -> String
 bin2hex = C8.unpack . Base16.encode . BA.convert
 
+newtype SymmetricCiphered = SymmetricCiphered ByteString
+    deriving (Eq,Show)
 
 data Message a = Message
-    { msgType    :: Method
-    , msgOrigin  :: NodeId
-    , msgNonce   :: Nonce24 -- cryptoNonce of TransactionId
-    , msgPayload :: a
+    { msgType       :: Method
+    , msgOrigin     :: NodeId
+    , msgNonce      :: Nonce24 -- cryptoNonce of TransactionId
+    , msgReturnPath :: Maybe SymmetricCiphered
+    , msgPayload    :: a
     }
  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
 
+typeHasEncryptedPayload OnionResponse1 = False
+typeHasEncryptedPayload _              = True
+
+msgDHTKey Message{ msgOrigin, msgType = PingType      } = Just msgOrigin
+msgDHTKey Message{ msgOrigin, msgType = PongType      } = Just msgOrigin
+msgDHTKey Message{ msgOrigin, msgType = GetNodesType  } = Just msgOrigin
+msgDHTKey Message{ msgOrigin, msgType = SendNodesType } = Just msgOrigin
+msgDHTKey Message{ msgOrigin, msgType = OnionRequest0 } = Just msgOrigin
+msgDHTKey _                                             = Nothing
+
 data Ciphered = Ciphered { cipheredMAC   :: Poly1305.Auth
                          , cipheredBytes :: ByteString }
  deriving Eq
 
-getMessage :: S.Get (Message Ciphered)
+newtype OnionPayload = OnionPayload { unpackOnionPayload :: ByteString }
+
+instance S.Serialize OnionPayload where
+    get = OnionPayload <$> (S.remaining >>= S.getBytes)
+    put (OnionPayload bs) = S.putByteString bs
+
+getMessage :: S.Get (Message (Either OnionPayload Ciphered))
 getMessage = do
         typ <- S.get
-        (nid,tid) <- case typ of -- Seriously... what the fuck?
-            DHTRequestType -> flip (,) <$> S.get <*> S.get
+        (nid,nonce) <- case typ of -- Seriously... what the fuck?
+            DHTRequestType -> do
+                S.skip 32 -- TODO: get destination key
+                          --       If it is ours, decrypt and handle.
+                          --       If not ours, search routing table and forward if it's in there.
+                flip (,) <$> S.get <*> S.get
             OnionRequest0  -> flip (,) <$> S.get <*> S.get
             OnionRequest1  -> flip (,) <$> S.get <*> S.get
             -- OnionRequest2  -> flip (,) <$> S.get <*> S.get
             AnnounceType   -> flip (,) <$> S.get <*> S.get
+            OnionResponse1 -> (NodeId $ BA.convert zeros32,)  <$> S.get -- XXX: no msgOrigin!
             _              -> (,) <$> S.get <*> S.get
-        mac <- Poly1305.Auth . BA.convert <$> S.getBytes 16
-        cnt <- S.remaining
-        bs <- S.getBytes cnt
-        return Message { msgType    = typ
-                       , msgOrigin  = nid
-                       , msgNonce   = tid
-                       , msgPayload = Ciphered mac bs }
-
-putMessage :: Message Ciphered -> S.Put
+        (payload,rpath) <- case typ of
+            OnionResponse1 -> do
+                rpath <- Just . SymmetricCiphered <$> S.getBytes (16 + 19)
+                payload <- Left . OnionPayload  <$> (S.remaining >>= S.getBytes)
+                return (payload,rpath)
+            _              -> do
+                payload <- Right <$> getCiphered
+                return (payload,Nothing)
+        return Message { msgType       = typ
+                       , msgOrigin     = nid
+                       , msgNonce      = nonce
+                       , msgReturnPath = rpath
+                       , msgPayload    = payload }
+
+putOnionPayload :: OnionPayload -> S.Put
+putOnionPayload (OnionPayload bs) = S.putByteString bs
+
+putMessage :: Message (Either OnionPayload Ciphered) -> S.Put
 putMessage (Message {..}) = do
         S.put msgType
         case msgType of -- Seriously... what the fuck?
@@ -336,9 +376,11 @@ putMessage (Message {..}) = do
             -- OnionRequest2  -> S.put msgNonce  >> S.put msgOrigin
             AnnounceType   -> S.put msgNonce  >> S.put msgOrigin
             _              -> S.put msgOrigin >> S.put msgNonce
-        let Ciphered (Poly1305.Auth mac) bs = msgPayload
-        S.putByteString (BA.convert mac)
-        S.putByteString bs
+        let putPayload    = either putOnionPayload putCiphered msgPayload
+            putReturnPath = forM_ msgReturnPath $ \(SymmetricCiphered bs) -> S.putByteString bs
+        case msgType of
+            OnionResponse1 -> putReturnPath >> putPayload
+            _              -> putPayload >> putReturnPath
 
 {-
 data Plain a = Plain
@@ -352,7 +394,7 @@ instance Serialize a => Serialize (Plain a) where
     put (Plain tid a) = put a >> put tid
 -}
 
--- TODO: Cache symmetric keys.
+-- TODO: Cache shared symmetric keys.
 data SecretsCache = SecretsCache
 newEmptyCache = return SecretsCache
 
@@ -398,9 +440,12 @@ computeSharedSecret sk recipient nonce = (hash, crypt)
     Cryptonite.CryptoPassed hash = Poly1305.initialize rs
 
 
-encryptMessage :: SecretKey -> SecretsCache -> NodeId -> Message ByteString -> Message Ciphered
+encryptMessage :: SecretKey -> SecretsCache -> NodeId -> Message ByteString -> Message (Either OnionPayload Ciphered)
 encryptMessage sk _ recipient plaintext
-    = withSecret encipherAndHash sk recipient (msgNonce plaintext) <$> plaintext
+    = if typeHasEncryptedPayload (msgType plaintext)
+        then Right . withSecret encipherAndHash sk recipient (msgNonce plaintext) <$> plaintext
+        else Left . OnionPayload <$> plaintext
+
 
 decryptMessage :: SecretKey -> SecretsCache -> Message Ciphered -> Either String (Message ByteString)
 decryptMessage sk _ ciphertext
@@ -452,6 +497,11 @@ showParseError bs addr err = unlines $
         concat [ either show show (either4or6 addr), " --> ", err ]
         : xxd 0 bs
 
+unzipMessage :: Message (Either a b) -> Either (Message a) (Message b)
+unzipMessage msg = either (\x -> Left  msg { msgPayload = x })
+                          (\y -> Right msg { msgPayload = y })
+                          (msgPayload msg)
+
 -- TODO:
 -- Represents the encrypted portion of a Tox packet.
 -- data Payload a = Payload a !Nonce8
@@ -460,11 +510,13 @@ showParseError bs addr err = unlines $
 
 parsePacket :: SecretKey -> SecretsCache -> ByteString -> SockAddr -> Either String (Message ByteString, NodeInfo)
 parsePacket sk cache bs addr = left (showParseError bs addr) $ do
-    ciphered <- S.runGet getMessage bs
-    ni <- nodeInfo (msgOrigin ciphered) addr
-    left (showPayloadError ciphered ni " --> ") $ do
-    msg <- decryptMessage sk cache ciphered
-    return (msg, ni)
+    msg <- S.runGet getMessage bs
+    ni <- nodeInfo (msgOrigin msg) addr
+    let decrypt ciphered = left (showPayloadError ciphered ni " --> ") $ do
+            msg <- decryptMessage sk cache ciphered
+            return (msg, ni)
+        passthrough onion = return (unpackOnionPayload <$> onion, ni)
+    either passthrough decrypt $ unzipMessage msg
 
 encodePacket :: SecretKey -> SecretsCache -> Message ByteString -> NodeInfo -> (ByteString, SockAddr)
 encodePacket sk cache msg ni = ( S.runPut . putMessage $ encryptMessage sk cache (nodeId ni) msg
@@ -489,7 +541,9 @@ newClient addr = do
     secret <- generateSecretKey
     let pubkey = key2id $ toPublic secret
     cache <- newEmptyCache
-    drg <- getSystemDRG
+    (symkey, drg) <- do
+        drg0 <- getSystemDRG
+        return $ randomBytesGenerate 32 drg0 :: IO (ByteString, SystemDRG)
     let tentative_ip4 = fromMaybe (IPv4 $ toEnum 0) (IPv4 <$> fromSockAddr addr)
         tentative_ip6 = fromMaybe (IPv6 $ toEnum 0) (IPv6 <$> fromSockAddr addr)
         tentative_info = NodeInfo
@@ -545,20 +599,27 @@ newClient addr = do
         -- mutual reference just to be safe.
         outgoingClient = client { clientNet = net { awaitMessage = return Nothing } }
 
-        dispatch tbl = DispatchMethods
+        dispatch tbl var = DispatchMethods
             { classifyInbound = classify
-            , lookupHandler = handlers
+            , lookupHandler = handlers var
             , tableMethods = tbl
             }
 
-        handlers :: Method -> Maybe Handler
-        handlers PingType     = handler PongType pingH
-        handlers GetNodesType = handler SendNodesType $ getNodesH routing
-        handlers _            = Nothing
+        -- handlers :: TVar -> Method -> Maybe Handler
+        handlers var PingType       = handler PongType pingH
+        handlers var GetNodesType   = handler SendNodesType $ getNodesH routing
+        handlers var OnionRequest0  = noreply OnionRequest0
+                                      $ onionSend0H (symmetricCipher (return symkey)
+                                                                     (fst <$> readTVar var)
+                                                                     (modifyTVar' var . first . const))
+                                                    udp
+        handlers var OnionResponse1 = noreply OnionResponse1
+                                      $ onionResponse1H (symmetricDecipher (return symkey))
+                                                        udp
+        handlers var _              = Nothing
         -- TODO DHTRequest public key (onion)
         -- TODO DHTRequest NAT ping
         -- TODO BootstrapInfo 0xf0
-        -- 
 
         genNonce24 var (TransactionId nonce8 _) = atomically $ do
             (g,pending) <- readTVar var
@@ -576,8 +637,8 @@ newClient addr = do
                     ) -> ToxClient
         mkclient (tbl,var) = Client
             { clientNet           = net
-            , clientDispatcher    = dispatch tbl
-            , clientErrorReporter = printErrors stderr
+            , clientDispatcher    = dispatch tbl var
+            , clientErrorReporter = (printErrors stderr) { reportTimeout = reportTimeout ignoreErrors }
             , clientPending       = var
             , clientAddress       = \maddr -> atomically $ do
                 let var = case flip prefer4or6 Nothing <$> maddr of
@@ -659,10 +720,11 @@ classify (Message { msgType    = typ
             _              -> const $ IsUnknown ("Unknown message type: "++show typ)
 
 encodePayload typ (TransactionId (Nonce8 tid) nonce) self dest b
-    = Message { msgType    = typ
-              , msgOrigin  = nodeId self
-              , msgNonce   = nonce
-              , msgPayload = S.encode b <> S.runPut (S.putWord64be tid)
+    = Message { msgType       = typ
+              , msgOrigin     = nodeId self
+              , msgNonce      = nonce
+              , msgReturnPath = Nothing
+              , msgPayload    = S.encode b <> S.runPut (S.putWord64be tid)
               }
 
 decodePayload :: S.Serialize a => Message ByteString -> Either String a
@@ -672,6 +734,14 @@ type Handler = MethodHandler String TransactionId NodeInfo (Message ByteString)
 
 handler typ f = Just $ MethodHandler decodePayload (encodePayload typ) f
 
+noreply :: S.Serialize b =>
+           Method
+           -> (addr -> Message b -> IO ())
+           -> Maybe (MethodHandler String tid addr (Message ByteString))
+noreply typ f = Just $ NoReply (mapM deserialize) f
+ where
+    deserialize = S.decode . bool id dropEnd8 (typeHasEncryptedPayload typ)
+
 transitionCommittee :: TriadCommittee NodeId SockAddr -> RoutingTransition NodeInfo -> STM (IO ())
 transitionCommittee committee (RoutingTransition ni Stranger) = do
     delVote committee (nodeId ni)
@@ -680,12 +750,14 @@ transitionCommittee committee (RoutingTransition ni Stranger) = do
 transitionCommittee committee _ = return $ return ()
 
 updateRouting :: ToxClient -> Routing -> NodeInfo -> Message ByteString -> IO ()
-updateRouting client routing naddr msg = do
-    case prefer4or6 naddr Nothing of
-        Want_IP4 -> go (routing4 routing) (committee4 routing) (sched4 routing)
-        Want_IP6 -> go (routing6 routing) (committee6 routing) (sched6 routing)
- where
-    go tbl committee sched = do
+updateRouting client routing addr msg = do
+    forM_ (msgDHTKey msg) $ \nid -> do
+        let naddr = addr { nodeId = nid }
+        case prefer4or6 naddr Nothing of
+            Want_IP4 -> updateTable client naddr (routing4 routing) (committee4 routing) (sched4 routing)
+            Want_IP6 -> updateTable client naddr (routing6 routing) (committee6 routing) (sched6 routing)
+
+updateTable client naddr tbl committee sched = do
         self <- atomically $ R.thisNode <$> readTVar tbl
         when (nodeIP self /= nodeIP naddr) $ do
             -- TODO: IP address vote?
@@ -727,6 +799,141 @@ instance S.Serialize SendNodes where
         mapM_ S.put ns'
 
 
+-- self -> A
+-- OnionRequest0: Message (OnionWrap (OnionWrap (Forward msg)))
+-- OnionRequest0: Message (OnionWrap (OnionWrap Ciphered))
+-- OnionRequest0: Message (OnionWrap Ciphered)
+-- OnionRequest0: Message Ciphered
+
+-- A -> B
+-- OnionRequest0: Message Ciphered
+-- OnionRequest0: Message (OnionWrap Ciphered)
+-- OnionRequest1: Message Ciphered ++ SockAddr
+-- OnionRequest1: Message Ciphered ++ SymmetricCiphered
+--
+-- B -> C
+-- OnionRequest1: Message Ciphered ++ SymmetricCiphered
+-- OnionRequest1: Message (OnionWrap Ciphered) ++ SymmetricCiphered
+-- OnionRequest2: Message Ciphered ++ (SockAddr ++ SymmetricCiphered)
+-- OnionRequest2: Message Ciphered ++ SymmetricCiphered
+--
+-- C -> D
+-- OnionRequest2: Message Ciphered ++ SymmetricCiphered
+-- OnionRequest2: Message (Forward msg) ++ SymmetricCiphered
+-- ?????????????: msg  ++ ( SockAddr ++ SymmetricCiphered)
+-- ?????????????: msg  ++ SymmetricCiphered
+
+-- D -> C
+-- ?????????????: msg ++ SymmetricCiphered
+-- OnionResponse3: Message SymmetricCiphered ++ response
+--
+-- C -> B
+-- OnionResponse3: Message SymmetricCiphered               ++ response
+-- OnionResponse3: Message (SockAddr ++ SymmetricCiphered) ++ response
+-- OnionResponse2: Message SymmetricCiphered               ++ response
+--
+-- B -> A
+-- OnionResponse2: Message SymmetricCiphered               ++ response
+-- OnionResponse2: Message (SockAddr ++ SymmetricCiphered) ++ response
+-- OnionResponse1: Message SymmetricCiphered               ++ response
+--
+-- A -> self
+-- OnionResponse1: Message SymmetricCiphered               ++ response
+-- OnionResponse1: Message SockAddr                        ++ response
+-- ??????????????: response
+--
+-- Onion payloads:
+--   AnounceRequest      (0x83)
+--      = SeekingKey nid
+--      | AnnouncingKey pingid nid sendback_key
+--
+--   AnnounceResponse    (0x84)
+--      = KeyNotFound  pingid [ni]       -- is_stored=0
+--      | KeyFound     sendback_key [ni] -- is_stored=1
+--      | Announced    pingid [ni]       -- is_stored=2  What's the pingid for in this caes?
+--                                       --              Should it be a fresh one?
+--
+--   -- After you find an announce node for your friend, you share your dht nodeid thus:
+--   DataToRouteRequest  (0x85)
+--      -- cleartext: Public key of destination node (used to lookup the sendback_key,ip,port of onion-return path)
+--      -- cleartext: nonce
+--      -- cleartext: alias  (just generated key)
+--      -- encrypted (nonce,alias,sendback_key):
+--              real public key
+--              id byte
+--              -- encrypted
+--                  DHTPublicKey (0x9c)
+--                  { no_replay   :: Word64
+--                  , dhtKey      :: NodeId
+--                  , nearbyNodes :: [NodeInfo]
+--                  }
+--              payload (optional)
+--
+--   -- The announce node forwards your message thus:
+--   -- This is the same as 0x85, but the destination key was removed.
+--   DataToRouteResponse (0x86)
+--      -- cleartext: nonce
+--      -- cleartext: alias
+--      -- encrypted payload.
+
+data OnionWrap a = OnionWrap
+    { forwardAddress :: SockAddr
+    , forwardAlias   :: NodeId
+    , onionPayload   :: a
+    }
+
+instance S.Serialize (OnionWrap Ciphered) where
+    get = getOnion
+    put = putOnion
+
+getOnion :: S.Get (OnionWrap Ciphered)
+getOnion = do
+    addr <- getForwardAddr
+    alias <- S.get
+    ciphered <- getCiphered
+    return $ OnionWrap addr alias ciphered
+
+getForwardAddr :: S.Get SockAddr
+getForwardAddr = do
+    addrfam <- S.get :: S.Get Word8
+    ip <- getIP addrfam
+    case ip of IPv4 _ -> S.skip 12 -- compliant peers would zero-fill this.
+               IPv6 _ -> return ()
+    port <- S.get :: S.Get PortNumber
+    return $ setPort port $ toSockAddr ip
+
+
+putForwardAddr :: SockAddr -> S.Put
+putForwardAddr saddr = fromMaybe (return $ error "unsupported SockAddr family") $ do
+    port <- sockAddrPort saddr
+    ip <- fromSockAddr $ either id id $ either4or6 saddr
+    return $ do
+        case ip of
+            IPv4 ip4 -> S.put (0x02 :: Word8) >> S.put ip4 >> S.putByteString (B.replicate 12 0)
+            IPv6 ip6 -> S.put (0x0a :: Word8) >> S.put ip6
+        S.put port
+
+putOnion :: OnionWrap Ciphered -> S.Put
+putOnion = error "todo: putOnion"
+
+getCiphered :: S.Get Ciphered
+getCiphered = do
+        mac <- Poly1305.Auth . BA.convert <$> S.getBytes 16
+        cnt <- S.remaining
+        bs <- S.getBytes cnt
+        return $ Ciphered mac bs
+
+putCiphered :: Ciphered -> S.Put
+putCiphered (Ciphered (Poly1305.Auth mac) bs) = do
+        S.putByteString (BA.convert mac)
+        S.putByteString bs
+
+data Announce = Announce
+    { announcePingId  :: NodeId -- Ping ID
+    , announceSeeking :: NodeId -- Public key we are searching for
+    , announceKey     :: NodeId -- Public key that we want those sending back data packets to use
+    }
+
 pingH :: NodeInfo -> Ping -> IO Pong
 pingH _ Ping = return Pong
 
@@ -762,6 +969,80 @@ getNodesH routing addr (GetNodes nid) = do
 
     k = 4
 
+
+symmetricCipher :: DRG g => STM ByteString -> STM g -> (g -> STM ()) -> ByteString -> IO SymmetricCiphered
+symmetricCipher currentSymmetricKey readG writeG bs = (>>= \e -> hPutStrLn stderr (show e) >> Cryptonite.throwCryptoErrorIO e) $ atomically $ do
+    g <- readG
+    let (sym_nonce_bytes, g') = randomBytesGenerate 12 g
+    writeG g'
+    symmkey <- currentSymmetricKey
+    return $ do
+        sym_nonce <- Symmetric.nonce12 sym_nonce_bytes
+        symm <- Symmetric.initialize symmkey sym_nonce
+        let (rpath_bs, symm') = Symmetric.encrypt bs symm
+            auth = Symmetric.finalize symm' -- 16 bytes
+            -- For a single SockAddr, bs will be 19 bytes which gives
+            -- 12 + 16 + 19 = 47 bytes.
+            -- We need 12 more make 59 bytes, so we'll include the nonce twice.
+        return $ SymmetricCiphered (sym_nonce_bytes <> sym_nonce_bytes <> BA.convert auth <> rpath_bs)
+
+symmetricDecipher currentSymmetricKey (Nonce24 nonce24) (SymmetricCiphered bs) = atomically $ do
+    symmkey <- currentSymmetricKey
+    return $ do
+        let sym_nonce_bytes = B.drop 12 nonce24
+            (mac, bs'')     = B.splitAt 16 bs
+        symm <- left show . Cryptonite.eitherCryptoError $ do
+            sym_nonce <- Symmetric.nonce12 sym_nonce_bytes
+            Symmetric.initialize symmkey sym_nonce
+        let (ds, symm') = Symmetric.decrypt bs'' symm
+            auth = Symmetric.finalize symm'
+        if BA.convert auth /= mac
+            then Left "symmetricDecipher: Auth fail."
+            else return $ ds
+
+
+
+-- OnionRequest0
+onionSend0H :: (ByteString -> IO SymmetricCiphered)
+            -> Transport err SockAddr ByteString
+            -> NodeInfo
+            -> Message (OnionWrap Ciphered)
+            -> IO ()
+onionSend0H symcipher udp addr Message{ msgNonce
+                                      , msgPayload = OnionWrap forward alias ciphered } = do
+    hPutStrLn stderr $ "onionSend0H( " ++ show addr ++ " --> " ++ either show show (either4or6 forward) ++ ")"
+    rpath <- symcipher (S.runPut $ putForwardAddr forward)
+    sendMessage udp forward $ S.runPut $ putMessage
+        Message { msgType       = OnionRequest1
+                , msgOrigin     = alias
+                , msgNonce      = msgNonce
+                , msgReturnPath = Just rpath
+                , msgPayload    = Right ciphered
+                }
+    hPutStrLn stderr $ "onionSend0H SENT ( " ++ show addr ++ " --> " ++ either show show (either4or6 forward) ++ ")"
+
+-- OnionResponse1
+--
+-- No public-key decryption here.
+onionResponse1H ::
+            (Nonce24 -> SymmetricCiphered -> IO (Either String ByteString))
+            -> Transport err SockAddr ByteString
+            -> NodeInfo
+            -> Message OnionPayload
+            -> IO ()
+onionResponse1H symdecipher udp addr Message{ msgNonce
+                                            , msgReturnPath
+                                            , msgPayload
+                                            }
+    = do
+        hPutStrLn stderr $ "onionResponse1H " ++ show addr ++ maybe " Nothing" (const" Just") msgReturnPath
+        forM_ msgReturnPath $ \rpath -> do
+            eaddr <- (>>= S.runGet getForwardAddr) <$> symdecipher msgNonce rpath
+            let go forward = do
+                hPutStrLn stderr $ "onionResponse1H( " ++ show addr ++ " --> " ++ either show show (either4or6 forward) ++ ")"
+                sendMessage udp forward (unpackOnionPayload msgPayload)
+            either (hPutStrLn stderr . mappend "onionResponse1H decipher ERROR ") (\x -> go x >> hPutStrLn stderr "onionResponse1H SENT") eaddr
+
 intKey :: TransactionId -> Int
 intKey (TransactionId (Nonce8 w) _) = fromIntegral w
 
@@ -769,8 +1050,8 @@ nonceKey :: TransactionId -> Nonce8
 nonceKey (TransactionId n _) = n
 
 -- randomBytesGenerate :: ByteArray byteArray => Int -> gen -> (byteArray, gen)
--- gen :: forall gen. DRG gen => gen -> ((Nonce8, Nonce24), gen)
-gen :: SystemDRG -> (TransactionId, SystemDRG)
+gen :: forall gen. DRG gen => gen -> (TransactionId, gen)
+-- gen :: SystemDRG -> (TransactionId, SystemDRG)
 gen g = let (bs, g')  = randomBytesGenerate 24 g
             (ws, g'') = randomBytesGenerate 8 g'
             Right w   = S.runGet S.getWord64be ws
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 29a221e8..c8a6fa80 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -124,18 +124,27 @@ data MethodHandler err tid addr x = forall a b. MethodHandler
       -- address of the query is provided to the handler.
     , methodAction :: addr -> a -> IO b
     }
+    | forall a. NoReply
+    { -- | Parse the query into a more specific type for this method.
+      methodParse :: x -> Either err a
+      -- | Fully typed action to perform upon the query.  The remote origin
+      -- address of the query is provided to the handler.
+    , noreplyAction :: addr -> a -> IO ()
+    }
 
 -- | Attempt to invoke a 'MethodHandler' upon a given inbound query.  If the
--- parse is successful, the returned IO action will construct our reply.
--- Otherwise, a parse err is returned.
+-- parse is successful, the returned IO action will construct our reply if
+-- there is one.  Otherwise, a parse err is returned.
 dispatchQuery :: MethodHandler err tid addr x -- ^ Handler to invoke.
                  -> tid                       -- ^ The transaction id for this query\/response session.
                  -> addr                      -- ^ Our own address, to which the query was sent.
                  -> x                         -- ^ The query packet.
                  -> addr                      -- ^ The origin address of the query.
-                 -> Either err (IO x)
+                 -> Either err (IO (Maybe x))
 dispatchQuery (MethodHandler unwrapQ wrapR f) tid self x addr =
-    fmap (\a -> wrapR tid self addr <$> f addr a) $ unwrapQ x
+    fmap (\a -> Just . wrapR tid self addr <$> f addr a) $ unwrapQ x
+dispatchQuery (NoReply unwrapQ f) tid self x addr =
+    fmap (\a -> f addr a >> return Nothing) $ unwrapQ x
 
 -- | These four parameters are required to implement an ougoing query.  A
 -- peer-to-peer algorithm will define a 'MethodSerializer' for every 'MethodHandler' that
@@ -365,7 +374,7 @@ handleMessage (Client net d err pending whoami responseID) again = do
                                   self <- whoami (Just addr)
                                   tid' <- responseID tid
                                   either (reportParseError err)
-                                         (>>= sendMessage net addr)
+                                         (>>= mapM_ (sendMessage net addr))
                                          (dispatchQuery m tid' self plain addr)
             IsResponse tid -> do
                 action <- atomically $ do