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
|
module Erebos.Network.Address (
InetAddress(..),
inetFromSockAddr,
inetToSockAddr,
SockAddr, PortNumber,
) where
import Data.Bifunctor
import Data.IP qualified as IP
import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable as F
import Network.Socket
import Text.Read
newtype InetAddress = InetAddress { fromInetAddress :: IP.IP }
deriving (Eq, Ord)
instance Show InetAddress where
show (InetAddress ipaddr)
| IP.IPv6 ipv6 <- ipaddr
, ( 0, 0, 0xffff, ipv4 ) <- IP.fromIPv6w ipv6
= show (IP.toIPv4w ipv4)
| otherwise
= show ipaddr
instance Read InetAddress where
readPrec = do
readPrec >>= return . InetAddress . \case
IP.IPv4 ipv4 -> IP.IPv6 $ IP.toIPv6w ( 0, 0, 0xffff, IP.fromIPv4w ipv4 )
ipaddr -> ipaddr
readListPrec = readListPrecDefault
instance F.Storable InetAddress where
sizeOf _ = sizeOf (undefined :: CInt) + 16
alignment _ = 8
peek ptr = (unpackFamily <$> peekByteOff ptr 0) >>= \case
AF_INET -> InetAddress . IP.IPv4 . IP.fromHostAddress <$> peekByteOff ptr (sizeOf (undefined :: CInt))
AF_INET6 -> InetAddress . IP.IPv6 . IP.toIPv6b . map fromIntegral <$> peekArray 16 (ptr `plusPtr` sizeOf (undefined :: CInt) :: Ptr Word8)
_ -> fail "InetAddress: unknown family"
poke ptr (InetAddress addr) = case addr of
IP.IPv4 ip -> do
pokeByteOff ptr 0 (packFamily AF_INET)
pokeByteOff ptr (sizeOf (undefined :: CInt)) (IP.toHostAddress ip)
IP.IPv6 ip -> do
pokeByteOff ptr 0 (packFamily AF_INET6)
pokeArray (ptr `plusPtr` sizeOf (undefined :: CInt) :: Ptr Word8) (map fromIntegral $ IP.fromIPv6b ip)
inetFromSockAddr :: SockAddr -> Maybe ( InetAddress, PortNumber )
inetFromSockAddr saddr = first InetAddress <$> IP.fromSockAddr saddr
inetToSockAddr :: ( InetAddress, PortNumber ) -> SockAddr
inetToSockAddr = IP.toSockAddr . first fromInetAddress
|