diff options
Diffstat (limited to 'dht/src/Network')
-rw-r--r-- | dht/src/Network/Tox/NodeId.hs | 90 |
1 files changed, 6 insertions, 84 deletions
diff --git a/dht/src/Network/Tox/NodeId.hs b/dht/src/Network/Tox/NodeId.hs index 311095ec..68888fdd 100644 --- a/dht/src/Network/Tox/NodeId.hs +++ b/dht/src/Network/Tox/NodeId.hs | |||
@@ -38,7 +38,7 @@ module Network.Tox.NodeId | |||
38 | , ToxContact(..) | 38 | , ToxContact(..) |
39 | , ToxProgress(..) | 39 | , ToxProgress(..) |
40 | , parseToken32 | 40 | , parseToken32 |
41 | , show64Token32 | 41 | , showToken32 |
42 | , show32Token32 | 42 | , show32Token32 |
43 | , nodeInfoFromJSON | 43 | , nodeInfoFromJSON |
44 | ) where | 44 | ) where |
@@ -91,6 +91,7 @@ import System.Endian | |||
91 | import qualified Data.Text as Text | 91 | import qualified Data.Text as Text |
92 | ;import Data.Text (Text) | 92 | ;import Data.Text (Text) |
93 | import Util (splitJID) | 93 | import Util (splitJID) |
94 | import Codec.AsciiKey256 | ||
94 | 95 | ||
95 | -- | perform io for hashes that do allocation and ffi. | 96 | -- | perform io for hashes that do allocation and ffi. |
96 | -- unsafeDupablePerformIO is used when possible as the | 97 | -- unsafeDupablePerformIO is used when possible as the |
@@ -163,42 +164,8 @@ zeroKey = throwCryptoError $ publicKey $ B.replicate 32 0 | |||
163 | zeroID :: NodeId | 164 | zeroID :: NodeId |
164 | zeroID = NodeId (replicate 4 0) (Just zeroKey) | 165 | zeroID = NodeId (replicate 4 0) (Just zeroKey) |
165 | 166 | ||
166 | -- | Convert to and from a Base64 variant that uses .- instead of +/. | ||
167 | nmtoken64 :: Bool -> Char -> Char | ||
168 | nmtoken64 False '.' = '+' | ||
169 | nmtoken64 False '-' = '/' | ||
170 | nmtoken64 True '+' = '.' | ||
171 | nmtoken64 True '/' = '-' | ||
172 | nmtoken64 _ c = c | ||
173 | |||
174 | -- | Parse 43-digit base64 token into 32-byte bytestring. | ||
175 | parseToken32 :: String -> Either String ByteString | ||
176 | parseToken32 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) | ||
177 | |||
178 | -- | Parse 52-digit z-base32 token into 32-byte bytestring. | ||
179 | parse32Token32 :: String -> Either String ByteString | ||
180 | parse32Token32 str = fmap (BA.drop 1) $ Base32.decode $ C8.pack $ 'y':map (fixupDigit32 . toLower) (take 52 str) | ||
181 | |||
182 | -- | Encode 32-byte bytestring as 43-digit base64 token. | ||
183 | show64Token32 :: ByteArrayAccess bin => bin -> String | ||
184 | show64Token32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs | ||
185 | |||
186 | -- | Encode 32-byte bytestring as 52-digit z-base32 token. | ||
187 | show32Token32 :: ByteArrayAccess bin => bin -> String | ||
188 | show32Token32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base32.encode $ BA.cons 0 $ BA.convert bs | ||
189 | |||
190 | instance Read NodeId where | 167 | instance Read NodeId where |
191 | readsPrec _ str | 168 | readsPrec _ str = readsPrecKey256 (fmap key2id . maybeCryptoError . publicKey) str |
192 | | (bs,_) <- Base16.decode (C8.pack $ take 64 str) | ||
193 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | ||
194 | = [ (key2id pub, drop (2 * B.length bs) str) ] | ||
195 | | Right bs <- parse32Token32 str | ||
196 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | ||
197 | = [ (key2id pub, drop 52 str) ] | ||
198 | | Right bs <- parseToken32 str | ||
199 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | ||
200 | = [ (key2id pub, drop 43 str) ] | ||
201 | | otherwise = [] | ||
202 | 169 | ||
203 | instance Show NodeId where | 170 | instance Show NodeId where |
204 | show nid = show32Token32 $ id2key nid | 171 | show nid = show32Token32 $ id2key nid |
@@ -279,14 +246,7 @@ nodeInfoFromJSON prefer4 (JSON.Object v) = do | |||
279 | <|> maybe empty (return . IPv6) (ip6str >>= readMaybe) | 246 | <|> maybe empty (return . IPv6) (ip6str >>= readMaybe) |
280 | else maybe empty (return . IPv6) (ip6str >>= readMaybe) | 247 | else maybe empty (return . IPv6) (ip6str >>= readMaybe) |
281 | <|> maybe empty (return . IPv4) (ip4str >>= readMaybe) | 248 | <|> maybe empty (return . IPv4) (ip4str >>= readMaybe) |
282 | let nidbs = C8.pack nidstr | 249 | idbs <- parseKey256 nidstr |
283 | (bs,_) = Base16.decode nidbs | ||
284 | enid = case C8.length nidbs of | ||
285 | 43 -> Base64.decode (C8.pack $ 'A' : map (nmtoken64 False) nidstr) | ||
286 | 52 -> Base32.decode (C8.pack $ 'y' : map (fixupDigit32 . toLower) nidstr) | ||
287 | _ -> Left "Wrong size of node-id." | ||
288 | idbs <- (guard (B.length bs == 32) >> return bs) | ||
289 | <|> either fail (return . B.drop 1) enid | ||
290 | return $ NodeInfo (bs2id idbs) ip (fromIntegral (portnum :: Word16)) | 250 | return $ NodeInfo (bs2id idbs) ip (fromIntegral (portnum :: Word16)) |
291 | 251 | ||
292 | getIP :: Word8 -> S.Get IP | 252 | getIP :: Word8 -> S.Get IP |
@@ -320,31 +280,6 @@ instance S.Serialize NodeInfo where | |||
320 | S.put port | 280 | S.put port |
321 | S.put nid | 281 | S.put nid |
322 | 282 | ||
323 | hexdigit :: Char -> Bool | ||
324 | hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F') | ||
325 | |||
326 | b64digit :: Char -> Bool | ||
327 | b64digit '.' = True | ||
328 | b64digit '+' = True | ||
329 | b64digit '-' = True | ||
330 | b64digit '/' = True | ||
331 | b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z') | ||
332 | |||
333 | zb32digit :: Char -> Bool | ||
334 | zb32digit '1' = True | ||
335 | zb32digit c = or [ '3' <= c && c <= '9' | ||
336 | , 'a' <= c && c <= 'k' | ||
337 | , 'm' <= c && c <= 'u' | ||
338 | , 'w' <= c && c <= 'z' | ||
339 | ] | ||
340 | |||
341 | -- Apply substitutions for mistaken z-base32 digits. | ||
342 | fixupDigit32 :: Char -> Char | ||
343 | fixupDigit32 'l' = '1' | ||
344 | fixupDigit32 '2' = 'z' | ||
345 | fixupDigit32 'v' = 'u' | ||
346 | fixupDigit32 c = c | ||
347 | |||
348 | ip_w_port :: Int -> RP.ReadP (IP, PortNumber) | 283 | ip_w_port :: Int -> RP.ReadP (IP, PortNumber) |
349 | ip_w_port i = do | 284 | ip_w_port i = do |
350 | ip <- RP.between (RP.char '[') (RP.char ']') | 285 | ip <- RP.between (RP.char '[') (RP.char ']') |
@@ -360,23 +295,10 @@ instance Read NodeInfo where | |||
360 | RP.skipSpaces | 295 | RP.skipSpaces |
361 | let parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')')) | 296 | let parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')')) |
362 | RP.+++ RP.munch (\c -> not (isSpace c) && not (c `elem` ("{}()"::[Char]))) | 297 | RP.+++ RP.munch (\c -> not (isSpace c) && not (c `elem` ("{}()"::[Char]))) |
363 | nodeidAt = do (is64,hexhash) <- foldr1 (RP.+++) | 298 | nodeidAt = do |
364 | [ fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit)) | 299 | nid <- bs2id <$> readP_key256 |
365 | , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit)) | ||
366 | , fmap (16,) (sequence $ replicate 64 (RP.satisfy isHexDigit)) | ||
367 | ] | ||
368 | RP.char '@' RP.+++ RP.satisfy isSpace | 300 | RP.char '@' RP.+++ RP.satisfy isSpace |
369 | addrstr <- parseAddr | 301 | addrstr <- parseAddr |
370 | nid <- case is64 of | ||
371 | 32 -> case Base32.decode $ C8.pack $ 'y' : map (fixupDigit32 . toLower) hexhash of | ||
372 | Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs) | ||
373 | _ -> fail "Bad node id." | ||
374 | 64 -> case Base64.decode $ C8.pack $ 'A' : map (nmtoken64 False) hexhash of | ||
375 | Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs) | ||
376 | _ -> fail "Bad node id." | ||
377 | _ -> case Base16.decode $ C8.pack hexhash of | ||
378 | (bs,rem) | B.length bs == 32 && B.null rem -> return (bs2id bs) | ||
379 | _ -> fail "Bad node id." | ||
380 | return (nid,addrstr) | 302 | return (nid,addrstr) |
381 | (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) ) | 303 | (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) ) |
382 | (ip,port) <- case RP.readP_to_S (ip_w_port i) addrstr of | 304 | (ip,port) <- case RP.readP_to_S (ip_w_port i) addrstr of |