{-# LANGUAGE TemplateHaskell   #-}
module Network.BitTorrent.Exchange.Status
       ( -- * Peer status
         PeerStatus(..)
       , choking
       , interested
       , updateStatus

         -- * Session status
       , SessionStatus(..)
       , clientStatus
       , peerStatus

         -- ** Query
       , canUpload
       , canDownload

         -- * Extra
       , inverseStatus
       , defaultUnchokeSlots
       ) where

import Control.Lens
import Data.Aeson.TH
import Data.List as L
import Data.Default

import Network.BitTorrent.Exchange.Message


-- |
data PeerStatus = PeerStatus {
    _choking    :: !Bool
  , _interested :: !Bool
  } deriving (Show, Eq)

$(makeLenses ''PeerStatus)
$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''PeerStatus)

instance Default PeerStatus where
  def = PeerStatus True False

updateStatus :: StatusUpdate -> PeerStatus -> PeerStatus
updateStatus Choke         = choking    .~ True
updateStatus Unchoke       = choking    .~ False
updateStatus Interested    = interested .~ True
updateStatus NotInterested = interested .~ False

statusUpdates :: PeerStatus -> PeerStatus -> [StatusUpdate]
statusUpdates a b = undefined

-- |
data SessionStatus = SessionStatus {
    _clientStatus :: !PeerStatus
  , _peerStatus   :: !PeerStatus
  } deriving (Show, Eq)

$(makeLenses ''SessionStatus)
$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''SessionStatus)

instance Default SessionStatus where
  def = SessionStatus def def

-- | Can the /client/ transfer to the /peer/?
canUpload :: SessionStatus -> Bool
canUpload SessionStatus {..}
  = _interested _peerStatus && not (_choking _clientStatus)

-- | Can the /client/ transfer from the /peer/?
canDownload :: SessionStatus -> Bool
canDownload SessionStatus {..}
  = _interested _clientStatus && not (_choking _peerStatus)

inverseStatus :: SessionStatus -> SessionStatus
inverseStatus SessionStatus {..} = SessionStatus _peerStatus _clientStatus

-- | Indicates how many peers are allowed to download from the client
-- by default.
defaultUnchokeSlots :: Int
defaultUnchokeSlots = 4