summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network.hs10
-rw-r--r--src/Test.hs7
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)])