diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/Tox/NodeId.hs | 32 |
1 files changed, 24 insertions, 8 deletions
diff --git a/src/Network/Tox/NodeId.hs b/src/Network/Tox/NodeId.hs index d0c57416..bba56e27 100644 --- a/src/Network/Tox/NodeId.hs +++ b/src/Network/Tox/NodeId.hs | |||
@@ -40,6 +40,7 @@ import qualified Data.ByteArray as BA | |||
40 | import qualified Data.ByteString as B | 40 | import qualified Data.ByteString as B |
41 | ;import Data.ByteString (ByteString) | 41 | ;import Data.ByteString (ByteString) |
42 | import qualified Data.ByteString.Base16 as Base16 | 42 | import qualified Data.ByteString.Base16 as Base16 |
43 | import qualified Data.ByteString.Base64 as Base64 | ||
43 | import qualified Data.ByteString.Char8 as C8 | 44 | import qualified Data.ByteString.Char8 as C8 |
44 | import Data.Char | 45 | import Data.Char |
45 | import Data.Data | 46 | import Data.Data |
@@ -122,15 +123,23 @@ instance Ord NodeId where | |||
122 | zeroID :: NodeId | 123 | zeroID :: NodeId |
123 | zeroID = NodeId $ replicate 4 0 -- throwCryptoError $ publicKey $ B.replicate 32 0 | 124 | zeroID = NodeId $ replicate 4 0 -- throwCryptoError $ publicKey $ B.replicate 32 0 |
124 | 125 | ||
126 | -- | Convert to and from a Base64 variant that uses .- instead of +/. | ||
127 | nmtoken64 :: Bool -> Char -> Char | ||
128 | nmtoken64 False '.' = '+' | ||
129 | nmtoken64 False '-' = '/' | ||
130 | nmtoken64 True '+' = '.' | ||
131 | nmtoken64 True '/' = '-' | ||
132 | nmtoken64 _ c = c | ||
133 | |||
125 | instance Read NodeId where | 134 | instance Read NodeId where |
126 | readsPrec _ str | 135 | readsPrec _ str |
127 | | (bs, xs) <- Base16.decode $ C8.pack str | 136 | | Right bs <- fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) |
128 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | 137 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 |
129 | = [ (key2id pub, drop 64 str) ] | 138 | = [ (key2id pub, drop 43 str) ] |
130 | | otherwise = [] | 139 | | otherwise = [] |
131 | 140 | ||
132 | instance Show NodeId where | 141 | instance Show NodeId where |
133 | show nid = C8.unpack $ Base16.encode $ BA.convert $ id2key nid | 142 | show nid = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert $ id2key nid |
134 | 143 | ||
135 | instance S.Serialize NodeId where | 144 | instance S.Serialize NodeId where |
136 | get = key2id <$> getPublicKey | 145 | get = key2id <$> getPublicKey |
@@ -241,18 +250,25 @@ instance S.Serialize NodeInfo where | |||
241 | hexdigit :: Char -> Bool | 250 | hexdigit :: Char -> Bool |
242 | hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F') | 251 | hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F') |
243 | 252 | ||
253 | b64digit :: Char -> Bool | ||
254 | b64digit '.' = True | ||
255 | b64digit '+' = True | ||
256 | b64digit '-' = True | ||
257 | b64digit '/' = True | ||
258 | b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z') | ||
259 | |||
244 | instance Read NodeInfo where | 260 | instance Read NodeInfo where |
245 | readsPrec i = RP.readP_to_S $ do | 261 | readsPrec i = RP.readP_to_S $ do |
246 | RP.skipSpaces | 262 | RP.skipSpaces |
247 | let n = 64 -- characters in node id. | 263 | let n = 43 -- characters in node id. |
248 | parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')')) | 264 | parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')')) |
249 | RP.+++ RP.munch (not . isSpace) | 265 | RP.+++ RP.munch (not . isSpace) |
250 | nodeidAt = do hexhash <- sequence $ replicate n (RP.satisfy hexdigit) | 266 | nodeidAt = do hexhash <- sequence $ replicate n (RP.satisfy b64digit) |
251 | RP.char '@' RP.+++ RP.satisfy isSpace | 267 | RP.char '@' RP.+++ RP.satisfy isSpace |
252 | addrstr <- parseAddr | 268 | addrstr <- parseAddr |
253 | nid <- case Base16.decode $ C8.pack hexhash of | 269 | nid <- case Base64.decode $ C8.pack $ 'A' : map (nmtoken64 False) hexhash of |
254 | (bs,_) | B.length bs==32 -> return (bs2id bs) | 270 | Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs) |
255 | _ -> fail "Bad node id." | 271 | _ -> fail "Bad node id." |
256 | return (nid,addrstr) | 272 | return (nid,addrstr) |
257 | (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) ) | 273 | (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) ) |
258 | let raddr = do | 274 | let raddr = do |