ServerC module provides a conduits interface for doServer

1 files changed, 38 insertions, 0 deletions

diff --git a/Presence/SocketLike.hs b/Presence/SocketLike.hs
new file mode 100644
index 00000000..12fa07a3
--- /dev/null
+++ b/Presence/SocketLike.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module SocketLike
+    ( SocketLike
+    , getSocketName
+    , getPeerName
+    , getPeerCred
+    , socketPort
+    , RestrictedSocket
+    , restrictSocket
+    , PortNumber
+    , SockAddr
+    , CUInt
+    ) where
+
+import Network.Socket 
+    ( PortNumber
+    , SockAddr
+    )
+import Foreign.C.Types ( CUInt )
+
+import qualified Network.Socket as NS
+
+class SocketLike sock where
+    getSocketName :: sock -> IO SockAddr
+    getPeerName   :: sock -> IO SockAddr
+    getPeerCred   :: sock -> IO (CUInt, CUInt, CUInt)
+    socketPort    :: sock -> IO PortNumber
+
+instance SocketLike NS.Socket where
+    getSocketName = NS.getSocketName
+    getPeerName   = NS.getPeerName
+    getPeerCred   = NS.getPeerCred
+    socketPort    = NS.socketPort
+
+newtype RestrictedSocket = Restricted NS.Socket deriving SocketLike
+
+restrictSocket :: NS.Socket -> RestrictedSocket
+restrictSocket socket = Restricted socket