summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Crypto/Tox.hs3
-rw-r--r--src/Network/Tox/NodeId.hs16
2 files changed, 15 insertions, 4 deletions
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index 8bb822d8..9b7e82c0 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -594,12 +594,13 @@ decodeSecret k64 = do
594 CryptoPassed x -> Just x 594 CryptoPassed x -> Just x
595 _ -> Nothing 595 _ -> Nothing
596 596
597-- Treats byte pairs as big-endian.
597xorsum :: ByteArrayAccess ba => ba -> Word16 598xorsum :: ByteArrayAccess ba => ba -> Word16
598xorsum bs = unsafeDupablePerformIO $ BA.withByteArray bs $ \ptr16 -> do 599xorsum bs = unsafeDupablePerformIO $ BA.withByteArray bs $ \ptr16 -> do
599 let (wcnt,r) = BA.length bs `divMod` 2 600 let (wcnt,r) = BA.length bs `divMod` 2
600 loop cnt !ac = do 601 loop cnt !ac = do
601 ac' <- xor ac <$> peekElemOff ptr16 cnt 602 ac' <- xor ac <$> peekElemOff ptr16 cnt
602 case cnt of 0 -> return ac' 603 case cnt of 0 -> return $ fromBE16 ac'
603 _ -> loop (cnt - 1) ac' 604 _ -> loop (cnt - 1) ac'
604 loop (wcnt - 1) $ case r of 605 loop (wcnt - 1) $ case r of
605 0 -> 0 606 0 -> 0
diff --git a/src/Network/Tox/NodeId.hs b/src/Network/Tox/NodeId.hs
index b12487a4..2f3a2bb1 100644
--- a/src/Network/Tox/NodeId.hs
+++ b/src/Network/Tox/NodeId.hs
@@ -493,6 +493,7 @@ instance OnionPacket 3 where mkOnion = OnionResponse3
493data NoSpam = NoSpam !Word32 !(Maybe Word16) 493data NoSpam = NoSpam !Word32 !(Maybe Word16)
494 deriving (Eq,Ord,Show) 494 deriving (Eq,Ord,Show)
495 495
496-- Utilizes Data.Serialize format for Word32 nospam and Word16 checksum.
496instance Read NoSpam where 497instance Read NoSpam where
497 readsPrec d s = case break isSpace s of 498 readsPrec d s = case break isSpace s of
498 ('$':ws ,rs) | (length ws == 8) -> base64decode rs (NoSpam <$> get <*> (Just <$> get)) ws 499 ('$':ws ,rs) | (length ws == 8) -> base64decode rs (NoSpam <$> get <*> (Just <$> get)) ws
@@ -535,16 +536,25 @@ instance Read NoSpamId where
535 nsid <- parseNoSpamId $ Text.pack jid 536 nsid <- parseNoSpamId $ Text.pack jid
536 return [(nsid,xs)] 537 return [(nsid,xs)]
537 538
539parseNoSpamHex hex = Right $ NoSpamId (read $ "0x"++nospamsum) (id2key $ read hkey)
540 where
541 (hkey,nospamsum) = splitAt 64 $ Text.unpack hex
542
538parseNoSpamId :: Text -> Either String NoSpamId 543parseNoSpamId :: Text -> Either String NoSpamId
539parseNoSpamId jid = do 544parseNoSpamId spec | Text.length spec == 76
545 , Text.all isHexDigit spec = parseNoSpamHex spec
546 | otherwise = parseNoSpamJID spec
547
548parseNoSpamJID :: Text -> Either String NoSpamId
549parseNoSpamJID jid = do
540 (Just u,h,_) <- Right $ splitJID jid 550 (Just u,h,_) <- Right $ splitJID jid
541 (base64,".tox") <- Right $ splitAt 43 $ Text.unpack h 551 (base64,".tox") <- Right $ splitAt 43 $ Text.unpack h
542 pub <- id2key <$> readEither base64 552 pub <- id2key <$> readEither base64
543 let ustr = Text.unpack u 553 let ustr = Text.unpack u
544 '$' : b64digits <- Right ustr -- TODO: support 0x prefix also. 554 '$' : b64digits <- Right ustr -- TODO: support 0x prefix also.
545 NoSpam nospam (Just x) <- readEither $ map (\case; '?' -> '0'; c -> c) ustr 555 NoSpam nospam (Just x) <- readEither $ map (\case; '?' -> '0'; c -> c) ustr
546 let nlo = fromIntegral nospam :: Word16 556 let nlo = fromIntegral (0x0FFFF .&. nospam) :: Word16
547 nhi = fromIntegral (nospam `shiftR` 16) :: Word16 557 nhi = fromIntegral (0x0FFFF .&. (nospam `shiftR` 16)) :: Word16
548 sum = x `xor` nlo `xor` nhi `xor` xorsum pub 558 sum = x `xor` nlo `xor` nhi `xor` xorsum pub
549 -- Find any question mark indices. 559 -- Find any question mark indices.
550 qs = catMaybes $ zipWith (\case; '?' -> Just ; _ -> const Nothing) b64digits [0..7] 560 qs = catMaybes $ zipWith (\case; '?' -> Just ; _ -> const Nothing) b64digits [0..7]