summaryrefslogtreecommitdiff
path: root/src/Network/Tox/NodeId.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/NodeId.hs')
-rw-r--r--src/Network/Tox/NodeId.hs58
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
30import Control.Applicative 30import Control.Applicative
31import Control.Arrow
31import Control.Monad 32import Control.Monad
32import Crypto.Error.Types (CryptoFailable (..), 33import 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
90newtype 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.
94data NodeId = NodeId [Word64] !(Maybe PublicKey)
95
96instance Eq NodeId where
97 (NodeId ws _) == (NodeId xs _)
98 = ws == xs
99
100instance Ord NodeId where
101 compare (NodeId ws _) (NodeId xs _) = compare ws xs
92 102
93instance Sized NodeId where size = ConstSize 32 103instance Sized NodeId where size = ConstSize 32
94 104
95key2id :: PublicKey -> NodeId 105key2id :: PublicKey -> NodeId
96key2id = NodeId . unpackPublicKey 106key2id k = NodeId (unpackPublicKey k) (Just k)
97 107
98bs2id :: ByteString -> NodeId 108bs2id :: ByteString -> NodeId
99bs2id bs = NodeId . unpackPublicKey $ throwCryptoError . publicKey $ bs 109bs2id bs = uncurry NodeId . (unpackPublicKey &&& Just) $ throwCryptoError . publicKey $ bs
100
101id2key :: NodeId -> PublicKey
102id2key (NodeId key) = throwCryptoError . publicKey $ (packPublicKey key :: BA.Bytes)
103
104 110
105{-
106id2key :: NodeId -> PublicKey 111id2key :: NodeId -> PublicKey
107id2key recipient = case publicKey recipient of 112id2key (NodeId ws (Just key)) = key
108 CryptoPassed key -> key 113id2key (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
112key2id :: PublicKey -> NodeId 115zeroKey :: PublicKey
113key2id pk = case S.decode (BA.convert pk) of 116zeroKey = throwCryptoError $ publicKey $ B.replicate 32 0
114 Left _ -> error "key2id"
115 Right nid -> nid
116
117-}
118
119{-
120instance Ord NodeId where
121 compare (NodeId a) (NodeId b) = compare (unpackPublicKey a) (unpackPublicKey b)
122-}
123 117
124zeroID :: NodeId 118zeroID :: NodeId
125zeroID = NodeId $ replicate 4 0 -- throwCryptoError $ publicKey $ B.replicate 32 0 119zeroID = 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 +/.
128nmtoken64 :: Bool -> Char -> Char 122nmtoken64 :: 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
149instance Hashable NodeId where 143instance 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
154testNodeIdBit :: NodeId -> Word -> Bool 146testNodeIdBit :: NodeId -> Word -> Bool
155testNodeIdBit (NodeId ws) i 147testNodeIdBit (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
161xorNodeId :: NodeId -> NodeId -> NodeId 153xorNodeId :: NodeId -> NodeId -> NodeId
162xorNodeId (NodeId xs) (NodeId ys) = NodeId $ zipWith xor xs ys 154xorNodeId (NodeId xs _) (NodeId ys _) = NodeId (zipWith xor xs ys) Nothing
163 155
164sampleNodeId :: Applicative m => (Int -> m ByteString) -> NodeId -> (Int,Word8,Word8) -> m NodeId 156sampleNodeId :: Applicative m => (Int -> m ByteString) -> NodeId -> (Int,Word8,Word8) -> m NodeId
165sampleNodeId gen (NodeId self) (q,m,b) 157sampleNodeId 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
177data NodeInfo = NodeInfo 169data NodeInfo = NodeInfo
178 { nodeId :: NodeId 170 { nodeId :: NodeId