{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} module ToxTransport ( toxTransport , TransportCrypto , UDPTransport , DirectMessage , Encrypted8 , OnionToOwner , OnionMessage , NetCrypto ) where import Network.QueryResponse import ToxAddress as Tox hiding (OnionToOwner, ReturnPath) import ToxCrypto import ToxPacket import Control.Applicative import Control.Arrow import Control.Concurrent.STM import Crypto.Hash import Crypto.Hash.Algorithms import qualified Data.ByteString as B ;import Data.ByteString (ByteString) import Data.Serialize as S (Get, Put, Serialize, decode, get, put, runGet) import Data.Typeable import Data.Word import GHC.TypeLits import Network.Socket newtype SymmetricKey = SymmetricKey ByteString data TransportCrypto = TransportCrypto { transportSecret :: SecretKey , transportPublic :: PublicKey , transportSymmetric :: STM SymmetricKey } transportDecrypt :: TransportCrypto -> Assym (Encrypted a) -> Either String a transportDecrypt = _todo -- layer :: TransportCrypto -- -> Transport String SockAddr ByteString -- -> Transport String Tox.Address ByteString -- layer crypto = layerTransport (toxParse crypto) (toxEncode crypto) toxEncode :: TransportCrypto -> ByteString -> Tox.Address -> (ByteString, SockAddr) toxEncode = _todo -- toxParse :: TransportCrypto -> ByteString -> SockAddr -> Either String (ByteString, Tox.Address) -- toxParse crypto bs saddr = case B.head bs of _todo data Message = Todo | DHTReq DHTRequest | AnnounceReq AnnounceRequest -- awaitMessage :: forall a. (Maybe (Either err (x, addr)) -> IO a) -> IO a type UDPTransport = Transport String SockAddr ByteString {- toxTransport :: TransportCrypto -> Transport String SockAddr ByteString -> Transport String Tox.Address Message toxTransport crypto (Transport await send close) = Transport await' send' close where await' :: HandleHi a -> IO a await' forMe = fix $ await . handleOnion crypto forMe send' = _todo -} toxTransport :: TransportCrypto -> UDPTransport -> IO ( Transport String NodeInfo (DirectMessage Encrypted8) , Transport String OnionToOwner (OnionMessage Encrypted) , Transport String SockAddr NetCrypto ) toxTransport crypto udp = do (dht,udp1) <- partitionTransport parseDHTAddr encodeDHTAddr id $ handleOnion crypto udp (onion,udp2) <- partitionTransport parseOnionAddr encodeOnionAddr id udp1 let netcrypto = layerTransport parseNetCrypto encodeNetCrypto udp2 return (dht,onion,netcrypto) type HandleHi a = Maybe (Either String (Message, Tox.Address)) -> IO a type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a data DirectMessage (f :: * -> *) = DirectPing (Assym (f Ping)) | DirectPong (Assym (f Pong)) | DirectGetNodes (Assym (f GetNodes)) | DirectSendNodes (Assym (f SendNodes)) | DirectCookieRequest (Assym (f CookieRequest)) | DirectCookie Nonce24 (f Cookie) | DirectDHTRequest PublicKey (Assym (f DHTRequest)) instance Sized GetNodes where size = ConstSize 32 -- TODO This right? instance Sized SendNodes where size = VarSize $ \(SendNodes ns) -> _nodeFormatSize * length ns instance Sized Ping where size = ConstSize 1 instance Sized Pong where size = ConstSize 1 newtype Encrypted8 a = E8 (Encrypted (a,Nonce8)) deriving Serialize -- instance (Sized a, Sized b) => Sized (a,b) where size = _todo getDirect :: Sized a => Get (Assym (Encrypted8 a)) getDirect = _todo getOnionAssym :: Get (Assym (Encrypted DataToRoute)) getOnionAssym = _todo getCookie :: Get (Nonce24, Encrypted8 Cookie) getCookie = get getDHTReqest :: Get (PublicKey, Assym (Encrypted8 DHTRequest)) getDHTReqest = _todo fanGet :: ByteString -> Get x -> (x -> a) -> (x -> b) -> Either String (a,b) fanGet bs getIt f nid = fmap (f &&& nid) $ runGet getIt bs -- Throws an error if called with a non-internet socket. direct :: Sized a => ByteString -> SockAddr -> (Assym (Encrypted8 a) -> DirectMessage Encrypted8) -> Either String (DirectMessage Encrypted8, NodeInfo) direct bs saddr f = fanGet bs getDirect f (asymNodeInfo saddr) -- Throws an error if called with a non-internet socket. asymNodeInfo saddr asym = either (error . mappend "asymNodeInfo: ") id $ nodeInfo (NodeId $ senderKey asym) saddr -- Throws an error if called with a non-internet socket. noReplyAddr saddr = either (error . mappend "noReplyAddr: ") id $ nodeInfo zeroID saddr parseDHTAddr :: (ByteString, SockAddr) -> Either (DirectMessage Encrypted8,NodeInfo) (ByteString,SockAddr) parseDHTAddr (msg,saddr) | Just (typ,bs) <- B.uncons msg , let right = Right (msg,saddr) left = either (const right) Left = case typ of 0x00 -> left $ direct bs saddr DirectPing 0x01 -> left $ direct bs saddr DirectPong 0x02 -> left $ direct bs saddr DirectGetNodes 0x04 -> left $ direct bs saddr DirectSendNodes 0x18 -> left $ direct bs saddr DirectCookieRequest 0x19 -> left $ fanGet bs getCookie (uncurry DirectCookie) (const $ noReplyAddr saddr) 0x20 -> left $ fanGet bs getDHTReqest (uncurry DirectDHTRequest) (asymNodeInfo saddr . snd) _ -> right encodeDHTAddr :: (DirectMessage Encrypted8,NodeInfo) -> (ByteString, SockAddr) encodeDHTAddr = _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 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 -- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr data NetCrypto = NetHandshake (Handshake Encrypted) | NetCrypto (CryptoPacket Encrypted) parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr) parseNetCrypto = _todo encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr) encodeNetCrypto = _todo data Handshake (f :: * -> *) = Handshake { handshakeCookie :: Cookie , handshakeNonce :: Nonce24 , hadshakeData :: f HandshakeData } data HandshakeData = HandshakeData { baseNonce :: Nonce24 , sessionKey :: PublicKey , cookieHash :: Digest SHA512 , otherCookie :: Cookie } data CryptoPacket (f :: * -> *) = CryptoPacket { pktNonce :: Word16 , pktData :: f CryptoData } data CryptoData = CryptoData { -- | [our recvbuffers buffer_start, (highest packet number handled + 1), (big endian)] bufferStart :: Word32 -- | [ uint32_t packet number if lossless -- , sendbuffer buffer_end if lossy , (big endian)] , bufferEnd :: Word32 -- | [data] , bufferData :: CryptoMessage } -- TODO: Flesh this out. data CryptoMessage -- First byte indicates data = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte) | PacketRequest -- ^ 1 packet request packet (lossy packet) | KillPacket -- ^ 2 connection kill packet (lossy packet) | UnspecifiedPacket -- ^ 3+ unspecified | MessengerLossless -- ^ 16+ reserved for Messenger usage (lossless packets) | MessengerLossy -- ^ 192+ reserved for Messenger usage (lossy packets) | Messenger255 -- ^ 255 reserved for Messenger usage (lossless packet) -- --> CookieRequest WithoutCookie -- <-- CookieResponse CookieAddress -- --> Handshake CookieAddress -- <-- Handshake CookieAddress -- Handshake packet: -- [uint8_t 26] (0x1a) -- [Cookie] -- [nonce (24 bytes)] -- [Encrypted message containing: -- [24 bytes base nonce] -- [session public key of the peer (32 bytes)] -- [sha512 hash of the entire Cookie sitting outside the encrypted part] -- [Other Cookie (used by the other to respond to the handshake packet)] -- ] -- cookie response packet (161 bytes): -- -- [uint8_t 25] -- [Random nonce (24 bytes)] -- [Encrypted message containing: -- [Cookie] -- [uint64_t echo id (that was sent in the request)] -- ] -- -- Encrypted message is encrypted with the exact same symmetric key as the -- cookie request packet it responds to but with a different nonce. -- (Encrypted message is encrypted with reqesters's DHT private key, -- responders's DHT public key and the nonce.) -- -- Since we don't receive the public key, we will need to lookup the key by -- the SockAddr... I don't understand why the CookieResponse message is -- special this way. TODO: implement a multimap (SockAddr -> SharedSecret) -- and wrap cookie queries with store/delete. TODO: Should the entire -- SharedScret cache be keyed on only SockAddr ? Perhaps the secret cache -- should be (NodeId -> Secret) and the cookie-request map should be -- (SockAddr -> NodeId) -- Encrypted packets: -- -- Length Contents -- :---------:-------------------------------------------------------------- -- `1` `uint8_t` (0x1b) -- `2` `uint16_t` The last 2 bytes of the nonce used to encrypt this -- variable  Payload -- -- The payload is encrypted with the session key and 'base nonce' set by the -- receiver in their handshake + packet number (starting at 0, big endian math). -- Byte value Packet Kind Return address -- :----------- :-------------------- -- `0x00` Ping Request DHTNode -- `0x01` Ping Response - -- `0x02` Nodes Request DHTNode -- `0x04` Nodes Response - -- `0x18` Cookie Request DHTNode, but without sending pubkey in response -- `0x19` Cookie Response - (no pubkey) -- -- `0x21` LAN Discovery DHTNode (No reply, port 33445, trigger Nodes Request/Response) -- -- `0x20` DHT Request DHTNode/-forward -- -- `0x1a` Crypto Handshake CookieAddress -- -- `0x1b` Crypto Data SessionAddress -- -- `0x83` Announce Request OnionToOwner -- `0x84` Announce Response - -- `0x85` Onion Data Request OnionToOwner -- `0x86` Onion Data Response - -- -- `0xf0` Bootstrap Info SockAddr? -- -- `0x80` Onion Request 0 -forward -- `0x81` Onion Request 1 -forward -- `0x82` Onion Request 2 -forward -- `0x8c` Onion Response 3 -return -- `0x8d` Onion Response 2 -return -- `0x8e` Onion Response 1 -return handleOnion :: TransportCrypto -> UDPTransport -> UDPTransport -- HandleHi a -> IO a -> HandleLo a handleOnion 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 parseMessage :: Word8 -> ByteString -> Either String (Message,Address) -- Announce :: Aliased Assymetric -> ReturnPath 3 -> Packet --0x83 parseMessage 0x83 bs = _todo -- Announce Request OnionToOwner parseMessage _ _ = _todo handleDHTRequest :: forall a. TransportCrypto -> SockAddr -> HandleHi a -> IO a -> DHTRequestPacket -> IO a handleDHTRequest crypto saddr forMe forThem (DHTRequestPacket target payload) | target == transportPublic crypto = forMe' payload | otherwise = _todo -- lookup target in close list, forward message >> forThem where forMe' :: Assym (Encrypted DHTRequest) -> IO a forMe' payload = do case (,) <$> transportDecrypt crypto payload <*> eaddr of Left e -> forMe (Just (Left e)) Right (p,addr) -> forMe (Just (Right (DHTReq p,addr))) eaddr :: Either String Tox.Address eaddr = fmap DHTNode $ nodeInfo (NodeId $ senderKey payload) saddr data Attributed a = Attributed { author :: PublicKey , attributedNonce :: Nonce24 , attributed :: a } -- `0x83` Announce Request OnionToOwner -- `0x85` Onion Data Request OnionToOwner data OPacket -- payload of an onion request -- `0x84` Announce Response - -- `0x86` Onion Data Response - data RPacket -- payload of an onion response -- n = 0, 1, 2 data OnionRequest (n :: Nat) = OnionRequest { onionNonce :: Nonce24 , onionForward :: Forwarding (3 - n) OPacket , 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 :: RPacket } 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) data Forwarding (n :: Nat) msg where NotForwarded :: msg -> Forwarding 0 msg Forwarding :: Attributed (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 Size a = ConstSize Int | VarSize (a -> Int) data PacketChunk a = Plain a | Assymetric a | Symmetric a -} 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) }