diff options
| -rw-r--r-- | src/Network.hs | 10 | ||||
| -rw-r--r-- | 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)]) |