Tox-XMPP: Switched to z-base32 domain names.

1 files changed, 54 insertions, 18 deletions

diff --git a/dht/src/Network/Tox/NodeId.hs b/dht/src/Network/Tox/NodeId.hs
index e0169199..311095ec 100644
--- a/dht/src/Network/Tox/NodeId.hs
+++ b/dht/src/Network/Tox/NodeId.hs
@@ -38,7 +38,8 @@ module Network.Tox.NodeId
     , ToxContact(..)
     , ToxProgress(..)
     , parseToken32
-    , showToken32
+    , show64Token32
+    , show32Token32
     , nodeInfoFromJSON
     ) where
 
@@ -61,6 +62,7 @@ import qualified Data.ByteArray               as BA
 import qualified Data.ByteString              as B
          ;import Data.ByteString              (ByteString)
 import qualified Data.ByteString.Base16       as Base16
+import qualified Data.ByteString.Base32.Z     as Base32
 import qualified Data.ByteString.Base64       as Base64
 import qualified Data.ByteString.Char8        as C8
 import Data.Char
@@ -173,22 +175,33 @@ nmtoken64 _     c   = c
 parseToken32 :: String -> Either String ByteString
 parseToken32 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str)
 
+-- | Parse 52-digit z-base32 token into 32-byte bytestring.
+parse32Token32 :: String -> Either String ByteString
+parse32Token32 str = fmap (BA.drop 1) $ Base32.decode $ C8.pack $ 'y':map (fixupDigit32 . toLower) (take 52 str)
+
 -- | Encode 32-byte bytestring as 43-digit base64 token.
-showToken32 :: ByteArrayAccess bin => bin -> String
-showToken32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs
+show64Token32 :: ByteArrayAccess bin => bin -> String
+show64Token32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs
+
+-- | Encode 32-byte bytestring as 52-digit z-base32 token.
+show32Token32 :: ByteArrayAccess bin => bin -> String
+show32Token32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base32.encode $ BA.cons 0 $ BA.convert bs
 
 instance Read NodeId where
     readsPrec _ str
         | (bs,_) <- Base16.decode (C8.pack $ take 64 str)
         , CryptoPassed pub <- publicKey bs -- B.length bs == 32
                     = [ (key2id pub, drop (2 * B.length bs) str) ]
+        | Right bs <- parse32Token32 str
+        , CryptoPassed pub <- publicKey bs -- B.length bs == 32
+                    = [ (key2id pub, drop 52 str) ]
         | Right bs <- parseToken32 str
         , CryptoPassed pub <- publicKey bs -- B.length bs == 32
                     = [ (key2id pub, drop 43 str) ]
         | otherwise = []
 
 instance Show NodeId where
-    show nid = showToken32 $ id2key nid
+    show nid = show32Token32 $ id2key nid
 
 instance S.Serialize NodeId where
     get = key2id <$> getPublicKey
@@ -266,8 +279,12 @@ nodeInfoFromJSON prefer4 (JSON.Object v) = do
                       <|> maybe empty (return . IPv6) (ip6str >>= readMaybe)
                 else maybe empty (return . IPv6) (ip6str >>= readMaybe)
                       <|> maybe empty (return . IPv4) (ip4str >>= readMaybe)
-        let (bs,_) = Base16.decode (C8.pack nidstr)
-            enid   = Base64.decode (C8.pack $ 'A' : map (nmtoken64 False) nidstr)
+        let nidbs  = C8.pack nidstr
+            (bs,_) = Base16.decode nidbs
+            enid   = case C8.length nidbs of
+                        43 -> Base64.decode (C8.pack $ 'A' : map (nmtoken64 False) nidstr)
+                        52 -> Base32.decode (C8.pack $ 'y' : map (fixupDigit32 . toLower) nidstr)
+                        _  -> Left "Wrong size of node-id."
         idbs <- (guard (B.length bs == 32) >> return bs)
                 <|> either fail (return . B.drop 1) enid
         return $ NodeInfo (bs2id idbs) ip (fromIntegral (portnum :: Word16))
@@ -313,6 +330,21 @@ b64digit '-' = True
 b64digit '/' = True
 b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z')
 
+zb32digit :: Char -> Bool
+zb32digit '1' = True
+zb32digit c = or [ '3' <= c && c <= '9'
+                 , 'a' <= c && c <= 'k'
+                 , 'm' <= c && c <= 'u'
+                 , 'w' <= c && c <= 'z'
+                 ]
+
+-- Apply substitutions for mistaken z-base32 digits.
+fixupDigit32 :: Char -> Char
+fixupDigit32 'l' = '1'
+fixupDigit32 '2' = 'z'
+fixupDigit32 'v' = 'u'
+fixupDigit32  c  =  c
+
 ip_w_port :: Int -> RP.ReadP (IP, PortNumber)
 ip_w_port i = do
             ip <- RP.between (RP.char '[') (RP.char ']')
@@ -326,19 +358,23 @@ ip_w_port i = do
 instance Read NodeInfo where
   readsPrec i = RP.readP_to_S $ do
     RP.skipSpaces
-    let n = 43 -- characters in node id.
-        parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')'))
+    let parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')'))
                       RP.+++ RP.munch (\c -> not (isSpace c) && not (c `elem` ("{}()"::[Char])))
-        nodeidAt = do (is64,hexhash) <-
-                        fmap (True,) (sequence $ replicate n (RP.satisfy b64digit))
-                          RP.+++ fmap (False,) (sequence $ replicate 64 (RP.satisfy isHexDigit))
+        nodeidAt = do (is64,hexhash) <- foldr1 (RP.+++)
+                        [ fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit))
+                        , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit))
+                        , fmap (16,) (sequence $ replicate 64 (RP.satisfy isHexDigit))
+                        ]
                       RP.char '@' RP.+++ RP.satisfy isSpace
                       addrstr <- parseAddr
-                      nid <- if is64
-                                then case Base64.decode $ C8.pack $ 'A' : map (nmtoken64 False) hexhash of
+                      nid <- case is64 of
+                        32 -> case Base32.decode $ C8.pack $ 'y' : map (fixupDigit32 . toLower) hexhash of
+                                  Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs)
+                                  _                              -> fail "Bad node id."
+                        64 -> case Base64.decode $ C8.pack $ 'A' : map (nmtoken64 False) hexhash of
                                   Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs)
                                   _                              -> fail "Bad node id."
-                                else case Base16.decode $ C8.pack hexhash of
+                        _  -> case Base16.decode $ C8.pack hexhash of
                                   (bs,rem) | B.length bs == 32 &&  B.null rem -> return (bs2id bs)
                                   _                                           -> fail "Bad node id."
                       return (nid,addrstr)
@@ -617,10 +653,10 @@ parseNoSpamJID jid = do
     (u,h) <- maybe (Left "Invalid JID.") Right
                 $ let (mu,h,_) = splitJID jid
                   in fmap (, h) mu
-    base64 <- case splitAt 43 $ Text.unpack h of
-                (base64,".tox") -> Right base64
-                _               -> Left "Hostname should be 43 base64 digits followed by .tox."
-    pub <- id2key <$> readEither base64
+    based <- case splitAt 52 $ Text.unpack h of
+                (base32,".tox") -> Right base32
+                _               -> Left "Hostname should be 52 z-base32 digits followed by .tox."
+    pub <- id2key <$> readEither based
     let ustr = Text.unpack u
     case ustr of
         '$' : b64digits       -> solveBase64NoSpamID b64digits pub