summaryrefslogtreecommitdiff
path: root/dht/src/Network/Tox/NodeId.hs
diff options
context:
space:
mode:
Diffstat (limited to 'dht/src/Network/Tox/NodeId.hs')
-rw-r--r--dht/src/Network/Tox/NodeId.hs90
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
91import qualified Data.Text as Text 91import qualified Data.Text as Text
92 ;import Data.Text (Text) 92 ;import Data.Text (Text)
93import Util (splitJID) 93import Util (splitJID)
94import 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
163zeroID :: NodeId 164zeroID :: NodeId
164zeroID = NodeId (replicate 4 0) (Just zeroKey) 165zeroID = NodeId (replicate 4 0) (Just zeroKey)
165 166
166-- | Convert to and from a Base64 variant that uses .- instead of +/.
167nmtoken64 :: Bool -> Char -> Char
168nmtoken64 False '.' = '+'
169nmtoken64 False '-' = '/'
170nmtoken64 True '+' = '.'
171nmtoken64 True '/' = '-'
172nmtoken64 _ c = c
173
174-- | Parse 43-digit base64 token into 32-byte bytestring.
175parseToken32 :: String -> Either String ByteString
176parseToken32 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.
179parse32Token32 :: String -> Either String ByteString
180parse32Token32 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.
183show64Token32 :: ByteArrayAccess bin => bin -> String
184show64Token32 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.
187show32Token32 :: ByteArrayAccess bin => bin -> String
188show32Token32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base32.encode $ BA.cons 0 $ BA.convert bs
189
190instance Read NodeId where 167instance 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
203instance Show NodeId where 170instance 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
292getIP :: Word8 -> S.Get IP 252getIP :: 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
323hexdigit :: Char -> Bool
324hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F')
325
326b64digit :: Char -> Bool
327b64digit '.' = True
328b64digit '+' = True
329b64digit '-' = True
330b64digit '/' = True
331b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z')
332
333zb32digit :: Char -> Bool
334zb32digit '1' = True
335zb32digit 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.
342fixupDigit32 :: Char -> Char
343fixupDigit32 'l' = '1'
344fixupDigit32 '2' = 'z'
345fixupDigit32 'v' = 'u'
346fixupDigit32 c = c
347
348ip_w_port :: Int -> RP.ReadP (IP, PortNumber) 283ip_w_port :: Int -> RP.ReadP (IP, PortNumber)
349ip_w_port i = do 284ip_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