summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--main.hs29
1 files changed, 23 insertions, 6 deletions
diff --git a/main.hs b/main.hs
index 1dbec06..bc62770 100644
--- a/main.hs
+++ b/main.hs
@@ -8,6 +8,12 @@ import Control.Concurrent.Async (race)
import Control.Exception.Base (finally)
import Data.Text (isPrefixOf, pack, replace, unpack)
+import qualified Data.ByteString.Char8 as BS8
+import Network.Wai (requestBody, requestMethod, responseLBS)
+import Network.Wai.Handler.Warp (run)
+import Network.HTTP.Types (status200, status404)
+import Network.HTTP.Types.Header (hContentType)
+import Network.HTTP.Types.Method (methodPost)
nick :: String
nick = "ni"
@@ -21,6 +27,9 @@ server_hostname = "ni.r"
server_port :: PortNumber
server_port = 6667;
+warp_port :: Int
+warp_port = 10080
+
main :: IO ()
main = withSocketsDo $ do
@@ -38,7 +47,7 @@ talk h = do
hSetNewlineMode h universalNewlineMode
hSetBuffering h LineBuffering
handshake h
- _ <- race fromServer toServer
+ _ <- race fromServer (warp h)
return ()
where
fromServer = forever $ do
@@ -48,8 +57,16 @@ talk h = do
hPutStrLn h (unpack (replace "PING" "PONG" (pack line)))
else
print line
- toServer = do
- line <- getLine
- case line of
- ":quit" -> do hPutStrLn h "/quit"; return ()
- _ -> do hPutStrLn h ("PRIVMSG " ++ chan ++ " :" ++ line); toServer
+
+warp :: Handle -> IO ()
+warp h =
+ run warp_port app
+ where
+ app req f =
+ if requestMethod req == methodPost
+ then do
+ s <- requestBody req
+ hPutStrLn h ("PRIVMSG " ++ chan ++ " :" ++ BS8.unpack s)
+ f $ responseLBS status200 [(hContentType, "text/plain")] "OK"
+ else do
+ f $ responseLBS status404 [] ""