Merge branch 'tidy' into dev

32 files changed, 2125 insertions, 1915 deletions

diff --git a/src/Network/BitTorrent/Address.hs b/src/Network/BitTorrent/Address.hs
new file mode 100644
index 00000000..eeb04c74
--- /dev/null
+++ b/src/Network/BitTorrent/Address.hs
@@ -0,0 +1,1172 @@
+-- |
+--   Module      :  Network.BitTorrent.Address
+--   Copyright   :  (c) Sam Truzjan 2013
+--                  (c) Daniel Gröber 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  provisional
+--   Portability :  portable
+--
+--   Peer and Node addresses.
+--
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE ViewPatterns               #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# OPTIONS -fno-warn-orphans           #-}
+module Network.BitTorrent.Address
+       ( -- * Address
+         Address (..)
+       , fromAddr
+
+         -- ** IP
+       , IPv4
+       , IPv6
+       , IP (..)
+
+         -- * PeerId
+         -- $peer-id
+       , PeerId
+
+         -- ** Generation
+       , genPeerId
+       , timestamp
+       , entropy
+
+         -- ** Encoding
+       , azureusStyle
+       , shadowStyle
+       , defaultClientId
+       , defaultVersionNumber
+
+         -- * PeerAddr
+         -- $peer-addr
+       , PeerAddr(..)
+       , defaultPorts
+       , peerSockAddr
+       , peerSocket
+
+         -- * Node
+         -- ** Id
+       , NodeId
+       , testIdBit
+       , genNodeId
+       , NodeDistance
+       , distance
+
+         -- ** Info
+       , NodeAddr (..)
+       , NodeInfo (..)
+       , rank
+
+         -- * Fingerprint
+         -- $fingerprint
+       , Software (..)
+       , Fingerprint (..)
+       , libFingerprint
+       , fingerprint
+
+         -- * Utils
+       , libUserAgent
+       ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.BEncode as BE
+import Data.BEncode   as BS
+import Data.BEncode.BDict (BKey)
+import Data.Bits
+import Data.ByteString as BS
+import Data.ByteString.Internal as BS
+import Data.ByteString.Base16 as Base16
+import Data.ByteString.Char8 as BC
+import Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Builder as BS
+import Data.Char
+import Data.Convertible
+import Data.Default
+import Data.Foldable
+import Data.IP
+import Data.List as L
+import Data.List.Split as L
+import Data.Maybe       (fromMaybe, catMaybes)
+import Data.Monoid
+import Data.Hashable
+import Data.Ord
+import Data.Serialize as S
+import Data.String
+import Data.Time
+import Data.Typeable
+import Data.Version
+import Data.Word
+import qualified Text.ParserCombinators.ReadP as RP
+import Text.Read        (readMaybe)
+import Network.HTTP.Types.QueryLike
+import Network.Socket
+import Text.PrettyPrint as PP hiding ((<>))
+import Text.PrettyPrint.Class
+import System.Locale    (defaultTimeLocale)
+import System.Entropy
+
+-- import Paths_bittorrent (version)
+
+{-----------------------------------------------------------------------
+--  Address
+-----------------------------------------------------------------------}
+
+instance Pretty UTCTime where
+  pretty = PP.text . show
+
+class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
+    => Address a where
+  toSockAddr   :: a        -> SockAddr
+  fromSockAddr :: SockAddr -> Maybe a
+
+fromAddr :: (Address a, Address b) => a -> Maybe b
+fromAddr = fromSockAddr . toSockAddr
+
+-- | Note that port is zeroed.
+instance Address IPv4 where
+  toSockAddr = SockAddrInet 0 . toHostAddress
+  fromSockAddr (SockAddrInet _ h) = Just (fromHostAddress h)
+  fromSockAddr  _                 = Nothing
+
+-- | Note that port is zeroed.
+instance Address IPv6 where
+  toSockAddr h = SockAddrInet6 0 0 (toHostAddress6 h) 0
+  fromSockAddr (SockAddrInet6 _ _ h _) = Just (fromHostAddress6 h)
+  fromSockAddr  _                      = Nothing
+
+-- | Note that port is zeroed.
+instance Address IP where
+  toSockAddr (IPv4 h) = toSockAddr h
+  toSockAddr (IPv6 h) = toSockAddr h
+  fromSockAddr sa =
+        IPv4 <$> fromSockAddr sa
+    <|> IPv6 <$> fromSockAddr sa
+
+setPort :: PortNumber -> SockAddr -> SockAddr
+setPort port (SockAddrInet  _   h  ) = SockAddrInet  port   h
+setPort port (SockAddrInet6 _ f h s) = SockAddrInet6 port f h s
+setPort _    (SockAddrUnix  s      ) = SockAddrUnix  s
+{-# INLINE setPort #-}
+
+getPort :: SockAddr -> Maybe PortNumber
+getPort (SockAddrInet  p   _  ) = Just p
+getPort (SockAddrInet6 p _ _ _) = Just p
+getPort (SockAddrUnix  _      ) = Nothing
+{-# INLINE getPort #-}
+
+instance Address a => Address (NodeAddr a) where
+  toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost
+  fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> getPort sa
+
+instance Address a => Address (PeerAddr a) where
+  toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost
+  fromSockAddr sa = PeerAddr Nothing <$> fromSockAddr sa <*> getPort sa
+
+{-----------------------------------------------------------------------
+--  Peer id
+-----------------------------------------------------------------------}
+-- $peer-id
+--
+--  'PeerID' represent self assigned peer identificator. Ideally each
+--  host in the network should have unique peer id to avoid
+--  collisions, therefore for peer ID generation we use good entropy
+--  source. Peer ID is sent in /tracker request/, sent and received in
+--  /peer handshakes/ and used in DHT queries.
+--
+
+-- TODO use unpacked Word160 form (length is known statically)
+
+-- | Peer identifier is exactly 20 bytes long bytestring.
+newtype PeerId = PeerId { getPeerId :: ByteString }
+  deriving (Show, Eq, Ord, BEncode, Typeable)
+
+peerIdLen :: Int
+peerIdLen = 20
+
+-- | For testing purposes only.
+instance Default PeerId where
+  def = azureusStyle defaultClientId defaultVersionNumber ""
+
+instance Hashable PeerId where
+  hashWithSalt = hashUsing getPeerId
+  {-# INLINE hashWithSalt #-}
+
+instance Serialize PeerId where
+  put = putByteString . getPeerId
+  get = PeerId <$> getBytes peerIdLen
+
+instance QueryValueLike PeerId where
+  toQueryValue (PeerId pid) = Just pid
+  {-# INLINE toQueryValue #-}
+
+instance IsString PeerId where
+  fromString str
+      | BS.length bs == peerIdLen = PeerId bs
+      | otherwise = error $ "Peer id should be 20 bytes long: " ++ show str
+    where
+      bs = fromString str
+
+instance Pretty PeerId where
+  pretty = text . BC.unpack . getPeerId
+
+instance Convertible BS.ByteString PeerId where
+  safeConvert bs
+    | BS.length bs == peerIdLen = pure (PeerId bs)
+    |          otherwise        = convError "invalid length" bs
+
+------------------------------------------------------------------------
+
+-- | Pad bytestring so it's becomes exactly request length. Conversion
+-- is done like so:
+--
+--     * length < size: Complete bytestring by given charaters.
+--
+--     * length = size: Output bytestring as is.
+--
+--     * length > size: Drop last (length - size) charaters from a
+--     given bytestring.
+--
+byteStringPadded :: ByteString -- ^ bytestring to be padded.
+                 -> Int        -- ^ size of result builder.
+                 -> Char       -- ^ character used for padding.
+                 -> BS.Builder
+byteStringPadded bs s c =
+      BS.byteString (BS.take s bs) <>
+      BS.byteString (BC.replicate padLen c)
+  where
+    padLen = s - min (BS.length bs) s
+
+-- | Azureus-style encoding have the following layout:
+--
+--     * 1  byte : '-'
+--
+--     * 2  bytes: client id
+--
+--     * 4  bytes: version number
+--
+--     * 1  byte : '-'
+--
+--     * 12 bytes: random number
+--
+azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
+             -> ByteString -- ^ Version number, padded with 'X'.
+             -> ByteString -- ^ Random number, padded with '0'.
+             -> PeerId     -- ^ Azureus-style encoded peer ID.
+azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
+    BS.char8 '-' <>
+      byteStringPadded cid 2  'H' <>
+      byteStringPadded ver 4  'X' <>
+    BS.char8 '-' <>
+      byteStringPadded rnd 12 '0'
+
+-- | Shadow-style encoding have the following layout:
+--
+--     * 1 byte   : client id.
+--
+--     * 0-4 bytes: version number. If less than 4 then padded with
+--     '-' char.
+--
+--     * 15 bytes : random number. If length is less than 15 then
+--     padded with '0' char.
+--
+shadowStyle :: Char       -- ^ Client ID.
+            -> ByteString -- ^ Version number.
+            -> ByteString -- ^ Random number.
+            -> PeerId     -- ^ Shadow style encoded peer ID.
+shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
+    BS.char8 cid <>
+      byteStringPadded ver 4  '-' <>
+      byteStringPadded rnd 15 '0'
+
+
+-- | 'HS'- 2 bytes long client identifier.
+defaultClientId :: ByteString
+defaultClientId = "HS"
+
+-- | Gives exactly 4 bytes long version number for any version of the
+-- package.  Version is taken from .cabal file.
+defaultVersionNumber :: ByteString
+defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
+                         versionBranch myVersion
+  where
+    Fingerprint _ myVersion = libFingerprint
+
+------------------------------------------------------------------------
+
+-- | Gives 15 characters long decimal timestamp such that:
+--
+--     * 6 bytes   : first 6 characters from picoseconds obtained with %q.
+--
+--     * 1 byte    : character \'.\' for readability.
+--
+--     * 9..* bytes: number of whole seconds since the Unix epoch
+--     (!)REVERSED.
+--
+--   Can be used both with shadow and azureus style encoding. This
+--   format is used to make the ID's readable for debugging purposes.
+--
+timestamp :: IO ByteString
+timestamp = (BC.pack . format) <$> getCurrentTime
+  where
+    format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
+               L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t))
+
+-- | Gives 15 character long random bytestring. This is more robust
+-- method for generation of random part of peer ID than 'timestamp'.
+entropy :: IO ByteString
+entropy = getEntropy 15
+
+-- NOTE: entropy generates incorrrect peer id
+
+-- |  Here we use 'azureusStyle' encoding with the following args:
+--
+--      * 'HS' for the client id; ('defaultClientId')
+--
+--      * Version of the package for the version number;
+--      ('defaultVersionNumber')
+--
+--      * UTC time day ++ day time for the random number. ('timestamp')
+--
+genPeerId :: IO PeerId
+genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
+
+{-----------------------------------------------------------------------
+-- Peer Addr
+-----------------------------------------------------------------------}
+-- $peer-addr
+--
+--   'PeerAddr' is used to represent peer address. Currently it's
+--   just peer IP and peer port but this might change in future.
+--
+
+{-----------------------------------------------------------------------
+--  Port number
+-----------------------------------------------------------------------}
+
+instance BEncode PortNumber where
+  toBEncode   = toBEncode    .  fromEnum
+  fromBEncode = fromBEncode >=> portNumber
+    where
+      portNumber :: Integer -> BS.Result PortNumber
+      portNumber n
+        | 0 <= n && n <= fromIntegral (maxBound :: Word16)
+        = pure $ fromIntegral n
+        | otherwise = decodingError $ "PortNumber: " ++ show n
+
+instance Serialize PortNumber where
+  get = fromIntegral <$> getWord16be
+  {-# INLINE get #-}
+  put = putWord16be . fromIntegral
+  {-# INLINE put #-}
+
+instance Hashable PortNumber where
+  hashWithSalt s = hashWithSalt s . fromEnum
+  {-# INLINE hashWithSalt #-}
+
+instance Pretty PortNumber where
+  pretty = PP.int . fromEnum
+  {-# INLINE pretty #-}
+
+{-----------------------------------------------------------------------
+--  IP addr
+-----------------------------------------------------------------------}
+
+class IPAddress i where
+  toHostAddr :: i -> Either HostAddress HostAddress6
+
+instance IPAddress IPv4 where
+  toHostAddr = Left . toHostAddress
+  {-# INLINE toHostAddr #-}
+
+instance IPAddress IPv6 where
+  toHostAddr = Right . toHostAddress6
+  {-# INLINE toHostAddr #-}
+
+instance IPAddress IP where
+  toHostAddr (IPv4 ip) = toHostAddr ip
+  toHostAddr (IPv6 ip) = toHostAddr ip
+  {-# INLINE toHostAddr #-}
+
+deriving instance Typeable IP
+deriving instance Typeable IPv4
+deriving instance Typeable IPv6
+
+ipToBEncode :: Show i => i -> BValue
+ipToBEncode ip = BString $ BS8.pack $ show ip
+{-# INLINE ipToBEncode #-}
+
+ipFromBEncode :: Read a => BValue -> BS.Result a
+ipFromBEncode (BString (BS8.unpack -> ipStr))
+  | Just ip <- readMaybe (ipStr) = pure ip
+  |         otherwise            = decodingError $ "IP: " ++ ipStr
+ipFromBEncode _    = decodingError $ "IP: addr should be a bstring"
+
+instance BEncode IP where
+  toBEncode   = ipToBEncode
+  {-# INLINE toBEncode #-}
+  fromBEncode = ipFromBEncode
+  {-# INLINE fromBEncode #-}
+
+instance BEncode IPv4 where
+  toBEncode   = ipToBEncode
+  {-# INLINE toBEncode #-}
+  fromBEncode = ipFromBEncode
+  {-# INLINE fromBEncode #-}
+
+instance BEncode IPv6 where
+  toBEncode   = ipToBEncode
+  {-# INLINE toBEncode #-}
+  fromBEncode = ipFromBEncode
+  {-# INLINE fromBEncode #-}
+
+-- | When 'get'ing an IP it must be 'isolate'd to the appropriate
+-- number of bytes since we have no other way of telling which
+-- address type we are trying to parse
+instance Serialize IP where
+    put (IPv4 ip) = put ip
+    put (IPv6 ip) = put ip
+
+    get = do
+      n <- remaining
+      case n of
+        4  -> IPv4 <$> get
+        16 -> IPv6 <$> get
+        _ -> fail "Wrong number of bytes remaining to parse IP"
+
+instance Serialize IPv4 where
+    put = putWord32host    .  toHostAddress
+    get = fromHostAddress <$> getWord32host
+
+instance Serialize IPv6 where
+    put ip = put $ toHostAddress6 ip
+    get = fromHostAddress6 <$> get
+
+instance Pretty IPv4 where
+  pretty = PP.text . show
+  {-# INLINE pretty #-}
+
+instance Pretty IPv6 where
+  pretty = PP.text . show
+  {-# INLINE pretty #-}
+
+instance Pretty IP where
+  pretty = PP.text . show
+  {-# INLINE pretty #-}
+
+instance Hashable IPv4 where
+  hashWithSalt = hashUsing toHostAddress
+  {-# INLINE hashWithSalt #-}
+
+instance Hashable IPv6 where
+  hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
+
+instance Hashable IP where
+  hashWithSalt s (IPv4 h) = hashWithSalt s h
+  hashWithSalt s (IPv6 h) = hashWithSalt s h
+
+{-----------------------------------------------------------------------
+--  Peer addr
+-----------------------------------------------------------------------}
+-- TODO check semantic of ord and eq instances
+
+-- | Peer address info normally extracted from peer list or peer
+-- compact list encoding.
+data PeerAddr a = PeerAddr
+  { peerId   :: !(Maybe PeerId)
+
+    -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved
+    -- 'HostName'.
+  , peerHost :: !a
+
+    -- | The port the peer listenning for incoming P2P sessions.
+  , peerPort :: {-# UNPACK #-} !PortNumber
+  } deriving (Show, Eq, Ord, Typeable, Functor)
+
+peer_ip_key, peer_id_key, peer_port_key :: BKey
+peer_ip_key   = "ip"
+peer_id_key   = "peer id"
+peer_port_key = "port"
+
+-- | The tracker's 'announce response' compatible encoding.
+instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where
+  toBEncode PeerAddr {..} = toDict $
+       peer_ip_key   .=! peerHost
+    .: peer_id_key   .=? peerId
+    .: peer_port_key .=! peerPort
+    .: endDict
+
+  fromBEncode = fromDict $ do
+    peerAddr <$>! peer_ip_key
+             <*>? peer_id_key
+             <*>! peer_port_key
+    where
+      peerAddr = flip PeerAddr
+
+-- | The tracker's 'compact peer list' compatible encoding. The
+-- 'peerId' is always 'Nothing'.
+--
+--   For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
+--
+-- TODO: test byte order
+instance (Serialize a) => Serialize (PeerAddr a) where
+  put PeerAddr {..} = put peerHost >> put peerPort
+  get = PeerAddr Nothing <$> get <*> get
+
+-- | @127.0.0.1:6881@
+instance Default (PeerAddr IPv4) where
+  def = "127.0.0.1:6881"
+
+-- | @127.0.0.1:6881@
+instance Default (PeerAddr IP) where
+  def = IPv4 <$> def
+
+-- | Example:
+--
+--   @peerPort \"127.0.0.1:6881\" == 6881@
+--
+instance IsString (PeerAddr IPv4) where
+  fromString str
+    | [hostAddrStr, portStr] <- splitWhen (== ':') str
+    , Just hostAddr <- readMaybe hostAddrStr
+    , Just portNum  <- toEnum <$> readMaybe portStr
+                = PeerAddr Nothing hostAddr portNum
+    | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str
+
+instance Read (PeerAddr IPv4) where
+  readsPrec i = RP.readP_to_S $ do
+    ipv4 <- RP.readS_to_P (readsPrec i)
+    _    <- RP.char ':'
+    port <- toEnum <$> RP.readS_to_P (readsPrec i)
+    return $ PeerAddr Nothing ipv4 port
+
+readsIPv6_port :: String -> [((IPv6, PortNumber), String)]
+readsIPv6_port = RP.readP_to_S $ do
+  ip <- RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']'
+  _ <- RP.char ':'
+  port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof
+  return (ip,port)
+
+instance IsString (PeerAddr IPv6) where
+  fromString str
+    | [((ip,port),"")] <- readsIPv6_port str =
+        PeerAddr Nothing ip port
+    | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str
+
+instance IsString (PeerAddr IP) where
+  fromString str
+    | '[' `L.elem` str = IPv6 <$> fromString str
+    |      otherwise   = IPv4 <$> fromString str
+
+-- | fingerprint + "at" + dotted.host.inet.addr:port
+-- TODO: instances for IPv6, HostName
+instance Pretty a => Pretty (PeerAddr a) where
+  pretty PeerAddr {..}
+    | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr
+    |     otherwise      = paddr
+    where
+      paddr = pretty peerHost <> ":" <> text (show peerPort)
+
+instance Hashable a => Hashable (PeerAddr a) where
+  hashWithSalt s PeerAddr {..} =
+    s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort
+
+-- | Ports typically reserved for bittorrent P2P listener.
+defaultPorts :: [PortNumber]
+defaultPorts =  [6881..6889]
+
+_resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i
+_resolvePeerAddr = undefined
+
+_peerSockAddr :: PeerAddr IP -> (Family, SockAddr)
+_peerSockAddr PeerAddr {..} =
+    case peerHost of
+          IPv4 ipv4 ->
+              (AF_INET, SockAddrInet peerPort (toHostAddress  ipv4))
+          IPv6 ipv6 ->
+              (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0)
+
+peerSockAddr :: PeerAddr IP -> SockAddr
+peerSockAddr = snd . _peerSockAddr
+
+-- | Create a socket connected to the address specified in a peerAddr
+peerSocket :: SocketType -> PeerAddr IP -> IO Socket
+peerSocket socketType pa = do
+    let (family, addr) = _peerSockAddr pa
+    sock <- socket family socketType defaultProtocol
+    connect sock addr
+    return sock
+
+{-----------------------------------------------------------------------
+--  Node info
+-----------------------------------------------------------------------}
+--   $node-info
+--
+--   A \"node\" is a client\/server listening on a UDP port
+--   implementing the distributed hash table protocol. The DHT is
+--   composed of nodes and stores the location of peers. BitTorrent
+--   clients include a DHT node, which is used to contact other nodes
+--   in the DHT to get the location of peers to download from using
+--   the BitTorrent protocol.
+
+-- TODO more compact representation ('ShortByteString's?)
+
+-- | Each node has a globally unique identifier known as the \"node
+-- ID.\"
+--
+--   Normally, /this/ node id should be saved between invocations
+--   of the client software.
+newtype NodeId = NodeId ByteString
+  deriving (Show, Eq, Ord, BEncode, Typeable)
+
+nodeIdSize :: Int
+nodeIdSize = 20
+
+-- | Meaningless node id, for testing purposes only.
+instance Default NodeId where
+  def = NodeId (BS.replicate nodeIdSize 0)
+
+instance Serialize NodeId where
+  get = NodeId <$> getByteString nodeIdSize
+  {-# INLINE get #-}
+  put (NodeId bs) = putByteString bs
+  {-# INLINE put #-}
+
+-- | ASCII encoded.
+instance IsString NodeId where
+  fromString str
+    | L.length str == nodeIdSize = NodeId (fromString str)
+    |           otherwise = error "fromString: invalid NodeId length"
+  {-# INLINE fromString #-}
+
+-- | base16 encoded.
+instance Pretty NodeId where
+  pretty (NodeId nid) = PP.text $ BC.unpack $ Base16.encode nid
+
+-- | Test if the nth bit is set.
+testIdBit :: NodeId -> Word -> Bool
+testIdBit (NodeId bs) i
+  | fromIntegral i < nodeIdSize * 8
+  , (q, r) <- quotRem (fromIntegral i) 8
+  = testBit (BS.index bs q) r
+  |     otherwise      = False
+{-# INLINE testIdBit #-}
+
+-- TODO WARN is the 'system' random suitable for this?
+-- | Generate random NodeID used for the entire session.
+--   Distribution of ID's should be as uniform as possible.
+--
+genNodeId :: IO NodeId
+genNodeId = NodeId <$> getEntropy nodeIdSize
+
+------------------------------------------------------------------------
+
+-- | In Kademlia, the distance metric is XOR and the result is
+-- interpreted as an unsigned integer.
+newtype NodeDistance = NodeDistance BS.ByteString
+  deriving (Eq, Ord)
+
+instance Pretty NodeDistance where
+  pretty (NodeDistance bs) = foldMap bitseq $ BS.unpack bs
+    where
+      listBits w = L.map (testBit w) (L.reverse [0..bitSize w - 1])
+      bitseq = foldMap (int . fromEnum) . listBits
+
+-- | distance(A,B) = |A xor B| Smaller values are closer.
+distance :: NodeId -> NodeId -> NodeDistance
+distance (NodeId a) (NodeId b) = NodeDistance (BS.pack (BS.zipWith xor a b))
+
+------------------------------------------------------------------------
+
+data NodeAddr a = NodeAddr
+  { nodeHost ::                !a
+  , nodePort :: {-# UNPACK #-} !PortNumber
+  } deriving (Eq, Typeable, Functor)
+
+instance Show a => Show (NodeAddr a) where
+  showsPrec i NodeAddr {..}
+    = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort
+
+instance Read (NodeAddr IPv4) where
+  readsPrec i x = [ (fromPeerAddr a, s) | (a, s) <- readsPrec i x ]
+
+-- | @127.0.0.1:6882@
+instance Default (NodeAddr IPv4) where
+  def = "127.0.0.1:6882"
+
+-- | KRPC compatible encoding.
+instance Serialize a => Serialize (NodeAddr a) where
+  get = NodeAddr <$> get <*> get
+  {-# INLINE get #-}
+  put NodeAddr {..} = put nodeHost >> put nodePort
+  {-# INLINE put #-}
+
+-- | Torrent file compatible encoding.
+instance BEncode a => BEncode (NodeAddr a) where
+  toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort)
+  {-# INLINE toBEncode #-}
+  fromBEncode b = uncurry NodeAddr <$> fromBEncode b
+  {-# INLINE fromBEncode #-}
+
+instance Hashable a => Hashable (NodeAddr a) where
+  hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort)
+  {-# INLINE hashWithSalt #-}
+
+instance Pretty ip => Pretty (NodeAddr ip) where
+  pretty NodeAddr {..} = pretty nodeHost <> ":" <> pretty nodePort
+
+-- | Example:
+--
+--   @nodePort \"127.0.0.1:6881\" == 6881@
+--
+instance IsString (NodeAddr IPv4) where
+  fromString = fromPeerAddr . fromString
+
+fromPeerAddr :: PeerAddr a -> NodeAddr a
+fromPeerAddr PeerAddr {..} = NodeAddr
+  { nodeHost = peerHost
+  , nodePort = peerPort
+  }
+
+------------------------------------------------------------------------
+
+data NodeInfo a = NodeInfo
+  { nodeId   :: !NodeId
+  , nodeAddr :: !(NodeAddr a)
+  } deriving (Show, Eq, Functor)
+
+instance Eq a => Ord (NodeInfo a) where
+  compare = comparing nodeId
+
+-- | KRPC 'compact list' compatible encoding: contact information for
+-- nodes is encoded as a 26-byte string. Also known as "Compact node
+-- info" the 20-byte Node ID in network byte order has the compact
+-- IP-address/port info concatenated to the end.
+instance Serialize a => Serialize (NodeInfo a) where
+  get = NodeInfo <$> get <*> get
+  put NodeInfo {..} = put nodeId >> put nodeAddr
+
+instance Pretty ip => Pretty (NodeInfo ip) where
+  pretty NodeInfo {..} = pretty nodeId <> "@(" <> pretty nodeAddr <> ")"
+
+instance Pretty ip => Pretty [NodeInfo ip] where
+  pretty = PP.vcat . PP.punctuate "," . L.map pretty
+
+-- | Order by closeness: nearest nodes first.
+rank :: Eq ip => NodeId -> [NodeInfo ip] -> [NodeInfo ip]
+rank nid = L.sortBy (comparing (distance nid . nodeId))
+
+{-----------------------------------------------------------------------
+-- Fingerprint
+-----------------------------------------------------------------------}
+-- $fingerprint
+--
+--   'Fingerprint' is used to identify the client implementation and
+--   version which also contained in 'Peer'. For exsample first 6
+--   bytes of peer id of this this library are @-HS0100-@ while for
+--   mainline we have @M4-3-6--@.  We could extract this info and
+--   print in human-friendly form: this is useful for debugging and
+--   logging.
+--
+--   For more information see:
+--   <http://bittorrent.org/beps/bep_0020.html>
+--
+--
+--   NOTE: Do /not/ use this information to control client
+--   capabilities (such as supported enchancements), this should be
+--   done using 'Network.BitTorrent.Extension'!
+--
+
+-- TODO FIXME
+version :: Version
+version = Version [0, 0, 0, 3] []
+
+-- | List of registered client versions + 'IlibHSbittorrent' (this
+-- package) + 'IUnknown' (for not recognized software). All names are
+-- prefixed by \"I\" because some of them starts from lowercase letter
+-- but that is not a valid Haskell constructor name.
+--
+data Software =
+   IUnknown
+
+ | IMainline
+
+ | IABC
+ | IOspreyPermaseed
+ | IBTQueue
+ | ITribler
+ | IShadow
+ | IBitTornado
+
+-- UPnP(!) Bit Torrent !???
+-- 'U' - UPnP NAT Bit Torrent
+ | IBitLord
+ | IOpera
+ | IMLdonkey
+
+ | IAres
+ | IArctic
+ | IAvicora
+ | IBitPump
+ | IAzureus
+ | IBitBuddy
+ | IBitComet
+ | IBitflu
+ | IBTG
+ | IBitRocket
+ | IBTSlave
+ | IBittorrentX
+ | IEnhancedCTorrent
+ | ICTorrent
+ | IDelugeTorrent
+ | IPropagateDataClient
+ | IEBit
+ | IElectricSheep
+ | IFoxTorrent
+ | IGSTorrent
+ | IHalite
+ | IlibHSbittorrent
+ | IHydranode
+ | IKGet
+ | IKTorrent
+ | ILH_ABC
+ | ILphant
+ | ILibtorrent
+ | ILibTorrent
+ | ILimeWire
+ | IMonoTorrent
+ | IMooPolice
+ | IMiro
+ | IMoonlightTorrent
+ | INetTransport
+ | IPando
+ | IqBittorrent
+ | IQQDownload
+ | IQt4TorrentExample
+ | IRetriever
+ | IShareaza
+ | ISwiftbit
+ | ISwarmScope
+ | ISymTorrent
+ | Isharktorrent
+ | ITorrentDotNET
+ | ITransmission
+ | ITorrentstorm
+ | ITuoTu
+ | IuLeecher
+ | IuTorrent
+ | IVagaa
+ | IBitLet
+ | IFireTorrent
+ | IXunlei
+ | IXanTorrent
+ | IXtorrent
+ | IZipTorrent
+   deriving (Show, Eq, Ord, Enum, Bounded)
+
+parseSoftware :: ByteString -> Software
+parseSoftware = f . BC.unpack
+ where
+  f "AG" = IAres
+  f "A~" = IAres
+  f "AR" = IArctic
+  f "AV" = IAvicora
+  f "AX" = IBitPump
+  f "AZ" = IAzureus
+  f "BB" = IBitBuddy
+  f "BC" = IBitComet
+  f "BF" = IBitflu
+  f "BG" = IBTG
+  f "BR" = IBitRocket
+  f "BS" = IBTSlave
+  f "BX" = IBittorrentX
+  f "CD" = IEnhancedCTorrent
+  f "CT" = ICTorrent
+  f "DE" = IDelugeTorrent
+  f "DP" = IPropagateDataClient
+  f "EB" = IEBit
+  f "ES" = IElectricSheep
+  f "FT" = IFoxTorrent
+  f "GS" = IGSTorrent
+  f "HL" = IHalite
+  f "HS" = IlibHSbittorrent
+  f "HN" = IHydranode
+  f "KG" = IKGet
+  f "KT" = IKTorrent
+  f "LH" = ILH_ABC
+  f "LP" = ILphant
+  f "LT" = ILibtorrent
+  f "lt" = ILibTorrent
+  f "LW" = ILimeWire
+  f "MO" = IMonoTorrent
+  f "MP" = IMooPolice
+  f "MR" = IMiro
+  f "ML" = IMLdonkey
+  f "MT" = IMoonlightTorrent
+  f "NX" = INetTransport
+  f "PD" = IPando
+  f "qB" = IqBittorrent
+  f "QD" = IQQDownload
+  f "QT" = IQt4TorrentExample
+  f "RT" = IRetriever
+  f "S~" = IShareaza
+  f "SB" = ISwiftbit
+  f "SS" = ISwarmScope
+  f "ST" = ISymTorrent
+  f "st" = Isharktorrent
+  f "SZ" = IShareaza
+  f "TN" = ITorrentDotNET
+  f "TR" = ITransmission
+  f "TS" = ITorrentstorm
+  f "TT" = ITuoTu
+  f "UL" = IuLeecher
+  f "UT" = IuTorrent
+  f "VG" = IVagaa
+  f "WT" = IBitLet
+  f "WY" = IFireTorrent
+  f "XL" = IXunlei
+  f "XT" = IXanTorrent
+  f "XX" = IXtorrent
+  f "ZT" = IZipTorrent
+  f _    = IUnknown
+
+-- | Used to represent a not recognized implementation
+instance Default Software where
+  def = IUnknown
+  {-# INLINE def #-}
+
+-- | Example: @\"BitLet\" == 'IBitLet'@
+instance IsString Software where
+  fromString str
+    | Just impl <- L.lookup str alist = impl
+    | otherwise = error $ "fromString: not recognized " ++ str
+    where
+      alist = L.map mk [minBound..maxBound]
+      mk  x = (L.tail $ show x, x)
+
+-- | Example: @pretty 'IBitLet' == \"IBitLet\"@
+instance Pretty Software where
+  pretty = text . L.tail . show
+
+-- | Just the '0' version.
+instance Default Version where
+  def = Version [0] []
+  {-# INLINE def #-}
+
+-- | For dot delimited version strings.
+--   Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@
+--
+instance IsString Version where
+  fromString str
+    | Just nums <- chunkNums str = Version nums []
+    | otherwise = error $ "fromString: invalid version string " ++ str
+    where
+      chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==)
+
+instance Pretty Version where
+  pretty = text . showVersion
+
+-- | The all sensible infomation that can be obtained from a peer
+-- identifier or torrent /createdBy/ field.
+data Fingerprint = Fingerprint Software Version
+  deriving (Show, Eq, Ord)
+
+-- | Unrecognized client implementation.
+instance Default Fingerprint where
+  def = Fingerprint def def
+  {-# INLINE def #-}
+
+-- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@
+instance IsString Fingerprint where
+  fromString str
+    | _ : ver <- _ver = Fingerprint (fromString impl) (fromString ver)
+    | otherwise = error $ "fromString: invalid client info string" ++ str
+    where
+      (impl, _ver) = L.span ((/=) '-') str
+
+instance Pretty Fingerprint where
+  pretty (Fingerprint s v) = pretty s <+> "version" <+> pretty v
+
+-- | Fingerprint of this (the bittorrent library) package. Normally,
+-- applications should introduce its own fingerprints, otherwise they
+-- can use 'libFingerprint' value.
+--
+libFingerprint :: Fingerprint
+libFingerprint =  Fingerprint IlibHSbittorrent version
+
+-- | HTTP user agent of this (the bittorrent library) package. Can be
+-- used in HTTP tracker requests.
+libUserAgent :: String
+libUserAgent = render (pretty IlibHSbittorrent <> "/" <> pretty version)
+
+{-----------------------------------------------------------------------
+--  For torrent file
+-----------------------------------------------------------------------}
+-- TODO collect information about createdBy torrent field
+{-
+renderImpl :: ClientImpl -> Text
+renderImpl = T.pack . L.tail . show
+
+renderVersion :: Version -> Text
+renderVersion = undefined
+
+renderClientInfo :: ClientInfo -> Text
+renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion
+
+parseClientInfo :: Text -> ClientImpl
+parseClientInfo t = undefined
+-}
+{-
+-- code used for generation; remove it later on
+
+mkEnumTyDef :: NM -> String
+mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
+
+mkPars :: NM -> String
+mkPars = unlines . map (\(code, impl) -> "  f \"" ++ code ++ "\" = " ++ "I" ++ impl)
+
+type NM = [(String, String)]
+nameMap :: NM
+nameMap =
+ [ ("AG", "Ares")
+ , ("A~", "Ares")
+ , ("AR", "Arctic")
+ , ("AV", "Avicora")
+ , ("AX", "BitPump")
+ , ("AZ", "Azureus")
+ , ("BB", "BitBuddy")
+ , ("BC", "BitComet")
+ , ("BF", "Bitflu")
+ , ("BG", "BTG")
+ , ("BR", "BitRocket")
+ , ("BS", "BTSlave")
+ , ("BX", "BittorrentX")
+ , ("CD", "EnhancedCTorrent")
+ , ("CT", "CTorrent")
+ , ("DE", "DelugeTorrent")
+ , ("DP", "PropagateDataClient")
+ , ("EB", "EBit")
+ , ("ES", "ElectricSheep")
+ , ("FT", "FoxTorrent")
+ , ("GS", "GSTorrent")
+ , ("HL", "Halite")
+ , ("HS", "libHSnetwork_bittorrent")
+ , ("HN", "Hydranode")
+ , ("KG", "KGet")
+ , ("KT", "KTorrent")
+ , ("LH", "LH_ABC")
+ , ("LP", "Lphant")
+ , ("LT", "Libtorrent")
+ , ("lt", "LibTorrent")
+ , ("LW", "LimeWire")
+ , ("MO", "MonoTorrent")
+ , ("MP", "MooPolice")
+ , ("MR", "Miro")
+ , ("MT", "MoonlightTorrent")
+ , ("NX", "NetTransport")
+ , ("PD", "Pando")
+ , ("qB", "qBittorrent")
+ , ("QD", "QQDownload")
+ , ("QT", "Qt4TorrentExample")
+ , ("RT", "Retriever")
+ , ("S~", "Shareaza")
+ , ("SB", "Swiftbit")
+ , ("SS", "SwarmScope")
+ , ("ST", "SymTorrent")
+ , ("st", "sharktorrent")
+ , ("SZ", "Shareaza")
+ , ("TN", "TorrentDotNET")
+ , ("TR", "Transmission")
+ , ("TS", "Torrentstorm")
+ , ("TT", "TuoTu")
+ , ("UL", "uLeecher")
+ , ("UT", "uTorrent")
+ , ("VG", "Vagaa")
+ , ("WT", "BitLet")
+ , ("WY", "FireTorrent")
+ , ("XL", "Xunlei")
+ , ("XT", "XanTorrent")
+ , ("XX", "Xtorrent")
+ , ("ZT", "ZipTorrent")
+ ]
+-}
+
+-- TODO use regexps
+
+-- | Tries to extract meaningful information from peer ID bytes. If
+-- peer id uses unknown coding style then client info returned is
+-- 'def'.
+--
+fingerprint :: PeerId -> Fingerprint
+fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
+  where
+    getCI    = do
+      leading <- BS.w2c <$> getWord8
+      case leading of
+        '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion
+        'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion
+        'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
+        'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
+        c   -> do
+          c1 <- w2c <$> S.lookAhead getWord8
+          if c1 == 'P'
+            then do
+                 _ <- getWord8
+                 Fingerprint <$> pure IOpera            <*> getOperaVersion
+            else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion
+
+    getMainlineVersion = do
+      str <- BC.unpack <$> getByteString 7
+      let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str
+      return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) []
+
+    getAzureusImpl    = parseSoftware <$> getByteString 2
+    getAzureusVersion = mkVer         <$> getByteString 4
+      where
+        mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
+
+    getBitCometImpl = do
+      bs <- getByteString 3
+      S.lookAhead $ do
+        _  <- getByteString 2
+        lr <- getByteString 4
+        return $
+          if lr == "LORD" then IBitLord  else
+          if bs == "UTB"  then IBitComet else
+          if bs == "xbc"  then IBitComet else def
+
+    getBitCometVersion = do
+      x <- getWord8
+      y <- getWord8
+      return $ Version [fromIntegral x, fromIntegral y] []
+
+    getOperaVersion = do
+      str <- BC.unpack <$> getByteString 4
+      return $ Version [fromMaybe 0 $ readMaybe str] []
+
+    getShadowImpl 'A' = IABC
+    getShadowImpl 'O' = IOspreyPermaseed
+    getShadowImpl 'Q' = IBTQueue
+    getShadowImpl 'R' = ITribler
+    getShadowImpl 'S' = IShadow
+    getShadowImpl 'T' = IBitTornado
+    getShadowImpl  _  = IUnknown
+
+    decodeShadowVerNr :: Char -> Maybe Int
+    decodeShadowVerNr c
+      | '0' < c && c <= '9' = Just  (fromEnum c - fromEnum '0')
+      | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10)
+      | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36)
+      |        otherwise    = Nothing
+
+    getShadowVersion = do
+      str <- BC.unpack <$> getByteString 5
+      return $ Version (catMaybes $ L.map decodeShadowVerNr str) []
diff --git a/src/Network/BitTorrent/Client.hs b/src/Network/BitTorrent/Client.hs
index bf6740c3..d21b4d1e 100644
--- a/src/Network/BitTorrent/Client.hs
+++ b/src/Network/BitTorrent/Client.hs
@@ -61,11 +61,9 @@ import Data.Text
 import Network
 
 import           Data.Torrent
-import           Data.Torrent.InfoHash
-import           Data.Torrent.Magnet
+import           Network.BitTorrent.Address
 import           Network.BitTorrent.Client.Types
 import           Network.BitTorrent.Client.Handle
-import           Network.BitTorrent.Core
 import           Network.BitTorrent.DHT      as DHT      hiding (Options)
 import           Network.BitTorrent.Tracker  as Tracker  hiding (Options)
 import           Network.BitTorrent.Exchange as Exchange hiding (Options)
diff --git a/src/Network/BitTorrent/Client/Handle.hs b/src/Network/BitTorrent/Client/Handle.hs
index 0d1b7f92..66baac48 100644
--- a/src/Network/BitTorrent/Client/Handle.hs
+++ b/src/Network/BitTorrent/Client/Handle.hs
@@ -26,8 +26,6 @@ import Data.List as L
 import Data.HashMap.Strict as HM
 
 import Data.Torrent
-import Data.Torrent.InfoHash
-import Data.Torrent.Magnet
 import Network.BitTorrent.Client.Types as Types
 import Network.BitTorrent.DHT      as DHT
 import Network.BitTorrent.Exchange as Exchange
diff --git a/src/Network/BitTorrent/Client/Types.hs b/src/Network/BitTorrent/Client/Types.hs
index c019bc5f..9bae7dc3 100644
--- a/src/Network/BitTorrent/Client/Types.hs
+++ b/src/Network/BitTorrent/Client/Types.hs
@@ -34,9 +34,9 @@ import Data.Ord
 import Network
 import System.Log.FastLogger
 
-import Data.Torrent.InfoHash
+import Data.Torrent
+import Network.BitTorrent.Address
 import Network.BitTorrent.Internal.Types as Types
-import Network.BitTorrent.Core
 import Network.BitTorrent.DHT      as DHT
 import Network.BitTorrent.Exchange as Exchange
 import Network.BitTorrent.Tracker  as Tracker hiding (Event)
@@ -100,7 +100,7 @@ externalAddr Client {..} = PeerAddr
 newtype BitTorrent a = BitTorrent
   { unBitTorrent :: ReaderT Client IO a
   } deriving ( Functor, Applicative, Monad
-             , MonadIO, MonadThrow, MonadUnsafeIO, MonadBase IO
+             , MonadIO, MonadThrow, MonadBase IO
              )
 
 class MonadBitTorrent m where
diff --git a/src/Network/BitTorrent/Core.hs b/src/Network/BitTorrent/Core.hs
deleted file mode 100644
index b9b3c065..00000000
--- a/src/Network/BitTorrent/Core.hs
+++ /dev/null
@@ -1,88 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   Re-export every @Network.BitTorrent.Core.*@ module.
---
-module Network.BitTorrent.Core
-       ( module Core
-
-         -- * Address class
-       , Address (..)
-       , fromAddr
-
-         -- * Re-exports from Data.IP
-       , IPv4
-       , IPv6
-       , IP (..)
-       ) where
-
-import Control.Applicative
-import Data.IP
-import Data.Hashable
-import Data.Serialize
-import Data.Time
-import Data.Typeable
-import Network.Socket (SockAddr (..), PortNumber)
-import Text.PrettyPrint as PP hiding ((<>))
-import Text.PrettyPrint.Class
-
-import Network.BitTorrent.Core.Fingerprint as Core
-import Network.BitTorrent.Core.NodeInfo    as Core
-import Network.BitTorrent.Core.PeerId      as Core
-import Network.BitTorrent.Core.PeerAddr    as Core
-
-
-instance Pretty UTCTime where
-  pretty = PP.text . show
-
-class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
-    => Address a where
-  toSockAddr   :: a        -> SockAddr
-  fromSockAddr :: SockAddr -> Maybe a
-
-fromAddr :: (Address a, Address b) => a -> Maybe b
-fromAddr = fromSockAddr . toSockAddr
-
--- | Note that port is zeroed.
-instance Address IPv4 where
-  toSockAddr = SockAddrInet 0 . toHostAddress
-  fromSockAddr (SockAddrInet _ h) = Just (fromHostAddress h)
-  fromSockAddr  _                 = Nothing
-
--- | Note that port is zeroed.
-instance Address IPv6 where
-  toSockAddr h = SockAddrInet6 0 0 (toHostAddress6 h) 0
-  fromSockAddr (SockAddrInet6 _ _ h _) = Just (fromHostAddress6 h)
-  fromSockAddr  _                      = Nothing
-
--- | Note that port is zeroed.
-instance Address IP where
-  toSockAddr (IPv4 h) = toSockAddr h
-  toSockAddr (IPv6 h) = toSockAddr h
-  fromSockAddr sa =
-        IPv4 <$> fromSockAddr sa
-    <|> IPv6 <$> fromSockAddr sa
-
-setPort :: PortNumber -> SockAddr -> SockAddr
-setPort port (SockAddrInet  _   h  ) = SockAddrInet  port   h
-setPort port (SockAddrInet6 _ f h s) = SockAddrInet6 port f h s
-setPort _    (SockAddrUnix  s      ) = SockAddrUnix  s
-{-# INLINE setPort #-}
-
-getPort :: SockAddr -> Maybe PortNumber
-getPort (SockAddrInet  p   _  ) = Just p
-getPort (SockAddrInet6 p _ _ _) = Just p
-getPort (SockAddrUnix  _      ) = Nothing
-{-# INLINE getPort #-}
-
-instance Address a => Address (NodeAddr a) where
-  toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost
-  fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> getPort sa
-
-instance Address a => Address (PeerAddr a) where
-  toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost
-  fromSockAddr sa = PeerAddr Nothing <$> fromSockAddr sa <*> getPort sa
diff --git a/src/Network/BitTorrent/Core/Fingerprint.hs b/src/Network/BitTorrent/Core/Fingerprint.hs
deleted file mode 100644
index d743acd0..00000000
--- a/src/Network/BitTorrent/Core/Fingerprint.hs
+++ /dev/null
@@ -1,290 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   'Fingerprint' is used to identify the client implementation and
---   version which also contained in 'Peer'. For exsample first 6
---   bytes of peer id of this this library are @-HS0100-@ while for
---   mainline we have @M4-3-6--@.  We could extract this info and
---   print in human-friendly form: this is useful for debugging and
---   logging.
---
---   For more information see:
---   <http://bittorrent.org/beps/bep_0020.html>
---
---
---   NOTE: Do /not/ use this information to control client
---   capabilities (such as supported enchancements), this should be
---   done using 'Network.BitTorrent.Extension'!
---
-{-# OPTIONS -fno-warn-orphans #-}
-module Network.BitTorrent.Core.Fingerprint
-       ( ClientImpl (..)
-       , Fingerprint (..)
-       , libFingerprint
-       , libUserAgent
-       ) where
-
-import Data.Default
-import Data.List as L
-import Data.List.Split as L
-import Data.Monoid
-import Data.String
-import Data.Version
-import Text.PrettyPrint hiding ((<>))
-import Text.PrettyPrint.Class
-import Text.Read (readMaybe)
--- import Paths_bittorrent (version)
-
--- TODO FIXME
-version :: Version
-version = Version [0, 0, 0, 3] []
-
--- | List of registered client versions + 'IlibHSbittorrent' (this
--- package) + 'IUnknown' (for not recognized software). All names are
--- prefixed by \"I\" because some of them starts from lowercase letter
--- but that is not a valid Haskell constructor name.
---
-data ClientImpl =
-   IUnknown
-
- | IMainline
-
- | IABC
- | IOspreyPermaseed
- | IBTQueue
- | ITribler
- | IShadow
- | IBitTornado
-
--- UPnP(!) Bit Torrent !???
--- 'U' - UPnP NAT Bit Torrent
- | IBitLord
- | IOpera
- | IMLdonkey
-
- | IAres
- | IArctic
- | IAvicora
- | IBitPump
- | IAzureus
- | IBitBuddy
- | IBitComet
- | IBitflu
- | IBTG
- | IBitRocket
- | IBTSlave
- | IBittorrentX
- | IEnhancedCTorrent
- | ICTorrent
- | IDelugeTorrent
- | IPropagateDataClient
- | IEBit
- | IElectricSheep
- | IFoxTorrent
- | IGSTorrent
- | IHalite
- | IlibHSbittorrent
- | IHydranode
- | IKGet
- | IKTorrent
- | ILH_ABC
- | ILphant
- | ILibtorrent
- | ILibTorrent
- | ILimeWire
- | IMonoTorrent
- | IMooPolice
- | IMiro
- | IMoonlightTorrent
- | INetTransport
- | IPando
- | IqBittorrent
- | IQQDownload
- | IQt4TorrentExample
- | IRetriever
- | IShareaza
- | ISwiftbit
- | ISwarmScope
- | ISymTorrent
- | Isharktorrent
- | ITorrentDotNET
- | ITransmission
- | ITorrentstorm
- | ITuoTu
- | IuLeecher
- | IuTorrent
- | IVagaa
- | IBitLet
- | IFireTorrent
- | IXunlei
- | IXanTorrent
- | IXtorrent
- | IZipTorrent
-   deriving (Show, Eq, Ord, Enum, Bounded)
-
--- | Used to represent a not recognized implementation
-instance Default ClientImpl where
-  def = IUnknown
-  {-# INLINE def #-}
-
--- | Example: @\"BitLet\" == 'IBitLet'@
-instance IsString ClientImpl where
-  fromString str
-    | Just impl <- L.lookup str alist = impl
-    | otherwise = error $ "fromString: not recognized " ++ str
-    where
-      alist = L.map mk [minBound..maxBound]
-      mk  x = (L.tail $ show x, x)
-
--- | Example: @pretty 'IBitLet' == \"IBitLet\"@
-instance Pretty ClientImpl where
-  pretty = text . L.tail . show
-
--- | Just the '0' version.
-instance Default Version where
-  def = Version [0] []
-  {-# INLINE def #-}
-
--- | For dot delimited version strings.
---   Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@
---
-instance IsString Version where
-  fromString str
-    | Just nums <- chunkNums str = Version nums []
-    | otherwise = error $ "fromString: invalid version string " ++ str
-    where
-      chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==)
-
-instance Pretty Version where
-  pretty = text . showVersion
-
--- | The all sensible infomation that can be obtained from a peer
--- identifier or torrent /createdBy/ field.
-data Fingerprint = Fingerprint
-  { ciImpl    :: ClientImpl
-  , ciVersion :: Version
-  } deriving (Show, Eq, Ord)
-
--- | Unrecognized client implementation.
-instance Default Fingerprint where
-  def = Fingerprint def def
-  {-# INLINE def #-}
-
--- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@
-instance IsString Fingerprint where
-  fromString str
-    | _ : ver <- _ver = Fingerprint (fromString impl) (fromString ver)
-    | otherwise = error $ "fromString: invalid client info string" ++ str
-    where
-      (impl, _ver) = L.span ((/=) '-') str
-
-instance Pretty Fingerprint where
-  pretty Fingerprint {..} = pretty ciImpl <+> "version" <+> pretty ciVersion
-
--- | Fingerprint of this (the bittorrent library) package. Normally,
--- applications should introduce its own fingerprints, otherwise they
--- can use 'libFingerprint' value.
---
-libFingerprint :: Fingerprint
-libFingerprint =  Fingerprint IlibHSbittorrent version
-
--- | HTTP user agent of this (the bittorrent library) package. Can be
--- used in HTTP tracker requests.
-libUserAgent :: String
-libUserAgent = render (pretty IlibHSbittorrent <> "/" <> pretty version)
-
-{-----------------------------------------------------------------------
---  For torrent file
------------------------------------------------------------------------}
--- TODO collect information about createdBy torrent field
-{-
-renderImpl :: ClientImpl -> Text
-renderImpl = T.pack . L.tail . show
-
-renderVersion :: Version -> Text
-renderVersion = undefined
-
-renderClientInfo :: ClientInfo -> Text
-renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion
-
-parseClientInfo :: Text -> ClientImpl
-parseClientInfo t = undefined
--}
-{-
--- code used for generation; remove it later on
-
-mkEnumTyDef :: NM -> String
-mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
-
-mkPars :: NM -> String
-mkPars = unlines . map (\(code, impl) -> "  f \"" ++ code ++ "\" = " ++ "I" ++ impl)
-
-type NM = [(String, String)]
-nameMap :: NM
-nameMap =
- [ ("AG", "Ares")
- , ("A~", "Ares")
- , ("AR", "Arctic")
- , ("AV", "Avicora")
- , ("AX", "BitPump")
- , ("AZ", "Azureus")
- , ("BB", "BitBuddy")
- , ("BC", "BitComet")
- , ("BF", "Bitflu")
- , ("BG", "BTG")
- , ("BR", "BitRocket")
- , ("BS", "BTSlave")
- , ("BX", "BittorrentX")
- , ("CD", "EnhancedCTorrent")
- , ("CT", "CTorrent")
- , ("DE", "DelugeTorrent")
- , ("DP", "PropagateDataClient")
- , ("EB", "EBit")
- , ("ES", "ElectricSheep")
- , ("FT", "FoxTorrent")
- , ("GS", "GSTorrent")
- , ("HL", "Halite")
- , ("HS", "libHSnetwork_bittorrent")
- , ("HN", "Hydranode")
- , ("KG", "KGet")
- , ("KT", "KTorrent")
- , ("LH", "LH_ABC")
- , ("LP", "Lphant")
- , ("LT", "Libtorrent")
- , ("lt", "LibTorrent")
- , ("LW", "LimeWire")
- , ("MO", "MonoTorrent")
- , ("MP", "MooPolice")
- , ("MR", "Miro")
- , ("MT", "MoonlightTorrent")
- , ("NX", "NetTransport")
- , ("PD", "Pando")
- , ("qB", "qBittorrent")
- , ("QD", "QQDownload")
- , ("QT", "Qt4TorrentExample")
- , ("RT", "Retriever")
- , ("S~", "Shareaza")
- , ("SB", "Swiftbit")
- , ("SS", "SwarmScope")
- , ("ST", "SymTorrent")
- , ("st", "sharktorrent")
- , ("SZ", "Shareaza")
- , ("TN", "TorrentDotNET")
- , ("TR", "Transmission")
- , ("TS", "Torrentstorm")
- , ("TT", "TuoTu")
- , ("UL", "uLeecher")
- , ("UT", "uTorrent")
- , ("VG", "Vagaa")
- , ("WT", "BitLet")
- , ("WY", "FireTorrent")
- , ("XL", "Xunlei")
- , ("XT", "XanTorrent")
- , ("XX", "Xtorrent")
- , ("ZT", "ZipTorrent")
- ]
--}
diff --git a/src/Network/BitTorrent/Core/NodeInfo.hs b/src/Network/BitTorrent/Core/NodeInfo.hs
deleted file mode 100644
index fe17c097..00000000
--- a/src/Network/BitTorrent/Core/NodeInfo.hs
+++ /dev/null
@@ -1,219 +0,0 @@
--- |
---   Module      :  Network.BitTorrent.Core.Node
---   Copyright   :  (c) Sam Truzjan 2013
---                  (c) Daniel Gröber 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   A \"node\" is a client\/server listening on a UDP port
---   implementing the distributed hash table protocol. The DHT is
---   composed of nodes and stores the location of peers. BitTorrent
---   clients include a DHT node, which is used to contact other nodes
---   in the DHT to get the location of peers to download from using
---   the BitTorrent protocol.
---
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveFunctor              #-}
-module Network.BitTorrent.Core.NodeInfo
-       (  -- * Node ID
-         NodeId
-       , testIdBit
-       , genNodeId
-
-         -- ** Node distance
-       , NodeDistance
-       , distance
-
-         -- * Node address
-       , NodeAddr (..)
-
-         -- * Node info
-       , NodeInfo (..)
-       , rank
-       ) where
-
-import Control.Applicative
-import Data.Bits
-import Data.ByteString as BS
-import Data.ByteString.Char8 as BC
-import Data.ByteString.Base16 as Base16
-import Data.BEncode as BE
-import Data.Default
-import Data.Hashable
-import Data.Foldable
-import Data.IP
-import Data.List as L
-import Data.Monoid
-import Data.Ord
-import Data.Serialize as S
-import Data.String
-import Data.Typeable
-import Data.Word
-import Network
-import System.Entropy
-import Text.PrettyPrint as PP hiding ((<>))
-import Text.PrettyPrint.Class
-
-import Network.BitTorrent.Core.PeerAddr (PeerAddr (..))
-
-{-----------------------------------------------------------------------
---  Node id
------------------------------------------------------------------------}
--- TODO more compact representation ('ShortByteString's?)
-
--- | Each node has a globally unique identifier known as the \"node
--- ID.\"
---
---   Normally, /this/ node id should be saved between invocations
---   of the client software.
-newtype NodeId = NodeId ByteString
-  deriving (Show, Eq, Ord, BEncode, Typeable)
-
-nodeIdSize :: Int
-nodeIdSize = 20
-
--- | Meaningless node id, for testing purposes only.
-instance Default NodeId where
-  def = NodeId (BS.replicate nodeIdSize 0)
-
-instance Serialize NodeId where
-  get = NodeId <$> getByteString nodeIdSize
-  {-# INLINE get #-}
-  put (NodeId bs) = putByteString bs
-  {-# INLINE put #-}
-
--- | ASCII encoded.
-instance IsString NodeId where
-  fromString str
-    | L.length str == nodeIdSize = NodeId (fromString str)
-    |           otherwise = error "fromString: invalid NodeId length"
-  {-# INLINE fromString #-}
-
--- | base16 encoded.
-instance Pretty NodeId where
-  pretty (NodeId nid) = PP.text $ BC.unpack $ Base16.encode nid
-
--- | Test if the nth bit is set.
-testIdBit :: NodeId -> Word -> Bool
-testIdBit (NodeId bs) i
-  | fromIntegral i < nodeIdSize * 8
-  , (q, r) <- quotRem (fromIntegral i) 8
-  = testBit (BS.index bs q) r
-  |     otherwise      = False
-{-# INLINE testIdBit #-}
-
--- TODO WARN is the 'system' random suitable for this?
--- | Generate random NodeID used for the entire session.
---   Distribution of ID's should be as uniform as possible.
---
-genNodeId :: IO NodeId
-genNodeId = NodeId <$> getEntropy nodeIdSize
-
-{-----------------------------------------------------------------------
---  Node distance
------------------------------------------------------------------------}
-
--- | In Kademlia, the distance metric is XOR and the result is
--- interpreted as an unsigned integer.
-newtype NodeDistance = NodeDistance BS.ByteString
-  deriving (Eq, Ord)
-
-instance Pretty NodeDistance where
-  pretty (NodeDistance bs) = foldMap bitseq $ BS.unpack bs
-    where
-      listBits w = L.map (testBit w) (L.reverse [0..bitSize w - 1])
-      bitseq = foldMap (int . fromEnum) . listBits
-
--- | distance(A,B) = |A xor B| Smaller values are closer.
-distance :: NodeId -> NodeId -> NodeDistance
-distance (NodeId a) (NodeId b) = NodeDistance (BS.pack (BS.zipWith xor a b))
-
-{-----------------------------------------------------------------------
---  Node address
------------------------------------------------------------------------}
-
-data NodeAddr a = NodeAddr
-  { nodeHost ::                !a
-  , nodePort :: {-# UNPACK #-} !PortNumber
-  } deriving (Eq, Typeable, Functor)
-
-instance Show a => Show (NodeAddr a) where
-  showsPrec i NodeAddr {..}
-    = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort
-
-instance Read (NodeAddr IPv4) where
-  readsPrec i x = [ (fromPeerAddr a, s) | (a, s) <- readsPrec i x ]
-
--- | @127.0.0.1:6882@
-instance Default (NodeAddr IPv4) where
-  def = "127.0.0.1:6882"
-
--- | KRPC compatible encoding.
-instance Serialize a => Serialize (NodeAddr a) where
-  get = NodeAddr <$> get <*> get
-  {-# INLINE get #-}
-  put NodeAddr {..} = put nodeHost >> put nodePort
-  {-# INLINE put #-}
-
--- | Torrent file compatible encoding.
-instance BEncode a => BEncode (NodeAddr a) where
-  toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort)
-  {-# INLINE toBEncode #-}
-  fromBEncode b = uncurry NodeAddr <$> fromBEncode b
-  {-# INLINE fromBEncode #-}
-
-instance Hashable a => Hashable (NodeAddr a) where
-  hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort)
-  {-# INLINE hashWithSalt #-}
-
-instance Pretty ip => Pretty (NodeAddr ip) where
-  pretty NodeAddr {..} = pretty nodeHost <> ":" <> pretty nodePort
-
--- | Example:
---
---   @nodePort \"127.0.0.1:6881\" == 6881@
---
-instance IsString (NodeAddr IPv4) where
-  fromString = fromPeerAddr . fromString
-
-fromPeerAddr :: PeerAddr a -> NodeAddr a
-fromPeerAddr PeerAddr {..} = NodeAddr
-  { nodeHost = peerHost
-  , nodePort = peerPort
-  }
-
-{-----------------------------------------------------------------------
---  Node info
------------------------------------------------------------------------}
-
-data NodeInfo a = NodeInfo
-  { nodeId   :: !NodeId
-  , nodeAddr :: !(NodeAddr a)
-  } deriving (Show, Eq, Functor)
-
-instance Eq a => Ord (NodeInfo a) where
-  compare = comparing nodeId
-
--- | KRPC 'compact list' compatible encoding: contact information for
--- nodes is encoded as a 26-byte string. Also known as "Compact node
--- info" the 20-byte Node ID in network byte order has the compact
--- IP-address/port info concatenated to the end.
-instance Serialize a => Serialize (NodeInfo a) where
-  get = NodeInfo <$> get <*> get
-  put NodeInfo {..} = put nodeId >> put nodeAddr
-
-instance Pretty ip => Pretty (NodeInfo ip) where
-  pretty NodeInfo {..} = pretty nodeId <> "@(" <> pretty nodeAddr <> ")"
-
-instance Pretty ip => Pretty [NodeInfo ip] where
-  pretty = PP.vcat . PP.punctuate "," . L.map pretty
-
--- | Order by closeness: nearest nodes first.
-rank :: Eq ip => NodeId -> [NodeInfo ip] -> [NodeInfo ip]
-rank nid = L.sortBy (comparing (distance nid . nodeId))
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
deleted file mode 100644
index 92fb83a7..00000000
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ /dev/null
@@ -1,354 +0,0 @@
--- |
---   Module      :  Network.BitTorrent.Core.PeerAddr
---   Copyright   :  (c) Sam Truzjan 2013
---                  (c) Daniel Gröber 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  provisional
---   Portability :  portable
---
---   'PeerAddr' is used to represent peer address. Currently it's
---   just peer IP and peer port but this might change in future.
---
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE StandaloneDeriving         #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE ViewPatterns               #-}
-{-# OPTIONS -fno-warn-orphans           #-} -- for PortNumber instances
-module Network.BitTorrent.Core.PeerAddr
-       ( -- * Peer address
-         PeerAddr(..)
-       , defaultPorts
-       , peerSockAddr
-       , peerSocket
-
-         -- * Peer storage
-       , PeerStore
-       , Network.BitTorrent.Core.PeerAddr.lookup
-       , Network.BitTorrent.Core.PeerAddr.insert
-       ) where
-
-import Control.Applicative
-import Control.Monad
-import Data.BEncode   as BS
-import Data.BEncode.BDict (BKey)
-import Data.ByteString.Char8 as BS8
-import Data.Char
-import Data.Default
-import Data.Hashable
-import Data.HashMap.Strict as HM
-import Data.IP
-import Data.List      as L
-import Data.List.Split
-import Data.Maybe
-import Data.Monoid
-import Data.Serialize as S
-import Data.String
-import Data.Typeable
-import Data.Word
-import Network.Socket
-import Text.PrettyPrint as PP hiding ((<>))
-import Text.PrettyPrint.Class
-import Text.Read (readMaybe)
-import qualified Text.ParserCombinators.ReadP as RP
-
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core.PeerId
-
-
-{-----------------------------------------------------------------------
---  Port number
------------------------------------------------------------------------}
-
-instance BEncode PortNumber where
-  toBEncode   = toBEncode    .  fromEnum
-  fromBEncode = fromBEncode >=> portNumber
-    where
-      portNumber :: Integer -> BS.Result PortNumber
-      portNumber n
-        | 0 <= n && n <= fromIntegral (maxBound :: Word16)
-        = pure $ fromIntegral n
-        | otherwise = decodingError $ "PortNumber: " ++ show n
-
-instance Serialize PortNumber where
-  get = fromIntegral <$> getWord16be
-  {-# INLINE get #-}
-  put = putWord16be . fromIntegral
-  {-# INLINE put #-}
-
-instance Hashable PortNumber where
-  hashWithSalt s = hashWithSalt s . fromEnum
-  {-# INLINE hashWithSalt #-}
-
-instance Pretty PortNumber where
-  pretty = PP.int . fromEnum
-  {-# INLINE pretty #-}
-
-{-----------------------------------------------------------------------
---  IP addr
------------------------------------------------------------------------}
-
-class IPAddress i where
-  toHostAddr :: i -> Either HostAddress HostAddress6
-
-instance IPAddress IPv4 where
-  toHostAddr = Left . toHostAddress
-  {-# INLINE toHostAddr #-}
-
-instance IPAddress IPv6 where
-  toHostAddr = Right . toHostAddress6
-  {-# INLINE toHostAddr #-}
-
-instance IPAddress IP where
-  toHostAddr (IPv4 ip) = toHostAddr ip
-  toHostAddr (IPv6 ip) = toHostAddr ip
-  {-# INLINE toHostAddr #-}
-
-deriving instance Typeable IP
-deriving instance Typeable IPv4
-deriving instance Typeable IPv6
-
-ipToBEncode :: Show i => i -> BValue
-ipToBEncode ip = BString $ BS8.pack $ show ip
-{-# INLINE ipToBEncode #-}
-
-ipFromBEncode :: Read a => BValue -> BS.Result a
-ipFromBEncode (BString (BS8.unpack -> ipStr))
-  | Just ip <- readMaybe (ipStr) = pure ip
-  |         otherwise            = decodingError $ "IP: " ++ ipStr
-ipFromBEncode _    = decodingError $ "IP: addr should be a bstring"
-
-instance BEncode IP where
-  toBEncode   = ipToBEncode
-  {-# INLINE toBEncode #-}
-  fromBEncode = ipFromBEncode
-  {-# INLINE fromBEncode #-}
-
-instance BEncode IPv4 where
-  toBEncode   = ipToBEncode
-  {-# INLINE toBEncode #-}
-  fromBEncode = ipFromBEncode
-  {-# INLINE fromBEncode #-}
-
-instance BEncode IPv6 where
-  toBEncode   = ipToBEncode
-  {-# INLINE toBEncode #-}
-  fromBEncode = ipFromBEncode
-  {-# INLINE fromBEncode #-}
-
--- | When 'get'ing an IP it must be 'isolate'd to the appropriate
--- number of bytes since we have no other way of telling which
--- address type we are trying to parse
-instance Serialize IP where
-    put (IPv4 ip) = put ip
-    put (IPv6 ip) = put ip
-
-    get = do
-      n <- remaining
-      case n of
-        4  -> IPv4 <$> get
-        16 -> IPv6 <$> get
-        _ -> fail "Wrong number of bytes remaining to parse IP"
-
-instance Serialize IPv4 where
-    put = putWord32host    .  toHostAddress
-    get = fromHostAddress <$> getWord32host
-
-instance Serialize IPv6 where
-    put ip = put $ toHostAddress6 ip
-    get = fromHostAddress6 <$> get
-
-instance Pretty IPv4 where
-  pretty = PP.text . show
-  {-# INLINE pretty #-}
-
-instance Pretty IPv6 where
-  pretty = PP.text . show
-  {-# INLINE pretty #-}
-
-instance Pretty IP where
-  pretty = PP.text . show
-  {-# INLINE pretty #-}
-
-instance Hashable IPv4 where
-  hashWithSalt = hashUsing toHostAddress
-  {-# INLINE hashWithSalt #-}
-
-instance Hashable IPv6 where
-  hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
-
-instance Hashable IP where
-  hashWithSalt s (IPv4 h) = hashWithSalt s h
-  hashWithSalt s (IPv6 h) = hashWithSalt s h
-
-{-----------------------------------------------------------------------
---  Peer addr
------------------------------------------------------------------------}
--- TODO check semantic of ord and eq instances
-
--- | Peer address info normally extracted from peer list or peer
--- compact list encoding.
-data PeerAddr a = PeerAddr
-  { peerId   :: !(Maybe PeerId)
-
-    -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved
-    -- 'HostName'.
-  , peerHost :: !a
-
-    -- | The port the peer listenning for incoming P2P sessions.
-  , peerPort :: {-# UNPACK #-} !PortNumber
-  } deriving (Show, Eq, Ord, Typeable, Functor)
-
-peer_ip_key, peer_id_key, peer_port_key :: BKey
-peer_ip_key   = "ip"
-peer_id_key   = "peer id"
-peer_port_key = "port"
-
--- | The tracker's 'announce response' compatible encoding.
-instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where
-  toBEncode PeerAddr {..} = toDict $
-       peer_ip_key   .=! peerHost
-    .: peer_id_key   .=? peerId
-    .: peer_port_key .=! peerPort
-    .: endDict
-
-  fromBEncode = fromDict $ do
-    peerAddr <$>! peer_ip_key
-             <*>? peer_id_key
-             <*>! peer_port_key
-    where
-      peerAddr = flip PeerAddr
-
--- | The tracker's 'compact peer list' compatible encoding. The
--- 'peerId' is always 'Nothing'.
---
---   For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
---
--- TODO: test byte order
-instance (Serialize a) => Serialize (PeerAddr a) where
-  put PeerAddr {..} = put peerHost >> put peerPort
-  get = PeerAddr Nothing <$> get <*> get
-
--- | @127.0.0.1:6881@
-instance Default (PeerAddr IPv4) where
-  def = "127.0.0.1:6881"
-
--- | @127.0.0.1:6881@
-instance Default (PeerAddr IP) where
-  def = IPv4 <$> def
-
--- | Example:
---
---   @peerPort \"127.0.0.1:6881\" == 6881@
---
-instance IsString (PeerAddr IPv4) where
-  fromString str
-    | [hostAddrStr, portStr] <- splitWhen (== ':') str
-    , Just hostAddr <- readMaybe hostAddrStr
-    , Just portNum  <- toEnum <$> readMaybe portStr
-                = PeerAddr Nothing hostAddr portNum
-    | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str
-
-instance Read (PeerAddr IPv4) where
-  readsPrec i = RP.readP_to_S $ do
-    ipv4 <- RP.readS_to_P (readsPrec i)
-    _    <- RP.char ':'
-    port <- toEnum <$> RP.readS_to_P (readsPrec i)
-    return $ PeerAddr Nothing ipv4 port
-
-readsIPv6_port :: String -> [((IPv6, PortNumber), String)]
-readsIPv6_port = RP.readP_to_S $ do
-  ip <- RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']'
-  _ <- RP.char ':'
-  port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof
-  return (ip,port)
-
-instance IsString (PeerAddr IPv6) where
-  fromString str
-    | [((ip,port),"")] <- readsIPv6_port str =
-        PeerAddr Nothing ip port
-    | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str
-
-instance IsString (PeerAddr IP) where
-  fromString str
-    | '[' `L.elem` str = IPv6 <$> fromString str
-    |      otherwise   = IPv4 <$> fromString str
-
--- | fingerprint + "at" + dotted.host.inet.addr:port
--- TODO: instances for IPv6, HostName
-instance Pretty a => Pretty (PeerAddr a) where
-  pretty PeerAddr {..}
-    | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr
-    |     otherwise      = paddr
-    where
-      paddr = pretty peerHost <> ":" <> text (show peerPort)
-
-instance Hashable a => Hashable (PeerAddr a) where
-  hashWithSalt s PeerAddr {..} =
-    s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort
-
--- | Ports typically reserved for bittorrent P2P listener.
-defaultPorts :: [PortNumber]
-defaultPorts =  [6881..6889]
-
-_resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i
-_resolvePeerAddr = undefined
-
-_peerSockAddr :: PeerAddr IP -> (Family, SockAddr)
-_peerSockAddr PeerAddr {..} =
-    case peerHost of
-          IPv4 ipv4 ->
-              (AF_INET, SockAddrInet peerPort (toHostAddress  ipv4))
-          IPv6 ipv6 ->
-              (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0)
-
-peerSockAddr :: PeerAddr IP -> SockAddr
-peerSockAddr = snd . _peerSockAddr
-
--- | Create a socket connected to the address specified in a peerAddr
-peerSocket :: SocketType -> PeerAddr IP -> IO Socket
-peerSocket socketType pa = do
-    let (family, addr) = _peerSockAddr pa
-    sock <- socket family socketType defaultProtocol
-    connect sock addr
-    return sock
-
-{-----------------------------------------------------------------------
---  Peer storage
------------------------------------------------------------------------}
--- TODO use more memory efficient representation
-
--- | Storage used to keep track a set of known peers in client,
--- tracker or DHT sessions.
-newtype PeerStore ip = PeerStore (HashMap InfoHash [PeerAddr ip])
-
--- | Empty store.
-instance Default (PeerStore a) where
-  def = PeerStore HM.empty
-  {-# INLINE def #-}
-
--- | Monoid under union operation.
-instance Eq a => Monoid (PeerStore a) where
-  mempty  = def
-  {-# INLINE mempty #-}
-
-  mappend (PeerStore a) (PeerStore b) =
-    PeerStore (HM.unionWith L.union a b)
-  {-# INLINE mappend #-}
-
--- | Can be used to store peers between invocations of the client
--- software.
-instance Serialize (PeerStore a) where
-  get = undefined
-  put = undefined
-
--- | Used in 'get_peers' DHT queries.
-lookup :: InfoHash -> PeerStore a -> [PeerAddr a]
-lookup ih (PeerStore m) = fromMaybe [] $ HM.lookup ih m
-
--- | Used in 'announce_peer' DHT queries.
-insert :: Eq a => InfoHash -> PeerAddr a -> PeerStore a -> PeerStore a
-insert ih a (PeerStore m) = PeerStore (HM.insertWith L.union ih [a] m)
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
deleted file mode 100644
index a180ff30..00000000
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ /dev/null
@@ -1,364 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---  'PeerID' represent self assigned peer identificator. Ideally each
---  host in the network should have unique peer id to avoid
---  collisions, therefore for peer ID generation we use good entropy
---  source. Peer ID is sent in /tracker request/, sent and received in
---  /peer handshakes/ and used in DHT queries.
---
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-module Network.BitTorrent.Core.PeerId
-       ( -- * PeerId
-         PeerId
-
-         -- * Generation
-       , genPeerId
-       , timestamp
-       , entropy
-
-         -- * Encoding
-       , azureusStyle
-       , shadowStyle
-       , defaultClientId
-       , defaultVersionNumber
-
-         -- * Decoding
-       , fingerprint
-       ) where
-
-import Control.Applicative
-import Data.BEncode as BE
-import Data.ByteString as BS
-import Data.ByteString.Internal as BS
-import Data.ByteString.Char8 as BC
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Lazy.Builder as BS
-import Data.Convertible
-import Data.Default
-import Data.Foldable    (foldMap)
-import Data.List as L
-import Data.List.Split as L
-import Data.Maybe       (fromMaybe, catMaybes)
-import Data.Monoid
-import Data.Hashable
-import Data.Serialize as S
-import Data.String
-import Data.Time.Clock  (getCurrentTime)
-import Data.Time.Format (formatTime)
-import Data.Typeable
-import Data.Version     (Version(Version), versionBranch)
-import Network.HTTP.Types.QueryLike
-import System.Entropy   (getEntropy)
-import System.Locale    (defaultTimeLocale)
-import Text.PrettyPrint hiding ((<>))
-import Text.PrettyPrint.Class
-import Text.Read        (readMaybe)
-
-import Network.BitTorrent.Core.Fingerprint
-
--- TODO use unpacked Word160 form (length is known statically)
-
--- | Peer identifier is exactly 20 bytes long bytestring.
-newtype PeerId = PeerId { getPeerId :: ByteString }
-  deriving (Show, Eq, Ord, BEncode, Typeable)
-
-peerIdLen :: Int
-peerIdLen = 20
-
--- | For testing purposes only.
-instance Default PeerId where
-  def = azureusStyle defaultClientId defaultVersionNumber ""
-
-instance Hashable PeerId where
-  hashWithSalt = hashUsing getPeerId
-  {-# INLINE hashWithSalt #-}
-
-instance Serialize PeerId where
-  put = putByteString . getPeerId
-  get = PeerId <$> getBytes peerIdLen
-
-instance QueryValueLike PeerId where
-  toQueryValue (PeerId pid) = Just pid
-  {-# INLINE toQueryValue #-}
-
-instance IsString PeerId where
-  fromString str
-      | BS.length bs == peerIdLen = PeerId bs
-      | otherwise = error $ "Peer id should be 20 bytes long: " ++ show str
-    where
-      bs = fromString str
-
-instance Pretty PeerId where
-  pretty = text . BC.unpack . getPeerId
-
-instance Convertible BS.ByteString PeerId where
-  safeConvert bs
-    | BS.length bs == peerIdLen = pure (PeerId bs)
-    |          otherwise        = convError "invalid length" bs
-
-{-----------------------------------------------------------------------
---  Encoding
------------------------------------------------------------------------}
-
--- | Pad bytestring so it's becomes exactly request length. Conversion
--- is done like so:
---
---     * length < size: Complete bytestring by given charaters.
---
---     * length = size: Output bytestring as is.
---
---     * length > size: Drop last (length - size) charaters from a
---     given bytestring.
---
-byteStringPadded :: ByteString -- ^ bytestring to be padded.
-                 -> Int        -- ^ size of result builder.
-                 -> Char       -- ^ character used for padding.
-                 -> BS.Builder
-byteStringPadded bs s c =
-      BS.byteString (BS.take s bs) <>
-      BS.byteString (BC.replicate padLen c)
-  where
-    padLen = s - min (BS.length bs) s
-
--- | Azureus-style encoding have the following layout:
---
---     * 1  byte : '-'
---
---     * 2  bytes: client id
---
---     * 4  bytes: version number
---
---     * 1  byte : '-'
---
---     * 12 bytes: random number
---
-azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
-             -> ByteString -- ^ Version number, padded with 'X'.
-             -> ByteString -- ^ Random number, padded with '0'.
-             -> PeerId     -- ^ Azureus-style encoded peer ID.
-azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
-    BS.char8 '-' <>
-      byteStringPadded cid 2  'H' <>
-      byteStringPadded ver 4  'X' <>
-    BS.char8 '-' <>
-      byteStringPadded rnd 12 '0'
-
--- | Shadow-style encoding have the following layout:
---
---     * 1 byte   : client id.
---
---     * 0-4 bytes: version number. If less than 4 then padded with
---     '-' char.
---
---     * 15 bytes : random number. If length is less than 15 then
---     padded with '0' char.
---
-shadowStyle :: Char       -- ^ Client ID.
-            -> ByteString -- ^ Version number.
-            -> ByteString -- ^ Random number.
-            -> PeerId     -- ^ Shadow style encoded peer ID.
-shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
-    BS.char8 cid <>
-      byteStringPadded ver 4  '-' <>
-      byteStringPadded rnd 15 '0'
-
-
--- | 'HS'- 2 bytes long client identifier.
-defaultClientId :: ByteString
-defaultClientId = "HS"
-
--- | Gives exactly 4 bytes long version number for any version of the
--- package.  Version is taken from .cabal file.
-defaultVersionNumber :: ByteString
-defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
-                         versionBranch $ ciVersion libFingerprint
-
-{-----------------------------------------------------------------------
---  Generation
------------------------------------------------------------------------}
-
--- | Gives 15 characters long decimal timestamp such that:
---
---     * 6 bytes   : first 6 characters from picoseconds obtained with %q.
---
---     * 1 byte    : character \'.\' for readability.
---
---     * 9..* bytes: number of whole seconds since the Unix epoch
---     (!)REVERSED.
---
---   Can be used both with shadow and azureus style encoding. This
---   format is used to make the ID's readable for debugging purposes.
---
-timestamp :: IO ByteString
-timestamp = (BC.pack . format) <$> getCurrentTime
-  where
-    format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
-               L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t))
-
--- | Gives 15 character long random bytestring. This is more robust
--- method for generation of random part of peer ID than 'timestamp'.
-entropy :: IO ByteString
-entropy = getEntropy 15
-
--- NOTE: entropy generates incorrrect peer id
-
--- |  Here we use 'azureusStyle' encoding with the following args:
---
---      * 'HS' for the client id; ('defaultClientId')
---
---      * Version of the package for the version number;
---      ('defaultVersionNumber')
---
---      * UTC time day ++ day time for the random number. ('timestamp')
---
-genPeerId :: IO PeerId
-genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
-
-{-----------------------------------------------------------------------
---  Decoding
------------------------------------------------------------------------}
-
-parseImpl :: ByteString -> ClientImpl
-parseImpl = f . BC.unpack
- where
-  f "AG" = IAres
-  f "A~" = IAres
-  f "AR" = IArctic
-  f "AV" = IAvicora
-  f "AX" = IBitPump
-  f "AZ" = IAzureus
-  f "BB" = IBitBuddy
-  f "BC" = IBitComet
-  f "BF" = IBitflu
-  f "BG" = IBTG
-  f "BR" = IBitRocket
-  f "BS" = IBTSlave
-  f "BX" = IBittorrentX
-  f "CD" = IEnhancedCTorrent
-  f "CT" = ICTorrent
-  f "DE" = IDelugeTorrent
-  f "DP" = IPropagateDataClient
-  f "EB" = IEBit
-  f "ES" = IElectricSheep
-  f "FT" = IFoxTorrent
-  f "GS" = IGSTorrent
-  f "HL" = IHalite
-  f "HS" = IlibHSbittorrent
-  f "HN" = IHydranode
-  f "KG" = IKGet
-  f "KT" = IKTorrent
-  f "LH" = ILH_ABC
-  f "LP" = ILphant
-  f "LT" = ILibtorrent
-  f "lt" = ILibTorrent
-  f "LW" = ILimeWire
-  f "MO" = IMonoTorrent
-  f "MP" = IMooPolice
-  f "MR" = IMiro
-  f "ML" = IMLdonkey
-  f "MT" = IMoonlightTorrent
-  f "NX" = INetTransport
-  f "PD" = IPando
-  f "qB" = IqBittorrent
-  f "QD" = IQQDownload
-  f "QT" = IQt4TorrentExample
-  f "RT" = IRetriever
-  f "S~" = IShareaza
-  f "SB" = ISwiftbit
-  f "SS" = ISwarmScope
-  f "ST" = ISymTorrent
-  f "st" = Isharktorrent
-  f "SZ" = IShareaza
-  f "TN" = ITorrentDotNET
-  f "TR" = ITransmission
-  f "TS" = ITorrentstorm
-  f "TT" = ITuoTu
-  f "UL" = IuLeecher
-  f "UT" = IuTorrent
-  f "VG" = IVagaa
-  f "WT" = IBitLet
-  f "WY" = IFireTorrent
-  f "XL" = IXunlei
-  f "XT" = IXanTorrent
-  f "XX" = IXtorrent
-  f "ZT" = IZipTorrent
-  f _    = IUnknown
-
--- TODO use regexps
-
--- | Tries to extract meaningful information from peer ID bytes. If
--- peer id uses unknown coding style then client info returned is
--- 'def'.
---
-fingerprint :: PeerId -> Fingerprint
-fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
-  where
-    getCI    = do
-      leading <- BS.w2c <$> getWord8
-      case leading of
-        '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion
-        'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion
-        'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
-        'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
-        c   -> do
-          c1 <- w2c <$> S.lookAhead getWord8
-          if c1 == 'P'
-            then do
-                 _ <- getWord8
-                 Fingerprint <$> pure IOpera            <*> getOperaVersion
-            else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion
-
-    getMainlineVersion = do
-      str <- BC.unpack <$> getByteString 7
-      let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str
-      return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) []
-
-    getAzureusImpl    = parseImpl <$> getByteString 2
-    getAzureusVersion = mkVer     <$> getByteString 4
-      where
-        mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
-
-    getBitCometImpl = do
-      bs <- getByteString 3
-      S.lookAhead $ do
-        _  <- getByteString 2
-        lr <- getByteString 4
-        return $
-          if lr == "LORD" then IBitLord  else
-          if bs == "UTB"  then IBitComet else
-          if bs == "xbc"  then IBitComet else def
-
-    getBitCometVersion = do
-      x <- getWord8
-      y <- getWord8
-      return $ Version [fromIntegral x, fromIntegral y] []
-
-    getOperaVersion = do
-      str <- BC.unpack <$> getByteString 4
-      return $ Version [fromMaybe 0 $ readMaybe str] []
-
-    getShadowImpl 'A' = IABC
-    getShadowImpl 'O' = IOspreyPermaseed
-    getShadowImpl 'Q' = IBTQueue
-    getShadowImpl 'R' = ITribler
-    getShadowImpl 'S' = IShadow
-    getShadowImpl 'T' = IBitTornado
-    getShadowImpl  _  = IUnknown
-
-    decodeShadowVerNr :: Char -> Maybe Int
-    decodeShadowVerNr c
-      | '0' < c && c <= '9' = Just  (fromEnum c - fromEnum '0')
-      | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10)
-      | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36)
-      |        otherwise    = Nothing
-
-    getShadowVersion = do
-      str <- BC.unpack <$> getByteString 5
-      return $ Version (catMaybes $ L.map decodeShadowVerNr str) []
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
index f587f7c8..39b33478 100644
--- a/src/Network/BitTorrent/DHT.hs
+++ b/src/Network/BitTorrent/DHT.hs
@@ -62,9 +62,8 @@ import Data.Conduit as C
 import Data.Conduit.List as C
 import Network.Socket
 
-import Data.Torrent (tNodes)
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
+import Data.Torrent
+import Network.BitTorrent.Address
 import Network.BitTorrent.DHT.Query
 import Network.BitTorrent.DHT.Session
 import Network.BitTorrent.DHT.Routing as T
diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs
index 028a4214..baa240b4 100644
--- a/src/Network/BitTorrent/DHT/ContactInfo.hs
+++ b/src/Network/BitTorrent/DHT/ContactInfo.hs
@@ -1,10 +1,24 @@
 module Network.BitTorrent.DHT.ContactInfo
-       (        ) where
+       ( PeerStore
+       , Network.BitTorrent.DHT.ContactInfo.lookup
+       , Network.BitTorrent.DHT.ContactInfo.insert
+       ) where
+
+import Data.Default
+import Data.List as L
+import Data.Maybe
+import Data.Monoid
+import Data.HashMap.Strict as HM
+import Data.Serialize
+
+import Data.Torrent
+import Network.BitTorrent.Address
+
 {-
 import Data.HashMap.Strict as HM
 
 import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
+import Network.BitTorrent.Address
 
 -- increase prefix when table is too large
 -- decrease prefix when table is too small
@@ -90,4 +104,36 @@ prune pref targetSize (Tip _ _) = undefined
 -- | Remove expired entries.
 splitGT :: Timestamp -> ContactInfo ip -> ContactInfo ip
 splitGT = undefined
--}
\ No newline at end of file
+-}
+
+-- | Storage used to keep track a set of known peers in client,
+-- tracker or DHT sessions.
+newtype PeerStore ip = PeerStore (HashMap InfoHash [PeerAddr ip])
+
+-- | Empty store.
+instance Default (PeerStore a) where
+  def = PeerStore HM.empty
+  {-# INLINE def #-}
+
+-- | Monoid under union operation.
+instance Eq a => Monoid (PeerStore a) where
+  mempty  = def
+  {-# INLINE mempty #-}
+
+  mappend (PeerStore a) (PeerStore b) =
+    PeerStore (HM.unionWith L.union a b)
+  {-# INLINE mappend #-}
+
+-- | Can be used to store peers between invocations of the client
+-- software.
+instance Serialize (PeerStore a) where
+  get = undefined
+  put = undefined
+
+-- | Used in 'get_peers' DHT queries.
+lookup :: InfoHash -> PeerStore a -> [PeerAddr a]
+lookup ih (PeerStore m) = fromMaybe [] $ HM.lookup ih m
+
+-- | Used in 'announce_peer' DHT queries.
+insert :: Eq a => InfoHash -> PeerAddr a -> PeerStore a -> PeerStore a
+insert ih a (PeerStore m) = PeerStore (HM.insertWith L.union ih [a] m)
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
index 7bcd00f0..145141ee 100644
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ b/src/Network/BitTorrent/DHT/Message.hs
@@ -92,8 +92,8 @@ import Data.Typeable
 import Network
 import Network.KRPC
 
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
+import Data.Torrent
+import Network.BitTorrent.Address
 import Network.BitTorrent.DHT.Token
 import Network.KRPC ()
 
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index 48dfc15a..d4710ecf 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -56,8 +56,8 @@ import Text.PrettyPrint as PP hiding ((<>), ($$))
 import Text.PrettyPrint.Class
 
 import Network.KRPC hiding (Options, def)
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
+import Data.Torrent
+import Network.BitTorrent.Address
 import Network.BitTorrent.DHT.Message
 import Network.BitTorrent.DHT.Routing
 import Network.BitTorrent.DHT.Session
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs
index 106aec31..ee295125 100644
--- a/src/Network/BitTorrent/DHT/Routing.hs
+++ b/src/Network/BitTorrent/DHT/Routing.hs
@@ -73,8 +73,8 @@ import GHC.Generics
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
+import Data.Torrent
+import Network.BitTorrent.Address
 
 {-----------------------------------------------------------------------
 --  Routing monad
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index e770b1d3..208f8ec8 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -75,6 +75,7 @@ import Control.Monad.Logger
 import Control.Monad.Reader
 import Control.Monad.Trans.Control
 import Control.Monad.Trans.Resource
+import Data.Conduit.Lazy
 import Data.Default
 import Data.Fixed
 import Data.Hashable
@@ -91,11 +92,11 @@ import System.Random (randomIO)
 import Text.PrettyPrint as PP hiding ((<>), ($$))
 import Text.PrettyPrint.Class
 
-import Data.Torrent.InfoHash
+import Data.Torrent as Torrent
 import Network.KRPC hiding (Options, def)
 import qualified Network.KRPC as KRPC (def)
-import Network.BitTorrent.Core
-import Network.BitTorrent.Core.PeerAddr as P
+import Network.BitTorrent.Address
+import Network.BitTorrent.DHT.ContactInfo as P
 import Network.BitTorrent.DHT.Message
 import Network.BitTorrent.DHT.Routing as R
 import Network.BitTorrent.DHT.Token   as T
@@ -253,10 +254,8 @@ data Node ip = Node
 -- | DHT keep track current session and proper resource allocation for
 -- safe multithreading.
 newtype DHT ip a = DHT { unDHT :: ReaderT (Node ip) IO a }
-  deriving ( Functor, Applicative, Monad
-           , MonadIO, MonadBase IO
-           , MonadReader (Node ip)
-           , MonadThrow, MonadUnsafeIO
+  deriving ( Functor, Applicative, Monad, MonadIO
+           , MonadBase IO, MonadReader (Node ip), MonadThrow
            )
 
 instance MonadBaseControl IO (DHT ip) where
diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs
index a38456fd..a0ed428b 100644
--- a/src/Network/BitTorrent/DHT/Token.hs
+++ b/src/Network/BitTorrent/DHT/Token.hs
@@ -50,7 +50,7 @@ import Data.String
 import Data.Time
 import System.Random
 
-import Network.BitTorrent.Core
+import Network.BitTorrent.Address
 
 -- TODO use ShortByteString
 
diff --git a/src/Network/BitTorrent/Exchange/Assembler.hs b/src/Network/BitTorrent/Exchange/Assembler.hs
deleted file mode 100644
index e5834948..00000000
--- a/src/Network/BitTorrent/Exchange/Assembler.hs
+++ /dev/null
@@ -1,168 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   Assembler is used to build pieces from blocks. In general
---   'Assembler' should be used to handle 'Transfer' messages when
---
---   A block can have one of the following status:
---
---     1) /not allowed/: Piece is not in download set. 'null' and 'empty'.
---
---
---     2) /waiting/: (allowed?) Block have been allowed to download,
---     but /this/ peer did not send any 'Request' message for this
---     block. To allow some piece use
---     'Network.BitTorrent.Exchange.Selector' and then 'allowedSet'
---     and 'allowPiece'.
---
---     3) /inflight/: (pending?) Block have been requested but
---     /remote/ peer did not send any 'Piece' message for this block.
---     Related functions 'markInflight'
---
---     4) /pending/: (stalled?) Block have have been downloaded
---     Related functions 'insertBlock'.
---
---   Piece status:
---
---     1) /assembled/: (downloaded?) All blocks in piece have been
---     downloaded but the piece did not verified yet.
---
---       * Valid: go to completed;
---
---       * Invalid: go to waiting.
---
---     2) /corrupted/:
---
---     3) /downloaded/: (verified?) A piece have been successfully
---     verified via the hash. Usually the piece should be stored to
---     the 'System.Torrent.Storage' and /this/ peer should send 'Have'
---     messages to the /remote/ peers.
---
-{-# LANGUAGE TemplateHaskell #-}
-module Network.BitTorrent.Exchange.Assembler
-       ( -- * Assembler
-         Assembler
-
-         -- * Query
-       , Network.BitTorrent.Exchange.Assembler.null
-       , Network.BitTorrent.Exchange.Assembler.size
-
-         -- *
-       , Network.BitTorrent.Exchange.Assembler.empty
-       , allowPiece
-
-         -- * Debugging
-       , Network.BitTorrent.Exchange.Assembler.valid
-       ) where
-
-import Control.Applicative
-import Control.Lens
-import Data.IntMap.Strict as IM
-import Data.List as L
-import Data.Map as M
-import Data.Maybe
-import Data.IP
-
-import Data.Torrent.Piece
-import Network.BitTorrent.Core
-import Network.BitTorrent.Exchange.Block as B
-
-{-----------------------------------------------------------------------
---  Assembler
------------------------------------------------------------------------}
-
-type Timestamp = ()
-{-
-data BlockRequest = BlockRequest
-  { requestSent    :: Timestamp
-  , requestedPeer  :: PeerAddr IP
-  , requestedBlock :: BlockIx
-  }
--}
-type BlockRange = (BlockOffset, BlockSize)
-type PieceMap = IntMap
-
-data Assembler = Assembler
-  { -- | A set of blocks that have been 'Request'ed but not yet acked.
-    _inflight :: Map (PeerAddr IP) (PieceMap [BlockRange])
-
-    -- | A set of blocks that but not yet assembled.
-  , _pending  :: PieceMap Bucket
-
-    -- | Used for validation of assembled pieces.
-  , info      :: PieceInfo
-  }
-
-$(makeLenses ''Assembler)
-
-
-valid :: Assembler -> Bool
-valid = undefined
-
-data Result a
-  = Completed   (Piece a)
-  | Corrupted    PieceIx
-  | NotRequested PieceIx
-  | Overlapped   BlockIx
-
-null :: Assembler -> Bool
-null = undefined
-
-size :: Assembler -> Bool
-size = undefined
-
-empty :: PieceInfo -> Assembler
-empty = Assembler M.empty IM.empty
-
-allowPiece :: PieceIx -> Assembler -> Assembler
-allowPiece pix a @ Assembler {..}  = over pending (IM.insert pix bkt) a
-  where
-    bkt = B.empty (piPieceLength info)
-
-allowedSet :: (PeerAddr IP) -> Assembler -> [BlockIx]
-allowedSet = undefined
-
---inflight :: PeerAddr -> BlockIx -> Assembler -> Assembler
---inflight = undefined
-
---  You should check if a returned by peer block is actually have
--- been requested and in-flight. This is needed to avoid "I send
--- random corrupted block" attacks.
-insert :: PeerAddr IP -> Block a -> Assembler -> Assembler
-insert = undefined
-
-{-
-insert :: Block a -> Assembler a -> (Assembler a, Maybe (Result a))
-insert blk @ Block {..} a @ Assembler {..} = undefined
-{-
-  = let (pending, mpiece) = inserta blk piecePending
-    in (Assembler inflightSet pending pieceInfo, f <$> mpiece)
-  where
-    f p = undefined
---      | checkPieceLazy pieceInfo p = Assembled p
---      |          otherwise         = Corrupted ixPiece
--}
-
-
-inflightPieces :: Assembler a -> [PieceIx]
-inflightPieces Assembler {..} = IM.keys piecePending
-
-completeBlocks :: PieceIx -> Assembler a -> [Block a]
-completeBlocks pix Assembler {..}  = fromMaybe [] $ IM.lookup pix piecePending
-
-incompleteBlocks :: PieceIx -> Assembler a -> [BlockIx]
-incompleteBlocks = undefined
-
-nextBlock :: Assembler a -> Maybe (Assembler a, BlockIx)
-nextBlock Assembler {..} = undefined
-
-inserta :: Block a
-        -> PieceMap [Block a]
-        -> (PieceMap [Block a], Maybe (Piece a))
-inserta = undefined
-
--}
diff --git a/src/Network/BitTorrent/Exchange/Bitfield.hs b/src/Network/BitTorrent/Exchange/Bitfield.hs
new file mode 100644
index 00000000..eca11d83
--- /dev/null
+++ b/src/Network/BitTorrent/Exchange/Bitfield.hs
@@ -0,0 +1,398 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   This modules provides all necessary machinery to work with
+--   bitfields. Bitfields are used to keep track indices of complete
+--   pieces either peer have or client have.
+--
+--   There are also commonly used piece seletion algorithms
+--   which used to find out which one next piece to download.
+--   Selectors considered to be used in the following order:
+--
+--     * Random first - at the start.
+--
+--     * Rarest first selection - performed to avoid situation when
+--     rarest piece is unaccessible.
+--
+--     * /End game/ seletion - performed after a peer has requested all
+--     the subpieces of the content.
+--
+--   Note that BitTorrent applies the strict priority policy for
+--   /subpiece/ or /blocks/ selection.
+--
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
+module Network.BitTorrent.Exchange.Bitfield
+       ( -- * Bitfield
+         PieceIx
+       , PieceCount
+       , Bitfield
+
+         -- * Construction
+       , haveAll
+       , haveNone
+       , have
+       , singleton
+       , interval
+       , adjustSize
+
+         -- * Query
+         -- ** Cardinality
+       , Network.BitTorrent.Exchange.Bitfield.null
+       , Network.BitTorrent.Exchange.Bitfield.full
+       , haveCount
+       , totalCount
+       , completeness
+
+         -- ** Membership
+       , member
+       , notMember
+       , findMin
+       , findMax
+       , isSubsetOf
+
+         -- ** Availability
+       , complement
+       , Frequency
+       , frequencies
+       , rarest
+
+         -- * Combine
+       , insert
+       , union
+       , intersection
+       , difference
+
+         -- * Conversion
+       , toList
+       , fromList
+
+         -- * Serialization
+       , fromBitmap
+       , toBitmap
+
+         -- * Piece selection
+       , Selector
+       , selector
+       , strategyClass
+
+       , strictFirst
+       , strictLast
+       , rarestFirst
+       , randomFirst
+       , endGame
+       ) where
+
+import Control.Monad
+import Control.Monad.ST
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as Lazy
+import           Data.Vector.Unboxed (Vector)
+import qualified Data.Vector.Unboxed as V
+import qualified Data.Vector.Unboxed.Mutable as VM
+import           Data.IntervalSet (IntSet)
+import qualified Data.IntervalSet as S
+import qualified Data.IntervalSet.ByteString as S
+import           Data.List (foldl')
+import           Data.Monoid
+import           Data.Ratio
+
+import Data.Torrent
+
+-- TODO cache some operations
+
+-- | Bitfields are represented just as integer sets but with
+-- restriction: the each set should be within given interval (or
+-- subset of the specified interval). Size is used to specify
+-- interval, so bitfield of size 10 might contain only indices in
+-- interval [0..9].
+--
+data Bitfield = Bitfield {
+    bfSize :: !PieceCount
+  , bfSet  :: !IntSet
+  } deriving (Show, Read, Eq)
+
+-- Invariants: all elements of bfSet lie in [0..bfSize - 1];
+
+instance Monoid Bitfield where
+  {-# SPECIALIZE instance Monoid Bitfield #-}
+  mempty  = haveNone 0
+  mappend = union
+  mconcat = unions
+
+{-----------------------------------------------------------------------
+    Construction
+-----------------------------------------------------------------------}
+
+-- | The empty bitfield of the given size.
+haveNone :: PieceCount -> Bitfield
+haveNone s = Bitfield s S.empty
+
+-- | The full bitfield containing all piece indices for the given size.
+haveAll :: PieceCount -> Bitfield
+haveAll s = Bitfield s (S.interval 0 (s - 1))
+
+-- | Insert the index in the set ignoring out of range indices.
+have :: PieceIx -> Bitfield -> Bitfield
+have ix Bitfield {..}
+  | 0 <= ix && ix < bfSize = Bitfield bfSize (S.insert ix bfSet)
+  |      otherwise         = Bitfield bfSize bfSet
+
+singleton :: PieceIx -> PieceCount -> Bitfield
+singleton ix pc = have ix (haveNone pc)
+
+-- | Assign new size to bitfield. FIXME Normally, size should be only
+-- decreased, otherwise exception raised.
+adjustSize :: PieceCount -> Bitfield -> Bitfield
+adjustSize s Bitfield {..} = Bitfield s bfSet
+
+-- | NOTE: for internal use only
+interval :: PieceCount -> PieceIx -> PieceIx -> Bitfield
+interval pc a b = Bitfield pc (S.interval a b)
+
+{-----------------------------------------------------------------------
+    Query
+-----------------------------------------------------------------------}
+
+-- | Test if bitifield have no one index: peer do not have anything.
+null :: Bitfield -> Bool
+null Bitfield {..} = S.null bfSet
+
+-- | Test if bitfield have all pieces.
+full :: Bitfield -> Bool
+full Bitfield {..} = S.size bfSet == bfSize
+
+-- | Count of peer have pieces.
+haveCount :: Bitfield -> PieceCount
+haveCount = S.size . bfSet
+
+-- | Total count of pieces and its indices.
+totalCount :: Bitfield -> PieceCount
+totalCount = bfSize
+
+-- | Ratio of /have/ piece count to the /total/ piece count.
+--
+--   > forall bf. 0 <= completeness bf <= 1
+--
+completeness :: Bitfield -> Ratio PieceCount
+completeness b = haveCount b % totalCount b
+
+inRange :: PieceIx -> Bitfield -> Bool
+inRange ix Bitfield {..} = 0 <= ix && ix < bfSize
+
+member :: PieceIx -> Bitfield -> Bool
+member ix bf @ Bitfield {..}
+  | ix `inRange` bf = ix `S.member` bfSet
+  |     otherwise   = False
+
+notMember :: PieceIx -> Bitfield -> Bool
+notMember ix bf @ Bitfield {..}
+  | ix `inRange` bf = ix `S.notMember` bfSet
+  |     otherwise   = True
+
+-- | Find first available piece index.
+findMin :: Bitfield -> PieceIx
+findMin = S.findMin . bfSet
+{-# INLINE findMin #-}
+
+-- | Find last available piece index.
+findMax :: Bitfield -> PieceIx
+findMax = S.findMax . bfSet
+{-# INLINE findMax #-}
+
+-- | Check if all pieces from first bitfield present if the second bitfield
+isSubsetOf :: Bitfield -> Bitfield -> Bool
+isSubsetOf a b = bfSet a `S.isSubsetOf` bfSet b
+{-# INLINE isSubsetOf #-}
+
+-- | Resulting bitfield includes only missing pieces.
+complement :: Bitfield -> Bitfield
+complement Bitfield {..} = Bitfield
+  { bfSet  = uni `S.difference` bfSet
+  , bfSize = bfSize
+  }
+  where
+    Bitfield _ uni = haveAll bfSize
+{-# INLINE complement #-}
+
+{-----------------------------------------------------------------------
+-- Availability
+-----------------------------------------------------------------------}
+
+-- | Frequencies are needed in piece selection startegies which use
+-- availability quantity to find out the optimal next piece index to
+-- download.
+type Frequency = Int
+
+-- TODO rename to availability
+-- | How many times each piece index occur in the given bitfield set.
+frequencies :: [Bitfield] -> Vector Frequency
+frequencies [] = V.fromList []
+frequencies xs = runST $ do
+    v <- VM.new size
+    VM.set v 0
+    forM_ xs $ \ Bitfield {..} -> do
+      forM_ (S.toList bfSet) $ \ x -> do
+        fr <- VM.read v x
+        VM.write v x (succ fr)
+    V.unsafeFreeze v
+  where
+    size = maximum (map bfSize xs)
+
+-- TODO it seems like this operation is veeery slow
+
+-- | Find least available piece index. If no piece available return
+-- 'Nothing'.
+rarest :: [Bitfield] -> Maybe PieceIx
+rarest xs
+    | V.null freqMap = Nothing
+    |     otherwise
+    = Just $ fst $ V.ifoldr' minIx (0, freqMap V.! 0) freqMap
+  where
+    freqMap = frequencies xs
+
+    minIx ::  PieceIx -> Frequency
+          -> (PieceIx,   Frequency)
+          -> (PieceIx,   Frequency)
+    minIx ix fr acc@(_, fra)
+      | fr < fra && fr > 0 = (ix, fr)
+      |     otherwise      = acc
+
+
+{-----------------------------------------------------------------------
+    Combine
+-----------------------------------------------------------------------}
+
+insert :: PieceIx -> Bitfield -> Bitfield
+insert pix bf @ Bitfield {..}
+  | 0 <= pix && pix < bfSize = Bitfield
+    { bfSet  = S.insert pix bfSet
+    , bfSize = bfSize
+    }
+  | otherwise = bf
+
+-- | Find indices at least one peer have.
+union :: Bitfield -> Bitfield -> Bitfield
+union a b = {-# SCC union #-} Bitfield {
+    bfSize = bfSize a `max` bfSize b
+  , bfSet  = bfSet a `S.union` bfSet b
+  }
+
+-- | Find indices both peers have.
+intersection :: Bitfield -> Bitfield -> Bitfield
+intersection a b = {-# SCC intersection #-} Bitfield {
+    bfSize = bfSize a `min` bfSize b
+  , bfSet  = bfSet a `S.intersection` bfSet b
+  }
+
+-- | Find indices which have first peer but do not have the second peer.
+difference :: Bitfield -> Bitfield -> Bitfield
+difference a b = {-# SCC difference #-} Bitfield {
+    bfSize = bfSize a -- FIXME is it reasonable?
+  , bfSet  = bfSet a `S.difference` bfSet b
+  }
+
+-- | Find indices the any of the peers have.
+unions :: [Bitfield] -> Bitfield
+unions = {-# SCC unions #-} foldl' union (haveNone 0)
+
+{-----------------------------------------------------------------------
+    Serialization
+-----------------------------------------------------------------------}
+
+-- | List all /have/ indexes.
+toList :: Bitfield -> [PieceIx]
+toList Bitfield {..} = S.toList bfSet
+
+-- | Make bitfield from list of /have/ indexes.
+fromList :: PieceCount -> [PieceIx] -> Bitfield
+fromList s ixs = Bitfield {
+    bfSize = s
+  , bfSet  = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs
+  }
+
+-- | Unpack 'Bitfield' from tightly packed bit array. Note resulting
+-- size might be more than real bitfield size, use 'adjustSize'.
+fromBitmap :: ByteString -> Bitfield
+fromBitmap bs = {-# SCC fromBitmap #-} Bitfield {
+    bfSize = B.length bs * 8
+  , bfSet  = S.fromByteString bs
+  }
+{-# INLINE fromBitmap #-}
+
+-- | Pack a 'Bitfield' to tightly packed bit array.
+toBitmap :: Bitfield -> Lazy.ByteString
+toBitmap Bitfield {..} = {-# SCC toBitmap #-} Lazy.fromChunks [intsetBM, alignment]
+  where
+    byteSize  = bfSize `div` 8 + if bfSize `mod` 8 == 0 then 0 else 1
+    alignment = B.replicate (byteSize - B.length intsetBM) 0
+    intsetBM  = S.toByteString bfSet
+
+{-----------------------------------------------------------------------
+--  Piece selection
+-----------------------------------------------------------------------}
+
+type Selector =  Bitfield      -- ^ Indices of client /have/ pieces.
+             ->  Bitfield      -- ^ Indices of peer /have/ pieces.
+             -> [Bitfield]     -- ^ Indices of other peers /have/ pieces.
+             -> Maybe PieceIx  -- ^ Zero-based index of piece to request
+                               --   to, if any.
+
+selector :: Selector       -- ^ Selector to use at the start.
+         -> Ratio PieceCount
+         -> Selector       -- ^ Selector to use after the client have
+                           -- the C pieces.
+         -> Selector       -- ^ Selector that changes behaviour based
+                           -- on completeness.
+selector start pt ready   h a xs =
+  case strategyClass pt h of
+    SCBeginning -> start h a xs
+    SCReady     -> ready h a xs
+    SCEnd       -> endGame h a xs
+
+data StartegyClass
+  = SCBeginning
+  | SCReady
+  | SCEnd
+    deriving (Show, Eq, Ord, Enum, Bounded)
+
+
+strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
+strategyClass threshold = classify . completeness
+  where
+    classify c
+      |        c < threshold       = SCBeginning
+      | c + 1 % numerator c < 1    = SCReady
+    -- FIXME numerator have is not total count
+      |          otherwise         = SCEnd
+
+
+-- | Select the first available piece.
+strictFirst :: Selector
+strictFirst h a _ = Just $ findMin (difference a h)
+
+-- | Select the last available piece.
+strictLast :: Selector
+strictLast h a _ = Just $ findMax (difference a h)
+
+-- |
+rarestFirst :: Selector
+rarestFirst h a xs = rarest (map (intersection want) xs)
+  where
+    want = difference h a
+
+-- | In average random first is faster than rarest first strategy but
+--    only if all pieces are available.
+randomFirst :: Selector
+randomFirst = do
+--  randomIO
+  error "randomFirst"
+
+endGame :: Selector
+endGame = strictLast
diff --git a/src/Network/BitTorrent/Exchange/Block.hs b/src/Network/BitTorrent/Exchange/Block.hs
index 16c124e9..ccc7a0a9 100644
--- a/src/Network/BitTorrent/Exchange/Block.hs
+++ b/src/Network/BitTorrent/Exchange/Block.hs
@@ -69,7 +69,7 @@ import Numeric
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 
-import Data.Torrent.Piece
+import Data.Torrent
 
 {-----------------------------------------------------------------------
 --  Block attributes
diff --git a/src/Network/BitTorrent/Exchange/Connection.hs b/src/Network/BitTorrent/Exchange/Connection.hs
index fd9022da..2d5f39bf 100644
--- a/src/Network/BitTorrent/Exchange/Connection.hs
+++ b/src/Network/BitTorrent/Exchange/Connection.hs
@@ -112,6 +112,7 @@ import Control.Concurrent hiding (yield)
 import Control.Exception
 import Control.Monad.Reader
 import Control.Monad.State
+import Control.Monad.Trans.Resource
 import Control.Lens
 import Data.ByteString as BS
 import Data.ByteString.Lazy as BSL
@@ -135,10 +136,10 @@ import Text.Show.Functions ()
 import System.Log.FastLogger (ToLogStr(..))
 import System.Timeout
 
-import Data.Torrent.Bitfield as BF
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
-import Network.BitTorrent.Exchange.Message as Msg
+import Data.Torrent
+import Network.BitTorrent.Address
+import Network.BitTorrent.Exchange.Bitfield as BF
+import Network.BitTorrent.Exchange.Message  as Msg
 
 -- TODO handle port message?
 -- TODO handle limits?
diff --git a/src/Network/BitTorrent/Exchange/Download.hs b/src/Network/BitTorrent/Exchange/Download.hs
new file mode 100644
index 00000000..9a6b5f91
--- /dev/null
+++ b/src/Network/BitTorrent/Exchange/Download.hs
@@ -0,0 +1,295 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--
+--
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TemplateHaskell        #-}
+module Network.BitTorrent.Exchange.Download
+       ( -- * Downloading
+         Download (..)
+       , Updates
+       , runDownloadUpdates
+
+         -- ** Metadata
+         -- $metadata-download
+       , MetadataDownload
+       , metadataDownload
+
+         -- ** Content
+         -- $content-download
+       , ContentDownload
+       , contentDownload
+       ) where
+
+import Control.Applicative
+import Control.Concurrent
+import Control.Lens
+import Control.Monad.State
+import Data.BEncode as BE
+import Data.ByteString as BS
+import Data.ByteString.Lazy as BL
+import Data.Default
+import Data.List as L
+import Data.Maybe
+import Data.Map as M
+import Data.Tuple
+
+import Data.Torrent as Torrent
+import Network.BitTorrent.Address
+import Network.BitTorrent.Exchange.Bitfield as BF
+import Network.BitTorrent.Exchange.Block    as Block
+import Network.BitTorrent.Exchange.Message  as Msg
+import System.Torrent.Storage (Storage, writePiece)
+
+
+{-----------------------------------------------------------------------
+--  Class
+-----------------------------------------------------------------------}
+
+type Updates s a = StateT s IO a
+
+runDownloadUpdates :: MVar s -> Updates s a -> IO a
+runDownloadUpdates var m = modifyMVar var (fmap swap . runStateT m)
+
+class Download s chunk | s -> chunk where
+  scheduleBlocks :: Int -> PeerAddr IP -> Bitfield -> Updates s [BlockIx]
+
+  -- |
+  scheduleBlock  :: PeerAddr IP -> Bitfield -> Updates s (Maybe BlockIx)
+  scheduleBlock addr bf = listToMaybe <$> scheduleBlocks 1 addr bf
+
+  -- | Get number of sent requests to this peer.
+  getRequestQueueLength :: PeerAddr IP -> Updates s Int
+
+  -- | Remove all pending block requests to the remote peer. May be used
+  -- when:
+  --
+  --     * a peer closes connection;
+  --
+  --     * remote peer choked this peer;
+  --
+  --     * timeout expired.
+  --
+  resetPending :: PeerAddr IP -> Updates s ()
+
+  -- | MAY write to storage, if a new piece have been completed.
+  --
+  --  You should check if a returned by peer block is actually have
+  -- been requested and in-flight. This is needed to avoid "I send
+  -- random corrupted block" attacks.
+  pushBlock :: PeerAddr IP -> chunk -> Updates s (Maybe Bool)
+
+{-----------------------------------------------------------------------
+--  Metadata download
+-----------------------------------------------------------------------}
+-- $metadata-download
+-- TODO
+
+data MetadataDownload = MetadataDownload
+  { _pendingPieces :: [(PeerAddr IP, PieceIx)]
+  , _bucket        :: Bucket
+  , _topic         :: InfoHash
+  }
+
+makeLenses ''MetadataDownload
+
+-- | Create a new scheduler for infodict of the given size.
+metadataDownload :: Int -> InfoHash -> MetadataDownload
+metadataDownload ps = MetadataDownload [] (Block.empty ps)
+
+instance Default MetadataDownload where
+  def = error "instance Default MetadataDownload"
+
+--cancelPending :: PieceIx -> Updates ()
+cancelPending pix = pendingPieces %= L.filter ((pix ==) . snd)
+
+instance Download MetadataDownload (Piece BS.ByteString) where
+  scheduleBlock addr bf = do
+    bkt  <- use bucket
+    case spans metadataPieceSize bkt of
+      []              -> return Nothing
+      ((off, _ ) : _) -> do
+        let pix = off `div` metadataPieceSize
+        pendingPieces %= ((addr, pix) :)
+        return (Just (BlockIx pix 0 metadataPieceSize))
+
+  resetPending addr = pendingPieces %= L.filter ((addr ==) . fst)
+
+  pushBlock addr Torrent.Piece {..} = do
+    p    <- use pendingPieces
+    when ((addr, pieceIndex) `L.notElem` p) $
+      error "not requested"
+    cancelPending pieceIndex
+
+    bucket %= Block.insert (metadataPieceSize * pieceIndex) pieceData
+    b <- use bucket
+    case toPiece b of
+      Nothing     -> return Nothing
+      Just chunks -> do
+          t <- use topic
+          case parseInfoDict (BL.toStrict chunks) t of
+            Right x -> do
+                pendingPieces .= []
+                return undefined -- (Just x)
+            Left  e -> do
+                pendingPieces .= []
+                bucket .= Block.empty (Block.size b)
+                return undefined -- Nothing
+   where
+      -- todo use incremental parsing to avoid BS.concat call
+      parseInfoDict :: BS.ByteString -> InfoHash -> Result InfoDict
+      parseInfoDict chunk topic =
+        case BE.decode chunk of
+          Right (infodict @ InfoDict {..})
+            | topic == idInfoHash -> return infodict
+            |      otherwise      -> Left "broken infodict"
+          Left err -> Left $ "unable to parse infodict " ++ err
+
+{-----------------------------------------------------------------------
+--  Content download
+-----------------------------------------------------------------------}
+-- $content-download
+--
+--  A block can have one of the following status:
+--
+--     1) /not allowed/: Piece is not in download set.
+--
+--     2) /waiting/: (allowed?) Block have been allowed to download,
+--     but /this/ peer did not send any 'Request' message for this
+--     block. To allow some piece use
+--     'Network.BitTorrent.Exchange.Selector' and then 'allowedSet'
+--     and 'allowPiece'.
+--
+--     3) /inflight/: (pending?) Block have been requested but
+--     /remote/ peer did not send any 'Piece' message for this block.
+--     Related functions 'markInflight'
+--
+--     4) /pending/: (stalled?) Block have have been downloaded
+--     Related functions 'insertBlock'.
+--
+--   Piece status:
+--
+--     1) /assembled/: (downloaded?) All blocks in piece have been
+--     downloaded but the piece did not verified yet.
+--
+--       * Valid: go to completed;
+--
+--       * Invalid: go to waiting.
+--
+--     2) /corrupted/:
+--
+--     3) /downloaded/: (verified?) A piece have been successfully
+--     verified via the hash. Usually the piece should be stored to
+--     the 'System.Torrent.Storage' and /this/ peer should send 'Have'
+--     messages to the /remote/ peers.
+--
+
+data PieceEntry = PieceEntry
+  { pending :: [(PeerAddr IP, BlockIx)]
+  , stalled :: Bucket
+  }
+
+pieceEntry :: PieceSize -> PieceEntry
+pieceEntry s = PieceEntry [] (Block.empty s)
+
+isEmpty :: PieceEntry -> Bool
+isEmpty PieceEntry {..} = L.null pending && Block.null stalled
+
+_holes :: PieceIx -> PieceEntry -> [BlockIx]
+_holes pix PieceEntry {..} = fmap mkBlockIx (spans defaultTransferSize stalled)
+  where
+    mkBlockIx (off, sz) = BlockIx pix off sz
+
+data ContentDownload = ContentDownload
+  { inprogress     :: !(Map PieceIx PieceEntry)
+  , bitfield       :: !Bitfield
+  , pieceSize      :: !PieceSize
+  , contentStorage ::  Storage
+  }
+
+contentDownload :: Bitfield -> PieceSize -> Storage -> ContentDownload
+contentDownload = ContentDownload M.empty
+
+--modifyEntry :: PieceIx -> (PieceEntry -> PieceEntry) -> DownloadUpdates ()
+modifyEntry pix f = modify $ \ s @ ContentDownload {..} -> s
+    { inprogress = alter (g pieceSize) pix inprogress }
+  where
+    g s = h . f . fromMaybe (pieceEntry s)
+    h e
+      | isEmpty e = Nothing
+      | otherwise = Just e
+
+instance Download ContentDownload (Block BL.ByteString) where
+  scheduleBlocks n addr maskBF = do
+    ContentDownload {..} <- get
+    let wantPieces = maskBF `BF.difference` bitfield
+    let wantBlocks = L.concat $ M.elems $ M.mapWithKey _holes $
+                     M.filterWithKey (\ pix _ -> pix `BF.member` wantPieces)
+                      inprogress
+
+    bixs <- if L.null wantBlocks
+      then do
+        mpix <- choosePiece wantPieces
+        case mpix of -- TODO return 'n' blocks
+          Nothing  -> return []
+          Just pix -> return [leadingBlock pix defaultTransferSize]
+      else chooseBlocks wantBlocks n
+
+    forM_ bixs $ \ bix -> do
+      modifyEntry (ixPiece bix) $ \ e @ PieceEntry {..} -> e
+        { pending = (addr, bix) : pending }
+
+    return bixs
+    where
+      -- TODO choose block nearest to pending or stalled sets to reduce disk
+      -- seeks on remote machines
+      --chooseBlocks :: [BlockIx] -> Int -> DownloadUpdates [BlockIx]
+      chooseBlocks xs n = return (L.take n xs)
+
+      -- TODO use selection strategies from Exchange.Selector
+      --choosePiece :: Bitfield -> DownloadUpdates (Maybe PieceIx)
+      choosePiece bf
+        | BF.null bf = return $ Nothing
+        | otherwise  = return $ Just $ BF.findMin bf
+
+  getRequestQueueLength addr = do
+    m <- gets (M.map (L.filter ((==) addr . fst) . pending) . inprogress)
+    return $ L.sum $ L.map L.length $ M.elems m
+
+  resetPending addr = modify $ \ s -> s { inprogress = reset (inprogress s) }
+    where
+      reset = fmap $ \ e -> e
+            { pending = L.filter (not . (==) addr . fst) (pending e) }
+
+  pushBlock addr blk @ Block {..} = do
+    mpe <- gets (M.lookup blkPiece . inprogress)
+    case mpe of
+      Nothing -> return Nothing
+      Just (pe @ PieceEntry {..})
+        | blockIx blk `L.notElem` fmap snd pending -> return Nothing
+        |             otherwise                    -> do
+         let bkt' = Block.insertLazy blkOffset blkData stalled
+         case toPiece bkt' of
+           Nothing        -> do
+             modifyEntry blkPiece $ \ e @ PieceEntry {..} -> e
+               { pending = L.filter ((==) (blockIx blk) . snd) pending
+               , stalled = bkt'
+               }
+             return (Just False)
+
+           Just pieceData -> do
+             -- TODO verify
+             storage <- gets contentStorage
+             liftIO $ writePiece (Torrent.Piece blkPiece pieceData) storage
+             modify $ \ s @ ContentDownload {..} -> s
+               { inprogress =  M.delete blkPiece inprogress
+               , bitfield   = BF.insert blkPiece bitfield
+               }
+             return (Just True)
diff --git a/src/Network/BitTorrent/Exchange/Manager.hs b/src/Network/BitTorrent/Exchange/Manager.hs
index b9aaa818..54727805 100644
--- a/src/Network/BitTorrent/Exchange/Manager.hs
+++ b/src/Network/BitTorrent/Exchange/Manager.hs
@@ -12,8 +12,8 @@ import Control.Monad
 import Data.Default
 import Network.Socket
 
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
+import Data.Torrent
+import Network.BitTorrent.Address
 import Network.BitTorrent.Exchange.Connection hiding (Options)
 import Network.BitTorrent.Exchange.Session
 
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs
index d8873f95..f8b76186 100644
--- a/src/Network/BitTorrent/Exchange/Message.hs
+++ b/src/Network/BitTorrent/Exchange/Message.hs
@@ -117,10 +117,10 @@ import Network.Socket hiding (KeepAlive)
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 
-import Data.Torrent.Bitfield
-import Data.Torrent.InfoHash
-import qualified Data.Torrent.Piece as P
-import Network.BitTorrent.Core
+import Data.Torrent hiding (Piece (..))
+import qualified Data.Torrent as P (Piece (..))
+import Network.BitTorrent.Address
+import Network.BitTorrent.Exchange.Bitfield
 import Network.BitTorrent.Exchange.Block
 
 {-----------------------------------------------------------------------
@@ -864,7 +864,7 @@ instance PeerMessage ExtendedMetadata where
 
 -- | All 'Piece's in 'MetadataData' messages MUST have size equal to
 -- this value. The last trailing piece can be shorter.
-metadataPieceSize :: P.PieceSize
+metadataPieceSize :: PieceSize
 metadataPieceSize = 16 * 1024
 
 isLastPiece :: P.Piece a -> Int -> Bool
@@ -877,8 +877,8 @@ isLastPiece P.Piece {..} total = succ pieceIndex == pcnt
 -- length; otherwise serialization MUST fail.
 isValidPiece :: P.Piece BL.ByteString -> Int -> Bool
 isValidPiece p @ P.Piece {..} total
-  | isLastPiece p total = P.pieceSize p <= metadataPieceSize
-  |       otherwise     = P.pieceSize p == metadataPieceSize
+  | isLastPiece p total = pieceSize p <= metadataPieceSize
+  |       otherwise     = pieceSize p == metadataPieceSize
 
 setMetadataPayload :: BS.ByteString -> ExtendedMetadata -> ExtendedMetadata
 setMetadataPayload bs (MetadataData (P.Piece pix _) t) =
diff --git a/src/Network/BitTorrent/Exchange/Selection.hs b/src/Network/BitTorrent/Exchange/Selection.hs
deleted file mode 100644
index 2724fabc..00000000
--- a/src/Network/BitTorrent/Exchange/Selection.hs
+++ /dev/null
@@ -1,85 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   Piece selection algorithms.
---
-module Network.BitTorrent.Exchange.Selection
-       ( -- * Selection
-         Selector
-       , selector
-       , strategyClass
-
-       , strictFirst
-       , strictLast
-       , rarestFirst
-       , randomFirst
-       , endGame
-       ) where
-
-import Data.Ratio
-
-import Data.Torrent.Bitfield
-
-
-type Selector =  Bitfield      -- ^ Indices of client /have/ pieces.
-             ->  Bitfield      -- ^ Indices of peer /have/ pieces.
-             -> [Bitfield]     -- ^ Indices of other peers /have/ pieces.
-             -> Maybe PieceIx  -- ^ Zero-based index of piece to request
-                               --   to, if any.
-
-selector :: Selector       -- ^ Selector to use at the start.
-         -> Ratio PieceCount
-         -> Selector       -- ^ Selector to use after the client have
-                           -- the C pieces.
-         -> Selector       -- ^ Selector that changes behaviour based
-                           -- on completeness.
-selector start pt ready   h a xs =
-  case strategyClass pt h of
-    SCBeginning -> start h a xs
-    SCReady     -> ready h a xs
-    SCEnd       -> endGame h a xs
-
-data StartegyClass
-  = SCBeginning
-  | SCReady
-  | SCEnd
-    deriving (Show, Eq, Ord, Enum, Bounded)
-
-
-strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
-strategyClass threshold = classify . completeness
-  where
-    classify c
-      |        c < threshold       = SCBeginning
-      | c + 1 % numerator c < 1    = SCReady
-    -- FIXME numerator have is not total count
-      |          otherwise         = SCEnd
-
-
--- | Select the first available piece.
-strictFirst :: Selector
-strictFirst h a _ = Just $ findMin (difference a h)
-
--- | Select the last available piece.
-strictLast :: Selector
-strictLast h a _ = Just $ findMax (difference a h)
-
--- |
-rarestFirst :: Selector
-rarestFirst h a xs = rarest (map (intersection want) xs)
-  where
-    want = difference h a
-
--- | In average random first is faster than rarest first strategy but
---    only if all pieces are available.
-randomFirst :: Selector
-randomFirst = do
---  randomIO
-  error "randomFirst"
-
-endGame :: Selector
-endGame = strictLast
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index 6f480ce4..30b7ed0e 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -45,18 +45,14 @@ import Text.PrettyPrint.Class
 import System.Log.FastLogger (LogStr, ToLogStr (..))
 
 import Data.BEncode as BE
-import Data.Torrent (InfoDict (..))
-import Data.Torrent.Bitfield as BF
-import Data.Torrent.InfoHash
-import Data.Torrent.Piece
-import qualified Data.Torrent.Piece as Torrent (Piece ())
+import Data.Torrent as Torrent
 import Network.BitTorrent.Internal.Types
-import Network.BitTorrent.Core
+import Network.BitTorrent.Address
+import Network.BitTorrent.Exchange.Bitfield as BF
 import Network.BitTorrent.Exchange.Block   as Block
 import Network.BitTorrent.Exchange.Connection
+import Network.BitTorrent.Exchange.Download as D
 import Network.BitTorrent.Exchange.Message as Message
-import Network.BitTorrent.Exchange.Session.Metadata as Metadata
-import Network.BitTorrent.Exchange.Session.Status   as SS
 import System.Torrent.Storage
 
 {-----------------------------------------------------------------------
@@ -93,13 +89,13 @@ type LogFun = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
 
 data SessionState
   = WaitingMetadata
-    { metadataDownload  :: MVar Metadata.Status
+    { metadataDownload  :: MVar MetadataDownload
     , metadataCompleted :: MVar InfoDict -- ^ used to unblock waiters
     , contentRootPath   :: FilePath
     }
   | HavingMetadata
     { metadataCache     :: Cached InfoDict
-    , contentDownload   :: MVar SessionStatus
+    , contentDownload   :: MVar ContentDownload
     , contentStorage    :: Storage
     }
 
@@ -108,8 +104,9 @@ newSessionState rootPath (Left  ih  ) = do
   WaitingMetadata <$> newMVar def <*> newEmptyMVar <*> pure rootPath
 newSessionState rootPath (Right dict) = do
   storage     <- openInfoDict ReadWriteEx rootPath dict
-  download    <- newMVar $ sessionStatus (BF.haveNone (totalPieces storage))
-                                        (piPieceLength (idPieceInfo dict))
+  download    <- newMVar $ D.contentDownload (BF.haveNone (totalPieces storage))
+                                           (piPieceLength (idPieceInfo dict))
+                                           storage
   return $ HavingMetadata (cache dict) download storage
 
 closeSessionState :: SessionState -> IO ()
@@ -119,8 +116,9 @@ closeSessionState HavingMetadata  {..} = close contentStorage
 haveMetadata :: InfoDict -> SessionState -> IO SessionState
 haveMetadata dict WaitingMetadata {..} = do
   storage     <- openInfoDict ReadWriteEx contentRootPath dict
-  download    <- newMVar $ sessionStatus (BF.haveNone (totalPieces storage))
-                                        (piPieceLength (idPieceInfo dict))
+  download    <- newMVar $ D.contentDownload (BF.haveNone (totalPieces storage))
+                                           (piPieceLength (idPieceInfo dict))
+                                            storage
   return HavingMetadata
     { metadataCache   = cache dict
     , contentDownload = download
diff --git a/src/Network/BitTorrent/Exchange/Session/Metadata.hs b/src/Network/BitTorrent/Exchange/Session/Metadata.hs
deleted file mode 100644
index 79156e2e..00000000
--- a/src/Network/BitTorrent/Exchange/Session/Metadata.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Network.BitTorrent.Exchange.Session.Metadata
-       ( -- * Transfer state
-         Status
-       , nullStatus
-
-         -- * State updates
-       , Updates
-       , runUpdates
-
-         -- * Piece transfer control
-       , scheduleBlock
-       , resetPending
-       , cancelPending
-       , pushBlock
-       ) where
-
-import Control.Concurrent
-import Control.Lens
-import Control.Monad.Reader
-import Control.Monad.State
-import Data.ByteString as BS
-import Data.ByteString.Lazy as BL
-import Data.Default
-import Data.List as L
-import Data.Tuple
-
-import Data.BEncode as BE
-import Data.Torrent
-import Data.Torrent.InfoHash
-import Data.Torrent.Piece as Torrent
-import Network.BitTorrent.Core
-import Network.BitTorrent.Exchange.Block   as Block
-import Network.BitTorrent.Exchange.Message as Message hiding (Status)
-
-
--- | Current transfer status.
-data Status = Status
-  { _pending :: [(PeerAddr IP, PieceIx)]
-  , _bucket  :: Bucket
-  }
-
-makeLenses ''Status
-
-instance Default Status where
-  def = error "default status"
-
--- | Create a new scheduler for infodict of the given size.
-nullStatus :: Int -> Status
-nullStatus ps = Status [] (Block.empty ps)
-
-type Updates = ReaderT (PeerAddr IP) (State Status)
-
-runUpdates :: MVar Status -> PeerAddr IP -> Updates a -> IO a
-runUpdates v a m = modifyMVar v (return . swap . runState (runReaderT m a))
-
-scheduleBlock :: Updates (Maybe PieceIx)
-scheduleBlock = do
-  addr <- ask
-  bkt  <- use bucket
-  case spans metadataPieceSize bkt of
-    []              -> return Nothing
-    ((off, _ ) : _) -> do
-      let pix = off `div` metadataPieceSize
-      pending %= ((addr, pix) :)
-      return (Just pix)
-
-cancelPending :: PieceIx -> Updates ()
-cancelPending pix = pending %= L.filter ((pix ==) . snd)
-
-resetPending :: Updates ()
-resetPending = do
-  addr <- ask
-  pending %= L.filter ((addr ==) . fst)
-
-parseInfoDict :: BS.ByteString -> InfoHash -> Result InfoDict
-parseInfoDict chunk topic =
-  case BE.decode chunk of
-    Right (infodict @ InfoDict {..})
-      | topic == idInfoHash -> return infodict
-      |      otherwise      -> Left "broken infodict"
-    Left err -> Left $ "unable to parse infodict " ++ err
-
--- todo use incremental parsing to avoid BS.concat call
-pushBlock :: Torrent.Piece BS.ByteString -> InfoHash -> Updates (Maybe InfoDict)
-pushBlock Torrent.Piece {..} topic = do
-  addr <- ask
-  p    <- use pending
-  when ((addr, pieceIndex) `L.notElem` p) $ error "not requested"
-  cancelPending pieceIndex
-
-  bucket %= Block.insert (metadataPieceSize * pieceIndex) pieceData
-  b <- use bucket
-  case toPiece b of
-    Nothing     -> return Nothing
-    Just chunks ->
-        case parseInfoDict (BL.toStrict chunks) topic of
-          Right x -> do
-              pending .= []
-              return (Just x)
-          Left  e -> do
-              pending .= []
-              bucket  .= Block.empty (Block.size b)
-              return Nothing
diff --git a/src/Network/BitTorrent/Exchange/Session/Status.hs b/src/Network/BitTorrent/Exchange/Session/Status.hs
deleted file mode 100644
index 565c3bf3..00000000
--- a/src/Network/BitTorrent/Exchange/Session/Status.hs
+++ /dev/null
@@ -1,175 +0,0 @@
-module Network.BitTorrent.Exchange.Session.Status
-       ( -- * Environment
-         StatusUpdates
-       , runStatusUpdates
-
-         -- * Status
-       , SessionStatus
-       , sessionStatus
-
-         -- * Query
-       , getBitfield
-       , getRequestQueueLength
-
-         -- * Control
-       , scheduleBlocks
-       , resetPending
-       , pushBlock
-       ) where
-
-import Control.Applicative
-import Control.Concurrent
-import Control.Monad.State
-import Data.ByteString.Lazy as BL
-import Data.Default
-import Data.List as L
-import Data.Maybe
-import Data.Map as M
-import Data.Set as S
-import Data.Tuple
-
-import Data.Torrent.Piece
-import Data.Torrent.Bitfield as BF
-import Network.BitTorrent.Core
-import Network.BitTorrent.Exchange.Block as Block
-import System.Torrent.Storage (Storage, writePiece)
-
-
-{-----------------------------------------------------------------------
---  Piece entry
------------------------------------------------------------------------}
-
-data PieceEntry = PieceEntry
-  { pending :: [(PeerAddr IP, BlockIx)]
-  , stalled :: Bucket
-  }
-
-pieceEntry :: PieceSize -> PieceEntry
-pieceEntry s = PieceEntry [] (Block.empty s)
-
-isEmpty :: PieceEntry -> Bool
-isEmpty PieceEntry {..} = L.null pending && Block.null stalled
-
-holes :: PieceIx -> PieceEntry -> [BlockIx]
-holes pix PieceEntry {..} = fmap mkBlockIx (spans defaultTransferSize stalled)
-  where
-    mkBlockIx (off, sz) = BlockIx pix off sz
-
-{-----------------------------------------------------------------------
---  Session status
------------------------------------------------------------------------}
-
-data SessionStatus = SessionStatus
-  { inprogress :: !(Map PieceIx PieceEntry)
-  , bitfield   :: !Bitfield
-  , pieceSize  :: !PieceSize
-  }
-
-sessionStatus :: Bitfield -> PieceSize -> SessionStatus
-sessionStatus bf ps = SessionStatus
-  { inprogress = M.empty
-  , bitfield   = bf
-  , pieceSize  = ps
-  }
-
-type StatusUpdates a = StateT SessionStatus IO a
-
--- |
-runStatusUpdates :: MVar SessionStatus -> StatusUpdates a -> IO a
-runStatusUpdates var m = modifyMVar var (fmap swap . runStateT m)
-
-getBitfield :: MVar SessionStatus -> IO Bitfield
-getBitfield var = bitfield <$> readMVar var
-
-getRequestQueueLength :: PeerAddr IP -> StatusUpdates Int
-getRequestQueueLength addr = do
-  m <- gets (M.elems . M.map (L.filter ((==) addr . fst) . pending) . inprogress)
-  return $ L.sum $ L.map L.length m
-
-modifyEntry :: PieceIx -> (PieceEntry -> PieceEntry) -> StatusUpdates ()
-modifyEntry pix f = modify $ \ s @ SessionStatus {..} -> s
-    { inprogress = alter (g pieceSize) pix inprogress }
-  where
-    g s = h . f . fromMaybe (pieceEntry s)
-    h e
-      | isEmpty e = Nothing
-      | otherwise = Just e
-
-{-----------------------------------------------------------------------
---  Piece download
------------------------------------------------------------------------}
-
--- TODO choose block nearest to pending or stalled sets to reduce disk
--- seeks on remote machines
-chooseBlocks :: [BlockIx] -> Int -> StatusUpdates [BlockIx]
-chooseBlocks xs n = return (L.take n xs)
-
--- TODO use selection strategies from Exchange.Selector
-choosePiece :: Bitfield -> StatusUpdates (Maybe PieceIx)
-choosePiece bf
-  | BF.null bf = return $ Nothing
-  | otherwise  = return $ Just $ BF.findMin bf
-
-scheduleBlocks :: PeerAddr IP -> Bitfield -> Int -> StatusUpdates [BlockIx]
-scheduleBlocks addr maskBF n = do
-  SessionStatus {..} <- get
-  let wantPieces = maskBF `BF.difference` bitfield
-  let wantBlocks = L.concat $ M.elems $ M.mapWithKey holes $
-                   M.filterWithKey (\ pix _ -> pix `BF.member` wantPieces) inprogress
-
-  bixs <- if L.null wantBlocks
-    then do
-      mpix <- choosePiece wantPieces
-      case mpix of -- TODO return 'n' blocks
-        Nothing  -> return []
-        Just pix -> return [leadingBlock pix defaultTransferSize]
-    else chooseBlocks wantBlocks n
-
-  forM_ bixs $ \ bix -> do
-    modifyEntry (ixPiece bix) $ \ e @ PieceEntry {..} -> e
-      { pending = (addr, bix) : pending }
-
-  return bixs
-
-
--- | Remove all pending block requests to the remote peer. May be used
--- when:
---
---     * a peer closes connection;
---
---     * remote peer choked this peer;
---
---     * timeout expired.
---
-resetPending :: PeerAddr IP -> StatusUpdates ()
-resetPending addr = modify $ \ s -> s { inprogress = reset (inprogress s) }
-  where
-    reset = fmap $ \ e -> e
-            { pending = L.filter (not . (==) addr . fst) (pending e) }
-
--- | MAY write to storage, if a new piece have been completed.
-pushBlock :: Block BL.ByteString -> Storage -> StatusUpdates (Maybe Bool)
-pushBlock blk @ Block {..} storage = do
-  mpe <- gets (M.lookup blkPiece . inprogress)
-  case mpe of
-    Nothing -> return Nothing
-    Just (pe @ PieceEntry {..})
-      | blockIx blk `L.notElem` fmap snd pending -> return Nothing
-      |             otherwise                    -> do
-       let bkt' = Block.insertLazy blkOffset blkData stalled
-       case toPiece bkt' of
-         Nothing        -> do
-           modifyEntry blkPiece $ \ e @ PieceEntry {..} -> e
-             { pending = L.filter ((==) (blockIx blk) . snd) pending
-             , stalled = bkt'
-             }
-           return (Just False)
-
-         Just pieceData -> do
-           -- TODO verify
-           liftIO $ writePiece (Piece blkPiece pieceData) storage
-           modify $ \ s @ SessionStatus {..} -> s
-             { inprogress =  M.delete blkPiece inprogress
-             , bitfield   = BF.insert blkPiece bitfield
-             }
-           return (Just True)
diff --git a/src/Network/BitTorrent/Internal/Progress.hs b/src/Network/BitTorrent/Internal/Progress.hs
new file mode 100644
index 00000000..9aff9935
--- /dev/null
+++ b/src/Network/BitTorrent/Internal/Progress.hs
@@ -0,0 +1,154 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   'Progress' used to track amount downloaded\/left\/upload bytes
+--   either on per client or per torrent basis. This value is used to
+--   notify the tracker and usually shown to the user. To aggregate
+--   total progress you can use the Monoid instance.
+--
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ViewPatterns    #-}
+{-# OPTIONS -fno-warn-orphans #-}
+module Network.BitTorrent.Internal.Progress
+       ( -- * Progress
+         Progress (..)
+
+         -- * Lens
+       , left
+       , uploaded
+       , downloaded
+
+         -- * Construction
+       , startProgress
+       , downloadedProgress
+       , enqueuedProgress
+       , uploadedProgress
+       , dequeuedProgress
+
+         -- * Query
+       , canDownload
+       , canUpload
+       ) where
+
+import Control.Applicative
+import Control.Lens hiding ((%=))
+import Data.ByteString.Lazy.Builder  as BS
+import Data.ByteString.Lazy.Builder.ASCII as BS
+import Data.Default
+import Data.Monoid
+import Data.Serialize as S
+import Data.Ratio
+import Data.Word
+import Network.HTTP.Types.QueryLike
+import Text.PrettyPrint as PP
+import Text.PrettyPrint.Class
+
+
+-- | Progress data is considered as dynamic within one client
+-- session. This data also should be shared across client application
+-- sessions (e.g. files), otherwise use 'startProgress' to get initial
+-- 'Progress' value.
+--
+data Progress = Progress
+  { _downloaded :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes downloaded;
+  , _left       :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes left;
+  , _uploaded   :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes uploaded.
+  } deriving (Show, Read, Eq)
+
+$(makeLenses ''Progress)
+
+-- | UDP tracker compatible encoding.
+instance Serialize Progress where
+  put Progress {..} = do
+    putWord64be $ fromIntegral _downloaded
+    putWord64be $ fromIntegral _left
+    putWord64be $ fromIntegral _uploaded
+
+  get = Progress
+    <$> (fromIntegral <$> getWord64be)
+    <*> (fromIntegral <$> getWord64be)
+    <*> (fromIntegral <$> getWord64be)
+
+instance Default Progress where
+  def = Progress 0 0 0
+  {-# INLINE def #-}
+
+-- | Can be used to aggregate total progress.
+instance Monoid Progress where
+  mempty  = def
+  {-# INLINE mempty #-}
+
+  mappend (Progress da la ua) (Progress db lb ub) = Progress
+    { _downloaded = da + db
+    , _left       = la + lb
+    , _uploaded   = ua + ub
+    }
+  {-# INLINE mappend #-}
+
+instance QueryValueLike Builder where
+  toQueryValue = toQueryValue . BS.toLazyByteString
+
+instance QueryValueLike Word64 where
+  toQueryValue = toQueryValue . BS.word64Dec
+
+-- | HTTP Tracker protocol compatible encoding.
+instance QueryLike Progress where
+  toQuery Progress {..} =
+    [ ("uploaded"  , toQueryValue _uploaded)
+    , ("left"      , toQueryValue _left)
+    , ("downloaded", toQueryValue _downloaded)
+    ]
+
+instance Pretty Progress where
+  pretty Progress {..} =
+    "/\\"  <+> PP.text (show _uploaded)   $$
+    "\\/"  <+> PP.text (show _downloaded) $$
+    "left" <+> PP.text (show _left)
+
+-- | Initial progress is used when there are no session before.
+--
+-- Please note that tracker might penalize client some way if the do
+-- not accumulate progress. If possible and save 'Progress' between
+-- client sessions to avoid that.
+--
+startProgress :: Integer -> Progress
+startProgress = Progress 0 0 . fromIntegral
+{-# INLINE startProgress #-}
+
+-- | Used when the client download some data from /any/ peer.
+downloadedProgress :: Int -> Progress -> Progress
+downloadedProgress (fromIntegral -> amount)
+                 = (left         -~ amount)
+                 . (downloaded   +~ amount)
+{-# INLINE downloadedProgress #-}
+
+-- | Used when the client upload some data to /any/ peer.
+uploadedProgress :: Int -> Progress -> Progress
+uploadedProgress (fromIntegral -> amount) = uploaded +~ amount
+{-# INLINE uploadedProgress #-}
+
+-- | Used when leecher join client session.
+enqueuedProgress :: Integer -> Progress -> Progress
+enqueuedProgress amount = left +~ fromIntegral amount
+{-# INLINE enqueuedProgress #-}
+
+-- | Used when leecher leave client session.
+--   (e.g. user deletes not completed torrent)
+dequeuedProgress :: Integer -> Progress -> Progress
+dequeuedProgress amount = left -~ fromIntegral amount
+{-# INLINE dequeuedProgress #-}
+
+ri2rw64 :: Ratio Int -> Ratio Word64
+ri2rw64 x = fromIntegral (numerator x) % fromIntegral (denominator x)
+
+-- | Check global /download/ limit by uploaded \/ downloaded ratio.
+canDownload :: Ratio Int -> Progress -> Bool
+canDownload limit Progress {..} = _uploaded % _downloaded > ri2rw64 limit
+
+-- | Check global /upload/ limit by downloaded \/ uploaded ratio.
+canUpload :: Ratio Int -> Progress -> Bool
+canUpload limit Progress {..} = _downloaded % _uploaded > ri2rw64 limit
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index cdc07af8..e4a41045 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -124,10 +124,9 @@ import Numeric
 import System.Entropy
 import Text.Read (readMaybe)
 
-import Data.Torrent.InfoHash
-import Data.Torrent.Progress
-import Network.BitTorrent.Core
-
+import Data.Torrent
+import Network.BitTorrent.Address
+import Network.BitTorrent.Internal.Progress
 
 {-----------------------------------------------------------------------
 --  Events
diff --git a/src/Network/BitTorrent/Tracker/RPC.hs b/src/Network/BitTorrent/Tracker/RPC.hs
index dc1bd4ec..6fd22b25 100644
--- a/src/Network/BitTorrent/Tracker/RPC.hs
+++ b/src/Network/BitTorrent/Tracker/RPC.hs
@@ -25,7 +25,7 @@ module Network.BitTorrent.Tracker.RPC
          -- * RPC
        , SAnnounceQuery (..)
        , RpcException (..)
-       , announce
+       , Network.BitTorrent.Tracker.RPC.announce
        , scrape
        ) where
 
@@ -36,9 +36,9 @@ import Network
 import Network.URI
 import Network.Socket (HostAddress)
 
-import           Data.Torrent.InfoHash
-import           Data.Torrent.Progress
-import           Network.BitTorrent.Core
+import           Data.Torrent
+import           Network.BitTorrent.Address
+import           Network.BitTorrent.Internal.Progress
 import           Network.BitTorrent.Tracker.Message
 import qualified Network.BitTorrent.Tracker.RPC.HTTP as HTTP
 import qualified Network.BitTorrent.Tracker.RPC.UDP  as UDP
diff --git a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
index 4a8e5f79..6e55eb04 100644
--- a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
@@ -47,8 +47,8 @@ import qualified Network.HTTP.Conduit as HTTP
 import           Network.HTTP.Types.Header (hUserAgent)
 import           Network.HTTP.Types.URI    (SimpleQuery, renderSimpleQuery)
 
-import Data.Torrent.InfoHash               (InfoHash)
-import Network.BitTorrent.Core.Fingerprint (libUserAgent)
+import Data.Torrent                        (InfoHash)
+import Network.BitTorrent.Address             (libUserAgent)
 import Network.BitTorrent.Tracker.Message hiding (Request, Response)
 
 {-----------------------------------------------------------------------
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
index 560acf84..cef7d665 100644
--- a/src/Network/BitTorrent/Tracker/Session.hs
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -57,8 +57,8 @@ import Data.Time
 import Data.Traversable
 import Network.URI
 
-import Data.Torrent.InfoHash
-import Network.BitTorrent.Core
+import Data.Torrent
+import Network.BitTorrent.Address
 import Network.BitTorrent.Internal.Cache
 import Network.BitTorrent.Internal.Types
 import Network.BitTorrent.Tracker.List as TL