Separated module OnionTransport from ToxTransport.

1 files changed, 196 insertions, 0 deletions

diff --git a/OnionTransport.hs b/OnionTransport.hs
new file mode 100644
index 00000000..804c444e
--- /dev/null
+++ b/OnionTransport.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TupleSections              #-}
+{-# LANGUAGE TypeOperators              #-}
+module OnionTransport
+    ( parseOnionAddr
+    , encodeOnionAddr
+    , forwardOnions
+    , OnionToOwner(..)
+    , OnionMessage(..)
+    , DataToRoute(..)
+    , AnnounceResponse(..)
+    , AnnounceRequest(..)
+    , Forwarding(..)
+    , ReturnPath(..)
+    , OnionRequest(..)
+    , OnionResponse(..)
+    , Addressed(..)
+    , UDPTransport
+    ) where
+
+import Network.QueryResponse
+import ToxCrypto
+import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo)
+
+import Control.Arrow
+import qualified Data.ByteString as B
+         ;import Data.ByteString (ByteString)
+import Data.Serialize            as S (Get, Put, Serialize, get, put, runGet)
+import Data.Typeable
+import Data.Word
+import GHC.TypeLits
+import Network.Socket
+
+type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
+
+type UDPTransport = Transport String SockAddr ByteString
+
+
+getOnionAssym :: Get (Assym (Encrypted DataToRoute))
+getOnionAssym = _todo
+
+data OnionMessage (f :: * -> *)
+    = OnionAnnounce (Assym (f (AnnounceRequest,Nonce8)))
+    | OnionAnnounceResponse Nonce8 Nonce24 (f AnnounceResponse)
+    | OnionToRoute PublicKey (Assym (f DataToRoute)) -- destination key, aliased Assym
+    | OnionToRouteResponse (Assym (f DataToRoute))
+
+data OnionToOwner = OnionToOwner NodeInfo (ReturnPath 3)
+                  | OnionToMe SockAddr -- SockAddr is immediate peer in route
+
+
+onionToOwner assym ret3 saddr = do
+    ni <- nodeInfo (NodeId $ senderKey assym) saddr
+    return $ OnionToOwner ni ret3
+-- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr
+
+
+onion bs saddr getf = do (f,(assym,ret3)) <- runGet ((,) <$> getf <*> getOnionRequest) bs
+                         oaddr <- onionToOwner assym ret3 saddr
+                         return (f assym, oaddr)
+
+
+parseOnionAddr :: (ByteString, SockAddr) -> Either (OnionMessage Encrypted,OnionToOwner) (ByteString,SockAddr)
+parseOnionAddr (msg,saddr)
+    | Just (typ,bs) <- B.uncons msg
+    , let right = Right (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
+    _ -> right
+
+encodeOnionAddr :: (OnionMessage Encrypted,OnionToOwner) -> (ByteString, SockAddr)
+encodeOnionAddr = _todo
+
+forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport -- HandleHi a -> IO a -> HandleLo a
+forwardOnions crypto udp = udp { awaitMessage = await' }
+ where
+    -- forMe :: HandleHi
+    -- forThem :: handleLo
+    await' :: HandleLo a -> IO a
+    await' forThem = awaitMessage udp $ \case
+        m@(Just (Right (bs,saddr))) -> case B.head bs of
+            0x80 -> forward forThem bs $ handleOnionRequest (Proxy :: Proxy 0) crypto saddr (forThem m)
+            0x81 -> forward forThem bs $ handleOnionRequest (Proxy :: Proxy 1) crypto saddr (forThem m)
+            0x82 -> forward forThem bs $ handleOnionRequest (Proxy :: Proxy 2) crypto saddr (forThem m)
+            0x8c -> forward forThem bs $ handleOnionResponse (Proxy :: Proxy 3) crypto saddr (forThem m)
+            0x8d -> forward forThem bs $ handleOnionResponse (Proxy :: Proxy 2) crypto saddr (forThem m)
+            0x8e -> forward forThem bs $ handleOnionResponse (Proxy :: Proxy 1) crypto saddr (forThem m)
+            _    -> forThem m
+        m -> forThem m
+
+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
+
+-- n = 0, 1, 2
+data OnionRequest (n :: Nat) = OnionRequest
+    { onionNonce    :: Nonce24
+    , onionForward  :: Forwarding (3 - n) (OnionMessage Encrypted)
+    , pathFromOwner :: ReturnPath n
+    }
+
+instance Serialize (OnionRequest n) where { get = _todo; put = _todo }
+instance Serialize (OnionResponse n) where { get = _todo; put = _todo }
+
+-- n = 1, 2, 3
+-- Attributed (Encrypted (
+
+data OnionResponse (n :: Nat) = OnionResponse
+    { pathToOwner :: ReturnPath n
+    , msgToOwner  :: OnionMessage Encrypted
+    }
+
+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)
+
+-- instance KnownNat n => Serialize (ReturnPath n) where
+--     -- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
+--     get = ReturnPath <$> getBytes ( 59 * (fromIntegral $ natVal $ Proxy @n) )
+--     put (ReturnPath bs) = putByteString bs
+
+
+data Forwarding (n :: Nat) msg where
+    NotForwarded :: msg -> Forwarding 0 msg
+    Forwarding :: Assym (Encrypted (Addressed (Forwarding n msg))) -> Forwarding (n + 1) msg
+
+handleOnionRequest :: KnownNat n => proxy n -> TransportCrypto -> SockAddr -> IO a -> OnionRequest n -> IO a
+handleOnionRequest = _todo
+
+handleOnionResponse :: KnownNat n => proxy n -> TransportCrypto -> SockAddr -> IO a -> OnionResponse n -> IO a
+handleOnionResponse = _todo
+
+data AnnounceRequest = AnnounceRequest
+    { announcePingId  :: Nonce32 -- Ping ID
+    , announceSeeking :: NodeId  -- Public key we are searching for
+    , announceKey     :: NodeId  -- Public key that we want those sending back data packets to use
+    }
+
+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
+
+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
+        case is_stored of
+            1 -> SendBackKey  <$> getPublicKey
+            2 -> Acknowledged <$> S.get
+            _ -> NotStored    <$> S.get
+    put (NotStored n32)    = S.put (0 :: Word8) >> S.put n32
+    put (SendBackKey key)  = S.put (1 :: Word8) >> putPublicKey key
+    put (Acknowledged n32) = S.put (2 :: Word8) >> S.put n32
+
+data AnnounceResponse = AnnounceResponse
+    { is_stored     :: KeyRecord
+    , announceNodes :: SendNodes
+    }
+
+instance Sized AnnounceResponse where
+    size = VarSize $ \AnnounceResponse {} -> _todo
+
+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)
+    }
+