Created
August 9, 2013 03:45
-
-
Save tonyday567/6191029 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} | |
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-unused-do-bind #-} | |
{-| Testing basic tcp server concepts and their interaction with pipes | |
TODO: | |
- [ ] test usage | |
- [ ] port staying open | |
setSocketOption sock ReuseAddr 1 | |
-} | |
module Main where | |
import Control.Monad (forever, when) | |
import Control.Monad.Trans.State.Strict | |
(StateT, get, put, evalStateT) | |
import qualified Data.ByteString.Char8 as C | |
import qualified Data.ByteString as B | |
-- import Data.Maybe (isJust) | |
-- import Data.Foldable (forM_) | |
import System.IO | |
(Handle, hSetBuffering, hPutStr, hGetLine, BufferMode(..)) | |
-- import qualified Network as N | |
import qualified Network.Socket as NS | |
import qualified Network.Simple.TCP as NST | |
import Pipes | |
-- import Pipes.Prelude as P | |
import Pipes.Concurrent | |
-- import Pipes.Lift | |
import Pipes.Network.TCP | |
-- helpers | |
host1p = NST.Host "127.0.0.1" | |
port = show 35660 | |
server :: NST.HostPreference -> NS.ServiceName -> IO () | |
server hp p = NST.serve hp p $ \(sock, _laddr) -> do | |
putStrLn "TCP server up" | |
NS.setSocketOption sock NS.ReuseAddr 1 | |
run (fromSocket sock 4096 >-> toSocket sock) | |
-- event, state | |
type Plug = Maybe (NS.Socket, NS.SockAddr) | |
data Event = Connect -- initially connect to port | |
| Quit -- disconnect | |
| Receive -- print to stdout | |
| Send String -- send a stream | |
help :: IO () | |
help = putStrLn "(c)onnect (q)uit (r)eceive (s)end" | |
logger = putStrLn | |
-- keypress events | |
user :: IO Event | |
user = do | |
command <- getLine | |
case command of | |
"c" -> return Connect | |
"q" -> return Quit | |
"r" -> return Receive | |
('s':xs) -> return $ Send xs | |
_ -> do | |
help | |
user | |
handler :: StateT Plug (Consumer Event IO) () | |
handler = forever $ do | |
event <- lift await | |
case event of | |
Connect -> do | |
h <- get | |
case h of | |
Just _ -> do | |
lift . lift $ logger "handle already exists in state" | |
return () | |
Nothing -> do | |
hp <- lift . lift $ | |
NST.connectSock "127.0.0.1" port | |
put $ Just hp | |
Quit -> do | |
h <- get | |
lift . lift $ logger "What should be done on quit?" | |
Receive -> do | |
h <- get | |
case h of | |
Nothing -> do | |
lift . lift $ logger "Receive request but no socket exists in state, how to now do a Connect?" | |
return () | |
Just hp -> do | |
lift . lift $ logger "getting everything" | |
fromSocket (fst hp) 4096 >-> lift $ B.putStrLn | |
Send x -> do | |
h <- get | |
case h of | |
Nothing -> return () | |
Just hp -> lift . lift $ hPutStr hp x | |
-- uses Pipes.Concurrent gratuitously | |
main :: IO () | |
main = do | |
help | |
forkIO $ server host1p port | |
(input, output) <- spawn Unbounded | |
forkIO $ do run $ lift user >~ toInput input | |
performGC | |
run $ fromOutput output >-> evalStateT handler Nothing | |
return () |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment