Added networking

1 files changed, 48 insertions, 10 deletions

diff --git a/Main.hs b/Main.hs
index 3ebb7d1..56fa613 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,17 +1,55 @@
-module Main where
+module Main (main) where
 
+import Control.Concurrent (forkFinally)
+import qualified Control.Exception as E
+import Control.Monad (unless, forever, void)
+
+import qualified Data.ByteString as S
 import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+
+import Network.Socket
+import Network.Socket.ByteString (recv, sendAll)
 
+import Web.Utils
 import Web.Response
-import Web.Request
 import Web.Router
-import Web.Views
-import Web.Utils
-import Web.Http
-
-table = [ Route indexGet (T.pack "/") GET
-        , Route helloGet (T.pack "/hello") GET ]
+import Routes
 
+main :: IO ()
 main = do
-  response <- resolve table (Request [] (T.pack "/hello") GET)
-  print $ formResponse response
\ No newline at end of file
+  print "Server launched"
+  runTCPServer Nothing "3000" talk
+  where
+    talk s = do
+      msg <- recv s 1024
+      -- print msg
+      print "Got request"
+      unless (S.null msg) $ do
+        let (request, _, _) = parseHttp $ decodeUtf8 msg
+        response <- resolve routesTable $ request
+        sendAll s $ encodeUtf8 (formResponse response)
+    
+
+-- from the "network-run" package.
+runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
+runTCPServer mhost port server = withSocketsDo $ do
+    addr <- resolve
+    E.bracket (open addr) close loop
+  where
+    resolve = do
+        let hints = defaultHints {
+                addrFlags = [AI_PASSIVE]
+              , addrSocketType = Stream
+              }
+        head <$> getAddrInfo (Just hints) mhost (Just port)
+    open addr = do
+        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+        setSocketOption sock ReuseAddr 1
+        withFdSocket sock $ setCloseOnExecIfNeeded
+        bind sock $ addrAddress addr
+        listen sock 1024
+        return sock
+    loop sock = forever $ do
+        (conn, _peer) <- accept sock
+        void $ forkFinally (server conn) (const $ gracefulClose conn 5000)