4 files changed, 55 insertions, 41 deletions

diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 068e9cb6..ad57403e 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -21,6 +21,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE BangPatterns      #-}
 -- TODO refine interface
 module Data.Torrent
        ( -- * Torrent
@@ -83,14 +84,14 @@ type Time = Text
 -- TODO more convenient form of torrent info.
 -- | Metainfo about particular torrent.
 data Torrent = Torrent {
-      tInfoHash     :: InfoHash
+      tInfoHash     :: !InfoHash
       -- ^ SHA1 hash of the 'TorrentInfo' of the 'Torrent'.
 
-    , tAnnounce     ::       URI
+    , tAnnounce     :: !URI
       -- ^ The URL of the tracker.
 
       -- NOTE: out of lexicographic order!
-    , tInfo         :: ContentInfo
+    , tInfo         :: !ContentInfo
       -- ^ Info about each content file.
 
     , tAnnounceList :: Maybe [[URI]]
@@ -112,9 +113,9 @@ data Torrent = Torrent {
       --   the info dictionary in the .torrent metafile.
 
     , tPublisher    :: Maybe URI
-      -- ^ Containing the RSA public key of the publisher of the torrent.
-      --   Private counterpart of this key that has the authority to allow
-      --   new peers onto the swarm.
+      -- ^ Containing the RSA public key of the publisher of the
+      -- torrent.  Private counterpart of this key that has the
+      -- authority to allow new peers onto the swarm.
 
     , tPublisherURL :: Maybe URI
     , tSignature    :: Maybe ByteString
@@ -144,22 +145,22 @@ simpleTorrent announce info = torrent announce info
 -- | Info part of the .torrent file contain info about each content file.
 data ContentInfo =
     SingleFile {
-      ciLength       :: Integer
+      ciLength       :: !Integer
       -- ^ Length of the file in bytes.
 
     , ciMD5sum       :: Maybe ByteString
       -- ^ 32 character long MD5 sum of the file.
       --   Used by third-party tools, not by bittorrent protocol itself.
 
-    , ciName         :: ByteString
+    , ciName         :: !ByteString
       -- ^ Suggested name of the file single file.
 
 
 
-    , ciPieceLength  :: Int
+    , ciPieceLength  :: !Int
       -- ^ Number of bytes in each piece.
 
-    , ciPieces       :: ByteString
+    , ciPieces       :: !ByteString
       -- ^ Concatenation of all 20-byte SHA1 hash values.
 
     , ciPrivate      :: Maybe Bool
@@ -171,28 +172,28 @@ data ContentInfo =
     }
 
   | MultiFile {
-      ciFiles        :: [FileInfo]
+      ciFiles        :: ![FileInfo]
       -- ^ List of the all files that torrent contains.
 
-    , ciName         :: ByteString
+    , ciName         :: !ByteString
       -- | The file path of the directory in which to store all the files.
 
-    , ciPieceLength  :: Int
-    , ciPieces       :: ByteString
+    , ciPieceLength  :: !Int
+    , ciPieces       :: !ByteString
     , ciPrivate      :: Maybe Bool
     } deriving (Show, Read, Eq)
 
 
 -- | Contain info about one single file.
 data FileInfo = FileInfo {
-      fiLength      :: Integer
+      fiLength      :: !Integer
       -- ^ Length of the file in bytes.
 
-    , fiMD5sum      :: Maybe ByteString
+    , fiMD5sum      ::  Maybe ByteString
       -- ^ 32 character long MD5 sum of the file.
       --   Used by third-party tools, not by bittorrent protocol itself.
 
-    , fiPath        :: [ByteString]
+    , fiPath        :: ![ByteString]
       -- ^ One or more string elements that together represent the
       --   path and filename. Each element in the list corresponds to
       --   either a directory name or (in the case of the last
@@ -323,16 +324,18 @@ blockCount :: Int         -- ^ Block size.
            -> Int         -- ^ Number of blocks.
 blockCount blkSize ci = contentLength ci `sizeInBase` blkSize
 
--- | File layout specifies the order and the size of each file in the storage.
---   Note that order of files is highly important since we coalesce all
---   the files in the given order to get the linear block address space.
+-- | File layout specifies the order and the size of each file in the
+--   storage. Note that order of files is highly important since we
+--   coalesce all the files in the given order to get the linear block
+--   address space.
 --
 type Layout = [(FilePath, Int)]
 
 -- | Extract files layout from torrent info with the given root path.
 contentLayout :: FilePath    -- ^ Root path for the all torrent files.
               -> ContentInfo -- ^ Torrent content information.
-              -> Layout      -- ^ The all file paths prefixed with the given root.
+              -> Layout      -- ^ The all file paths prefixed with the
+                             -- given root.
 contentLayout rootPath = filesLayout
   where
     filesLayout   (SingleFile { ciName = name, ciLength = len })
@@ -356,7 +359,11 @@ isMultiFile _            = False
 
 -- | Read and decode a .torrent file.
 fromFile :: FilePath -> IO Torrent
-fromFile = B.readFile >=> either (throwIO . userError) return . decoded
+fromFile path = do
+  contents <- B.readFile path
+  case decoded contents of
+    Right !t -> return t
+    Left msg -> throwIO $ userError  $ msg ++ " while reading torrent"
 
 {-----------------------------------------------------------------------
     Info hash
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