Presence/SocketLike.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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