1 files changed, 76 insertions, 0 deletions

diff --git a/dht/src/Network/BitTorrent/Tracker/Transport.hs b/dht/src/Network/BitTorrent/Tracker/Transport.hs
new file mode 100644
index 00000000..60cb832d
--- /dev/null
+++ b/dht/src/Network/BitTorrent/Tracker/Transport.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE TupleSections #-}
+module Network.BitTorrent.Tracker.Transport where
+
+import Control.Concurrent.STM
+import Crypto.Random
+import Data.ByteString (ByteString)
+import Data.Functor.Contravariant
+import Data.IntMap.Strict (IntMap)
+import qualified Data.Serialize as S
+import Network.Socket
+
+import Data.QueryResponse.Table
+import Data.TableMethods
+import Network.Address
+import Network.BitTorrent.Tracker.Message
+import Network.QueryResponse as QR
+
+parseTracker :: ByteString -> SockAddr -> Either String (Transaction Request, SockAddr)
+parseTracker bs saddr = fmap (, saddr) $ S.decode bs
+
+encodeTracker :: Transaction Response -> SockAddr -> (ByteString, SockAddr)
+encodeTracker resp saddr = (S.encode resp,saddr)
+
+type Handler = MethodHandlerA String TransactionId SockAddr (Transaction Request) (Transaction Response)
+
+type Client = QR.ClientA String MessageId TransactionId SockAddr (Transaction Request) (Transaction Response)
+
+handlers :: MessageId -> Maybe Handler
+handlers ConnectId  = Nothing
+handlers AnnounceId = Nothing
+handlers ScrapeId   = Nothing
+handlers ErrorId    = Nothing
+handlers _          = Nothing
+
+methodOfRequest :: Request -> MessageId
+methodOfRequest Connect  {} = ConnectId
+methodOfRequest Announce {} = AnnounceId
+methodOfRequest Scrape   {} = ScrapeId
+
+classify :: Transaction Request -> MessageClass String MessageId TransactionId SockAddr (Transaction Request)
+classify qry = IsQuery (methodOfRequest $ request qry) (transIdQ qry)
+
+dispatch :: DRG g =>
+            DispatchMethodsA
+                        (g, IntMap (Maybe (Transaction Response) -> IO ()))
+                        String
+                        MessageId
+                        TransactionId
+                        SockAddr
+                        (Transaction Request)
+                        (Transaction Response)
+dispatch = DispatchMethods
+    { classifyInbound = classify
+    , lookupHandler   = handlers
+    , tableMethods    = transactionMethods (contramap fromEnum intMapMethods) genTransactionId
+    }
+
+newClient :: ErrorReporter SockAddr (Transaction Request) MessageId TransactionId String
+             -> TransportA String SockAddr (Transaction Request) (Transaction Response)
+             -> IO (ClientA String
+                            MessageId
+                            TransactionId
+                            SockAddr
+                            (Transaction Request)
+                            (Transaction Response))
+newClient err net = do
+    drg <- drgNew
+    state <- newTVarIO (drg, mempty)
+    return QR.Client
+        { clientNet           = net
+        , clientDispatcher    = dispatch
+        , clientErrorReporter = err
+        , clientPending       = state
+        , clientAddress       = const $ return localhost4
+        , clientResponseId    = return
+        }