Forward port to GHC 8.10.1-alpha2 (83edba07e4)

10 files changed, 113 insertions, 27 deletions

diff --git a/dht/Data/BitSyntax.hs b/dht/Data/BitSyntax.hs
index 6d14d0c1..9ebffe73 100644
--- a/dht/Data/BitSyntax.hs
+++ b/dht/Data/BitSyntax.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP                      #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE TemplateHaskell          #-}
 -- | This module contains fuctions and templates for building up and breaking
 --   down packed bit structures. It's something like Erlang's bit-syntax (or,
 --   actually, more like Python's struct module).
@@ -278,7 +279,11 @@ readElement (stmts, inputname, tuplenames) (Context funcname) = do
   let stmt = BindS (TupP [VarP valname, VarP restname])
                    (AppE (AppE (VarE funcname)
                                (VarE inputname))
+#if MIN_VERSION_template_haskell(2,16,0)
+                         (TupE $ map (Just . VarE) $ reverse tuplenames))
+#else
                          (TupE $ map VarE $ reverse tuplenames))
+#endif
 
   return (stmt : stmts, restname, valname : tuplenames)
 
diff --git a/dht/dht-client.cabal b/dht/dht-client.cabal
index 0da181df..6a449a6a 100644
--- a/dht/dht-client.cabal
+++ b/dht/dht-client.cabal
@@ -27,6 +27,10 @@ description:
 extra-source-files:    ChangeLog
                        cbits/*.h
 
+flag avahi
+  description:         Advertise Tox node on avahi.
+                       Disable to avoid an indirect dependency on lens.
+  default:             True
 
 flag network-uri
   description:         Use network-uri package.
@@ -207,7 +211,6 @@ library
                     , blaze-builder
                     , exceptions
                     , hinotify
-                    , avahi >= 0.2.0
                     , dput-hslogger
                     , word64-map
                     , network-addr
@@ -223,6 +226,9 @@ library
   if impl(ghc < 8)
       Build-depends:  transformers
 
+  if flag(avahi)
+      Build-depends:  avahi >= 0.2.0
+
   if flag(no-constraint-extras)
     build-depends:    dependent-sum < 0.6
   else
@@ -282,11 +288,14 @@ library
         build-depends: cryptonite >= 0.22
 
 executable avahi
-  hs-source-dirs:      examples
-  main-is:             avahi.hs
-  default-language:    Haskell2010
-  build-depends:       base-prelude, dht-client, avahi, network
-  ghc-options:         -fobject-code
+      hs-source-dirs:      examples
+      main-is:             avahi.hs
+  if flag(avahi)
+      default-language:    Haskell2010
+      build-depends:       base-prelude, dht-client, avahi, network
+      ghc-options:         -fobject-code
+  else
+      buildable: False
 
 executable dht
   hs-source-dirs:      examples
diff --git a/dht/examples/dht.hs b/dht/examples/dht.hs
index 3e1b1656..6615477b 100644
--- a/dht/examples/dht.hs
+++ b/dht/examples/dht.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                      #-}
 {-# LANGUAGE NondecreasingIndentation #-}
 import Control.Applicative
 import Control.Monad
@@ -13,6 +14,10 @@ import System.IO
 import System.IO.Unsafe
 import qualified Data.ByteString as B
 
+#if MIN_VERSION_haskeline(0,8,0)
+import Control.Exception (handle)
+#endif
+
 -- | Reads one character.  If it is not a digit,
 -- then it is discarded and 'Nothing' is returned.
 hReadDigit :: Handle -> IO (Maybe Char)
diff --git a/dht/src/Codec/AsciiKey256.hs b/dht/src/Codec/AsciiKey256.hs
index ee17b7c1..1738a368 100644
--- a/dht/src/Codec/AsciiKey256.hs
+++ b/dht/src/Codec/AsciiKey256.hs
@@ -3,6 +3,7 @@ module Codec.AsciiKey256 where
 
 import Control.Applicative
 import Control.Monad
+import Control.Monad.Fail                     as MF
 import Data.Bits
 import qualified Data.ByteArray               as BA
          ;import Data.ByteArray               as BA (ByteArrayAccess)
@@ -112,7 +113,7 @@ readsPrecKey256 publicKey str
         | otherwise = []
 
 
-parseKey256 :: (Monad m, Alternative m) => String -> m ByteString
+parseKey256 :: (MonadFail m, Alternative m) => String -> m ByteString
 parseKey256 nidstr = do
         let nidbs  = C8.pack nidstr
             (bs,_) = Base16.decode nidbs
@@ -121,7 +122,7 @@ parseKey256 nidstr = do
                         43 -> parseToken32 nidstr
                         _  -> Left "Wrong size of key."
         idbs <- (guard (B.length bs == 32) >> return bs)
-                <|> either fail return enid
+                <|> either MF.fail return enid
         return idbs
 
 readP_key256 :: RP.ReadP ByteString
@@ -131,7 +132,7 @@ readP_key256 = do
         , fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit))
         , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit))
         ]
-      let failure = fail "Bad key."
+      let failure = MF.fail "Bad key."
       case is64 of
         32 -> case parse32Token32 hexhash of
                   Right bs -> return bs
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs
index 55e81069..d6f747d9 100644
--- a/dht/src/Data/Tox/Onion.hs
+++ b/dht/src/Data/Tox/Onion.hs
@@ -38,7 +38,11 @@ import Data.Function
 import Data.Functor.Contravariant
 import Data.Functor.Identity
 #if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
+import Data.IP hiding ( fromSockAddr
+#if MIN_VERSION_iproute(1,7,8)
+                      , toSockAddr
+#endif
+                      )
 #else
 import Data.IP
 #endif
diff --git a/dht/src/Network/BitTorrent/MainlineDHT.hs b/dht/src/Network/BitTorrent/MainlineDHT.hs
index e604f5e5..fc69fedd 100644
--- a/dht/src/Network/BitTorrent/MainlineDHT.hs
+++ b/dht/src/Network/BitTorrent/MainlineDHT.hs
@@ -40,7 +40,11 @@ import Data.Digest.CRC32C
 import Data.Function                          (fix)
 import Data.Hashable
 #if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
+import Data.IP hiding ( fromSockAddr
+#if MIN_VERSION_iproute(1,7,8)
+                      , toSockAddr
+#endif
+                      )
 #else
 import Data.IP
 #endif
diff --git a/dht/src/Network/Tox/Avahi.hs b/dht/src/Network/Tox/Avahi.hs
index 635ba656..2ca6515c 100644
--- a/dht/src/Network/Tox/Avahi.hs
+++ b/dht/src/Network/Tox/Avahi.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns    #-}
 module Network.Tox.Avahi
@@ -10,11 +11,17 @@ module Network.Tox.Avahi
 import Control.Applicative
 import Data.Foldable
 import Network.Address
-import Network.Avahi
 import Network.BSD         (getHostName)
 import Network.Tox.NodeId
 import Text.Read
 
+#if defined(VERSION_avahi)
+import Network.Avahi
+#else
+data Service = Service
+#endif
+
+
 toxServiceName :: String
 toxServiceName = "_tox_dht._udp"
 
@@ -26,7 +33,9 @@ a <.> b = a ++ "." ++ b
 
 toxService :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> Service
 toxService hostname (fromIntegral -> port) dhtkey toxid =
-  Service {
+  Service
+#if defined(VERSION_avahi)
+  {
     serviceProtocol = PROTO_UNSPEC,
     serviceName     = "Tox DHT @ " ++ hostname,
     serviceType     = toxServiceName,
@@ -36,10 +45,15 @@ toxService hostname (fromIntegral -> port) dhtkey toxid =
     servicePort     = port,
     serviceText     = maybe (show dhtkey) (show . ((,) dhtkey)) toxid
   }
+#endif
 
 announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
+#if defined(VERSION_avahi)
 announceToxServiceWithHostname  = (boobs.boobs) announce toxService
   where boobs = ((.).(.))
+#else
+announceToxServiceWithHostname _ _ _ _ = return ()
+#endif
 
 announceToxService :: PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
 announceToxService a b c = do
@@ -48,6 +62,7 @@ announceToxService a b c = do
 
 queryToxService :: (NodeInfo -> Maybe NodeId -> IO ()) -> IO ()
 queryToxService cb =
+#if defined(VERSION_avahi)
   browse $
   BrowseQuery
   { lookupProtocol    = PROTO_UNSPEC
@@ -63,3 +78,6 @@ queryToxService cb =
           addr = readMaybe =<< serviceAddress
           p    = fromIntegral servicePort
       forM_ nid $ \n -> forM_ addr $ \a -> cb (NodeInfo n a p) (snd <$> both)
+#else
+  return ()
+#endif
diff --git a/dht/src/Network/Tox/NodeId.hs b/dht/src/Network/Tox/NodeId.hs
index d05e3697..667e7d71 100644
--- a/dht/src/Network/Tox/NodeId.hs
+++ b/dht/src/Network/Tox/NodeId.hs
@@ -47,6 +47,7 @@ module Network.Tox.NodeId
 import Control.Applicative
 import Control.Arrow
 import Control.Monad
+import Control.Monad.Fail as MF
 #ifdef CRYPTONITE_BACKPORT
 import Crypto.Error.Types                     (CryptoFailable (..),
                                                throwCryptoError)
@@ -70,7 +71,11 @@ import Data.Char
 import Data.Data
 import Data.Hashable
 #if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
+import Data.IP hiding ( fromSockAddr
+#if MIN_VERSION_iproute(1,7,8)
+                      , toSockAddr
+#endif
+                      )
 #else
 import Data.IP
 #endif
@@ -258,7 +263,7 @@ getIP 0x02 = IPv4 <$> S.get
 getIP 0x0a = IPv6 <$> S.get
 getIP 0x82 = IPv4 <$> S.get -- TODO: TCP TOX_TCP_INET
 getIP 0x8a = IPv6 <$> S.get -- TODO: TCP TOX_TCP_INET6
-getIP x    = fail ("unsupported address family ("++show x++")")
+getIP x    = MF.fail ("unsupported address family ("++show x++")")
 
 instance Sized NodeInfo where
     size = VarSize $ \(NodeInfo nid ip port) ->
@@ -306,7 +311,7 @@ instance Read NodeInfo where
                       return (nid,addrstr)
     (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) )
     (ip,port) <- case RP.readP_to_S (ip_w_port i) addrstr of
-                    [] -> fail "Bad address."
+                    [] -> MF.fail "Bad address."
                     ((ip,port),_):_ -> return (ip,port)
     return $ NodeInfo nid ip port
 
@@ -406,7 +411,7 @@ getIP 0x02 = IPv4 <$> S.get
 getIP 0x0a = IPv6 <$> S.get
 getIP 0x82 = IPv4 <$> S.get -- TODO: TCP
 getIP 0x8a = IPv6 <$> S.get -- TODO: TCP
-getIP x    = fail ("unsupported address family ("++show x++")")
+getIP x    = MF.fail ("unsupported address family ("++show x++")")
 
 instance S.Serialize NodeInfo where
     get = do
@@ -445,7 +450,7 @@ instance Read NodeInfo where
                       addrstr <- parseAddr
                       nid <- case Base16.decode $ C8.pack hexhash of
                               (bs,_) | B.length bs==32 -> return (PubKey bs)
-                              _                        -> fail "Bad node id."
+                              _                        -> MF.fail "Bad node id."
                       return (nid,addrstr)
     (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) )
     let raddr = do
@@ -457,7 +462,7 @@ instance Read NodeInfo where
             return (ip, port)
 
     (ip,port) <- case RP.readP_to_S raddr addrstr of
-                    [] -> fail "Bad address."
+                    [] -> MF.fail "Bad address."
                     ((ip,port),_):_ -> return (ip,port)
     return $ NodeInfo nid ip port
 
@@ -518,15 +523,15 @@ instance Read NoSpam where
         ('0':'x':ws,rs) | (length ws == 12) -> base16decode rs (NoSpam <$> get <*> (Just <$> get)) ws
         _                                   -> []
 
-base64decode :: Monad m => t1 -> Get t -> String -> m (t, t1)
+base64decode :: MonadFail m => t1 -> Get t -> String -> m (t, t1)
 base64decode rs getter s =
-    either fail (\a -> return (a,rs))
+    either MF.fail (\a -> return (a,rs))
         $ runGet getter
            =<< Base64.decode (C8.pack $ map (nmtoken64 False) s)
 
-base16decode :: Monad m => t1 -> Get t -> String -> m (t, t1)
+base16decode :: MonadFail m => t1 -> Get t -> String -> m (t, t1)
 base16decode rs getter s =
-    either fail (\a -> return (a,rs))
+    either MF.fail (\a -> return (a,rs))
         $ runGet getter
         $ fst
         $ Base16.decode (C8.pack s)
@@ -559,7 +564,7 @@ instance Show NoSpamId where
     show (NoSpamId nspam pub) = '$' : nospam64 nspam ++ "@" ++ show (key2id pub) ++ ".tox"
 
 instance Read NoSpamId where
-    readsPrec d s = either fail id $ do
+    readsPrec d s = either MF.fail id $ do
         (jid,xs) <- Right $ break isSpace s
         nsid <- parseNoSpamId $ Text.pack jid
         return [(nsid,xs)]
diff --git a/network-addr/src/Network/Address.hs b/network-addr/src/Network/Address.hs
index 57bb11d1..d1275b53 100644
--- a/network-addr/src/Network/Address.hs
+++ b/network-addr/src/Network/Address.hs
@@ -111,7 +111,11 @@ import Data.Char
 import Data.Convertible
 import Data.Default
 #if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
+import Data.IP hiding ( fromSockAddr
+#if MIN_VERSION_iproute(1,7,8)
+                      , toSockAddr
+#endif
+                      )
 #else
 import Data.IP
 #endif
diff --git a/server/server.cabal b/server/server.cabal
index 95d7aacf..44441ef1 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -15,11 +15,42 @@ maintainer:          joe@jerkface.net
 category:            Network
 extra-source-files:  CHANGELOG.md
 
+flag network-uri
+  description:         Use network-uri package.
+  default:             True
+
+-- supports network-2.7, 2.8, with deprecation warnings
+flag old-network-bsd
+  description:         Use network-bsd package.
+  default:             True
+
+-- supports network >3.0
+flag new-network-bsd
+  description:         Use newer network-bsd package.
+  default:             False
+
+
 library
   exposed-modules:     Network.QueryResponse, Network.StreamServer, Network.SocketLike, Network.QueryResponse.TCP, Data.TableMethods, Connection.Tcp, Control.Concurrent.Delay, DNSCache, GetHostByAddr, ControlMaybe, SockAddr, Control.Concurrent.PingMachine, Connection
   other-modules: ForkLabeled, DebugTag
   other-extensions:    CPP, GADTs, LambdaCase, PartialTypeSignatures, RankNTypes, ScopedTypeVariables, TupleSections, TypeFamilies, TypeOperators, OverloadedStrings, GeneralizedNewtypeDeriving, DoAndIfThenElse, FlexibleInstances, StandaloneDeriving
-  build-depends:       base, stm, bytestring, dependent-map, dependent-sum, contravariant, containers, time, network, cpu, dput-hslogger, directory, lifted-base, hashable, conduit, text, psq-wrap, minmax-psq, lifted-concurrent, word64-map, network-addr
+  build-depends:       base, stm, bytestring, dependent-map, dependent-sum, contravariant, containers, time, cpu, dput-hslogger, directory, lifted-base, hashable, conduit, text, psq-wrap, minmax-psq, lifted-concurrent, word64-map, network-addr
   hs-source-dirs:      src
   default-language:    Haskell2010
   cpp-options: -DTHREAD_DEBUG
+  if flag(old-network-bsd)
+    Build-depends:  network < 3.0
+                  , network-uri  >= 2.6
+                  , network-bsd < 2.8.1.0
+  else
+   if flag(new-network-bsd)
+    Build-depends:  network >= 3.0
+                  , network-uri  >= 2.6
+                  , network-bsd >= 2.8.1.0
+   else
+    if flag(network-uri)
+      Build-depends:  network      >= 2.6 && < 3.0
+                    , network-uri  >= 2.6
+    else
+      Build-depends:  network      >= 2.4 && < 2.6
+