Fleshed out some Onion Transport stubs.

1 files changed, 102 insertions, 31 deletions

diff --git a/OnionTransport.hs b/OnionTransport.hs
index d6f6671e..7a837a2b 100644
--- a/OnionTransport.hs
+++ b/OnionTransport.hs
@@ -35,12 +35,15 @@ import Network.QueryResponse
 import ToxCrypto hiding (encrypt,decrypt)
 import ToxAddress
 import qualified ToxCrypto
-import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo)
+import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo,DHTPublicKey)
 
 import Control.Arrow
 import qualified Data.ByteString as B
          ;import Data.ByteString (ByteString)
+import Data.Coerce
+import Data.Functor.Contravariant
 import Data.Functor.Identity
+import Data.Monoid
 import Data.Serialize            as S
 import Data.Typeable
 import Data.Word
@@ -69,6 +72,16 @@ data OnionToOwner = OnionToOwner NodeInfo (ReturnPath 3)
                   | OnionToMe SockAddr -- SockAddr is immediate peer in route
     deriving Show
 
+instance Sized (OnionMessage Encrypted) where
+    size = VarSize $ \case
+        OnionAnnounce a -> case size of ConstSize n -> n + 1
+                                        VarSize f   -> f a + 1
+        OnionAnnounceResponse n8 n24 x -> case size of ConstSize n -> n + 33
+                                                       VarSize f   -> f x + 33
+        OnionToRoute pubkey a -> case size of ConstSize n -> n + 33
+                                              VarSize f   -> f a + 33
+        OnionToRouteResponse a -> case size of ConstSize n -> n + 1
+                                               VarSize f   -> f a + 1
 
 onionToOwner :: Assym a -> ReturnPath 3 -> SockAddr -> Either String OnionToOwner
 onionToOwner assym ret3 saddr = do
@@ -94,23 +107,28 @@ parseOnionAddr (msg,saddr)
           query = either (const right) Left
           response = either (const right) (Left . (, OnionToMe saddr))
     = case typ of
-    0x83 -> query $ onion bs saddr (pure OnionAnnounce)                          -- Announce Request
-    0x85 -> query $ onion bs saddr (OnionToRoute <$> getPublicKey)               -- Onion Data Request
-    0x84 -> response $ runGet (OnionAnnounceResponse <$> get <*> get <*> get) bs -- Announce Response
-    0x86 -> response $ runGet (OnionToRouteResponse <$> getOnionAssym) bs        -- Onion Data Response
+    0x83 -> query $ onion bs saddr (pure OnionAnnounce)            -- Announce Request
+    0x85 -> query $ onion bs saddr (OnionToRoute <$> getPublicKey) -- Onion Data Request
+    0x84 -> response $ runGet (getOnionReply 0x84) bs              -- Announce Response
+    0x86 -> response $ runGet (getOnionReply 0x86) bs              -- Onion Data Response
     _ -> right
 
+getOnionReply :: Word8 -> Get (OnionMessage Encrypted)
+getOnionReply 0x84 = OnionAnnounceResponse <$> get <*> get <*> get
+getOnionReply 0x86 = OnionToRouteResponse <$> getOnionAssym
+
+putOnionMsg :: OnionMessage Encrypted -> Put
+putOnionMsg (OnionAnnounce                a) = putOnionAssym 0x83 (return ()) a
+putOnionMsg (OnionToRoute pubkey          a) = putOnionAssym 0x85 (putPublicKey pubkey) a
+putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x
+putOnionMsg (OnionToRouteResponse         a) = putOnionAssym 0x86 (return ()) a
+
 encodeOnionAddr :: (OnionMessage Encrypted,OnionToOwner) -> (ByteString, SockAddr)
-encodeOnionAddr (msg,addr) = ( runPut (putmsg >> putpath), saddr )
+encodeOnionAddr (msg,addr) = ( runPut (putOnionMsg msg >> putpath), saddr )
  where
     (saddr,putpath) | OnionToOwner ni p <- addr = (nodeAddr ni, put p)
                     | OnionToMe a       <- addr = (a, return ())
 
-    putmsg | OnionAnnounce a                <- msg = putOnionAssym 0x83 (return ()) a
-           | OnionToRoute pubkey a          <- msg = putOnionAssym 0x85 (putPublicKey pubkey) a
-           | OnionToRouteResponse a         <- msg = putOnionAssym 0x86 (return ()) a
-           | OnionAnnounceResponse n8 n24 x <- msg = put (0x84 :: Word8) >> put n8 >> put n24 >> put x
-
 forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport -- HandleHi a -> IO a -> HandleLo a
 forwardOnions crypto udp = udp { awaitMessage = await' }
  where
@@ -128,8 +146,7 @@ forwardOnions crypto udp = udp { awaitMessage = await' }
             _    -> forThem m
         m -> forThem m
 
-forward :: forall c b b1.
-          Serialize b =>
+forward :: forall c b b1. Serialize b =>
               (Maybe (Either String b1) -> c) -> ByteString -> (b -> c) -> c
 forward forMe bs f = either (forMe . Just . Left) f $ decode $ B.tail bs
 
@@ -154,23 +171,44 @@ data OnionResponse (n :: Nat) = OnionResponse
     , msgToOwner  :: OnionMessage Encrypted
     }
 
-instance ( KnownNat n, Serialize (ReturnPath n) ) => Serialize (OnionResponse n) where
-    get = OnionResponse <$> get <*> get
-    put (OnionResponse p m) = put p >> put m
+instance ( Serialize (ReturnPath n) ) => Serialize (OnionResponse n) where
+    get = OnionResponse <$> get <*> (get >>= getOnionReply)
+    put (OnionResponse p m) = put p >> putOnionMsg m
 
 
 data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a }
 
+instance Sized a => Sized (Addressed a) where
+    size = case size of
+            ConstSize n -> ConstSize     $ 1{-family-} + 16{-ip-} + 2{-port-} + n
+            VarSize f   -> VarSize $ \x -> 1{-family-} + 16{-ip-} + 2{-port-} + f x
+
 data ReturnPath (n :: Nat) where
     NoReturnPath :: ReturnPath 0
     ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath (n - 1))) -> ReturnPath n
 
-instance KnownNat n => Sized (Addressed (ReturnPath n)) where size = _todo
---     -- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
+-- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
+instance KnownNat n => Sized (ReturnPath n) where
+    size = ConstSize $ 59 * fromIntegral (natVal (Proxy :: Proxy n))
+
+instance Serialize (ReturnPath 0) where get              = pure NoReturnPath
+                                        put NoReturnPath = pure ()
+
+instance Serialize (ReturnPath 1) where get                    = ReturnPath <$> get <*> get
+                                        put (ReturnPath n24 p) = put n24 >> put p
 
+instance Serialize (ReturnPath 2) where get                    = ReturnPath <$> get <*> get
+                                        put (ReturnPath n24 p) = put n24 >> put p
+
+instance Serialize (ReturnPath 3) where get                    = ReturnPath <$> get <*> get
+                                        put (ReturnPath n24 p) = put n24 >> put p
+
+{-
+-- This doesn't work because it tried to infer it for (0 - 1)
 instance (Serialize (Encrypted (Addressed (ReturnPath (n - 1))))) => Serialize (ReturnPath n) where
     get = ReturnPath <$> get <*> get
     put (ReturnPath n24 p) = put n24 >> put p
+-}
 
 instance KnownNat n => Show (ReturnPath n) where
     show rpath = "ReturnPath" ++ show (natVal rpath)
@@ -186,9 +224,25 @@ data Forwarding (n :: Nat) msg where
     NotForwarded :: msg -> Forwarding 0 msg
     Forwarding :: Assym (Encrypted (Addressed (Forwarding (n - 1) msg))) -> Forwarding n msg
 
-instance (KnownNat n, Sized msg) => Sized (Addressed (Forwarding n msg)) where size = _todo
-
-instance (Serialize msg, Serialize (Encrypted (Addressed (Forwarding (n - 1) msg)))) => Serialize (Forwarding n msg) where
+instance Sized msg => Sized (Forwarding 0 msg)
+   where size = case size :: Size msg of
+                 ConstSize n -> ConstSize n
+                 VarSize f -> VarSize $ \(NotForwarded x) -> f x
+instance Sized msg => Sized (Forwarding 1 msg)
+   where size = case size :: Size (Assym (Encrypted (Addressed (Forwarding 0 msg)))) of
+                 ConstSize n -> ConstSize n
+                 VarSize f -> VarSize $ \(Forwarding a) -> f a
+instance Sized msg => Sized (Forwarding 2 msg)
+   where size = case size :: Size (Assym (Encrypted (Addressed (Forwarding 1 msg)))) of
+                 ConstSize n -> ConstSize n
+                 VarSize f -> VarSize $ \(Forwarding a) -> f a
+instance Sized msg => Sized (Forwarding 3 msg)
+   where size = case size :: Size (Assym (Encrypted (Addressed (Forwarding 2 msg)))) of
+                 ConstSize n -> ConstSize n
+                 VarSize f -> VarSize $ \(Forwarding a) -> f a
+
+
+instance (Serialize (Encrypted (Addressed (Forwarding (n - 1) msg)))) => Serialize (Forwarding n msg) where
     get = Forwarding <$> getAliasedAssym
     put (Forwarding x) = putAliasedAssym x
 
@@ -205,19 +259,28 @@ data AnnounceRequest = AnnounceRequest
     , announceKey     :: NodeId  -- Public key that we want those sending back data packets to use
     }
 
-instance Sized AnnounceRequest where size = _todo
+instance Sized AnnounceRequest where size = ConstSize (32*3)
 
 instance S.Serialize AnnounceRequest where
     get = AnnounceRequest <$> S.get <*> S.get <*> S.get
     put (AnnounceRequest p s k) = S.put (p,s,k)
 
 getOnionRequest :: Sized msg => Get (Assym (Encrypted msg), ReturnPath 3)
-getOnionRequest = (,) <$> getAliasedAssym <*> _todo
+getOnionRequest = do
+    -- Assumes return path is constant size so that we can isolate
+    -- the variable-sized prefix.
+    cnt <- remaining
+    a <- isolate (case size :: Size (ReturnPath 3) of ConstSize n -> cnt - n)
+                 getAliasedAssym
+    path <- get
+    return (a,path)
 
 data KeyRecord = NotStored    Nonce32
                | SendBackKey  PublicKey
                | Acknowledged Nonce32
 
+instance Sized KeyRecord where size = ConstSize 33
+
 instance S.Serialize KeyRecord where
     get = do
         is_stored <- S.get :: S.Get Word8
@@ -235,23 +298,31 @@ data AnnounceResponse = AnnounceResponse
     }
 
 instance Sized AnnounceResponse where
-    size = VarSize $ \AnnounceResponse {} -> _todo
+    size = contramap is_stored size <> contramap announceNodes size
 
 instance S.Serialize AnnounceResponse where
     get = AnnounceResponse <$> S.get <*> S.get
     put (AnnounceResponse st ns) = S.put st >> S.put ns
 
 data DataToRoute = DataToRoute
-    { dataFromKey :: PublicKey
-    , dataToRoute :: Encrypted (Word8,ByteString)
+    { dataFromKey :: PublicKey -- Real public key of sender
+    , dataToRoute :: Encrypted OnionData -- (Word8,ByteString) -- DHTPK 0x9c
     }
 
 instance Sized DataToRoute where
-    size = VarSize $ \DataToRoute {} -> _todo
+    size = ConstSize 32 <> contramap dataToRoute size
 
 instance Serialize DataToRoute where
-    get = return $ DataToRoute _todo _todo
-    put _ = return () -- todo
+    get = DataToRoute <$> getPublicKey <*> get
+    put (DataToRoute k dta) = putPublicKey k >> put dta
+
+data OnionData = OnionDHTPublicKey DHTPublicKey -- 0x9c
+
+instance Sized OnionData where
+    size = VarSize $ \(OnionDHTPublicKey dhtpk) -> case size of
+            ConstSize n -> n -- Override because OnionData probably
+                             -- should be treated as variable sized.
+            VarSize f   -> f dhtpk
 
 encrypt :: TransportCrypto -> OnionMessage Identity -> OnionToOwner -> (OnionMessage Encrypted, OnionToOwner)
 encrypt crypto msg rpath = (transcode (encryptMessage crypto) msg, rpath)
@@ -264,7 +335,7 @@ encryptMessage crypto n (Right a) = ToxCrypto.encrypt secret plain
     plain  = encodePlain $ runIdentity $ assymData a
 encryptMessage crypto n (Left x) = ToxCrypto.encrypt secret plain
  where
-    secret = computeSharedSecret (transportSecret crypto) _todo n
+    secret = computeSharedSecret (transportSecret crypto) _todo n -- OnionAnnounceResponse has no sender key
     plain  = encodePlain $ runIdentity $ x
 
 decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionToOwner -> Either String (OnionMessage Identity, OnionToOwner)
@@ -280,7 +351,7 @@ decryptMessage crypto n (Right assymE) = plain $ ToxCrypto.decrypt secret e
     secret = computeSharedSecret (transportSecret crypto) (senderKey assymE) n
     e      = assymData assymE
     plain  = Composed . fmap Identity . (>>= decodePlain)
-decryptMessage crypto n (Left e) = _todo
+decryptMessage crypto n (Left e) = _todo -- OnionAnnounceResponse has no sender key
 
 
 sequenceMessage :: Applicative m => OnionMessage (m ∘ f) -> m (OnionMessage f)