-- |
-- Module      :  Control.ITC
-- Copyright   :  (c) Alexandru Scvortov 2009
-- License     :  LGPL (see LICENSE file)
-- Maintainer  :  scvalex@gmail.com
--

module Control.ITC
    ( BridgeMessage, sendMessage
    , sendGetTorrentList, sendDownloadTorrent, sendGetTrackers
    , sendNOP, sendGetPieceArray, sendGetTorrentInfo
    , sendGetPeers
    , DecodedBridgeMessage(..), extractMessage
    ) where

import Control.Concurrent.MVar
import Control.Concurrent.STM
import Data.Bencoding
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char ( toLower )
import Data.Metainfo

-------------------- One side --------------------

sendGetTorrentList :: TChan BridgeMessage -> IO (MVar Bencoding)
sendGetTorrentList inCh = sendMessage inCh "GetTorrentList" (toBencoding "")

sendDownloadTorrent :: TChan BridgeMessage -> L.ByteString -> IO (MVar Bencoding)
sendDownloadTorrent inCh bs = sendMessage inCh "DownloadTorrent" bs

sendNOP :: TChan BridgeMessage -> IO (MVar Bencoding)
sendNOP inCh = sendMessage inCh "NOP" ""

sendGetPieceArray :: TChan BridgeMessage -> InfoHash -> IO (MVar Bencoding)
sendGetPieceArray inCh ih = sendMessage inCh "GetPieceArray" ih

sendGetTorrentInfo :: TChan BridgeMessage -> InfoHash -> IO (MVar Bencoding)
sendGetTorrentInfo inCh ih = sendMessage inCh "GetTorrentInfo" ih

sendGetTrackers :: TChan BridgeMessage -> InfoHash -> IO (MVar Bencoding)
sendGetTrackers inCh ih = sendMessage inCh "GetTrackers" ih

sendGetPeers :: TChan BridgeMessage -> InfoHash -> IO (MVar Bencoding)
sendGetPeers inCh ih = sendMessage inCh "GetPeers" ih

sendMessage :: (BencodedData a) => TChan BridgeMessage -> String -> a -> IO (MVar Bencoding)
sendMessage inCh text cargo = do
  o <- newEmptyMVar
  atomically $ writeTChan inCh (bencDictInsert ("message", text) 
                                 $ bencDictInsert ("cargo", cargo)
                                 newBencoding
                               , o)
  return o

----------------- The other side -----------------

-- | A general message.  The Bencoding holds the actual message and
-- the MVar is used to deposit the response, should there be one, or
-- to inform the requesting thread that the computation is finished.
type BridgeMessage = (Bencoding, MVar Bencoding)

-- FIXME: add support for the following messages:
--    * statTorrent :: TorrentDesc -> Statistics

data DecodedBridgeMessage = Nop
                          | GetPieceArray InfoHash
                          | DownloadTorrent Metainfo
                          | GetTorrentList
                          | GetTorrentInfo InfoHash
                          | GetTrackers InfoHash
                          | GetPeers InfoHash
                            deriving ( Show )

extractMessage :: (Monad m) => Bencoding -> m DecodedBridgeMessage
extractMessage bd = do
  msg <- fromBencoding =<< bencDictLookup "message" bd
  let cargo = bencDictLookup "cargo" bd
      cargo' = maybe newBencoding id cargo
  case (map toLower msg) of
    "nop" -> return Nop
    "getpiecearray" -> decodeInfoHashMessage cargo' GetPieceArray
    "downloadtorrent" -> case fromBencoding cargo' of
                           Nothing -> fail "No Metainfo in DownloadTorrent message"
                           Just bs -> 
                               case parseMetainfo (bs :: L.ByteString) of
                                     Nothing -> fail "Could not parse Metainfo"
                                     Just mi -> return $ DownloadTorrent mi
    "gettorrentlist" -> return GetTorrentList
    "gettorrentinfo" -> decodeInfoHashMessage cargo' GetTorrentInfo
    "gettrackers" -> decodeInfoHashMessage cargo' GetTrackers
    "getpeers" -> decodeInfoHashMessage cargo' GetPeers
    _ -> fail "Unknown message."

decodeInfoHashMessage :: (Monad m) => Bencoding -> (InfoHash -> DecodedBridgeMessage) -> m DecodedBridgeMessage
decodeInfoHashMessage cargo cnstr = case fromBencoding cargo of
                                      Nothing -> fail "No InfoHash specified"
                                      Just ih -> return $ cnstr ih
