summaryrefslogtreecommitdiff
path: root/Presence/SocketLike.hs
blob: af0249ae313a4e33d2c80db657384c355725d61b (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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module SocketLike
    ( SocketLike
    , getSocketName
    , getPeerName
    , getPeerCred
    , socketPort
    , sIsConnected
    , sIsBound
    , sIsListening
    , sIsReadable
    , sIsWritable
    , sClose
    , RestrictedSocket
    , restrictSocket
    , restrictHandleSocket
    , PortNumber
    , SockAddr(..)
    , CUInt
    ) where

import Network.Socket 
    ( PortNumber
    , SockAddr
    )
import Foreign.C.Types ( CUInt )

import qualified Network.Socket as NS
import System.IO (Handle,hClose)

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
    sClose        :: sock -> IO ()

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

    sClose        = NS.sClose

-- newtype RestrictedSocket = Restricted NS.Socket deriving (SocketLike,Show)
data RestrictedSocket = Restricted (Maybe Handle) NS.Socket deriving Show

instance SocketLike RestrictedSocket where
    getSocketName (Restricted mb sock) = NS.getSocketName sock
    getPeerName   (Restricted mb sock) = NS.getPeerName sock
    getPeerCred   (Restricted mb sock) = NS.getPeerCred sock
    socketPort    (Restricted mb sock) = NS.socketPort sock
    sIsConnected  (Restricted mb sock) = NS.sIsConnected sock
    sIsBound      (Restricted mb sock) = NS.sIsBound sock
    sIsListening  (Restricted mb sock) = NS.sIsListening sock
    sIsReadable   (Restricted mb sock) = NS.sIsReadable sock
    sIsWritable   (Restricted mb sock) = NS.sIsWritable sock
    sClose        (Restricted mb sock) = maybe (NS.sClose sock) (\h -> hClose h >> NS.sClose sock) mb

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

restrictHandleSocket :: Handle ->  NS.Socket -> RestrictedSocket
restrictHandleSocket h socket = Restricted (Just h) socket