~ Minor fixes.

* Annotate all required fields as strict. These are always used and
  there is no reason to keep them lazy.
* Augment user errors with location.

3 files changed, 26 insertions, 19 deletions

diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index 6b97d8d1..d2d3da6c 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -181,7 +181,7 @@ handshake sock hs = do
 
     case checkIH (S.decode resp) of
       Right hs' -> return hs'
-      Left msg  -> throw $ userError msg
+      Left msg  -> throwIO $ userError $ msg ++ " in handshake body."
   where
     checkIH (Right hs')
       | hsInfoHash hs /= hsInfoHash hs'
@@ -234,10 +234,10 @@ ppBlockIx BlockIx {..} =
 
 data Block = Block {
     -- | Zero-based piece index.
-    blkPiece  :: !PieceLIx
+    blkPiece  :: {-# UNPACK #-} !PieceLIx
 
     -- | Zero-based byte offset within the piece.
-  , blkOffset :: !Int
+  , blkOffset :: {-# UNPACK #-} !Int
 
     -- | Payload.
   , blkData   :: !ByteString
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index cb776431..e1f9ff76 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -172,6 +172,7 @@ withTracker initProgress conn action = bracket start end (action . fst)
   where
     start = do
       resp <- askTracker (startedReq conn initProgress)
+      print resp
       se   <- newSession initProgress (respInterval resp) (respPeers resp)
       tid  <- forkIO (syncSession se)
       return (se, tid)
@@ -179,10 +180,13 @@ withTracker initProgress conn action = bracket start end (action . fst)
     syncSession se @ TSession {..} = forever $ do
         waitInterval se
         pr   <- getProgress se
+        print "tracker req"
         resp <- tryJust isIOException $ do
                     askTracker (regularReq defaultNumWant conn pr)
+        print "tracker resp"
         case resp of
-          Right (OK {..}) -> do
+          Right (ok @ OK {..}) -> do
+            print ok
             writeIORef seInterval respInterval
             writeList2Chan sePeers respPeers
           _ -> return ()
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs
index c94a2dfc..13127e7c 100644
--- a/src/Network/BitTorrent/Tracker/Protocol.hs
+++ b/src/Network/BitTorrent/Tracker/Protocol.hs
@@ -67,28 +67,28 @@ data Event = Started
 --   to keep track lists of active peer for a particular torrent.
 --
 data TRequest = TRequest { -- TODO peer here -- TODO detach announce
-     reqAnnounce   :: URI
+     reqAnnounce   :: !URI
      -- ^ Announce url of the torrent usually obtained from 'Torrent'.
 
-   , reqInfoHash   :: InfoHash
+   , reqInfoHash   :: !InfoHash
      -- ^ Hash of info part of the torrent usually obtained from
      -- 'Torrent'.
 
-   , reqPeerID     :: PeerID
+   , reqPeerID     :: !PeerID
      -- ^ ID of the peer doing request.
 
-   , reqPort       :: PortNumber
+   , reqPort       :: !PortNumber
      -- ^ Port to listen to for connections from other
      -- peers. Normally, tracker should respond with this port when
      -- some peer request the tracker with the same info hash.
 
-   , reqUploaded   :: Integer
+   , reqUploaded   :: !Integer
      -- ^ Number of bytes that the peer has uploaded in the swarm.
 
-   , reqDownloaded :: Integer
+   , reqDownloaded :: !Integer
      -- ^ Number of bytes downloaded in the swarm by the peer.
 
-   , reqLeft       :: Integer
+   , reqLeft       :: !Integer
      -- ^ Number of bytes needed in order to complete download.
 
    , reqIP         :: Maybe HostAddress
@@ -111,25 +111,25 @@ data TRequest = TRequest { -- TODO peer here -- TODO detach announce
 data TResponse =
      Failure Text -- ^ Failure reason in human readable form.
    | OK {
-       respWarning     :: Maybe Text
+       respWarning     ::  Maybe Text
        -- ^ Human readable warning.
 
-     , respInterval    :: Int
+     , respInterval    :: !Int
        -- ^ Recommended interval to wait between requests.
 
-     , respMinInterval :: Maybe Int
+     , respMinInterval ::  Maybe Int
        -- ^ Minimal amount of time between requests. A peer /should/
        -- make timeout with at least 'respMinInterval' value,
        -- otherwise tracker might not respond. If not specified the
        -- same applies to 'respInterval'.
 
-     , respComplete    :: Maybe Int
+     , respComplete    ::  Maybe Int
        -- ^ Number of peers completed the torrent. (seeders)
 
-     , respIncomplete  :: Maybe Int
+     , respIncomplete  ::  Maybe Int
        -- ^ Number of peers downloading the torrent. (leechers)
 
-     , respPeers       :: [PeerAddr]
+     , respPeers       :: ![PeerAddr]
        -- ^ Peers that must be contacted.
      } deriving Show
 
@@ -227,11 +227,14 @@ askTracker req = do
 
     rawResp  <- simpleHTTP r
     respBody <- getResponseBody rawResp
+    print $ respBody
     checkResult $ decoded respBody
   where
     mkHTTPRequest :: URI -> Request ByteString
     mkHTTPRequest uri = Request uri GET [] ""
 
-    checkResult (Left err)            = ioError (userError err)
-    checkResult (Right (Failure err)) = ioError (userError (show err))
+    checkResult (Left err)
+      = ioError $ userError $ err ++ " in tracker response"
+    checkResult (Right (Failure err))
+      = ioError $ userError $ show err ++ " in tracker response"
     checkResult (Right resp)          = return resp