started project

1 files changed, 81 insertions, 0 deletions

diff --git a/Presence/Server.hs b/Presence/Server.hs
new file mode 100644
index 00000000..c41f047f
--- /dev/null
+++ b/Presence/Server.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module Server where
+
+import Network.Socket
+import qualified Data.ByteString as S (ByteString)
+import Data.ByteString.Lazy.Char8 as L 
+    ( ByteString
+    , hPutStrLn
+    , fromChunks
+    , putStrLn )
+import Data.ByteString.Char8 
+    ( hGetNonBlocking
+    )
+import System.IO 
+    ( Handle
+    , IOMode(..)
+    , hSetBuffering
+    , BufferMode(..)
+    , hWaitForInput
+    , hClose
+    , hIsEOF
+    )
+import Control.Monad
+import Control.Monad.Fix (fix)
+import Todo
+import Control.Concurrent (forkIO)
+import Control.Exception (handle,SomeException(..))
+import Data.HList
+import Data.HList.TypeEqGeneric1()
+import Data.HList.TypeCastGeneric1()
+
+
+newtype ConnId = ConnId Int
+  deriving Eq
+
+newtype ConnectionFinalizer = ConnectionFinalizer (IO ())
+
+getPacket h = do { hWaitForInput h (-1) ; fmap (fromChunks . (:[])) $ hGetNonBlocking h 1024 }
+
+{-
+doServer ::
+  HList st 
+  => PortNumber :*: st
+      -> ( Handle :*: ConnId :*: PortNumber :*: st
+            -> S.ByteString 
+            -> (() -> IO ()) 
+            -> IO () )
+      -> IO b
+-}
+doServer port g startCon = runServer2 port (runConn2 g)
+ where
+    runConn2 g st (sock,_) = do
+        h <- socketToHandle sock ReadWriteMode
+        hSetBuffering h NoBuffering
+        st'' <- startCon (h .*. st)
+        handle (\(SomeException _) -> return ()) $ fix $ \loop -> do
+            let continue () = hIsEOF h >>= flip when loop . not
+            packet <- getPacket h
+            g st'' packet continue
+        let ConnectionFinalizer cleanup = hOccursFst st''
+        cleanup
+        hClose h
+
+    {-
+    runServer2 ::
+      Num num =>
+      PortNumber -> (num -> (Socket, SockAddr) -> IO b -> IO b) -> IO b
+    -}
+    runServer2 st@(HCons port _) go = do
+        sock <- socket AF_INET Stream 0
+        setSocketOption sock ReuseAddr 1
+        bindSocket sock (SockAddrInet port iNADDR_ANY)
+        listen sock 2
+        mainLoop sock (ConnId 0) go
+     where
+        mainLoop sock idnum@(ConnId n) go = do
+            con <- accept sock
+            forkIO $ go (idnum .*. st) con 
+            mainLoop sock (ConnId (n+1)) go
+