hstorchat 0.1.0.0 → 0.1.1.0
raw patch · 4 files changed
+45/−48 lines, 4 filesdep ~HUnitdep ~QuickCheckdep ~attoparsec
Dependency ranges changed: HUnit, QuickCheck, attoparsec, base, containers, hsqml, network, process, random, safecopy, socks, tagged, test-framework, test-framework-hunit, test-framework-quickcheck2, text
Files
- hstorchat.cabal +26/−8
- qml/HSTorChat.qml +1/−1
- src/Network/HSTorChat/GUI.hs +3/−3
- src/Network/HSTorChat/Protocol.hs +15/−36
hstorchat.cabal view
@@ -1,5 +1,5 @@ name: hstorchat-version: 0.1.0.0+version: 0.1.1.0 synopsis: Distributed instant messaging over Tor copyright: (c) 2014 Christopher Reichert license: GPL-3@@ -19,9 +19,17 @@ library hs-source-dirs: src default-language: Haskell2010- build-depends: base >=4.6 && <4.7, network,- socks, process, hsqml>=0.3, safecopy, tagged,- attoparsec, text, socks, random, containers+ build-depends: attoparsec == 0.11.*,+ base == 4.*,+ containers >= 0.4 && < 0.6,+ hsqml == 0.3.*,+ network == 2.5.*,+ random == 1.0.*,+ safecopy == 0.8.*,+ socks == 0.5.*,+ tagged == 0.7.*,+ text == 1.1.*+ exposed-modules: Network.HSTorChat.Client, Network.HSTorChat.GUI, Network.HSTorChat.Protocol@@ -30,8 +38,13 @@ main-is: src/Main.hs ghc-options: -Wall -threaded -fno-warn-unused-do-bind default-language: Haskell2010- build-depends: base >=4.6 && <4.7, network, hstorchat, process,- hsqml>=0.3, text, containers+ build-depends: base == 4.*,+ containers >= 0.4 && < 0.6,+ hsqml == 0.3.*,+ hstorchat,+ network == 2.5.*,+ process == 1.2.*,+ text == 1.1.* test-suite hstorchat-tests type: exitcode-stdio-1.0@@ -39,8 +52,13 @@ main-is: Main.hs ghc-options: -Wall default-language: Haskell2010- build-depends: base, hstorchat, test-framework, test-framework-hunit,- test-framework-quickcheck2, HUnit, QuickCheck+ build-depends: base == 4.*,+ hstorchat,+ HUnit == 1.2.*,+ QuickCheck == 2.7.*,+ test-framework == 0.8.*,+ test-framework-hunit == 0.3.*,+ test-framework-quickcheck2 == 0.3.* source-repository head type: git
qml/HSTorChat.qml view
@@ -149,7 +149,7 @@ focus: true wrapMode: TextEdit.Wrap onCursorRectangleChanged: msgentryflick.ensureVisible(cursorRectangle)- Keys.onReturnPressed: { if (buddylist.length <= 0) return+ Keys.onReturnPressed: { if (buddies.length <= 0) return sendMsg(buddies[buddylist.currentIndex], msgentry.text) msgentry.text = "" msgarea.positionViewAtBeginning()
src/Network/HSTorChat/GUI.hs view
@@ -88,8 +88,9 @@ newBuddy :: ObjRef TorChat -> T.Text -> IO () newBuddy tc onion | T.length onion /= 16 = putStrLn $ T.unpack onion ++ " is not 16 characters long."- | otherwise = putStrLn ("Requesting buddy connection: " ++ T.unpack onion) >>- hstorchatOutConn (onion `T.append` ".onion") >>= ping+ | otherwise = do putStrLn ("Requesting buddy connection: " ++ T.unpack onion)+ _ <- forkIO $ hstorchatOutConn (onion `T.append` ".onion") >>= ping+ return () where ping Nothing = putStrLn $ "Error attempting to connect to " ++ T.unpack onion ping (Just oHdl) = do gen <- getStdGen let cky = gencookie gen@@ -99,7 +100,6 @@ modifyMVar_ (_pending tc') $ \p -> return $ PendingConnection cky onion oHdl : filter ((/= onion) . _ponion) p hPutStrLn oHdl $ formatMsg $ Ping (_myonion tc') cky- statusChanged :: ObjRef TorChat -> T.Text -> IO () statusChanged tc status
src/Network/HSTorChat/Protocol.hs view
@@ -117,16 +117,16 @@ buddylist bs = snd . unzip $ M.toList bs parseResponse :: Parser ProtocolMsg-parseResponse = try parsePingPong- <|> try parseVersion- <|> try parseClient- <|> try parseStatus- <|> try parseAddMe- <|> parseMsg+parseResponse = choice [ parsePingPong+ , parseVersion+ , parseClient+ , parseStatus+ , parseAddMe+ , parseMessage+ ] parsePingPong :: Parser ProtocolMsg-parsePingPong = try parsePing- <|> try parsePong+parsePingPong = try parsePing <|> try parsePong parsePing :: Parser ProtocolMsg parsePing = do@@ -140,31 +140,17 @@ return $ Ping bdy cky parsePong :: Parser ProtocolMsg-parsePong = do- string "pong"- skipSpace- -- parse secret key.- key <- takeText- return $ Pong key+parsePong = liftM Pong $ string "pong" >> skipSpace >> takeText parseVersion :: Parser ProtocolMsg-parseVersion = do- string "version"- skipSpace- v <- takeText- return $ Version v+parseVersion = liftM Version $ string "version" >> skipSpace >> takeText parseClient :: Parser ProtocolMsg-parseClient = do- string "client"- skipSpace- c <- takeText- return $ Client c+parseClient = liftM Client $ string "client" >> skipSpace >> takeText parseStatus :: Parser ProtocolMsg parseStatus = do- string "status"- skipSpace+ string "status" >> skipSpace st <- takeText return $ Status (read $ capitalized (T.unpack st) :: BuddyStatus) where@@ -172,14 +158,7 @@ capitalized (x:xs) = C.toUpper x : xs parseAddMe :: Parser ProtocolMsg-parseAddMe = do- string "add_me"- skipSpace- return AddMe+parseAddMe = string "add_me" >> skipSpace >> return AddMe -parseMsg :: Parser ProtocolMsg-parseMsg = do- string "message"- skipSpace- msg <- takeText- return $ Message msg+parseMessage :: Parser ProtocolMsg+parseMessage = liftM Message $ string "message" >> skipSpace >> takeText