diff options
-rw-r--r-- | src/Network/Tox/NodeId.hs | 58 |
1 files changed, 25 insertions, 33 deletions
diff --git a/src/Network/Tox/NodeId.hs b/src/Network/Tox/NodeId.hs index 2ad17616..95604108 100644 --- a/src/Network/Tox/NodeId.hs +++ b/src/Network/Tox/NodeId.hs | |||
@@ -28,6 +28,7 @@ module Network.Tox.NodeId | |||
28 | , sampleNodeId) where | 28 | , sampleNodeId) where |
29 | 29 | ||
30 | import Control.Applicative | 30 | import Control.Applicative |
31 | import Control.Arrow | ||
31 | import Control.Monad | 32 | import Control.Monad |
32 | import Crypto.Error.Types (CryptoFailable (..), | 33 | import Crypto.Error.Types (CryptoFailable (..), |
33 | throwCryptoError) | 34 | throwCryptoError) |
@@ -87,42 +88,35 @@ packPublicKey ws = BA.allocAndFreeze (8 * length ws) $ | |||
87 | x:xs -> do poke ptr (toBE64 x) | 88 | x:xs -> do poke ptr (toBE64 x) |
88 | loop xs (plusPtr ptr 8) | 89 | loop xs (plusPtr ptr 8) |
89 | 90 | ||
90 | newtype NodeId = NodeId [Word64] | 91 | -- We represent the node id redundantly in two formats. The [Word64] format is |
91 | deriving (Eq,Ord) -- ByteArrayAccess) -- (Eq,Ord,ByteArrayAccess, Bits, Hashable) | 92 | -- convenient for short-circuiting xor/distance comparisons. The PublicKey |
93 | -- format is convenient for encryption. | ||
94 | data NodeId = NodeId [Word64] !(Maybe PublicKey) | ||
95 | |||
96 | instance Eq NodeId where | ||
97 | (NodeId ws _) == (NodeId xs _) | ||
98 | = ws == xs | ||
99 | |||
100 | instance Ord NodeId where | ||
101 | compare (NodeId ws _) (NodeId xs _) = compare ws xs | ||
92 | 102 | ||
93 | instance Sized NodeId where size = ConstSize 32 | 103 | instance Sized NodeId where size = ConstSize 32 |
94 | 104 | ||
95 | key2id :: PublicKey -> NodeId | 105 | key2id :: PublicKey -> NodeId |
96 | key2id = NodeId . unpackPublicKey | 106 | key2id k = NodeId (unpackPublicKey k) (Just k) |
97 | 107 | ||
98 | bs2id :: ByteString -> NodeId | 108 | bs2id :: ByteString -> NodeId |
99 | bs2id bs = NodeId . unpackPublicKey $ throwCryptoError . publicKey $ bs | 109 | bs2id bs = uncurry NodeId . (unpackPublicKey &&& Just) $ throwCryptoError . publicKey $ bs |
100 | |||
101 | id2key :: NodeId -> PublicKey | ||
102 | id2key (NodeId key) = throwCryptoError . publicKey $ (packPublicKey key :: BA.Bytes) | ||
103 | |||
104 | 110 | ||
105 | {- | ||
106 | id2key :: NodeId -> PublicKey | 111 | id2key :: NodeId -> PublicKey |
107 | id2key recipient = case publicKey recipient of | 112 | id2key (NodeId ws (Just key)) = key |
108 | CryptoPassed key -> key | 113 | id2key (NodeId key Nothing) = throwCryptoError . publicKey $ (packPublicKey key :: BA.Bytes) |
109 | -- This should never happen because a NodeId is 32 bytes. | ||
110 | CryptoFailed e -> error ("Unexpected pattern fail: "++show e) | ||
111 | 114 | ||
112 | key2id :: PublicKey -> NodeId | 115 | zeroKey :: PublicKey |
113 | key2id pk = case S.decode (BA.convert pk) of | 116 | zeroKey = throwCryptoError $ publicKey $ B.replicate 32 0 |
114 | Left _ -> error "key2id" | ||
115 | Right nid -> nid | ||
116 | |||
117 | -} | ||
118 | |||
119 | {- | ||
120 | instance Ord NodeId where | ||
121 | compare (NodeId a) (NodeId b) = compare (unpackPublicKey a) (unpackPublicKey b) | ||
122 | -} | ||
123 | 117 | ||
124 | zeroID :: NodeId | 118 | zeroID :: NodeId |
125 | zeroID = NodeId $ replicate 4 0 -- throwCryptoError $ publicKey $ B.replicate 32 0 | 119 | zeroID = NodeId (replicate 4 0) (Just zeroKey) |
126 | 120 | ||
127 | -- | Convert to and from a Base64 variant that uses .- instead of +/. | 121 | -- | Convert to and from a Base64 variant that uses .- instead of +/. |
128 | nmtoken64 :: Bool -> Char -> Char | 122 | nmtoken64 :: Bool -> Char -> Char |
@@ -147,24 +141,22 @@ instance S.Serialize NodeId where | |||
147 | put nid = putPublicKey $ id2key nid | 141 | put nid = putPublicKey $ id2key nid |
148 | 142 | ||
149 | instance Hashable NodeId where | 143 | instance Hashable NodeId where |
150 | hashWithSalt salt (NodeId key) = hashWithSalt salt (head key) | 144 | hashWithSalt salt (NodeId ws _) = hashWithSalt salt (head ws) |
151 | |||
152 | -- instance FiniteBits NodeId where finiteBitSize _ = 256 | ||
153 | 145 | ||
154 | testNodeIdBit :: NodeId -> Word -> Bool | 146 | testNodeIdBit :: NodeId -> Word -> Bool |
155 | testNodeIdBit (NodeId ws) i | 147 | testNodeIdBit (NodeId ws _) i -- TODO: Optmize: use ByteArray key if it's available. |
156 | | fromIntegral i < 256 -- 256 bits | 148 | | fromIntegral i < 256 -- 256 bits |
157 | , (q, r) <- quotRem (fromIntegral i) 64 | 149 | , (q, r) <- quotRem (fromIntegral i) 64 |
158 | = testBit (ws !! q) (63 - r) | 150 | = testBit (ws !! q) (63 - r) |
159 | | otherwise = False | 151 | | otherwise = False |
160 | 152 | ||
161 | xorNodeId :: NodeId -> NodeId -> NodeId | 153 | xorNodeId :: NodeId -> NodeId -> NodeId |
162 | xorNodeId (NodeId xs) (NodeId ys) = NodeId $ zipWith xor xs ys | 154 | xorNodeId (NodeId xs _) (NodeId ys _) = NodeId (zipWith xor xs ys) Nothing |
163 | 155 | ||
164 | sampleNodeId :: Applicative m => (Int -> m ByteString) -> NodeId -> (Int,Word8,Word8) -> m NodeId | 156 | sampleNodeId :: Applicative m => (Int -> m ByteString) -> NodeId -> (Int,Word8,Word8) -> m NodeId |
165 | sampleNodeId gen (NodeId self) (q,m,b) | 157 | sampleNodeId gen (NodeId self k) (q,m,b) |
166 | | q <= 0 = bs2id <$> gen 32 | 158 | | q <= 0 = bs2id <$> gen 32 |
167 | | q >= 32 = pure (NodeId self) | 159 | | q >= 32 = pure (NodeId self k) |
168 | | let (qw,r) = (q+7) `divMod` 8 -- How many Word64 to prepend? | 160 | | let (qw,r) = (q+7) `divMod` 8 -- How many Word64 to prepend? |
169 | bw = shiftL (fromIntegral b) (8*(7-r)) | 161 | bw = shiftL (fromIntegral b) (8*(7-r)) |
170 | mw = bw - 1 :: Word64 | 162 | mw = bw - 1 :: Word64 |
@@ -172,7 +164,7 @@ sampleNodeId gen (NodeId self) (q,m,b) | |||
172 | h = xor bw (complement mw .&. t0) | 164 | h = xor bw (complement mw .&. t0) |
173 | = flip fmap (gen $ 8 * (4 - (qw-1)) ) $ \bs -> | 165 | = flip fmap (gen $ 8 * (4 - (qw-1)) ) $ \bs -> |
174 | let (w:ws) = unpackPublicKey bs | 166 | let (w:ws) = unpackPublicKey bs |
175 | in NodeId $ hd ++ (h .|. (w .&. mw)) : ws | 167 | in NodeId (hd ++ (h .|. (w .&. mw)) : ws) Nothing |
176 | 168 | ||
177 | data NodeInfo = NodeInfo | 169 | data NodeInfo = NodeInfo |
178 | { nodeId :: NodeId | 170 | { nodeId :: NodeId |