diff --git a/Network/RTorrent/Action.hs b/Network/RTorrent/Action.hs --- a/Network/RTorrent/Action.hs +++ b/Network/RTorrent/Action.hs @@ -51,6 +51,7 @@ module Network.RTorrent.Action ( Action , simpleAction + , pureAction , sequenceActions , (<+>) diff --git a/Network/RTorrent/Action/Internals.hs b/Network/RTorrent/Action/Internals.hs --- a/Network/RTorrent/Action/Internals.hs +++ b/Network/RTorrent/Action/Internals.hs @@ -12,6 +12,7 @@ module Network.RTorrent.Action.Internals ( Action (..) , simpleAction + , pureAction , sequenceActions , (<+>) @@ -118,6 +119,10 @@ -- | Sequence multiple actions, for example with @f = []@. sequenceActions :: Traversable f => f (i -> Action i a) -> i -> Action i (f a) sequenceActions = runActionB . traverse ActionB + +-- | An action that does nothing but return the value. +pureAction :: a -> i -> Action i a +pureAction a = Action [] (const (return a)) infixr 6 <+> -- | Combine two actions to get a new one. diff --git a/Network/RTorrent/Chunk.hs b/Network/RTorrent/Chunk.hs new file mode 100644 --- /dev/null +++ b/Network/RTorrent/Chunk.hs @@ -0,0 +1,40 @@ +{-| +Module : Chunk +Copyright : (c) Kai Lindholm, 2015 +License : MIT +Maintainer : megantti@gmail.com +Stability : experimental + +-} + +module Network.RTorrent.Chunk ( + convertChunks + , convertChunksPad +) where + +-- | Convert a string representing bits to a list of booleans +-- and pads it to the correct length. +convertChunksPad :: Int -- ^ Total number of chunks + -> String -- ^ A bitfield represented in hexadecimals + -> Maybe [Bool] +convertChunksPad len = fmap (pad len) . convertChunks + where + pad i str + | i <= 0 = [] + | otherwise = case str of + [] -> replicate i False + (x:xs) -> x : pad (i - 1) xs + +-- | Convert a string representing bits to a list of booleans. +convertChunks :: String -- ^ A bitfield represented in hexadecimals + -> Maybe [Bool] +convertChunks [] = Nothing +convertChunks str = fmap concat . mapM convert $ str + where + base2 = reverse . map (toEnum . (`mod` 2)) . take 4 . iterate (`div` 2) + convert = fmap base2 . num + num ch + | '0' <= ch && ch <= '9' = Just $ fromEnum ch - fromEnum '0' + | 'A' <= ch && ch <= 'F' = Just $ 10 + fromEnum ch - fromEnum 'A' + | otherwise = Nothing + diff --git a/Network/RTorrent/Command/Internals.hs b/Network/RTorrent/Command/Internals.hs --- a/Network/RTorrent/Command/Internals.hs +++ b/Network/RTorrent/Command/Internals.hs @@ -28,7 +28,7 @@ import Control.Applicative import Control.DeepSeq -import Control.Monad.Error +import Control.Monad.Except import Control.Monad.Identity import qualified Codec.Binary.UTF8.String as U @@ -95,7 +95,7 @@ single v = fail $ "Failed to match a singleton array, got: " ++ show v parseValue :: (Monad m, XmlRpcType a) => Value -> m a -parseValue = fromRight . runIdentity . runErrorT . fromValue +parseValue = fromRight . runIdentity . runExceptT . fromValue where fromRight (Right r) = return r fromRight (Left e) = fail $ "parseValue failed: " ++ e diff --git a/Network/RTorrent/File.hs b/Network/RTorrent/File.hs --- a/Network/RTorrent/File.hs +++ b/Network/RTorrent/File.hs @@ -26,6 +26,7 @@ , getFileCompletedChunks , getFilePriority , setFilePriority + , getFileOffset ) where import Control.Applicative @@ -33,6 +34,7 @@ import Network.RTorrent.Action.Internals import Network.RTorrent.Torrent +import Network.RTorrent.Chunk import Network.RTorrent.Command.Internals import Network.RTorrent.Priority import Network.XmlRpc.Internals @@ -57,6 +59,7 @@ , fileSizeChunks :: !Int , fileCompletedChunks :: !Int , filePriority :: !FilePriority + , fileOffset :: !Int , fileId :: FileId } deriving Show @@ -64,12 +67,13 @@ rnf (FileId tid i) = rnf tid `seq` rnf i instance NFData FileInfo where - rnf (FileInfo fid fp fsb fsc fcc fpt) = + rnf (FileInfo fid fp fsb fsc fcc fo fpt) = rnf fp `seq` rnf fsb `seq` rnf fsc `seq` rnf fcc `seq` rnf fpt + `seq` rnf fo `seq` rnf fid type FileAction = Action FileId @@ -100,6 +104,11 @@ getFileCompletedChunks :: FileId -> FileAction Int getFileCompletedChunks = simpleAction "f.completed_chunks" [] +-- | Get the offset of a file in a torrent, +-- when chunks are interpreted as continuous data. +getFileOffset :: FileId -> FileAction Int +getFileOffset = simpleAction "f.offset" [] + getFilePriority :: FileId -> FileAction FilePriority getFilePriority = simpleAction "f.priority" [] @@ -114,6 +123,7 @@ <*> b getFileSizeChunks <*> b getFileCompletedChunks <*> b getFilePriority + <*> b getFileOffset where b = ActionB diff --git a/Network/RTorrent/RPC.hs b/Network/RTorrent/RPC.hs --- a/Network/RTorrent/RPC.hs +++ b/Network/RTorrent/RPC.hs @@ -99,7 +99,7 @@ , callRTorrent ) where -import Control.Monad.Error (ErrorT(..), throwError, strMsg) +import Control.Monad.Except (ExceptT(..), throwError, runExceptT) import Control.Exception import Data.Monoid import qualified Data.ByteString as BS @@ -111,17 +111,17 @@ import Network.RTorrent.CommandList import Network.RTorrent.SCGI -callRTorrentRaw :: HostName -> Int -> C.RTMethodCall -> ErrorT String IO Value +callRTorrentRaw :: HostName -> Int -> C.RTMethodCall -> ExceptT String IO Value callRTorrentRaw host port calls = do let request = Body [] . mconcat . LB.toChunks $ renderCall call - Body _ content <- ErrorT $ query host port request + Body _ content <- ExceptT $ query host port request let cs = map (toEnum . fromEnum) $ BS.unpack content response <- parseResponse cs case response of Return ret -> case ret of ValueArray arr -> return $ ValueArray arr - val -> throwError . strMsg $ "Got value of type " ++ show (getType val) - Fault code err -> throwError . strMsg $ show code ++ ": " ++ err + val -> throwError $ "Got value of type " ++ show (getType val) + Fault code err -> throwError $ show code ++ ": " ++ err where call = MethodCall "system.multicall" [C.runRTMethodCall calls] @@ -134,7 +134,7 @@ -> a -> IO (Either String (Ret a)) callRTorrent host port command = - (runErrorT $ do + (runExceptT $ do ret <- callRTorrentRaw host port (C.commandCall command) C.commandValue command ret) `catches` [ Handler (\e -> return . Left $ show (e :: IOException)) diff --git a/Network/RTorrent/SCGI.hs b/Network/RTorrent/SCGI.hs --- a/Network/RTorrent/SCGI.hs +++ b/Network/RTorrent/SCGI.hs @@ -59,12 +59,17 @@ mappend <$> A.takeTill (== '\r') <*> (("\r\n" *> pure "") <|> lineParser) headerParser = (,) <$> A.takeTill (== ':') <*> (": " *> lineParser) + takeUntil :: Parser a -> Parser b -> Parser ([a], b) + takeUntil a b = (end <$> b) + <|> (cont <$> a <*> takeUntil a b) + where + end x = ([], x) + cont x (xs, y) = (x : xs, y) + contentParser = "\r\n" *> A.takeByteString parseBody = do - header <- headerParser - (moreHeaders, [content]) <- - partitionEithers <$> A.many' (A.eitherP headerParser contentParser) - return $ Body (header : moreHeaders) content + (headers, content) <- takeUntil headerParser contentParser + return $ Body headers content query :: HostName -> Int -> Body -> IO (Either String Body) query host port queryBody = do diff --git a/Network/RTorrent/Torrent.hs b/Network/RTorrent/Torrent.hs --- a/Network/RTorrent/Torrent.hs +++ b/Network/RTorrent/Torrent.hs @@ -1,6 +1,6 @@ {-| Module : Torrent -Copyright : (c) Kai Lindholm, 2014 +Copyright : (c) Kai Lindholm, 2014-2015 License : MIT Maintainer : megantti@gmail.com Stability : experimental @@ -40,6 +40,9 @@ , setTorrentDir , getTorrentRatio , getTorrentFileCount + , getTorrentSizeChunks + , getTorrentChunks + , getTorrentChunkSize ) where @@ -49,6 +52,7 @@ import Network.RTorrent.Action.Internals import Network.RTorrent.Command.Internals +import Network.RTorrent.Chunk import Network.RTorrent.Priority -- | A newtype wrapper for torrent identifiers. @@ -120,7 +124,7 @@ stop = simpleAction "d.stop" [] closeStop :: TorrentId -> TorrentAction Int -closeStop = fmap (\(a :*: b) -> a + b) . (close <+> stop) +closeStop = fmap (\(a :*: b) -> a + b) . (stop <+> close) -- | Erase a torrent. erase :: TorrentId -> TorrentAction Int @@ -176,6 +180,23 @@ getTorrentFileCount :: TorrentId -> TorrentAction Int getTorrentFileCount = simpleAction "d.get_size_files" [] + +-- | A total number of chunks. +getTorrentSizeChunks :: TorrentId -> TorrentAction Int +getTorrentSizeChunks = simpleAction "d.size_chunks" [] + +-- | Get a list that shows which chunks of the torrent are recorded as completed. +-- Will return 'Nothing' in the case that the torrent is closed. +getTorrentChunks :: TorrentId -> TorrentAction (Maybe [Bool]) +getTorrentChunks = fmap combine . (getTorrentSizeChunks <+> chunks) + where + combine (count :*: ch) = convertChunksPad count ch + chunks :: TorrentId -> TorrentAction String + chunks = simpleAction "d.bitfield" [] + +-- | Get the size of a chunk. +getTorrentChunkSize :: TorrentId -> TorrentAction Int +getTorrentChunkSize = simpleAction "d.chunk_size" [] -- | Execute a command on all torrents. -- For example the command diff --git a/rtorrent-rpc.cabal b/rtorrent-rpc.cabal --- a/rtorrent-rpc.cabal +++ b/rtorrent-rpc.cabal @@ -1,5 +1,5 @@ name: rtorrent-rpc -version: 0.2.1.0 +version: 0.2.2.0 synopsis: A library for communicating with RTorrent over its XML-RPC interface. description: A library for communicating with RTorrent over its XML-RPC interface. @@ -8,7 +8,7 @@ author: Kai Lindholm maintainer: megantti@gmail.com homepage: https://github.com/megantti/rtorrent-rpc -copyright: (c) Kai Lindholm, 2014 +copyright: (c) Kai Lindholm, 2014-2015 category: Network build-type: Simple -- extra-source-files: @@ -18,6 +18,7 @@ exposed-modules: Network.RTorrent Network.RTorrent.Action Network.RTorrent.Action.Internals + Network.RTorrent.Chunk Network.RTorrent.Command Network.RTorrent.Command.Internals Network.RTorrent.CommandList @@ -35,7 +36,7 @@ mtl >=2.1 && <2.3, bytestring >=0.10 && <0.11 , network >=2.6, - haxr >=3000.10.3.1 && <3000.11, + haxr >=3000.10.4.2 && <3000.10.5, blaze-builder >=0.3 && <0.4, blaze-textual >=0.2 && <0.3, attoparsec >=0.12 && <0.13,