Refactoring for tox/mainline code-sharing.

2 files changed, 45 insertions, 38 deletions

diff --git a/Mainline.hs b/Mainline.hs
index 6aa1c517..77c0d5f1 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -29,7 +29,7 @@ import qualified Data.ByteArray               as BA
 import qualified Data.ByteString              as B
          ;import Data.ByteString              (ByteString)
 import qualified Data.ByteString.Base16       as Base16
-import qualified Data.ByteString.Char8        as Char8
+import qualified Data.ByteString.Char8        as C8
 import Data.ByteString.Lazy                   (toStrict)
 import qualified Data.ByteString.Lazy.Char8   as L8
 import Data.Char
@@ -55,7 +55,8 @@ import Debug.Trace
 import Kademlia
 import Network.Address                        (Address, fromAddr, fromSockAddr,
                                                setPort, sockAddrPort, testIdBit,
-                                               toSockAddr, genBucketSample')
+                                               toSockAddr, genBucketSample', WantIP(..),
+                                               un4map,either4or6,ipFamily)
 import Network.BitTorrent.DHT.ContactInfo     as Peers
 import Network.BitTorrent.DHT.Search          (Search (..))
 import Network.BitTorrent.DHT.Token           as Token
@@ -92,7 +93,7 @@ instance BEncode NodeId where
     toBEncode (NodeId bs) = toBEncode bs
 
 instance Show NodeId where
-    show (NodeId bs) = Char8.unpack $ Base16.encode bs
+    show (NodeId bs) = C8.unpack $ Base16.encode bs
 
 instance S.Serialize NodeId where
     get = NodeId <$> S.getBytes 20
@@ -103,7 +104,7 @@ instance FiniteBits NodeId where
 
 instance Read NodeId where
     readsPrec _ str
-        | (bs, xs) <- Base16.decode $ Char8.pack str
+        | (bs, xs) <- Base16.decode $ C8.pack str
         , B.length bs == 20
                     = [ (NodeId bs, drop 40 str) ]
         | otherwise = []
@@ -143,7 +144,7 @@ instance FromJSON NodeInfo where
         portnum <- v JSON..: "port"
         ip <- maybe empty (return . IPv6) (ip6str >>= readMaybe)
               <|> maybe empty (return . IPv4) (ip4str >>= readMaybe)
-        let (bs,_) = Base16.decode (Char8.pack nidstr)
+        let (bs,_) = Base16.decode (C8.pack nidstr)
         guard (B.length bs == 20)
         return $ NodeInfo (NodeId bs) ip (fromIntegral (portnum :: Word16))
 
@@ -159,7 +160,7 @@ instance Read NodeInfo where
         nodeidAt = do hexhash <- sequence $ replicate n (RP.satisfy hexdigit)
                       RP.char '@' RP.+++ RP.satisfy isSpace
                       addrstr <- parseAddr
-                      nid <- case Base16.decode $ Char8.pack hexhash of
+                      nid <- case Base16.decode $ C8.pack hexhash of
                               (bs,_) | B.length bs==20 -> return (NodeId bs)
                               _                        -> fail "Bad node id."
                       return (nid,addrstr)
@@ -360,12 +361,6 @@ encodeMessage (R origin tid v ip)
         Right (BDict vals) -> encodeResponse tid (BDict $ genericArgs origin False `BE.union` vals) ip
         Left  err          -> encodeError tid err
 
-either4or6 :: SockAddr -> Either SockAddr SockAddr
-either4or6 a4@(SockAddrInet port addr)         = Left a4
-either4or6 a6@(SockAddrInet6 port _ addr _)
-    | Just ip4 <- (fromSockAddr a6 >>= un4map) = Left (setPort port $ toSockAddr ip4)
-    | otherwise                                = Right a6
-
 
 encodeAddr :: SockAddr -> ByteString
 encodeAddr = either encode4 encode6 . either4or6
@@ -733,9 +728,6 @@ instance BEncode Ping where
   toBEncode Ping = toDict endDict
   fromBEncode _  = pure Ping
 
-data WantIP = Want_IP4 | Want_IP6 | Want_Both
- deriving (Eq, Enum, Ord, Show)
-
 wantList :: WantIP -> [ByteString]
 wantList Want_IP4  = ["ip4"]
 wantList Want_IP6  = ["ip6"]
@@ -791,31 +783,9 @@ binary get k = field (req k) >>= either (fail . format) return .
 pingH :: NodeInfo -> Ping -> IO Pong
 pingH _ Ping = return Pong
 
--- | True if the argument is an IPv4-mapped address with prefix ::FFFF:0:0/96
--- as defined in RFC 4291.
-is4mapped :: IPv6 -> Bool
-is4mapped ip
-    | [0,0,0,0,0,0xffff,_,_] <- fromIPv6 ip
-                = True
-    | otherwise = False
-
-un4map :: IPv6 -> Maybe IPv4
-un4map ip
-    | [0,0,0,0,0,0xffff,x,y] <- fromIPv6 ip
-                = Just $ toIPv4
-                       $ map (.&. 0xFF)
-                             [x `shiftR` 8, x, y `shiftR` 8, y ]
-    | otherwise = Nothing
-
 prefer4or6 :: NodeInfo -> Maybe WantIP -> WantIP
 prefer4or6 addr iptyp = fromMaybe (ipFamily $ nodeIP addr) iptyp
 
-ipFamily :: IP -> WantIP
-ipFamily ip = case ip of
-    IPv4 _               -> Want_IP4
-    IPv6 a | is4mapped a -> Want_IP4
-           | otherwise   -> Want_IP6
-
 findNodeH :: Routing -> NodeInfo -> FindNode -> IO NodeFound
 findNodeH routing addr (FindNode node iptyp) = do
     let preferred = prefer4or6 addr iptyp
@@ -1035,7 +1005,7 @@ mainlineSend meth unwrap msg client nid addr = do
         { methodTimeout  = 5
         , method         = meth
         , wrapQuery      = encodeQueryPayload meth (isReadonlyClient client)
-        , unwrapResponse = (>>= either (Left . Error GenericError . Char8.pack)
+        , unwrapResponse = (>>= either (Left . Error GenericError . C8.pack)
                                        (Right . unwrap)
                                        . BE.fromBEncode)
                            . rspPayload
diff --git a/src/Network/Address.hs b/src/Network/Address.hs
index 8715a82d..cc06ac0d 100644
--- a/src/Network/Address.hs
+++ b/src/Network/Address.hs
@@ -35,6 +35,11 @@ module Network.Address
        , IPv4
        , IPv6
        , IP (..)
+       , un4map
+       , WantIP (..)
+       , ipFamily
+       , is4mapped
+       , either4or6
 
          -- * PeerId
          -- $peer-id
@@ -1180,3 +1185,35 @@ getBindAddress listenPortString enabled6 = do
                   else SockAddrInet (parsePort listenPortString) iNADDR_ANY
                     where parsePort s = fromMaybe 0 $ readMaybe s
     return listenAddr
+
+-- | True if the argument is an IPv4-mapped address with prefix ::FFFF:0:0/96
+-- as defined in RFC 4291.
+is4mapped :: IPv6 -> Bool
+is4mapped ip
+    | [0,0,0,0,0,0xffff,_,_] <- fromIPv6 ip
+                = True
+    | otherwise = False
+
+un4map :: IPv6 -> Maybe IPv4
+un4map ip
+    | [0,0,0,0,0,0xffff,x,y] <- fromIPv6 ip
+                = Just $ toIPv4
+                       $ L.map (.&. 0xFF)
+                               [x `shiftR` 8, x, y `shiftR` 8, y ]
+    | otherwise = Nothing
+
+ipFamily :: IP -> WantIP
+ipFamily ip = case ip of
+    IPv4 _               -> Want_IP4
+    IPv6 a | is4mapped a -> Want_IP4
+           | otherwise   -> Want_IP6
+
+either4or6 :: SockAddr -> Either SockAddr SockAddr
+either4or6 a4@(SockAddrInet port addr)         = Left a4
+either4or6 a6@(SockAddrInet6 port _ addr _)
+    | Just ip4 <- (fromSockAddr a6 >>= un4map) = Left (setPort port $ toSockAddr ip4)
+    | otherwise                                = Right a6
+
+data WantIP = Want_IP4 | Want_IP6 | Want_Both
+ deriving (Eq, Enum, Ord, Show)
+