From ebe2292bc4bd19ec68935c2135160ca6aa0dbae3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 6 May 2023 22:35:37 +0200
Subject: Initial IPv6 support

---
 src/Network.hs | 10 +++++++++-
 src/Test.hs    |  7 +------
 2 files changed, 10 insertions(+), 7 deletions(-)

diff --git a/src/Network.hs b/src/Network.hs
index be6fa09..14adad6 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -28,6 +28,7 @@ import Control.Monad.State
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
 import Data.Function
+import Data.IP qualified as IP
 import Data.List
 import Data.Map (Map)
 import qualified Data.Map as M
@@ -130,7 +131,13 @@ data PeerAddress = DatagramAddress Socket SockAddr
                  | PeerIceSession IceSession
 
 instance Show PeerAddress where
-    show (DatagramAddress _ addr) = show addr
+    show (DatagramAddress _ saddr) = unwords $ case IP.fromSockAddr saddr of
+        Just (IP.IPv6 ipv6, port)
+            | (0, 0, 0xffff, ipv4) <- IP.fromIPv6w ipv6
+            -> [show (IP.toIPv4w ipv4), show port]
+        Just (addr, port)
+            -> [show addr, show port]
+        _ -> [show saddr]
     show (PeerIceSession ice) = show ice
 
 instance Eq PeerAddress where
@@ -374,6 +381,7 @@ startServer opt origHead logd' services = do
     void $ forkIO $ withSocketsDo $ do
         let hints = defaultHints
               { addrFlags = [AI_PASSIVE]
+              , addrFamily = AF_INET6
               , addrSocketType = Datagram
               }
         addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort opt)
diff --git a/src/Test.hs b/src/Test.hs
index f9f764b..a7dd730 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -14,7 +14,6 @@ import Data.ByteString qualified as B
 import Data.ByteString.Char8 qualified as BC
 import Data.ByteString.Lazy qualified as BL
 import Data.Foldable
-import Data.IP (fromSockAddr)
 import Data.Ord
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -332,11 +331,7 @@ cmdStartServer = do
         let printPeer (idx, p) = do
                 params <- peerIdentity p >>= return . \case
                     PeerIdentityFull pid -> ("id":) $ map (maybe "<unnamed>" T.unpack . idName) (unfoldOwners pid)
-                    _ -> ("addr":) $ case peerAddress p of
-                        DatagramAddress _ saddr
-                            | Just (addr, port) <- fromSockAddr saddr -> [show addr, show port]
-                            | otherwise -> []
-                        PeerIceSession ice -> [show ice]
+                    _ -> [ "addr", show (peerAddress p) ]
                 outLine out $ unwords $ [ "peer", show idx ] ++ params
 
             update (nid, []) = printPeer (nid, peer) >> return (nid + 1, [(nid, peer)])
-- 
cgit v1.2.3