Finish "session" and "netcrypto" todo stubs

author: James Crayne <jim.crayne@gmail.com> 2018-05-30 00:43:09 +0000
committer: James Crayne <jim.crayne@gmail.com> 2018-05-30 00:43:09 +0000
commit: c7adc4afe5908753627d42386463604ce634de62 (patch)
tree: 6acbdf4dd4284a07a169c338b8413941f128ae8a /examples
parent: 55533838c0089fb94dd4f007d4e3f0b676a8ffc4 (diff)
1 files changed, 90 insertions, 15 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index ec6c89f1..74e08073 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -459,6 +459,19 @@ clientSession s@Session{..} sock cnum h = do
                    case B.unsnoc x of
                                 Just (str,c) | isSpace c -> (str,False)
                                 _ -> (x,True)
+    let readHex :: (Read n, Integral n) => String -> Maybe n
+        readHex s = readMaybe ("0x" ++ s)
+        strToSession :: String -> IO (Either String Tox.NetCryptoSession)
+        strToSession idStr
+          = case readHex idStr of
+                Nothing -> return (Left "Unable to parse session id")
+                Just id -> do
+                    sessions <- filter ((==id) . Tox.ncSessionId)
+                              . concat
+                              . Map.elems <$> (atomically $ readTVar (Tox.netCryptoSessionsByKey cryptosessions))
+                    case sessions of
+                        []     -> return (Left "Session not found")
+                        (x:xs) -> return (Right x)
    let mkrow :: (SecretKey, PublicKey) -> (String,String)
        mkrow (a,b) | Just x <- encodeSecret a= (B.unpack x, show (Tox.key2id b))
        mkrow _ = error (concat ["Assertion fail in 'mkrow' function at ", __FILE__, ":", show __LINE__])
@@ -723,43 +736,105 @@ clientSession s@Session{..} sock cnum h = do
        -- send ONLINE packet to session N
        ("session", s) | (idStr,"online",unstripped) <- twoWords s
                        , stripped <- strp unstripped
-                        -> cmd0 $
+                        -> cmd0 $ do
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendOnline"
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case mbTox of
+                                        Nothing -> hPutClient h "Requires Tox enabled."
+                                        Just tox-> do
+                                            Tox.sendOnline (Tox.toxCryptoKeys tox) session
+                                            hPutClient h "sent ONLINE"
        -- session <N> online
        -- send OFFLINE packet to session N
        ("session", s) | (idStr,"offline",unstripped) <- twoWords s
                        , stripped <- strp unstripped
-                        -> cmd0 $
+                        -> cmd0 $ do
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendOffline"
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case mbTox of
+                                        Nothing -> hPutClient h "Requires Tox enabled."
+                                        Just tox-> do
+                                            Tox.sendOffline (Tox.toxCryptoKeys tox) session
+                                            hPutClient h "sent OFFLINE"
        -- session <N> kill
        -- send KILL packet to session N
        ("session", s) | (idStr,"kill",unstripped) <- twoWords s
                        , stripped <- strp unstripped
-                        -> cmd0 $
+                        -> cmd0 $ do
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendKill"
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case mbTox of
+                                        Nothing -> hPutClient h "Requires Tox enabled."
+                                        Just tox-> do
+                                            Tox.sendKill (Tox.toxCryptoKeys tox) session
+                                            hPutClient h "sent KillPacket"
        -- session <N> nick <NICKNAME>
        -- send NICK packet to session N, setting nick to NICKNAME
        ("session", s) | (idStr,"nick",unstripped) <- twoWords s
                        , nick <- strp unstripped
-                        -> cmd0 $
+                        -> cmd0 $ do
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call setNick with crypto session and nick"
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case mbTox of
+                                        Nothing -> hPutClient h "Requires Tox enabled."
+                                        Just tox-> do
+                                            Tox.setNick (Tox.toxCryptoKeys tox) session (B.pack nick)
+                                            hPutClient h "sent NICKNAME"
        -- session <N> status <STATUS>
        -- send USERSTATUS packet to session N, set status to STATUS
        ("session", s) | (idStr,"status",unstripped) <- twoWords s
-                        , status <- strp unstripped
+                        , statusStr  <- strp unstripped
-                        -> cmd0 $
+                        -> cmd0 $ do
-                            hPutClient h "TODO: parse idStr to get sessionId, parse status, call setStatus"
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case mbTox of
+                                        Nothing -> hPutClient h "Requires Tox enabled."
+                                        Just tox-> do
+                                            case readMaybe statusStr of
+                                                Nothing -> hPutClient h "Unable to parse status"
+                                                Just status -> do
+                                                    Tox.setStatus (Tox.toxCryptoKeys tox) session status
+                                                    hPutClient h "sent USERSTATUS"
        -- session <N> typing <TYPINGSTATUS>
        -- send TYPING packet to session N, set typing to TYPINGSTATUS
        ("session", s) | (idStr,"typing",unstripped) <- twoWords s
                        , typingstatus <- strp unstripped
-                        -> cmd0 $
+                        -> cmd0 $ do
-                            hPutClient h "TODO: parse idStr to get sessionId, parse typing status, call setTyping"
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case mbTox of
+                                        Nothing -> hPutClient h "Requires Tox enabled."
+                                        Just tox-> do
+                                            case readMaybe typingstatus of
+                                                Nothing -> hPutClient h "Unable to parse status"
+                                                Just status -> do
+                                                    Tox.setTyping (Tox.toxCryptoKeys tox) session status
+                                                    hPutClient h "sent TYPINGSTATUS"
        -- session <N> statusmsg <MSG>
        -- send STATUSMESSAGE packet to session N, setting status message to MSG
        ("session", s) | (idStr,"statusmsg",statusmsg) <- twoWords s
-                        -> cmd0 $
+                        -> cmd0 $ do
-                            hPutClient h "TODO: parse idStr to get sessionId, call setStatusMsg"
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case mbTox of
+                                        Nothing -> hPutClient h "Requires Tox enabled."
+                                        Just tox-> do
+                                            Tox.setStatusMsg (Tox.toxCryptoKeys tox) session (B.pack statusmsg)
+                                            hPutClient h "sent STATUSMESSAGE"
        ("onion", s) -> cmd0 $ join $ atomically $ do
            rm <- readTVar $ routeMap onionRouter
author	James Crayne <jim.crayne@gmail.com>	2018-05-30 00:43:09 +0000
committer	James Crayne <jim.crayne@gmail.com>	2018-05-30 00:43:09 +0000
commit	c7adc4afe5908753627d42386463604ce634de62 (patch)
tree	6acbdf4dd4284a07a169c338b8413941f128ae8a /examples
parent	55533838c0089fb94dd4f007d4e3f0b676a8ffc4 (diff)

diff --git a/examples/dhtd.hs b/examples/dhtd.hs index ec6c89f1..74e08073 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs
@@ -459,6 +459,19 @@ clientSession s@Session{..} sock cnum h = do
459	case B.unsnoc x of	459	case B.unsnoc x of
460	Just (str,c) \| isSpace c -> (str,False)	460	Just (str,c) \| isSpace c -> (str,False)
461	_ -> (x,True)	461	_ -> (x,True)
		462	let readHex :: (Read n, Integral n) => String -> Maybe n
		463	readHex s = readMaybe ("0x" ++ s)
		464	strToSession :: String -> IO (Either String Tox.NetCryptoSession)
		465	strToSession idStr
		466	= case readHex idStr of
		467	Nothing -> return (Left "Unable to parse session id")
		468	Just id -> do
		469	sessions <- filter ((==id) . Tox.ncSessionId)
		470	. concat
		471	. Map.elems <$> (atomically $ readTVar (Tox.netCryptoSessionsByKey cryptosessions))
		472	case sessions of
		473	[] -> return (Left "Session not found")
		474	(x:xs) -> return (Right x)
462	let mkrow :: (SecretKey, PublicKey) -> (String,String)	475	let mkrow :: (SecretKey, PublicKey) -> (String,String)
463	mkrow (a,b) \| Just x <- encodeSecret a= (B.unpack x, show (Tox.key2id b))	476	mkrow (a,b) \| Just x <- encodeSecret a= (B.unpack x, show (Tox.key2id b))
464	mkrow _ = error (concat ["Assertion fail in 'mkrow' function at ", __FILE__, ":", show __LINE__])	477	mkrow _ = error (concat ["Assertion fail in 'mkrow' function at ", __FILE__, ":", show __LINE__])
@@ -723,43 +736,105 @@ clientSession s@Session{..} sock cnum h = do
723	-- send ONLINE packet to session N	736	-- send ONLINE packet to session N
724	("session", s) \| (idStr,"online",unstripped) <- twoWords s	737	("session", s) \| (idStr,"online",unstripped) <- twoWords s
725	, stripped <- strp unstripped	738	, stripped <- strp unstripped
726	-> cmd0 $	739	-> cmd0 $ do
727	hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendOnline"	740	lrSession <- strToSession idStr
		741	case lrSession of
		742	Left s -> hPutClient h s
		743	Right session -> do
		744	case mbTox of
		745	Nothing -> hPutClient h "Requires Tox enabled."
		746	Just tox-> do
		747	Tox.sendOnline (Tox.toxCryptoKeys tox) session
		748	hPutClient h "sent ONLINE"
728	-- session <N> online	749	-- session <N> online
729	-- send OFFLINE packet to session N	750	-- send OFFLINE packet to session N
730	("session", s) \| (idStr,"offline",unstripped) <- twoWords s	751	("session", s) \| (idStr,"offline",unstripped) <- twoWords s
731	, stripped <- strp unstripped	752	, stripped <- strp unstripped
732	-> cmd0 $	753	-> cmd0 $ do
733	hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendOffline"	754	lrSession <- strToSession idStr
		755	case lrSession of
		756	Left s -> hPutClient h s
		757	Right session -> do
		758	case mbTox of
		759	Nothing -> hPutClient h "Requires Tox enabled."
		760	Just tox-> do
		761	Tox.sendOffline (Tox.toxCryptoKeys tox) session
		762	hPutClient h "sent OFFLINE"
734	-- session <N> kill	763	-- session <N> kill
735	-- send KILL packet to session N	764	-- send KILL packet to session N
736	("session", s) \| (idStr,"kill",unstripped) <- twoWords s	765	("session", s) \| (idStr,"kill",unstripped) <- twoWords s
737	, stripped <- strp unstripped	766	, stripped <- strp unstripped
738	-> cmd0 $	767	-> cmd0 $ do
739	hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendKill"	768	lrSession <- strToSession idStr
		769	case lrSession of
		770	Left s -> hPutClient h s
		771	Right session -> do
		772	case mbTox of
		773	Nothing -> hPutClient h "Requires Tox enabled."
		774	Just tox-> do
		775	Tox.sendKill (Tox.toxCryptoKeys tox) session
		776	hPutClient h "sent KillPacket"
740	-- session <N> nick <NICKNAME>	777	-- session <N> nick <NICKNAME>
741	-- send NICK packet to session N, setting nick to NICKNAME	778	-- send NICK packet to session N, setting nick to NICKNAME
742	("session", s) \| (idStr,"nick",unstripped) <- twoWords s	779	("session", s) \| (idStr,"nick",unstripped) <- twoWords s
743	, nick <- strp unstripped	780	, nick <- strp unstripped
744	-> cmd0 $	781	-> cmd0 $ do
745	hPutClient h "TODO: parse idStr to get sessionId, lookup session, call setNick with crypto session and nick"	782	lrSession <- strToSession idStr
		783	case lrSession of
		784	Left s -> hPutClient h s
		785	Right session -> do
		786	case mbTox of
		787	Nothing -> hPutClient h "Requires Tox enabled."
		788	Just tox-> do
		789	Tox.setNick (Tox.toxCryptoKeys tox) session (B.pack nick)
		790	hPutClient h "sent NICKNAME"
746	-- session <N> status <STATUS>	791	-- session <N> status <STATUS>
747	-- send USERSTATUS packet to session N, set status to STATUS	792	-- send USERSTATUS packet to session N, set status to STATUS
748	("session", s) \| (idStr,"status",unstripped) <- twoWords s	793	("session", s) \| (idStr,"status",unstripped) <- twoWords s
749	, status <- strp unstripped	794	, statusStr <- strp unstripped
750	-> cmd0 $	795	-> cmd0 $ do
751	hPutClient h "TODO: parse idStr to get sessionId, parse status, call setStatus"	796	lrSession <- strToSession idStr
		797	case lrSession of
		798	Left s -> hPutClient h s
		799	Right session -> do
		800	case mbTox of
		801	Nothing -> hPutClient h "Requires Tox enabled."
		802	Just tox-> do
		803	case readMaybe statusStr of
		804	Nothing -> hPutClient h "Unable to parse status"
		805	Just status -> do
		806	Tox.setStatus (Tox.toxCryptoKeys tox) session status
		807	hPutClient h "sent USERSTATUS"
752	-- session <N> typing <TYPINGSTATUS>	808	-- session <N> typing <TYPINGSTATUS>
753	-- send TYPING packet to session N, set typing to TYPINGSTATUS	809	-- send TYPING packet to session N, set typing to TYPINGSTATUS
754	("session", s) \| (idStr,"typing",unstripped) <- twoWords s	810	("session", s) \| (idStr,"typing",unstripped) <- twoWords s
755	, typingstatus <- strp unstripped	811	, typingstatus <- strp unstripped
756	-> cmd0 $	812	-> cmd0 $ do
757	hPutClient h "TODO: parse idStr to get sessionId, parse typing status, call setTyping"	813	lrSession <- strToSession idStr
		814	case lrSession of
		815	Left s -> hPutClient h s
		816	Right session -> do
		817	case mbTox of
		818	Nothing -> hPutClient h "Requires Tox enabled."
		819	Just tox-> do
		820	case readMaybe typingstatus of
		821	Nothing -> hPutClient h "Unable to parse status"
		822	Just status -> do
		823	Tox.setTyping (Tox.toxCryptoKeys tox) session status
		824	hPutClient h "sent TYPINGSTATUS"
758	-- session <N> statusmsg <MSG>	825	-- session <N> statusmsg <MSG>
759	-- send STATUSMESSAGE packet to session N, setting status message to MSG	826	-- send STATUSMESSAGE packet to session N, setting status message to MSG
760	("session", s) \| (idStr,"statusmsg",statusmsg) <- twoWords s	827	("session", s) \| (idStr,"statusmsg",statusmsg) <- twoWords s
761	-> cmd0 $	828	-> cmd0 $ do
762	hPutClient h "TODO: parse idStr to get sessionId, call setStatusMsg"	829	lrSession <- strToSession idStr
		830	case lrSession of
		831	Left s -> hPutClient h s
		832	Right session -> do
		833	case mbTox of
		834	Nothing -> hPutClient h "Requires Tox enabled."
		835	Just tox-> do
		836	Tox.setStatusMsg (Tox.toxCryptoKeys tox) session (B.pack statusmsg)
		837	hPutClient h "sent STATUSMESSAGE"
763		838
764	("onion", s) -> cmd0 $ join $ atomically $ do	839	("onion", s) -> cmd0 $ join $ atomically $ do
765	rm <- readTVar $ routeMap onionRouter	840	rm <- readTVar $ routeMap onionRouter