Progress on OnionTransport.

1 files changed, 59 insertions, 15 deletions

diff --git a/OnionTransport.hs b/OnionTransport.hs
index aa4bae1e..d6f6671e 100644
--- a/OnionTransport.hs
+++ b/OnionTransport.hs
@@ -1,12 +1,16 @@
 {-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE UndecidableInstances       #-}
 module OnionTransport
     ( parseOnionAddr
     , encodeOnionAddr
@@ -29,6 +33,7 @@ module OnionTransport
 
 import Network.QueryResponse
 import ToxCrypto hiding (encrypt,decrypt)
+import ToxAddress
 import qualified ToxCrypto
 import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo)
 
@@ -36,11 +41,12 @@ import Control.Arrow
 import qualified Data.ByteString as B
          ;import Data.ByteString (ByteString)
 import Data.Functor.Identity
-import Data.Serialize            as S (Get, Put, Serialize, get, put, runGet)
+import Data.Serialize            as S
 import Data.Typeable
 import Data.Word
 import GHC.TypeLits
 import Network.Socket
+import GHC.Generics
 
 type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
 
@@ -48,7 +54,10 @@ type UDPTransport = Transport String SockAddr ByteString
 
 
 getOnionAssym :: Get (Assym (Encrypted DataToRoute))
-getOnionAssym = _todo
+getOnionAssym = getAliasedAssym
+
+putOnionAssym :: Serialize a => Word8 -> Put -> Assym a -> Put
+putOnionAssym typ p a = put typ >> p >> putAliasedAssym a
 
 data OnionMessage (f :: * -> *)
     = OnionAnnounce (Assym (f (AnnounceRequest,Nonce8)))
@@ -61,12 +70,18 @@ data OnionToOwner = OnionToOwner NodeInfo (ReturnPath 3)
     deriving Show
 
 
+onionToOwner :: Assym a -> ReturnPath 3 -> SockAddr -> Either String OnionToOwner
 onionToOwner assym ret3 saddr = do
     ni <- nodeInfo (NodeId $ senderKey assym) saddr
     return $ OnionToOwner ni ret3
 -- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr
 
 
+onion :: Sized msg =>
+               ByteString
+               -> SockAddr
+               -> Get (Assym (Encrypted msg) -> t)
+               -> Either String (t, OnionToOwner)
 onion bs saddr getf = do (f,(assym,ret3)) <- runGet ((,) <$> getf <*> getOnionRequest) bs
                          oaddr <- onionToOwner assym ret3 saddr
                          return (f assym, oaddr)
@@ -86,7 +101,15 @@ parseOnionAddr (msg,saddr)
     _ -> right
 
 encodeOnionAddr :: (OnionMessage Encrypted,OnionToOwner) -> (ByteString, SockAddr)
-encodeOnionAddr = _todo
+encodeOnionAddr (msg,addr) = ( runPut (putmsg >> 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' }
@@ -117,8 +140,11 @@ data OnionRequest (n :: Nat) = OnionRequest
     , pathFromOwner :: ReturnPath n
     }
 
-instance Serialize (OnionRequest n) where { get = _todo; put = _todo }
-instance Serialize (OnionResponse n) where { get = _todo; put = _todo }
+instance ( Serialize (Forwarding (3 - n) (OnionMessage Encrypted))
+         , Serialize (ReturnPath n)
+         ) => Serialize (OnionRequest n) where
+    get = OnionRequest <$> get <*> get <*> get
+    put (OnionRequest n f p) = put n >> put f >> put p
 
 -- n = 1, 2, 3
 -- Attributed (Encrypted (
@@ -128,11 +154,23 @@ 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
+
+
 data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a }
 
 data ReturnPath (n :: Nat) where
     NoReturnPath :: ReturnPath 0
-    ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath n)) -> ReturnPath (n + 1)
+    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)
+
+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)
@@ -146,7 +184,14 @@ instance KnownNat n => Show (ReturnPath n) where
 
 data Forwarding (n :: Nat) msg where
     NotForwarded :: msg -> Forwarding 0 msg
-    Forwarding :: Assym (Encrypted (Addressed (Forwarding n msg))) -> Forwarding (n + 1) 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
+    get = Forwarding <$> getAliasedAssym
+    put (Forwarding x) = putAliasedAssym x
+
 
 handleOnionRequest :: KnownNat n => proxy n -> TransportCrypto -> SockAddr -> IO a -> OnionRequest n -> IO a
 handleOnionRequest = _todo
@@ -160,23 +205,19 @@ data AnnounceRequest = AnnounceRequest
     , announceKey     :: NodeId  -- Public key that we want those sending back data packets to use
     }
 
+instance Sized AnnounceRequest where size = _todo
+
 instance S.Serialize AnnounceRequest where
     get = AnnounceRequest <$> S.get <*> S.get <*> S.get
     put (AnnounceRequest p s k) = S.put (p,s,k)
 
-getOnionRequest :: Get (Assym (Encrypted msg), ReturnPath 3)
-getOnionRequest = _todo
+getOnionRequest :: Sized msg => Get (Assym (Encrypted msg), ReturnPath 3)
+getOnionRequest = (,) <$> getAliasedAssym <*> _todo
 
 data KeyRecord = NotStored    Nonce32
                | SendBackKey  PublicKey
                | Acknowledged Nonce32
 
-getPublicKey :: Get PublicKey
-getPublicKey = _todo
-
-putPublicKey :: PublicKey -> Put
-putPublicKey = _todo
-
 instance S.Serialize KeyRecord where
     get = do
         is_stored <- S.get :: S.Get Word8
@@ -205,6 +246,9 @@ data DataToRoute = DataToRoute
     , dataToRoute :: Encrypted (Word8,ByteString)
     }
 
+instance Sized DataToRoute where
+    size = VarSize $ \DataToRoute {} -> _todo
+
 instance Serialize DataToRoute where
     get = return $ DataToRoute _todo _todo
     put _ = return () -- todo