Add hashable instances for all address types

2 files changed, 24 insertions, 1 deletions

diff --git a/src/Network/BitTorrent/Core.hs b/src/Network/BitTorrent/Core.hs
index 2ddee517..5717e4de 100644
--- a/src/Network/BitTorrent/Core.hs
+++ b/src/Network/BitTorrent/Core.hs
@@ -9,7 +9,10 @@
 --
 module Network.BitTorrent.Core
        ( module Core
+
+         -- * Address class
        , Address (..)
+       , fromAddr
 
          -- * Re-exports from Data.IP
        , IPv4
@@ -19,6 +22,7 @@ module Network.BitTorrent.Core
 
 import Control.Applicative
 import Data.IP
+import Data.Hashable
 import Data.Serialize
 import Data.Time
 import Data.Typeable
@@ -35,10 +39,14 @@ import Network.BitTorrent.Core.PeerAddr    as Core
 instance Pretty UTCTime where
   pretty = PP.text . show
 
-class (Eq a, Serialize a, Typeable a, Pretty a) => Address a where
+class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
+    => Address a where
   toSockAddr   :: a        -> SockAddr
   fromSockAddr :: SockAddr -> Maybe a
 
+fromAddr :: (Address a, Address b) => a -> Maybe b
+fromAddr = fromSockAddr . toSockAddr
+
 -- | Note that port is zeroed.
 instance Address IPv4 where
   toSockAddr = SockAddrInet 0 . toHostAddress
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 4905f910..d634716c 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -176,6 +176,17 @@ instance Pretty IP where
   pretty = PP.text . show
   {-# INLINE pretty #-}
 
+instance Hashable IPv4 where
+  hashWithSalt = hashUsing toHostAddress
+  {-# INLINE hashWithSalt #-}
+
+instance Hashable IPv6 where
+  hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
+
+instance Hashable IP where
+  hashWithSalt s (IPv4 h) = hashWithSalt s h
+  hashWithSalt s (IPv6 h) = hashWithSalt s h
+
 {-----------------------------------------------------------------------
 --  Peer addr
 -----------------------------------------------------------------------}
@@ -267,6 +278,10 @@ instance Pretty a => Pretty (PeerAddr a) where
     where
       paddr = pretty peerHost <> ":" <> text (show peerPort)
 
+instance Hashable a => Hashable (PeerAddr a) where
+  hashWithSalt s PeerAddr {..} =
+    s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort
+
 -- | Ports typically reserved for bittorrent P2P listener.
 defaultPorts :: [PortNumber]
 defaultPorts =  [6881..6889]