summaryrefslogtreecommitdiff
path: root/src/Erebos/Network
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-07-23 21:12:04 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-07-24 21:09:21 +0200
commitf419207d9a1cb2749bea3bc07b36a00a8b656079 (patch)
tree708a66ba2fc02074c7646297444a69454dc59cf5 /src/Erebos/Network
parent4c1e51c54d06da32327883cc6f48afb71fa34648 (diff)
Move InetAddress to separate module
Diffstat (limited to 'src/Erebos/Network')
-rw-r--r--src/Erebos/Network/Address.hs65
1 files changed, 65 insertions, 0 deletions
diff --git a/src/Erebos/Network/Address.hs b/src/Erebos/Network/Address.hs
new file mode 100644
index 0000000..63f6af1
--- /dev/null
+++ b/src/Erebos/Network/Address.hs
@@ -0,0 +1,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