diff options
Diffstat (limited to 'src/Network/Tox')
-rw-r--r-- | src/Network/Tox/DHT/Transport.hs | 7 | ||||
-rw-r--r-- | src/Network/Tox/Onion/Handlers.hs | 8 | ||||
-rw-r--r-- | src/Network/Tox/Onion/Transport.hs | 103 | ||||
-rw-r--r-- | src/Network/Tox/Transport.hs | 2 |
4 files changed, 93 insertions, 27 deletions
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index 5bd9caa1..0787c2c1 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs | |||
@@ -43,6 +43,7 @@ import Data.Monoid | |||
43 | import Data.Serialize as S | 43 | import Data.Serialize as S |
44 | import Data.Tuple | 44 | import Data.Tuple |
45 | import Data.Word | 45 | import Data.Word |
46 | import Foreign.C (CTime(..)) | ||
46 | import Network.Socket | 47 | import Network.Socket |
47 | 48 | ||
48 | type DHTTransport = Transport String NodeInfo (DHTMessage Encrypted8) | 49 | type DHTTransport = Transport String NodeInfo (DHTMessage Encrypted8) |
@@ -201,7 +202,11 @@ instance Serialize DHTRequest where | |||
201 | -- | `32` | Our DHT public key | | 202 | -- | `32` | Our DHT public key | |
202 | -- | `[39, 204]` | Maximum of 4 nodes in packed format | | 203 | -- | `[39, 204]` | Maximum of 4 nodes in packed format | |
203 | data DHTPublicKey = DHTPublicKey | 204 | data DHTPublicKey = DHTPublicKey |
204 | { dhtpkNonce :: Nonce8 -- no_replay | 205 | { dhtpkNonce :: Word64 -- ^ The `no_replay` number is protection if |
206 | -- someone tries to replay an older packet and | ||
207 | -- should be set to an always increasing number. | ||
208 | -- It is 8 bytes so you should set a high | ||
209 | -- resolution monotonic time as the value. | ||
205 | , dhtpk :: PublicKey -- dht public key | 210 | , dhtpk :: PublicKey -- dht public key |
206 | , dhtpkNodes :: SendNodes -- other reachable nodes | 211 | , dhtpkNodes :: SendNodes -- other reachable nodes |
207 | } | 212 | } |
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs index 0c137bf5..3eec0390 100644 --- a/src/Network/Tox/Onion/Handlers.hs +++ b/src/Network/Tox/Onion/Handlers.hs | |||
@@ -242,14 +242,6 @@ sendOnion getTimeout client req oaddr unwrap = | |||
242 | $ join mb | 242 | $ join mb |
243 | 243 | ||
244 | -- | Lookup the secret counterpart for a given alias key. | 244 | -- | Lookup the secret counterpart for a given alias key. |
245 | selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector | ||
246 | selectAlias crypto pkey = do | ||
247 | ks <- filter (\(sk,pk) -> pk == id2key pkey) | ||
248 | <$> readTVar (userKeys crypto) | ||
249 | maybe (return SearchingAlias) | ||
250 | (return . uncurry AnnouncingAlias) | ||
251 | (listToMaybe ks) | ||
252 | |||
253 | getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) | 245 | getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) |
254 | -> TransportCrypto | 246 | -> TransportCrypto |
255 | -> Client r | 247 | -> Client r |
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs index 4c3de3e6..6635fad1 100644 --- a/src/Network/Tox/Onion/Transport.hs +++ b/src/Network/Tox/Onion/Transport.hs | |||
@@ -25,6 +25,8 @@ module Network.Tox.Onion.Transport | |||
25 | , OnionMessage(..) | 25 | , OnionMessage(..) |
26 | , Rendezvous(..) | 26 | , Rendezvous(..) |
27 | , DataToRoute(..) | 27 | , DataToRoute(..) |
28 | , OnionData(..) | ||
29 | , AnnouncedRendezvous(..) | ||
28 | , AnnounceResponse(..) | 30 | , AnnounceResponse(..) |
29 | , AnnounceRequest(..) | 31 | , AnnounceRequest(..) |
30 | , Forwarding(..) | 32 | , Forwarding(..) |
@@ -41,6 +43,7 @@ module Network.Tox.Onion.Transport | |||
41 | , N3 | 43 | , N3 |
42 | , onionKey | 44 | , onionKey |
43 | , onionAliasSelector | 45 | , onionAliasSelector |
46 | , selectAlias | ||
44 | ) where | 47 | ) where |
45 | 48 | ||
46 | import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) | 49 | import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) |
@@ -50,13 +53,12 @@ import Network.Tox.NodeId | |||
50 | import qualified Crypto.Tox as ToxCrypto | 53 | import qualified Crypto.Tox as ToxCrypto |
51 | import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,FriendRequest,asymNodeInfo) | 54 | import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,FriendRequest,asymNodeInfo) |
52 | 55 | ||
53 | import Debug.Trace | ||
54 | import Control.Arrow | ||
55 | import Control.Applicative | 56 | import Control.Applicative |
57 | import Control.Arrow | ||
56 | import Control.Concurrent.STM | 58 | import Control.Concurrent.STM |
57 | import Control.Monad | 59 | import Control.Monad |
58 | import qualified Data.ByteString as B | 60 | import qualified Data.ByteString as B |
59 | ;import Data.ByteString (ByteString) | 61 | ;import Data.ByteString (ByteString) |
60 | import Data.Coerce | 62 | import Data.Coerce |
61 | import Data.Function | 63 | import Data.Function |
62 | import Data.Functor.Contravariant | 64 | import Data.Functor.Contravariant |
@@ -64,14 +66,16 @@ import Data.Functor.Identity | |||
64 | import Data.IP | 66 | import Data.IP |
65 | import Data.Maybe | 67 | import Data.Maybe |
66 | import Data.Monoid | 68 | import Data.Monoid |
67 | import Data.Serialize as S | 69 | import Data.Serialize as S |
68 | import Data.Type.Equality | 70 | import Data.Type.Equality |
69 | import Data.Typeable | 71 | import Data.Typeable |
70 | import Data.Word | 72 | import Data.Word |
71 | import GHC.Generics () | 73 | import Debug.Trace |
74 | import GHC.Generics () | ||
72 | import GHC.TypeLits | 75 | import GHC.TypeLits |
73 | import Network.Socket | 76 | import Network.Socket |
74 | import System.IO | 77 | import System.IO |
78 | import qualified Text.ParserCombinators.ReadP as RP | ||
75 | 79 | ||
76 | type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a | 80 | type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a |
77 | 81 | ||
@@ -609,6 +613,15 @@ instance Sized OnionData where | |||
609 | ConstSize n -> n | 613 | ConstSize n -> n |
610 | VarSize f -> f req | 614 | VarSize f -> f req |
611 | 615 | ||
616 | instance Serialize OnionData where | ||
617 | get = do | ||
618 | tag <- get | ||
619 | case tag :: Word8 of | ||
620 | 0x9c -> OnionDHTPublicKey <$> get | ||
621 | 0x20 -> OnionFriendRequest <$> get | ||
622 | _ -> fail $ "Unknown onion data: "++show tag | ||
623 | put (OnionDHTPublicKey dpk) = put (0x9c :: Word8) >> put dpk | ||
624 | put (OnionFriendRequest fr) = put (0x20 :: Word8) >> put fr | ||
612 | 625 | ||
613 | selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey) | 626 | selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey) |
614 | selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias skey pkey) _ _) | 627 | selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias skey pkey) _ _) |
@@ -731,30 +744,86 @@ data Rendezvous = Rendezvous | |||
731 | deriving Eq | 744 | deriving Eq |
732 | 745 | ||
733 | instance Show Rendezvous where | 746 | instance Show Rendezvous where |
734 | show (Rendezvous k ni) = concat [show $ key2id k, ":", show ni] | 747 | showsPrec d (Rendezvous k ni) |
735 | 748 | = showsPrec d (key2id k) | |
749 | . (':' :) | ||
750 | . showsPrec d ni | ||
751 | |||
752 | data AnnouncedRendezvous = AnnouncedRendezvous | ||
753 | { remoteUserKey :: PublicKey | ||
754 | , rendezvous :: Rendezvous | ||
755 | } | ||
756 | deriving Eq | ||
757 | |||
758 | instance Show AnnouncedRendezvous where | ||
759 | showsPrec d (AnnouncedRendezvous remote rendez) | ||
760 | = showsPrec d (key2id remote) | ||
761 | . (':' :) | ||
762 | . showsPrec d rendez | ||
763 | |||
764 | instance Read AnnouncedRendezvous where | ||
765 | readsPrec d = RP.readP_to_S $ do | ||
766 | ukstr <- RP.munch (/=':') | ||
767 | RP.char ':' | ||
768 | rkstr <- RP.munch (/=':') | ||
769 | RP.char ':' | ||
770 | nistr <- RP.munch (const True) | ||
771 | return AnnouncedRendezvous | ||
772 | { remoteUserKey = id2key $ read ukstr | ||
773 | , rendezvous = Rendezvous | ||
774 | { rendezvousKey = id2key $ read rkstr | ||
775 | , rendezvousNode = read nistr | ||
776 | } | ||
777 | } | ||
778 | |||
779 | |||
780 | selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector | ||
781 | selectAlias crypto pkey = do | ||
782 | ks <- filter (\(sk,pk) -> pk == id2key pkey) | ||
783 | <$> readTVar (userKeys crypto) | ||
784 | maybe (return SearchingAlias) | ||
785 | (return . uncurry AnnouncingAlias) | ||
786 | (listToMaybe ks) | ||
736 | 787 | ||
737 | 788 | ||
738 | parseDataToRoute | 789 | parseDataToRoute |
739 | :: TransportCrypto | 790 | :: TransportCrypto |
740 | -> (OnionMessage Encrypted,OnionDestination r) | 791 | -> (OnionMessage Encrypted,OnionDestination r) |
741 | -> IO (Either (DataToRoute,Rendezvous) (OnionMessage Encrypted, OnionDestination r)) | 792 | -> IO (Either ((PublicKey,OnionData),AnnouncedRendezvous) (OnionMessage Encrypted, OnionDestination r)) |
742 | parseDataToRoute crypto (OnionToRouteResponse dta, od) = | 793 | parseDataToRoute crypto (OnionToRouteResponse dta, od) = |
743 | return $ either (const $ Right (OnionToRouteResponse dta,od)) Left $ do | 794 | return $ either (const $ Right (OnionToRouteResponse dta,od)) Left $ do |
744 | -- XXX: Do something with decryption failure? | 795 | -- XXX: Do something with decryption failure? |
745 | decrypted <- uncomposed | 796 | dtr <- fmap runIdentity |
746 | $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto) | 797 | $ uncomposed |
747 | (asymmNonce dta) | 798 | $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto) |
748 | (Right dta) | 799 | (asymmNonce dta) |
749 | return ( runIdentity decrypted | 800 | (Right dta) |
750 | , Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od ) | 801 | let (sk,pk) = case onionAliasSelector od of |
802 | SearchingAlias -> (onionAliasSecret &&& onionAliasPublic) crypto | ||
803 | AnnouncingAlias sk pk -> (sk,pk) | ||
804 | omsg <- fmap runIdentity | ||
805 | $ uncomposed | ||
806 | $ decryptMessage (sk,pk) | ||
807 | (asymmNonce dta) | ||
808 | (Left (dataFromKey dtr, dataToRoute dtr)) | ||
809 | return ( (pk, omsg) | ||
810 | , AnnouncedRendezvous | ||
811 | (dataFromKey dtr) | ||
812 | $ Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od ) | ||
751 | parseDataToRoute _ msg = return $ Right msg | 813 | parseDataToRoute _ msg = return $ Right msg |
752 | 814 | ||
753 | encodeDataToRoute :: TransportCrypto | 815 | encodeDataToRoute :: TransportCrypto |
754 | -> (DataToRoute,Rendezvous) | 816 | -> ((PublicKey,OnionData),AnnouncedRendezvous) |
755 | -> IO (Maybe (OnionMessage Encrypted,OnionDestination r)) | 817 | -> IO (Maybe (OnionMessage Encrypted,OnionDestination r)) |
756 | encodeDataToRoute crypto (plain, Rendezvous pub ni) = do | 818 | encodeDataToRoute crypto ((me,omsg), AnnouncedRendezvous toxid (Rendezvous pub ni)) = do |
757 | nonce <- atomically $ transportNewNonce crypto | 819 | nonce <- atomically $ transportNewNonce crypto |
820 | asel <- atomically $ selectAlias crypto (key2id me) | ||
821 | let (sk,pk) = case asel of | ||
822 | AnnouncingAlias sk pk -> (sk,pk) | ||
823 | _ -> (onionAliasSecret crypto, onionAliasPublic crypto) | ||
824 | let plain = DataToRoute { dataFromKey = pk | ||
825 | , dataToRoute = encryptMessage sk toxid nonce omsg | ||
826 | } | ||
758 | let dta = encryptMessage (onionAliasSecret crypto) pub nonce plain | 827 | let dta = encryptMessage (onionAliasSecret crypto) pub nonce plain |
759 | return $ Just ( OnionToRoute pub -- Public key of destination node | 828 | return $ Just ( OnionToRoute pub -- Public key of destination node |
760 | Asymm { senderKey = onionAliasPublic crypto | 829 | Asymm { senderKey = onionAliasPublic crypto |
diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs index 2a4e7eee..5cda1524 100644 --- a/src/Network/Tox/Transport.hs +++ b/src/Network/Tox/Transport.hs | |||
@@ -24,7 +24,7 @@ toxTransport :: | |||
24 | -> UDPTransport | 24 | -> UDPTransport |
25 | -> IO ( Transport String NodeInfo (DHTMessage Encrypted8) | 25 | -> IO ( Transport String NodeInfo (DHTMessage Encrypted8) |
26 | , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) | 26 | , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) |
27 | , Transport String Rendezvous DataToRoute | 27 | , Transport String AnnouncedRendezvous (PublicKey,OnionData) |
28 | , Transport String SockAddr NetCrypto ) | 28 | , Transport String SockAddr NetCrypto ) |
29 | toxTransport crypto orouter closeLookup udp = do | 29 | toxTransport crypto orouter closeLookup udp = do |
30 | (dht,udp1) <- partitionTransport parseDHTAddr (Just . encodeDHTAddr) $ forwardOnions crypto udp | 30 | (dht,udp1) <- partitionTransport parseDHTAddr (Just . encodeDHTAddr) $ forwardOnions crypto udp |