summaryrefslogtreecommitdiff
path: root/Presence/SocketLike.hs
blob: cf52aca82b9ecb80d3f529514b0326bdf2c6cacc (plain)
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module SocketLike
    ( SocketLike
    , getSocketName
    , getPeerName
    , getPeerCred
    , socketPort
    , sIsConnected
    , sIsBound
    , sIsListening
    , sIsReadable
    , sIsWritable
    , 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
    sIsConnected  :: sock -> IO Bool
    sIsBound      :: sock -> IO Bool
    sIsListening  :: sock -> IO Bool
    sIsReadable   :: sock -> IO Bool
    sIsWritable   :: sock -> IO Bool

instance SocketLike NS.Socket where
    getSocketName = NS.getSocketName
    getPeerName   = NS.getPeerName
    getPeerCred   = NS.getPeerCred
    socketPort    = NS.socketPort
    sIsConnected  = NS.sIsConnected -- warning: this is always False if the socket
                                    --          was converted to a Handle
    sIsBound      = NS.sIsBound
    sIsListening  = NS.sIsListening
    sIsReadable   = NS.sIsReadable
    sIsWritable   = NS.sIsWritable

newtype RestrictedSocket = Restricted NS.Socket deriving SocketLike

restrictSocket :: NS.Socket -> RestrictedSocket
restrictSocket socket = Restricted socket