From 0ef0bfedc65cc67cbe8ad66ab9ae2fb9ae20b7f3 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 29 Jul 2017 03:13:26 -0400
Subject: Refactoring for tox/mainline code-sharing.

---
 Mainline.hs | 46 ++++++++--------------------------------------
 1 file changed, 8 insertions(+), 38 deletions(-)

(limited to 'Mainline.hs')

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
-- 
cgit v1.2.3