diff options
Diffstat (limited to 'Connection.hs')
-rw-r--r-- | Connection.hs | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/Connection.hs b/Connection.hs index a7e5d4cc..9a4077f5 100644 --- a/Connection.hs +++ b/Connection.hs | |||
@@ -5,8 +5,11 @@ module Connection where | |||
5 | import Control.Applicative | 5 | import Control.Applicative |
6 | import Control.Arrow | 6 | import Control.Arrow |
7 | import Control.Concurrent.STM | 7 | import Control.Concurrent.STM |
8 | import Data.Bits | ||
9 | import Data.Word | ||
8 | import qualified Data.Map as Map | 10 | import qualified Data.Map as Map |
9 | ;import Data.Map (Map) | 11 | ;import Data.Map (Map) |
12 | import Network.Socket (SockAddr(..)) | ||
10 | 13 | ||
11 | import PingMachine | 14 | import PingMachine |
12 | 15 | ||
@@ -34,6 +37,43 @@ data Connection status = Connection | |||
34 | } | 37 | } |
35 | deriving Functor | 38 | deriving Functor |
36 | 39 | ||
40 | -- | A 'PeerAddress' identifies an active session. For inactive sessions, multiple | ||
41 | -- values may be feasible. | ||
42 | |||
43 | -- We use a 'SockAddr' as it is convenient for TCP and UDP connections. But if | ||
44 | -- that is not your use case, see 'uniqueAsKey'. | ||
45 | newtype PeerAddress = PeerAddress { peerAddress :: SockAddr } | ||
46 | deriving (Eq,Ord,Show) | ||
47 | |||
48 | -- | A 24-byte word. | ||
49 | data Uniq24 = Uniq24 !Word64 !Word64 !Word64 | ||
50 | deriving (Eq,Ord,Show) | ||
51 | |||
52 | -- | Coerce a 'Uniq24' to a useable 'PeerAddress'. Note that this stores the | ||
53 | -- special value 0 into the port number of the underlying 'SockAddr' and thus | ||
54 | -- should be compatible for mixing together with TCP/UDP peers. | ||
55 | uniqueAsKey :: Uniq24 -> PeerAddress | ||
56 | uniqueAsKey (Uniq24 x y z) = PeerAddress $ SockAddrInet6 (fromIntegral 0) a bcde f | ||
57 | where | ||
58 | a = fromIntegral (x `shiftR` 32) | ||
59 | b = fromIntegral x | ||
60 | c = fromIntegral (y `shiftR` 32) | ||
61 | d = fromIntegral y | ||
62 | e = fromIntegral (z `shiftR` 32) | ||
63 | f = fromIntegral z | ||
64 | bcde = (b,c,d,e) | ||
65 | |||
66 | -- | Inverse of 'uniqueAsKey' | ||
67 | keyAsUnique :: PeerAddress -> Maybe Uniq24 | ||
68 | keyAsUnique (PeerAddress (SockAddrInet6 0 a bcde f)) = Just $ Uniq24 x y z | ||
69 | where | ||
70 | (b,c,d,e) = bcde | ||
71 | x = (fromIntegral a `shiftL` 32) .|. fromIntegral b | ||
72 | y = (fromIntegral c `shiftL` 32) .|. fromIntegral d | ||
73 | z = (fromIntegral e `shiftL` 32) .|. fromIntegral f | ||
74 | keyAsUniq _ = Nothing | ||
75 | |||
76 | |||
37 | -- | This is an interface to make or query status information about connections | 77 | -- | This is an interface to make or query status information about connections |
38 | -- of a specific kind. | 78 | -- of a specific kind. |
39 | -- | 79 | -- |
@@ -58,6 +98,12 @@ data Manager status k = Manager | |||
58 | , showProgress :: status -> String | 98 | , showProgress :: status -> String |
59 | -- | Show a connection key as a string. | 99 | -- | Show a connection key as a string. |
60 | , showKey :: k -> String | 100 | , showKey :: k -> String |
101 | -- | Obtain an address from a human-friendly name. For TCP/UDP | ||
102 | -- connections, this might be a forward-resolving DNS query. | ||
103 | , resolvePeer :: k -> IO [PeerAddress] | ||
104 | -- | This is the reverse of 'resolvePeer'. For TCP/UDP connections, this | ||
105 | -- might be a reverse-resolve DNS query. | ||
106 | , reverseAddress :: PeerAddress -> IO [k] | ||
61 | } | 107 | } |
62 | 108 | ||
63 | -- | Present status information (visible in a UI) for a connection. | 109 | -- | Present status information (visible in a UI) for a connection. |