diff options
author | joe <joe@jerkface.net> | 2017-09-06 01:37:32 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-09-06 01:37:32 -0400 |
commit | e3f0f902bc1dff0eb0611a363b2f7aa0f0f86fb8 (patch) | |
tree | 1de1df4707959f54b74cba4f848bc47c4db3df10 | |
parent | 921f845e56033b959247dc0347083e287963f677 (diff) |
Switched Tox NodeId representation to [Word64]
-rw-r--r-- | DHTHandlers.hs | 14 | ||||
-rw-r--r-- | DHTTransport.hs | 3 | ||||
-rw-r--r-- | OnionTransport.hs | 2 | ||||
-rw-r--r-- | ToxAddress.hs | 91 |
4 files changed, 83 insertions, 27 deletions
diff --git a/DHTHandlers.hs b/DHTHandlers.hs index 437b05f3..7ff7a3ce 100644 --- a/DHTHandlers.hs +++ b/DHTHandlers.hs | |||
@@ -26,6 +26,7 @@ import Data.IP | |||
26 | import Data.Ord | 26 | import Data.Ord |
27 | import Data.Maybe | 27 | import Data.Maybe |
28 | import Data.Bits | 28 | import Data.Bits |
29 | import System.IO | ||
29 | 30 | ||
30 | data TransactionId = TransactionId | 31 | data TransactionId = TransactionId |
31 | { transactionKey :: Nonce8 -- ^ Used to lookup pending query. | 32 | { transactionKey :: Nonce8 -- ^ Used to lookup pending query. |
@@ -95,8 +96,9 @@ prefer4or6 addr iptyp = fromMaybe (ipFamily $ nodeIP addr) iptyp | |||
95 | toxSpace :: R.KademliaSpace NodeId NodeInfo | 96 | toxSpace :: R.KademliaSpace NodeId NodeInfo |
96 | toxSpace = R.KademliaSpace | 97 | toxSpace = R.KademliaSpace |
97 | { R.kademliaLocation = nodeId | 98 | { R.kademliaLocation = nodeId |
98 | , R.kademliaTestBit = testIdBit | 99 | , R.kademliaTestBit = testNodeIdBit |
99 | , R.kademliaXor = xor | 100 | , R.kademliaXor = xorNodeId |
101 | , R.kademliaSample = sampleNodeId | ||
100 | } | 102 | } |
101 | 103 | ||
102 | 104 | ||
@@ -133,7 +135,7 @@ type Client = QR.Client String PacketKind TransactionId NodeInfo Message | |||
133 | 135 | ||
134 | wrapAssym :: TransactionId -> NodeInfo -> NodeInfo -> (Nonce8 -> dta) -> Assym dta | 136 | wrapAssym :: TransactionId -> NodeInfo -> NodeInfo -> (Nonce8 -> dta) -> Assym dta |
135 | wrapAssym (TransactionId n8 n24) src dst dta = Assym | 137 | wrapAssym (TransactionId n8 n24) src dst dta = Assym |
136 | { senderKey = let NodeId pubkey = nodeId src in pubkey | 138 | { senderKey = id2key $ nodeId src |
137 | , assymNonce = n24 | 139 | , assymNonce = n24 |
138 | , assymData = dta n8 | 140 | , assymData = dta n8 |
139 | } | 141 | } |
@@ -158,7 +160,9 @@ unpong _ = Nothing | |||
158 | 160 | ||
159 | ping :: Client -> NodeInfo -> IO Bool | 161 | ping :: Client -> NodeInfo -> IO Bool |
160 | ping client addr = do | 162 | ping client addr = do |
163 | hPutStrLn stderr $ show addr ++ " <-- ping" | ||
161 | reply <- QR.sendQuery client (serializer PingType DHTPing unpong) Ping addr | 164 | reply <- QR.sendQuery client (serializer PingType DHTPing unpong) Ping addr |
165 | hPutStrLn stderr $ show addr ++ " -pong-> " ++ show reply | ||
162 | maybe (return False) (\Pong -> return True) $ join reply | 166 | maybe (return False) (\Pong -> return True) $ join reply |
163 | 167 | ||
164 | unsendNodes :: Message -> Maybe (Assym (Nonce8,SendNodes)) | 168 | unsendNodes :: Message -> Maybe (Assym (Nonce8,SendNodes)) |
@@ -170,12 +174,14 @@ unwrapNodes (SendNodes ns) = (ns,ns,()) | |||
170 | 174 | ||
171 | getNodes :: Client -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],())) | 175 | getNodes :: Client -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],())) |
172 | getNodes client nid addr = do | 176 | getNodes client nid addr = do |
177 | hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid | ||
173 | reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr | 178 | reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr |
179 | hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply | ||
174 | return $ fmap unwrapNodes $ join reply | 180 | return $ fmap unwrapNodes $ join reply |
175 | 181 | ||
176 | updateRouting :: Client -> Routing -> NodeInfo -> Message -> IO () | 182 | updateRouting :: Client -> Routing -> NodeInfo -> Message -> IO () |
177 | updateRouting client routing naddr msg = do | 183 | updateRouting client routing naddr msg = do |
178 | -- hPutStrLn stderr $ "updateRouting "++show typ | 184 | hPutStrLn stderr $ "updateRouting "++show (fst $ dhtMessageType $ fst $ DHTTransport.encrypt (error "updateRouting") msg naddr ) |
179 | -- TODO: check msg type | 185 | -- TODO: check msg type |
180 | case prefer4or6 naddr Nothing of | 186 | case prefer4or6 naddr Nothing of |
181 | Want_IP4 -> updateTable client naddr (routing4 routing) (committee4 routing) (sched4 routing) | 187 | Want_IP4 -> updateTable client naddr (routing4 routing) (committee4 routing) (sched4 routing) |
diff --git a/DHTTransport.hs b/DHTTransport.hs index 3d008174..013fa322 100644 --- a/DHTTransport.hs +++ b/DHTTransport.hs | |||
@@ -21,6 +21,7 @@ module DHTTransport | |||
21 | , mapMessage | 21 | , mapMessage |
22 | , encrypt | 22 | , encrypt |
23 | , decrypt | 23 | , decrypt |
24 | , dhtMessageType | ||
24 | ) where | 25 | ) where |
25 | 26 | ||
26 | import ToxAddress | 27 | import ToxAddress |
@@ -122,7 +123,7 @@ direct bs saddr f = fanGet bs getDHT f (asymNodeInfo saddr) | |||
122 | 123 | ||
123 | -- Throws an error if called with a non-internet socket. | 124 | -- Throws an error if called with a non-internet socket. |
124 | asymNodeInfo :: SockAddr -> Assym a -> NodeInfo | 125 | asymNodeInfo :: SockAddr -> Assym a -> NodeInfo |
125 | asymNodeInfo saddr asym = either (error . mappend "asymNodeInfo: ") id $ nodeInfo (NodeId $ senderKey asym) saddr | 126 | asymNodeInfo saddr asym = either (error . mappend "asymNodeInfo: ") id $ nodeInfo (key2id $ senderKey asym) saddr |
126 | 127 | ||
127 | 128 | ||
128 | fanGet :: ByteString -> Get x -> (x -> a) -> (x -> b) -> Either String (a,b) | 129 | fanGet :: ByteString -> Get x -> (x -> a) -> (x -> b) -> Either String (a,b) |
diff --git a/OnionTransport.hs b/OnionTransport.hs index e05e2ca0..6901038d 100644 --- a/OnionTransport.hs +++ b/OnionTransport.hs | |||
@@ -108,7 +108,7 @@ instance Serialize (OnionMessage Encrypted) where | |||
108 | 108 | ||
109 | onionToOwner :: Assym a -> ReturnPath N3 -> SockAddr -> Either String OnionToOwner | 109 | onionToOwner :: Assym a -> ReturnPath N3 -> SockAddr -> Either String OnionToOwner |
110 | onionToOwner assym ret3 saddr = do | 110 | onionToOwner assym ret3 saddr = do |
111 | ni <- nodeInfo (NodeId $ senderKey assym) saddr | 111 | ni <- nodeInfo (key2id $ senderKey assym) saddr |
112 | return $ OnionToOwner ni ret3 | 112 | return $ OnionToOwner ni ret3 |
113 | -- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr | 113 | -- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr |
114 | 114 | ||
diff --git a/ToxAddress.hs b/ToxAddress.hs index c95c221b..6a724d0f 100644 --- a/ToxAddress.hs +++ b/ToxAddress.hs | |||
@@ -1,3 +1,4 @@ | |||
1 | {-# LANGUAGE ApplicativeDo #-} | ||
1 | {-# LANGUAGE BangPatterns #-} | 2 | {-# LANGUAGE BangPatterns #-} |
2 | {-# LANGUAGE CPP #-} | 3 | {-# LANGUAGE CPP #-} |
3 | {-# LANGUAGE DataKinds #-} | 4 | {-# LANGUAGE DataKinds #-} |
@@ -13,7 +14,18 @@ | |||
13 | {-# LANGUAGE ScopedTypeVariables #-} | 14 | {-# LANGUAGE ScopedTypeVariables #-} |
14 | {-# LANGUAGE TupleSections #-} | 15 | {-# LANGUAGE TupleSections #-} |
15 | {-# LANGUAGE TypeApplications #-} | 16 | {-# LANGUAGE TypeApplications #-} |
16 | module ToxAddress (NodeInfo(..),NodeId(..),nodeInfo,nodeAddr,zeroID,key2id,id2key,getIP) where | 17 | module ToxAddress |
18 | ( NodeInfo(..) | ||
19 | , NodeId | ||
20 | , nodeInfo | ||
21 | , nodeAddr | ||
22 | , zeroID | ||
23 | , key2id | ||
24 | , id2key | ||
25 | , getIP | ||
26 | , xorNodeId | ||
27 | , testNodeIdBit | ||
28 | , sampleNodeId) where | ||
17 | 29 | ||
18 | import Control.Applicative | 30 | import Control.Applicative |
19 | import Control.Monad | 31 | import Control.Monad |
@@ -43,6 +55,9 @@ import qualified Text.ParserCombinators.ReadP as RP | |||
43 | import Text.Read | 55 | import Text.Read |
44 | import Data.Bits | 56 | import Data.Bits |
45 | import ToxCrypto | 57 | import ToxCrypto |
58 | import Foreign.Ptr | ||
59 | import Data.Function | ||
60 | import System.Endian | ||
46 | 61 | ||
47 | -- | perform io for hashes that do allocation and ffi. | 62 | -- | perform io for hashes that do allocation and ffi. |
48 | -- unsafeDupablePerformIO is used when possible as the | 63 | -- unsafeDupablePerformIO is used when possible as the |
@@ -56,22 +71,34 @@ unsafeDoIO = unsafeDupablePerformIO | |||
56 | unsafeDoIO = unsafePerformIO | 71 | unsafeDoIO = unsafePerformIO |
57 | #endif | 72 | #endif |
58 | 73 | ||
59 | unpackPublicKey :: PublicKey -> [Word64] | 74 | unpackPublicKey :: ByteArrayAccess bs => bs -> [Word64] |
60 | unpackPublicKey bs = loop 0 | 75 | unpackPublicKey bs = loop 0 |
61 | where loop i | 76 | where loop i |
62 | | i == 4 = [] | 77 | | i == (BA.length bs `div` 8) = [] |
63 | | otherwise = | 78 | | otherwise = |
64 | let !v = unsafeDoIO $ BA.withByteArray bs (\p -> peekElemOff p i) | 79 | let !v = unsafeDoIO $ BA.withByteArray bs (\p -> fromBE64 <$> peekElemOff p i) |
65 | in v : loop (i+1) | 80 | in v : loop (i+1) |
66 | 81 | ||
67 | newtype NodeId = NodeId PublicKey | 82 | packPublicKey :: BA.ByteArray bs => [Word64] -> bs |
68 | deriving (Eq,ByteArrayAccess) -- (Eq,Ord,ByteArrayAccess, Bits, Hashable) | 83 | packPublicKey ws = BA.allocAndFreeze (8 * length ws) $ |
84 | flip fix ws $ \loop ys ptr -> case ys of | ||
85 | [] -> return () | ||
86 | x:xs -> do poke ptr (toBE64 x) | ||
87 | loop xs (plusPtr ptr 8) | ||
88 | |||
89 | newtype NodeId = NodeId [Word64] | ||
90 | deriving (Eq,Ord) -- ByteArrayAccess) -- (Eq,Ord,ByteArrayAccess, Bits, Hashable) | ||
91 | |||
69 | 92 | ||
70 | key2id :: PublicKey -> NodeId | 93 | key2id :: PublicKey -> NodeId |
71 | key2id = NodeId | 94 | key2id = NodeId . unpackPublicKey |
95 | |||
96 | bs2id :: ByteString -> NodeId | ||
97 | bs2id bs = NodeId . unpackPublicKey $ throwCryptoError . publicKey $ bs | ||
72 | 98 | ||
73 | id2key :: NodeId -> PublicKey | 99 | id2key :: NodeId -> PublicKey |
74 | id2key (NodeId key) = key | 100 | id2key (NodeId key) = throwCryptoError . publicKey $ (packPublicKey key :: BA.Bytes) |
101 | |||
75 | 102 | ||
76 | {- | 103 | {- |
77 | id2key :: NodeId -> PublicKey | 104 | id2key :: NodeId -> PublicKey |
@@ -87,33 +114,55 @@ key2id pk = case S.decode (BA.convert pk) of | |||
87 | 114 | ||
88 | -} | 115 | -} |
89 | 116 | ||
117 | {- | ||
90 | instance Ord NodeId where | 118 | instance Ord NodeId where |
91 | compare (NodeId a) (NodeId b) = compare (unpackPublicKey a) (unpackPublicKey b) | 119 | compare (NodeId a) (NodeId b) = compare (unpackPublicKey a) (unpackPublicKey b) |
120 | -} | ||
92 | 121 | ||
93 | zeroID :: NodeId | 122 | zeroID :: NodeId |
94 | zeroID = NodeId $ throwCryptoError $ publicKey $ B.replicate 32 0 | 123 | zeroID = NodeId $ replicate 4 0 -- throwCryptoError $ publicKey $ B.replicate 32 0 |
95 | 124 | ||
96 | instance Read NodeId where | 125 | instance Read NodeId where |
97 | readsPrec _ str | 126 | readsPrec _ str |
98 | | (bs, xs) <- Base16.decode $ C8.pack str | 127 | | (bs, xs) <- Base16.decode $ C8.pack str |
99 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | 128 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 |
100 | = [ (NodeId pub, drop 64 str) ] | 129 | = [ (key2id pub, drop 64 str) ] |
101 | | otherwise = [] | 130 | | otherwise = [] |
102 | 131 | ||
103 | instance Show NodeId where | 132 | instance Show NodeId where |
104 | show (NodeId bs) = C8.unpack $ Base16.encode $ BA.convert bs | 133 | show nid = C8.unpack $ Base16.encode $ BA.convert $ id2key nid |
105 | 134 | ||
106 | instance S.Serialize NodeId where | 135 | instance S.Serialize NodeId where |
107 | get = NodeId <$> getPublicKey | 136 | get = key2id <$> getPublicKey |
108 | put (NodeId bs) = putPublicKey bs | 137 | put nid = putPublicKey $ id2key nid |
109 | |||
110 | instance Bits NodeId where -- TODO | ||
111 | 138 | ||
112 | instance Hashable NodeId where | 139 | instance Hashable NodeId where |
113 | hashWithSalt salt (NodeId key) = hashWithSalt salt (BA.convert key :: ByteString) | 140 | hashWithSalt salt (NodeId key) = salt `xor` fromIntegral (byteSwap64 $ head key) |
114 | 141 | ||
115 | instance FiniteBits NodeId where | 142 | -- instance FiniteBits NodeId where finiteBitSize _ = 256 |
116 | finiteBitSize _ = 256 | 143 | |
144 | testNodeIdBit :: NodeId -> Word -> Bool | ||
145 | testNodeIdBit (NodeId ws) i | ||
146 | | fromIntegral i < 256 -- 256 bits | ||
147 | , (q, r) <- quotRem (fromIntegral i) 64 | ||
148 | = testBit (ws !! q) (63 - r) | ||
149 | | otherwise = False | ||
150 | |||
151 | xorNodeId :: NodeId -> NodeId -> NodeId | ||
152 | xorNodeId (NodeId xs) (NodeId ys) = NodeId $ zipWith xor xs ys | ||
153 | |||
154 | sampleNodeId :: Applicative m => (Int -> m ByteString) -> NodeId -> (Int,Word8,Word8) -> m NodeId | ||
155 | sampleNodeId gen (NodeId self) (q,m,b) | ||
156 | | q <= 0 = bs2id <$> gen 32 | ||
157 | | q >= 32 = pure (NodeId self) | ||
158 | | let (qw,r) = (q+7) `divMod` 8 -- How many Word64 to prepend? | ||
159 | bw = shiftL (fromIntegral b) (8*(7-r)) | ||
160 | mw = bw - 1 :: Word64 | ||
161 | (hd, t0 : _) = splitAt (qw-1) self | ||
162 | h = xor bw (complement mw .&. t0) | ||
163 | = flip fmap (gen $ 8 * (4 - (qw-1)) ) $ \bs -> | ||
164 | let (w:ws) = unpackPublicKey bs | ||
165 | in NodeId $ hd ++ (h .|. (w .&. mw)) : ws | ||
117 | 166 | ||
118 | data NodeInfo = NodeInfo | 167 | data NodeInfo = NodeInfo |
119 | { nodeId :: NodeId | 168 | { nodeId :: NodeId |
@@ -156,7 +205,7 @@ instance FromJSON NodeInfo where | |||
156 | <|> maybe empty (return . IPv4) (ip4str >>= readMaybe) | 205 | <|> maybe empty (return . IPv4) (ip4str >>= readMaybe) |
157 | let (bs,_) = Base16.decode (C8.pack nidstr) | 206 | let (bs,_) = Base16.decode (C8.pack nidstr) |
158 | guard (B.length bs == 32) | 207 | guard (B.length bs == 32) |
159 | return $ NodeInfo (NodeId $ throwCryptoError . publicKey $ bs) ip (fromIntegral (portnum :: Word16)) | 208 | return $ NodeInfo (bs2id bs) ip (fromIntegral (portnum :: Word16)) |
160 | 209 | ||
161 | getIP :: Word8 -> S.Get IP | 210 | getIP :: Word8 -> S.Get IP |
162 | getIP 0x02 = IPv4 <$> S.get | 211 | getIP 0x02 = IPv4 <$> S.get |
@@ -199,7 +248,7 @@ instance Read NodeInfo where | |||
199 | RP.char '@' RP.+++ RP.satisfy isSpace | 248 | RP.char '@' RP.+++ RP.satisfy isSpace |
200 | addrstr <- parseAddr | 249 | addrstr <- parseAddr |
201 | nid <- case Base16.decode $ C8.pack hexhash of | 250 | nid <- case Base16.decode $ C8.pack hexhash of |
202 | (bs,_) | B.length bs==32 -> return (NodeId $ throwCryptoError . publicKey $ bs) | 251 | (bs,_) | B.length bs==32 -> return (bs2id bs) |
203 | _ -> fail "Bad node id." | 252 | _ -> fail "Bad node id." |
204 | return (nid,addrstr) | 253 | return (nid,addrstr) |
205 | (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) ) | 254 | (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) ) |