module Net.Servers where
import Control.Monad(unless)
import Data.Char(isPrint,isAscii)
import Data.Maybe(fromJust)

import Net.Concurrent
import Net.ClientInterface
import Net.Interface as Net
import qualified Net.TCP_Client as TCP
import qualified Net.UDP_Client as UDP
import qualified Net.PortNumber as Port
import Monad.Util
import Net.Packet(outLen,loopbackout)
import Net.PacketParsing(doParse,doUnparse)

tcpEchoServer :: ([Char] -> m a) -> Net m -> m b
tcpEchoServer [Char] -> m a
debug Net m
net = Passive m -> m b
forall {b}. Passive m -> m b
server (Passive m -> m b) -> m (Passive m) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Interface m -> Port -> m (Passive m)
forall (m :: * -> *). Interface m -> Port -> m (Passive m)
TCP.listen (Net m -> Interface m
forall (m :: * -> *). Net m -> Interface m
tcp Net m
net) Port
Port.echo
  where
    server :: Passive m -> m b
server Passive m
socket = m ThreadId -> m b
forall {m :: * -> *} {a} {b}. Monad m => m a -> m b
loop (m ThreadId -> m b) -> m ThreadId -> m b
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (m () -> m ThreadId)
-> ((Peer, Active m) -> m ()) -> (Peer, Active m) -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peer, Active m) -> m ()
forall {a}. Show a => (a, Active m) -> m ()
echo ((Peer, Active m) -> m ThreadId)
-> m (Peer, Active m) -> m ThreadId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Passive m -> m (Peer, Active m)
forall (m :: * -> *). Passive m -> m (Peer, Active m)
TCP.accept Passive m
socket

    echo :: (a, Active m) -> m ()
echo (a
peer,Active m
con) =
      do [Char] -> m a
debug ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"echo server accepted a connection from "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
peer
	 m ()
loop
	 [Char] -> m a
debug ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"echo server closing connection to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
peer
	 Active m -> m ()
forall (m :: * -> *). Active m -> m ()
TCP.close Active m
con
      where
        loop :: m ()
loop = do OutPacket
p <- InPacket -> OutPacket
loopbackout (InPacket -> OutPacket) -> m InPacket -> m OutPacket
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Active m -> m InPacket
forall {m :: * -> *}. Active m -> m InPacket
TCP.rx Active m
con
		  let n :: Int
n=OutPacket -> Int
outLen OutPacket
p
	          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
		    do [Char] -> m a
debug ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"echo server echoing "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" bytes"
		       Active m -> OutPacket -> m ()
forall {m :: * -> *}. Active m -> OutPacket -> m ()
TCP.tx Active m
con OutPacket
p
		       m ()
loop

udpEchoServer :: ([Char] -> m a) -> Net m -> m b
udpEchoServer [Char] -> m a
debug Net m
net = TimedInterface m (Addr, Packet InPacket) (Addr, Packet OutPacket)
-> m b
forall {a} {b}.
Show a =>
TimedInterface m (a, Packet InPacket) (a, Packet OutPacket) -> m b
server (TimedInterface m (Addr, Packet InPacket) (Addr, Packet OutPacket)
 -> m b)
-> m (TimedInterface
        m (Addr, Packet InPacket) (Addr, Packet OutPacket))
-> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Interface m
-> Port
-> m (TimedInterface
        m (Addr, Packet InPacket) (Addr, Packet OutPacket))
forall (m :: * -> *). Interface m -> Port -> m (UDP_API m)
UDP.listen (Net m -> Interface m
forall (m :: * -> *). Net m -> Interface m
udp Net m
net) Port
Port.echo
  where
    server :: TimedInterface m (a, Packet InPacket) (a, Packet OutPacket) -> m b
server TimedInterface m (a, Packet InPacket) (a, Packet OutPacket)
iface = m () -> m b
forall {m :: * -> *} {a} {b}. Monad m => m a -> m b
loop (m () -> m b) -> m () -> m b
forall a b. (a -> b) -> a -> b
$ Maybe (a, Packet InPacket) -> m ()
echo (Maybe (a, Packet InPacket) -> m ())
-> m (Maybe (a, Packet InPacket)) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TimedInterface m (a, Packet InPacket) (a, Packet OutPacket)
-> Maybe Int -> m (Maybe (a, Packet InPacket))
forall (m :: * -> *) i o.
TimedInterface m i o -> Maybe Int -> m (Maybe i)
rxT TimedInterface m (a, Packet InPacket) (a, Packet OutPacket)
iface Maybe Int
forall a. Maybe a
Nothing
      where
	echo :: Maybe (a, Packet InPacket) -> m ()
echo (Just (a
srcIP,Packet InPacket
udpP)) =
	    do [Char] -> m a
debug ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"replying to UDP echo request from "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
srcIP
	       TimedInterface m (a, Packet InPacket) (a, Packet OutPacket)
-> (a, Packet OutPacket) -> m ()
forall (m :: * -> *) i o. TimedInterface m i o -> o -> m ()
txT TimedInterface m (a, Packet InPacket) (a, Packet OutPacket)
iface (a
srcIP,InPacket -> OutPacket
loopbackout (InPacket -> OutPacket) -> Packet InPacket -> Packet OutPacket
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Packet InPacket
reply)
	  where
	    reply :: Packet InPacket
reply = Packet InPacket
udpP{UDP.sourcePort=Port.echo,
			 UDP.destPort=UDP.sourcePort udpP}

simpleTCPServer :: ([Char] -> m a)
-> Net m -> Port -> (Interface m (Maybe a) o -> m a) -> m b
simpleTCPServer [Char] -> m a
debug Net m
net Port
port Interface m (Maybe a) o -> m a
simpleServer =
    Passive m -> m b
forall {b}. Passive m -> m b
listener (Passive m -> m b) -> m (Passive m) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Interface m -> Port -> m (Passive m)
forall (m :: * -> *). Interface m -> Port -> m (Passive m)
TCP.listen (Net m -> Interface m
forall (m :: * -> *). Net m -> Interface m
tcp Net m
net) Port
port
  where
    listener :: Passive m -> m b
listener Passive m
socket = m ThreadId -> m b
forall {m :: * -> *} {a} {b}. Monad m => m a -> m b
loop (m ThreadId -> m b) -> m ThreadId -> m b
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (m () -> m ThreadId)
-> ((Peer, Active m) -> m ()) -> (Peer, Active m) -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peer, Active m) -> m ()
forall {a}. Show a => (a, Active m) -> m ()
clientHandler ((Peer, Active m) -> m ThreadId)
-> m (Peer, Active m) -> m ThreadId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Passive m -> m (Peer, Active m)
forall (m :: * -> *). Passive m -> m (Peer, Active m)
TCP.accept Passive m
socket

    clientHandler :: (a, Active m) -> m ()
clientHandler (a
peer,Active m
con) =
      do [Char] -> m a
debug ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"server on "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Port -> [Char]
forall a. Show a => a -> [Char]
show Port
port
		 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" accepted a connection from "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
peer
	 Interface m (Maybe a) o -> m a
simpleServer Interface { rx :: m (Maybe a)
rx=(InPacket -> Maybe a) -> m InPacket -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InPacket -> Maybe a
forall {a}. Parse a => InPacket -> Maybe a
doParse (m InPacket -> m (Maybe a)) -> m InPacket -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Active m -> m InPacket
forall {m :: * -> *}. Active m -> m InPacket
TCP.rx Active m
con,
				  tx :: o -> m ()
tx=Active m -> OutPacket -> m ()
forall {m :: * -> *}. Active m -> OutPacket -> m ()
TCP.tx Active m
con(OutPacket -> m ()) -> (o -> OutPacket) -> o -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.o -> OutPacket
forall {a}. Unparse a => a -> OutPacket
doUnparse}
	 [Char] -> m a
debug ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"server on "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Port -> [Char]
forall a. Show a => a -> [Char]
show Port
port[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" closing connection to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
peer
	 Active m -> m ()
forall (m :: * -> *). Active m -> m ()
TCP.close Active m
con

{- --old:
lineBuffered debug iface =
  do inCh <- newChan
     let getInput = do opts <- rx iface
		       case opts of
		         Just s -> do writeChan inCh s
				      unless (null s) getInput
			 _ -> do debug "Line buffered input parser failure"
				 writeChan inCh []
     fork $ do getInput
	         debug "End of line buffered input"
     lns <- lines . concat . takeWhile (not.null) # getChanContents inCh
     linesCh <- newChan
     fork $ mapM_ (writeChan linesCh) lns >> writeChan linesCh []
     return iface { rx=readChan linesCh }
-}
lineBuffered :: p -> Interface m (Maybe [Char]) o -> m (Interface m [Char] o)
lineBuffered p
debug Interface m (Maybe [Char]) o
iface =
  do v [Char]
bufVar <- [Char] -> m (v [Char])
forall a. a -> m (v a)
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => a -> io (v a)
newMVar []
     let rxloop :: [Char] -> m ([Char], [Char])
rxloop [Char]
buf = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') [Char]
buf of
		        ([Char]
line,Char
'\n':[Char]
buf') -> ([Char], [Char]) -> m ([Char], [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
line,[Char]
buf')
		        ([Char], [Char])
_ -> m ([Char], [Char])
-> ([Char] -> m ([Char], [Char]))
-> Maybe [Char]
-> m ([Char], [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m ([Char], [Char])
rxloop [Char]
buf) ([Char] -> m ([Char], [Char])
rxloop ([Char] -> m ([Char], [Char]))
-> ([Char] -> [Char]) -> [Char] -> m ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
buf[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)) (Maybe [Char] -> m ([Char], [Char]))
-> m (Maybe [Char]) -> m ([Char], [Char])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Interface m (Maybe [Char]) o -> m (Maybe [Char])
forall (m :: * -> *) i o. Interface m i o -> m i
rx Interface m (Maybe [Char]) o
iface
         rxLine :: m [Char]
rxLine = do [Char]
buf <- v [Char] -> m [Char]
forall a. v a -> m a
forall (v :: * -> *) (io :: * -> *) a. MVarIO v io => v a -> io a
takeMVar v [Char]
bufVar
		     ([Char]
line,[Char]
buf') <- [Char] -> m ([Char], [Char])
rxloop [Char]
buf
		     v [Char] -> [Char] -> m ()
forall a. v a -> a -> m ()
forall (v :: * -> *) (io :: * -> *) a.
MVarIO v io =>
v a -> a -> io ()
putMVar v [Char]
bufVar [Char]
buf'
		     [Char] -> m [Char]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
line
     Interface m [Char] o -> m (Interface m [Char] o)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Interface m (Maybe [Char]) o
iface { rx=rxLine }

-- | A simple telnet server for line-based services
telnetServer :: ([Char] -> m a)
-> p -> (Interface m [Char] p -> [Char] -> m a) -> Net m -> m b
telnetServer [Char] -> m a
debug p
prompt Interface m [Char] p -> [Char] -> m a
execute Net m
net =
    ([Char] -> m a)
-> Net m -> Port -> (Interface m (Maybe [Char]) p -> m ()) -> m b
forall {a} {o} {m :: * -> *} {a} {a} {b}.
(Parse a, Unparse o, ForkIO m) =>
([Char] -> m a)
-> Net m -> Port -> (Interface m (Maybe a) o -> m a) -> m b
simpleTCPServer [Char] -> m a
debug Net m
net Port
Port.telnet (Interface m [Char] p -> m ()
server (Interface m [Char] p -> m ())
-> (Interface m (Maybe [Char]) p -> m (Interface m [Char] p))
-> Interface m (Maybe [Char]) p
-> m ()
forall {m :: * -> *} {a} {b} {t}.
Monad m =>
(a -> m b) -> (t -> m a) -> t -> m b
@@ ([Char] -> m a)
-> Interface m (Maybe [Char]) p -> m (Interface m [Char] p)
forall {m :: * -> *} {m :: * -> *} {v :: * -> *} {p} {o}.
(MVarIO v m, MVarIO v m) =>
p -> Interface m (Maybe [Char]) o -> m (Interface m [Char] o)
lineBuffered [Char] -> m a
debug)
  where
    server :: Interface m [Char] p -> m ()
server Interface m [Char] p
iface =
      do [Char] -> m a
debug [Char]
"Telnet server prompting for a command"
	 Interface m [Char] p -> p -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx Interface m [Char] p
iface p
prompt
	 [Char]
s <- Interface m [Char] p -> m [Char]
forall (m :: * -> *) i o. Interface m i o -> m i
rx Interface m [Char] p
iface
	 [Char] -> m a
debug ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
"Got a command: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s
	 if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s Bool -> Bool -> Bool
|| [Char]
s[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"logout\r"
	   then do [Char] -> m a
debug [Char]
"Telnet session ending"
		   () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	   else do let cmd :: [Char]
cmd = [Char
c|Char
c<-[Char]
s,Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
c]
		   Interface m [Char] p -> [Char] -> m a
execute Interface m [Char] p
iface [Char]
cmd
	           Interface m [Char] p -> m ()
server Interface m [Char] p
iface

-- | A simple telnet client for line-based services
telnet :: Interface m [Char] [Char] -> Net m -> Peer -> m ()
telnet Interface m [Char] [Char]
user Net m
net Peer
peer =
     m () -> (Active m -> m ()) -> Maybe (Active m) -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
timeout Active m -> m ()
telnetSession (Maybe (Active m) -> m ()) -> m (Maybe (Active m)) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Interface m -> Peer -> m (Maybe (Active m))
forall (m :: * -> *). Interface m -> Peer -> m (Maybe (Active m))
TCP.connect (Net m -> Interface m
forall (m :: * -> *). Net m -> Interface m
tcp Net m
net) Peer
peer
  where
    timeout :: m ()
timeout = Interface m [Char] [Char] -> [Char] -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx Interface m [Char] [Char]
user [Char]
"Connection attempt timed out\n"

    telnetSession :: Active m -> m ()
telnetSession Active m
iface =
	do Interface m [Char] [Char] -> [Char] -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx Interface m [Char] [Char]
user ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Connected to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Peer -> [Char]
forall a. Show a => a -> [Char]
show Peer
peer[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"
	   r Bool
stopRef <- Bool -> m (r Bool)
forall a. a -> m (r a)
forall (r :: * -> *) (io :: * -> *) a. RefIO r io => a -> io (r a)
newRef Bool
False
	   m () -> m ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$
	     do m Bool -> m ()
forall {m :: * -> *}. Monad m => m Bool -> m ()
repeatM (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ do [Char]
s<- Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Char] -> [Char])
-> (InPacket -> Maybe [Char]) -> InPacket -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InPacket -> Maybe [Char]
forall {a}. Parse a => InPacket -> Maybe a
doParse (InPacket -> [Char]) -> m InPacket -> m [Char]
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Active m -> m InPacket
forall {m :: * -> *}. Active m -> m InPacket
TCP.rx Active m
iface
			     Interface m [Char] [Char] -> [Char] -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx Interface m [Char] [Char]
user [Char]
s
			     Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s
		r Bool -> Bool -> m ()
forall a. r a -> a -> m ()
forall (r :: * -> *) (io :: * -> *) a.
RefIO r io =>
r a -> a -> io ()
writeRef r Bool
stopRef Bool
True
	   m Bool -> m ()
forall {m :: * -> *}. Monad m => m Bool -> m ()
repeatM (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$
	     do [Char]
line <- [Char] -> [Char]
addcr ([Char] -> [Char]) -> m [Char] -> m [Char]
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Interface m [Char] [Char] -> m [Char]
forall (m :: * -> *) i o. Interface m i o -> m i
rx Interface m [Char] [Char]
user
		Bool
stop <- ([Char]
line[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
".\r" Bool -> Bool -> Bool
||) (Bool -> Bool) -> m Bool -> m Bool
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# r Bool -> m Bool
forall a. r a -> m a
forall (r :: * -> *) (io :: * -> *) a. RefIO r io => r a -> io a
readRef r Bool
stopRef
		Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
stop (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Active m -> OutPacket -> m ()
forall {m :: * -> *}. Active m -> OutPacket -> m ()
TCP.tx Active m
iface (OutPacket -> m ()) -> ([Char] -> OutPacket) -> [Char] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> OutPacket
forall {a}. Unparse a => a -> OutPacket
doUnparse ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
line[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"
		Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
stop)
	   Active m -> m ()
forall (m :: * -> *). Active m -> m ()
TCP.close Active m
iface
	   Interface m [Char] [Char] -> [Char] -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx Interface m [Char] [Char]
user ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Connection to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Peer -> [Char]
forall a. Show a => a -> [Char]
show Peer
peer[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" closed\n"
    addcr :: [Char] -> [Char]
addcr [Char]
s = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s Bool -> Bool -> Bool
|| [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
sChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\r' then [Char]
s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\r" else [Char]
s