2 files changed, 92 insertions, 17 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 $
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendOnline"
+                        -> cmd0 $ do
+                            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 $
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendOffline"
+                        -> cmd0 $ do
+                            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 $
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call sendKill"
+                        -> cmd0 $ do
+                            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 $
-                            hPutClient h "TODO: parse idStr to get sessionId, lookup session, call setNick with crypto session and nick"
+                        -> cmd0 $ do
+                            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
-                        -> cmd0 $
-                            hPutClient h "TODO: parse idStr to get sessionId, parse status, call setStatus"
+                        , statusStr  <- strp unstripped
+                        -> cmd0 $ do
+                            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 $
-                            hPutClient h "TODO: parse idStr to get sessionId, parse typing status, call setTyping"
+                        -> cmd0 $ do
+                            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 $
-                            hPutClient h "TODO: parse idStr to get sessionId, call setStatusMsg"
+                        -> cmd0 $ do
+                            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
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 40288502..141ef792 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -204,9 +204,9 @@ instance Serialize CryptoData where
 --
 -- The Enum instance on 'UserStatus' is not arbitrary.  It corresponds
 -- to on-the-wire id numbers.
-data UserStatus = Online | Away | Busy deriving (Show,Eq,Ord,Enum)
+data UserStatus = Online | Away | Busy deriving (Show,Read,Eq,Ord,Enum)
 
-data TypingStatus = NotTyping | Typing deriving (Show,Eq,Ord,Enum)
+data TypingStatus = NotTyping | Typing deriving (Show,Read,Eq,Ord,Enum)
 
 data CryptoMessage
         = OneByte  { msgID :: MessageID }