summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorDebian Live user <user@localhost.localdomain>2017-10-28 09:29:08 +0000
committerDebian Live user <user@localhost.localdomain>2017-10-28 09:29:08 +0000
commit886b22aae08cf7a2de1cbe0036319616037308f2 (patch)
tree2c453248237ae7b38ba1439bef45833937d28bda /src
parent58d078d19c5e3c391a1bba3dddafff15308af757 (diff)
Use Data.Word64Map in tox clients when 32 bit ghc
Diffstat (limited to 'src')
-rw-r--r--src/Network/QueryResponse.hs13
-rw-r--r--src/Network/Tox.hs8
-rw-r--r--src/Network/Tox/Crypto/Transport.hs2
3 files changed, 18 insertions, 5 deletions
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 1901e164..9563fa7c 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -27,6 +27,7 @@ import qualified Data.IntMap.Strict as IntMap
27 ;import Data.IntMap.Strict (IntMap) 27 ;import Data.IntMap.Strict (IntMap)
28import qualified Data.Map.Strict as Map 28import qualified Data.Map.Strict as Map
29 ;import Data.Map.Strict (Map) 29 ;import Data.Map.Strict (Map)
30import qualified Data.Word64Map as W64Map
30import Data.Maybe 31import Data.Maybe
31import Data.Typeable 32import Data.Typeable
32import Network.Socket 33import Network.Socket
@@ -128,6 +129,10 @@ partitionTransportM parse encodex tr = do
128 } 129 }
129 return (xtr, ytr) 130 return (xtr, ytr)
130 131
132-- |
133-- * f add x --> Nothing, consume x
134-- --> Just id, leave x to a different handler
135-- --> Just g, apply g to x and leave that to a different handler
131addHandler :: ErrorReporter addr x meth tid err -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x 136addHandler :: ErrorReporter addr x meth tid err -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x
132addHandler err f tr = tr 137addHandler err f tr = tr
133 { awaitMessage = \kont -> fix $ \eat -> awaitMessage tr $ \m -> do 138 { awaitMessage = \kont -> fix $ \eat -> awaitMessage tr $ \m -> do
@@ -304,7 +309,7 @@ data TransactionMethods d tid addr x = TransactionMethods
304 dispatchRegister :: MVar x -> addr -> d -> STM (tid, d) 309 dispatchRegister :: MVar x -> addr -> d -> STM (tid, d)
305 -- | This method is invoked when an incoming packet /x/ indicates it is 310 -- | This method is invoked when an incoming packet /x/ indicates it is
306 -- a response to the transaction with id /tid/. The returned IO action 311 -- a response to the transaction with id /tid/. The returned IO action
307 -- is will write the packet to the correct 'MVar' thus completing the 312 -- will write the packet to the correct 'MVar' thus completing the
308 -- dispatch. 313 -- dispatch.
309 , dispatchResponse :: tid -> x -> d -> STM (d, IO ()) 314 , dispatchResponse :: tid -> x -> d -> STM (d, IO ())
310 -- | When a timeout interval elapses, this method is called to remove the 315 -- | When a timeout interval elapses, this method is called to remove the
@@ -323,10 +328,14 @@ data TableMethods t tid = TableMethods
323 , tblLookup :: forall a. tid -> t a -> Maybe a 328 , tblLookup :: forall a. tid -> t a -> Maybe a
324 } 329 }
325 330
326-- | Methods for using 'Data.IntMap. 331-- | Methods for using 'Data.IntMap'.
327intMapMethods :: TableMethods IntMap Int 332intMapMethods :: TableMethods IntMap Int
328intMapMethods = TableMethods IntMap.insert IntMap.delete IntMap.lookup 333intMapMethods = TableMethods IntMap.insert IntMap.delete IntMap.lookup
329 334
335-- | Methods for using 'Data.Word64Map'.
336w64MapMethods :: TableMethods IntMap Int
337w64MapMethods = TableMethods W64Map.insert W64Map.delete W64Map.lookup
338
330-- | Methods for using 'Data.Map' 339-- | Methods for using 'Data.Map'
331mapMethods :: Ord tid => TableMethods (Map tid) tid 340mapMethods :: Ord tid => TableMethods (Map tid) tid
332mapMethods = TableMethods Map.insert Map.delete Map.lookup 341mapMethods = TableMethods Map.insert Map.delete Map.lookup
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index af8114f4..c587578d 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -155,6 +155,9 @@ gen g = let (bs, g') = randomBytesGenerate 24 g
155intKey :: DHT.TransactionId -> Int 155intKey :: DHT.TransactionId -> Int
156intKey (DHT.TransactionId (Nonce8 w) _) = fromIntegral w 156intKey (DHT.TransactionId (Nonce8 w) _) = fromIntegral w
157 157
158w64Key :: DHT.TransactionId -> Word64
159w64Key (DHT.TransactionId (Nonce8 w) _) = w
160
158nonceKey :: DHT.TransactionId -> Nonce8 161nonceKey :: DHT.TransactionId -> Nonce8
159nonceKey (DHT.TransactionId n _) = n 162nonceKey (DHT.TransactionId n _) = n
160 163
@@ -178,6 +181,7 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
178 -- If we have 8-byte keys for IntMap, then use it for transaction lookups. 181 -- If we have 8-byte keys for IntMap, then use it for transaction lookups.
179 -- Otherwise, use ordinary Map. The details of which will be hidden by an 182 -- Otherwise, use ordinary Map. The details of which will be hidden by an
180 -- existential closure (see mkclient below). 183 -- existential closure (see mkclient below).
184 --
181 tblvar <- 185 tblvar <-
182 if fitsInInt (Proxy :: Proxy Word64) 186 if fitsInInt (Proxy :: Proxy Word64)
183 then do 187 then do
@@ -185,9 +189,9 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
185 intmap_var <- atomically $ newTVar (drg, mempty) 189 intmap_var <- atomically $ newTVar (drg, mempty)
186 return $ Right (intmapT,intmap_var) 190 return $ Right (intmapT,intmap_var)
187 else do 191 else do
188 let mapT = transactionMethods (contramap nonceKey mapMethods) gen 192 let word64mapT = transactionMethods (contramap w64key w64MapMethods) gen
189 map_var <- atomically $ newTVar (drg, mempty) 193 map_var <- atomically $ newTVar (drg, mempty)
190 return $ Left (mapT,map_var) 194 return $ Left (word64mapT,map_var)
191 let dispatch tbl var handlers = DispatchMethods 195 let dispatch tbl var handlers = DispatchMethods
192 { classifyInbound = classify 196 { classifyInbound = classify
193 , lookupHandler = handlers -- var 197 , lookupHandler = handlers -- var
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 40ca8b11..2a0e4a38 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -25,7 +25,7 @@ data NetCrypto
25 | NetCrypto (CryptoPacket Encrypted) 25 | NetCrypto (CryptoPacket Encrypted)
26 26
27parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr) 27parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr)
28parseNetCrypto _ _ = Left "TODO: parseNetCrypto" 28parseNetCrypto pkt saddr = Left "TODO: parseNetCrypto"
29 29
30encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr) 30encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr)
31encodeNetCrypto _ _ = _todo 31encodeNetCrypto _ _ = _todo