DNS fixes

1 files changed, 11 insertions, 6 deletions

diff --git a/Presence/DNSCache.hs b/Presence/DNSCache.hs
index 35493b19..854aa6c3 100644
--- a/Presence/DNSCache.hs
+++ b/Presence/DNSCache.hs
@@ -6,6 +6,7 @@ module DNSCache
     , newDNSCache
     , parseAddress
     , strip_brackets
+    , withPort
     ) where
 
 import Control.Concurrent
@@ -40,9 +41,8 @@ data DNSCache =
 
 newDNSCache :: IO DNSCache
 newDNSCache = do
-    atomically $ do
-        fcache <- newTVar Map.empty
-        rcache <- newTVar Map.empty
+        fcache <- newTVarIO Map.empty
+        rcache <- newTVarIO Map.empty
         return DNSCache { fcache=fcache, rcache=rcache }
 
 equivBy f a b = f a == f b
@@ -64,13 +64,14 @@ dnsObserve :: DNSCache -> Bool -> TimeStamp -> [(Text,SockAddr)] -> STM ()
 dnsObserve dns withScrub utc obs = do
     f <- readTVar $ fcache dns
     r <- readTVar $ rcache dns
-    let gs = do
-            g <- groupBy (equivBy fst) $ sortBy (comparing fst) obs
+    let obs' = map (\(n,a)->(n,a `withPort` 0)) obs
+        gs = do
+            g <- groupBy (equivBy fst) $ sortBy (comparing fst) obs'
             (n,_) <- take 1 g
             return (n,map snd g)
         f' = foldl' updatef f gs
         hs = do
-            h <- groupBy (equivBy snd) $ sortBy (comparing snd) obs
+            h <- groupBy (equivBy snd) $ sortBy (comparing snd) obs'
             (_,a) <- take 1 h
             return (a,map fst h)
         r' = foldl' updater r hs
@@ -206,3 +207,7 @@ parseAddress addr_str = do
                         (Just "0")
     return . listToMaybe $ map addrAddress info
 
+withPort :: SockAddr -> Int -> SockAddr
+withPort (SockAddrInet _ a)      port = SockAddrInet (toEnum port) a
+withPort (SockAddrInet6 _ a b c) port = SockAddrInet6 (toEnum port) a b c
+