Factor out some new libraries

	word64-map:
		Data.Word64Map
	network-addr:
		Network.Address
	tox-crypto:
		Crypto.Tox
	lifted-concurrent:
		Control.Concurrent.Lifted.Instrument
		Control.Concurrent.Async.Lifted.Instrument
	psq-wrap:
		Data.Wrapper.PSQInt
		Data.Wrapper.PSQ
	minmax-psq:
		Data.MinMaxPSQ
        tasks:
                Control.Concurrent.Tasks
	kad:
		Network.Kademlia
		Network.Kademlia.Bootstrap
		Network.Kademlia.Routing
		Network.Kademlia.CommonAPI
		Network.Kademlia.Persistence
		Network.Kademlia.Search

1 files changed, 135 insertions, 0 deletions

diff --git a/dht/Connection.hs b/dht/Connection.hs
new file mode 100644
index 00000000..9a4077f5
--- /dev/null
+++ b/dht/Connection.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE LambdaCase    #-}
+module Connection where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Concurrent.STM
+import Data.Bits
+import Data.Word
+import qualified Data.Map as Map
+         ;import Data.Map (Map)
+import Network.Socket (SockAddr(..))
+
+import PingMachine
+
+-- | This type indicates the current status of a connection.  The type
+-- parameter indicates protocol-specific status information.  To present
+-- information as a user-comprehensible string, use 'showStatus'.
+data Status status
+    = Dormant
+    | InProgress status
+    | Established
+ deriving (Show,Eq,Ord,Functor)
+
+-- | A policy indicates a desired connection status.
+data Policy
+    = RefusingToConnect -- ^ We desire no connection.
+    | OpenToConnect     -- ^ We will cooperate if a remote side initiates.
+    | TryingToConnect   -- ^ We desire to be connected.
+ deriving (Eq,Ord,Show)
+
+-- | Information obtained via the 'connectionStatus' interface to
+-- 'Manager'.
+data Connection status = Connection
+    { connStatus    :: Status status
+    , connPolicy    :: Policy
+    }
+ deriving Functor
+
+-- | A 'PeerAddress' identifies an active session.  For inactive sessions, multiple
+-- values may be feasible.
+
+-- We use a 'SockAddr' as it is convenient for TCP and UDP connections.  But if
+-- that is not your use case, see 'uniqueAsKey'.
+newtype PeerAddress = PeerAddress { peerAddress :: SockAddr }
+    deriving (Eq,Ord,Show)
+
+-- | A 24-byte word.
+data Uniq24 = Uniq24 !Word64 !Word64 !Word64
+ deriving (Eq,Ord,Show)
+
+-- | Coerce a 'Uniq24' to a useable 'PeerAddress'.  Note that this stores the
+-- special value 0 into the port number of the underlying 'SockAddr' and thus
+-- should be compatible for mixing together with TCP/UDP peers.
+uniqueAsKey :: Uniq24 -> PeerAddress
+uniqueAsKey (Uniq24 x y z) = PeerAddress $ SockAddrInet6 (fromIntegral 0) a bcde f
+ where
+    a = fromIntegral (x `shiftR` 32)
+    b = fromIntegral x
+    c = fromIntegral (y `shiftR` 32)
+    d = fromIntegral y
+    e = fromIntegral (z `shiftR` 32)
+    f = fromIntegral z
+    bcde = (b,c,d,e)
+
+-- | Inverse of 'uniqueAsKey'
+keyAsUnique :: PeerAddress -> Maybe Uniq24
+keyAsUnique (PeerAddress (SockAddrInet6 0 a bcde f)) = Just $ Uniq24 x y z
+ where
+    (b,c,d,e) = bcde
+    x = (fromIntegral a `shiftL` 32) .|. fromIntegral b
+    y = (fromIntegral c `shiftL` 32) .|. fromIntegral d
+    z = (fromIntegral e `shiftL` 32) .|. fromIntegral f
+keyAsUniq _ = Nothing
+
+
+-- | This is an interface to make or query status information about connections
+-- of a specific kind.
+--
+-- Type parameters:
+--
+--    /k/ names a connection.  It should implement Ord, and can be parsed and
+--    displayed using 'stringToKey' and 'showKey'.
+--
+--    /status/ indicates the progress of a connection.  It is intended as a
+--    parameter to the 'InProgress' constructor of 'Status'.
+--
+data Manager status k = Manager
+    { -- | Connect or disconnect a connection.
+      setPolicy    :: k -> Policy -> IO ()
+      -- | Lookup a connection status.
+    , status       :: k -> STM (Connection status)
+      -- | Obtain a list of all known connections.
+    , connections  :: STM [k]
+      -- | Parse a connection key out of a string.  Inverse of 'showKey'.
+    , stringToKey  :: String -> Maybe k
+      -- | Convert a progress value to a string.
+    , showProgress :: status -> String
+      -- | Show a connection key as a string.
+    , showKey      :: k -> String
+      -- | Obtain an address from a human-friendly name.  For TCP/UDP
+      -- connections, this might be a forward-resolving DNS query.
+    , resolvePeer :: k -> IO [PeerAddress]
+      -- | This is the reverse of 'resolvePeer'.  For TCP/UDP connections, this
+      -- might be a reverse-resolve DNS query.
+    , reverseAddress :: PeerAddress -> IO [k]
+    }
+
+-- | Present status information (visible in a UI) for a connection.
+showStatus :: Manager status k -> Status status -> String
+showStatus mgr Dormant        = "dormant"
+showStatus mgr Established    = "established"
+showStatus mgr (InProgress s) = "in progress ("++showProgress mgr s++")"
+
+
+-- | Combine two different species of 'Manager' into a single interface using
+-- 'Either' to combine key and status types.
+addManagers :: (Ord kA, Ord kB) =>
+            Manager statusA kA
+            -> Manager statusB kB
+            -> Manager (Either statusA statusB) (Either kA kB)
+addManagers mgrA mgrB = Manager
+    { setPolicy = either (setPolicy mgrA) (setPolicy mgrB)
+    , status = \case
+        Left  k -> fmap Left  <$> status mgrA k
+        Right k -> fmap Right <$> status mgrB k
+    , connections = do
+        as <- connections mgrA
+        bs <- connections mgrB
+        return $ map Left as ++ map Right bs
+    , stringToKey = \str ->  Left <$> stringToKey mgrA str
+                        <|> Right <$> stringToKey mgrB str
+    , showProgress = either (showProgress mgrA) (showProgress mgrB)
+    , showKey = either (showKey mgrA) (showKey mgrB)
+    }