diff options
author | joe <joe@jerkface.net> | 2017-10-26 21:18:26 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-10-26 21:18:26 -0400 |
commit | 50d3bb1fc90c4d83d390fa2c5b328935d0ffed1d (patch) | |
tree | b53c59775113f9d1388293ab6e92318972015475 /src/Network | |
parent | 6e191acf0592add909d340284ec541a27e3021d8 (diff) |
Publish method to send Tox friend-request.
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/Tox/DHT/Transport.hs | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index 47505a21..b7982a1a 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs | |||
@@ -18,6 +18,8 @@ module Network.Tox.DHT.Transport | |||
18 | , SendNodes(..) | 18 | , SendNodes(..) |
19 | , DHTPublicKey(..) | 19 | , DHTPublicKey(..) |
20 | , FriendRequest(..) | 20 | , FriendRequest(..) |
21 | , NoSpam(..) | ||
22 | , verifyChecksum | ||
21 | , CookieRequest | 23 | , CookieRequest |
22 | , Cookie | 24 | , Cookie |
23 | , DHTRequest | 25 | , DHTRequest |
@@ -36,6 +38,7 @@ import Network.QueryResponse | |||
36 | import Control.Arrow | 38 | import Control.Arrow |
37 | import Control.Monad | 39 | import Control.Monad |
38 | import Data.Bool | 40 | import Data.Bool |
41 | import qualified Data.ByteString.Char8 as B8 | ||
39 | import qualified Data.ByteString as B | 42 | import qualified Data.ByteString as B |
40 | ;import Data.ByteString (ByteString) | 43 | ;import Data.ByteString (ByteString) |
41 | import Data.Functor.Contravariant | 44 | import Data.Functor.Contravariant |
@@ -45,6 +48,9 @@ import Data.Tuple | |||
45 | import Data.Word | 48 | import Data.Word |
46 | import Foreign.C (CTime(..)) | 49 | import Foreign.C (CTime(..)) |
47 | import Network.Socket | 50 | import Network.Socket |
51 | import qualified Data.ByteString.Base64 as Base64 | ||
52 | import qualified Data.ByteString.Base16 as Base16 | ||
53 | import Data.Char (isSpace) | ||
48 | 54 | ||
49 | type DHTTransport = Transport String NodeInfo (DHTMessage Encrypted8) | 55 | type DHTTransport = Transport String NodeInfo (DHTMessage Encrypted8) |
50 | type HandleHi a = Maybe (Either String (DHTMessage Encrypted8, NodeInfo)) -> IO a | 56 | type HandleHi a = Maybe (Either String (DHTMessage Encrypted8, NodeInfo)) -> IO a |
@@ -221,6 +227,32 @@ data FriendRequest = FriendRequest | |||
221 | } | 227 | } |
222 | deriving (Eq, Show) | 228 | deriving (Eq, Show) |
223 | 229 | ||
230 | data NoSpam = NoSpam !Word32 !(Maybe Word16) | ||
231 | |||
232 | instance Read NoSpam where | ||
233 | readsPrec d s = case break isSpace s of | ||
234 | (ws,rs) | (length ws == 6) -> base64decode rs (flip NoSpam Nothing <$> get) ws | ||
235 | (ws,rs) | (length ws == 8) -> base64decode rs (NoSpam <$> get <*> (Just <$> get)) ws | ||
236 | (ws,rs) | (length ws == 12) -> base16decode rs (NoSpam <$> get <*> (Just <$> get)) ws | ||
237 | _ -> [] | ||
238 | |||
239 | base64decode :: Monad m => t1 -> Get t -> String -> m (t, t1) | ||
240 | base64decode rs getter s = | ||
241 | either fail (\a -> return (a,rs)) | ||
242 | $ runGet getter | ||
243 | =<< Base64.decode (B8.pack s) | ||
244 | |||
245 | base16decode :: Monad m => t1 -> Get t -> String -> m (t, t1) | ||
246 | base16decode rs getter s = | ||
247 | either fail (\a -> return (a,rs)) | ||
248 | $ runGet getter | ||
249 | $ fst | ||
250 | $ Base16.decode (B8.pack s) | ||
251 | |||
252 | verifyChecksum :: PublicKey -> Word16 -> Either String () | ||
253 | verifyChecksum _ _ = return () -- TODO | ||
254 | |||
255 | |||
224 | -- When sent as a DHT request packet (this is the data sent in the DHT request | 256 | -- When sent as a DHT request packet (this is the data sent in the DHT request |
225 | -- packet): | 257 | -- packet): |
226 | -- | 258 | -- |