rtorrent-rpc 0.2.2.0 → 0.3.0.0

raw patch · 18 files changed

+756/−515 lines, 18 filesdep +aesondep +aeson-prettydep +base64-bytestringdep −deepseqdep −haxrdep −splitdep ~attoparsecdep ~basedep ~blaze-buildersetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, aeson-pretty, base64-bytestring, containers, directory, network-uri, scientific, text, vector, vector-split

Dependencies removed: deepseq, haxr, split, utf8-string

Dependency ranges changed: attoparsec, base, blaze-builder, blaze-textual, bytestring, mtl, network

API changes (from Hackage documentation)

Files

• Network/RTorrent.hs +1/−1
• Network/RTorrent/Action.hs +6/−6
• Network/RTorrent/Action/Internals.hs +111/−62
• Network/RTorrent/Chunk.hs +16/−11
• Network/RTorrent/Command/Internals.hs +47/−65
• Network/RTorrent/CommandList.hs +37/−24
• Network/RTorrent/File.hs +45/−43
• Network/RTorrent/JSONRPC.hs +69/−0
• Network/RTorrent/Peer.hs +36/−52
• Network/RTorrent/Priority.hs +10/−17
• Network/RTorrent/Query.hs +128/−0
• Network/RTorrent/RPC.hs +67/−48
• Network/RTorrent/SCGI.hs +0/−79
• Network/RTorrent/Torrent.hs +31/−44
• Network/RTorrent/Tracker.hs +32/−44
• Network/RTorrent/Value.hs +95/−0
• Setup.hs +0/−2
• rtorrent-rpc.cabal +25/−17

@@ -1,6 +1,6 @@ {-| Module      : RTorrent-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2015 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental

@@ -2,7 +2,7 @@  {-| Module      : Action-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -20,14 +20,14 @@ For example,   @-callRTorrent "localhost" 5000 $ some_action (some_id :: SomeId)+callRTorrent "tcp://localhost:5000" $ some_action (some_id :: SomeId) @ is a valid thing to write when @some@ is one of the previous objects.  To call an action on all torrents, you can use 'Network.RTorrent.Torrent.allTorrents', so that  @-callRTorrent "localhost" 5000 $ allTorrents getTorrentId+callRTorrent "tcp://localhost:5000" $ allTorrents getTorrentId @ will return a list of torrent ids. @@ -37,14 +37,14 @@ They will also return ids for each object. Then for example  -> allFiles getFileSizeBytes :: TorrentId -> TorrentAction [FileId :*: Int]+> allFiles getFileSizeBytes :: TorrentId -> TorrentAction (Vector (FileId :*: Int)) is an action that will return a list of ids and file sizes when run on a torrent. These can further be used with 'Network.RTorrent.Torrent.allTorrents'.  To combine actions, you can use '<+>' and 'sequenceActions'-which correspond to ':*:' and @[]@ for commands.+which correspond to ':*:' and @[]@ or @Vector@ for commands. -In order to write new actions, 'simpleAction' can be used.+'simpleAction' can be used to write new actions.  -} 

@@ -1,8 +1,9 @@ {-# LANGUAGE TypeOperators, TypeFamilies, RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}  {-| Module      : Action.Internals-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -21,39 +22,61 @@     , ActionB (..)      , AllAction (..)-    , allToMulti +    , allToMulti ) where  import Control.Applicative import Control.Monad+import Control.Monad.Except (throwError)  import Data.Monoid import Data.Traversable hiding (mapM) -import Network.XmlRpc.Internals+import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+ import Network.RTorrent.Command.Internals import Network.RTorrent.Priority+import Network.RTorrent.Value  -- | A type for actions that can act on different things like torrents and files. -- -- @a@ is the return type.-data Action i a -    = Action [(String, [Param])] (forall m. (Monad m, Applicative m) => Value -> m a) i+data Action i a = Action {+          actionCmds :: V.Vector (T.Text, V.Vector Param)                +          -- ^ Commands and parameters+        , actionParse :: forall m. (Monad m, MonadFail m) => Value -> m a +          -- ^ Value parser+        , actionIndex :: i+          -- ^ Index at which the action is executed.+    }  -- | Wrapper to get monoid and applicative instances.-newtype ActionB i a = ActionB { runActionB :: i -> Action i a} +newtype ActionB i a = ActionB { runActionB :: i -> Action i a}  -- | A simple action that can be used when constructing new ones.--- --- Watch out for using @Bool@ as @a@ since using it with this function will probably result in an error,--- since RTorrent actually returns 0 or 1 instead of a bool.--- One workaround is to get an @Int@ and use @Bool@'s @Enum@ instance.-simpleAction :: XmlRpcType a => -       String-    -> [Param] +-- For example, +--+-- @+-- getTorrentDir :: TorrentId -> TorrentAction Text+-- getTorrentDir = simpleAction "d.directory" []+--+-- setTorrentDir :: Text -> TorrentId -> TorrentAction Int+-- setTorrentDir dir = simpleAction "d.directory.set" [PString dir]+-- @+--+-- A list of commands can be found in +--+-- <https://github.com/rakshasa/rtorrent/wiki/rTorrent-0.9-Comprehensive-Command-list-%28WIP%29>+--+-- but to get a proper explanation for the commands a dive into the source code of RTorrent is possibly needed.+simpleAction :: RpcType a =>+       T.Text+    -> [Param]     -> i     -> Action i a-simpleAction cmd params = Action [(cmd, params)] parseSingle+simpleAction cmd params = Action (V.singleton (cmd, V.fromList params)) parseValue  instance Functor (Action i) where     fmap f (Action cmds p fid) = Action cmds (fmap f . p) fid@@ -62,113 +85,139 @@     fmap f = ActionB . (fmap f .) . runActionB  instance Applicative (ActionB i) where-    pure a = ActionB $ Action [] (const (pure a))  +    pure a = ActionB $ Action V.empty (const (pure a)) -    (ActionB a) <*> (ActionB b) = ActionB $ \tid -> let -        parse :: (Monad m, Applicative m) => (Value -> m (a -> b)) -> (Value -> m a) -> Value -> m b+    (ActionB a) <*> (ActionB b) = ActionB $ \tid -> let+        arrayd 1 x = V.head x+        arrayd _ x = ValueArray x++        parse :: (Monad m, MonadFail m) => (Value -> m (a -> b)) -> (Value -> m a) -> Value -> m b         parse parseA parseB arr = do-            (valsA, valsB) <- splitAt len <$> getArray arr-            parseA (ValueArray valsA) -              <*> parseB (ValueArray valsB) +            (valsA, valsB) <- V.splitAt len <$> getArray arr+            parseA (arrayd (length cmdsA) valsA)+              <*> parseB (arrayd (length cmdsB) valsB)         len = length cmdsA         Action cmdsA pA _ = a tid         Action cmdsB pB _ = b tid-      in Action (cmdsA ++ cmdsB) (parse pA pB) tid+      in Action (cmdsA <> cmdsB) (parse pA pB) tid +instance Semigroup a => Semigroup (ActionB i a) where+    (<>) = liftA2 (<>)+ instance Monoid a => Monoid (ActionB i a) where     mempty = pure mempty-    mappend = liftA2 mappend   -instance XmlRpcType i => Command (Action i a) where+instance RpcType i => Command (Action i a) where     type Ret (Action i a) = a -    commandCall (Action cmds _ tid) = -          RTMethodCall -        . ValueArray-        . concatMap (\(cmd, params) -> -                        getArray'-                      . runRTMethodCall $ mkRTMethodCall cmd -                                    (toValue tid : map toValue params))+    commandCall (Action cmds _ tid) =+        RTMethodCall+        . V.map (\(cmd, params) ->+               (cmd, V.cons (toValue tid) (V.map toValue params)))         $ cmds+    commandValue (Action cmds parse _) = parse <=< deconstructArray+      where+        deconstructArray = if length cmds > 1 then return else single -    commandValue (Action _ parse _) = parse     levels (Action cmds _ _) = length cmds  -- | Parameters for actions.-data Param = -    PString String+data Param =+    PString T.Text   | PInt Int+  | PBool Bool   | PTorrentPriority TorrentPriority   | PFilePriority FilePriority+  | PFilter [T.Text]  instance Show Param where     show (PString str) = show str     show (PInt i) = show i+    show (PBool b) = show b     show (PTorrentPriority p) = show (fromEnum p)     show (PFilePriority p) = show (fromEnum p)+    show (PFilter f) = show f -instance XmlRpcType Param where+instance RpcType Param where     toValue (PString str) = toValue str+    toValue (PBool b) = toValue b     toValue (PInt i) = toValue i     toValue (PTorrentPriority p) = toValue p     toValue (PFilePriority p) = toValue p+    toValue (PFilter p) = ValueArray . V.fromList . map ValueString $ p -    fromValue = fail "No fromValue for Params"-    getType _ = TUnknown+    fromValue _ = throwError "No fromValue for Params" --- | Sequence multiple actions, for example with @f = []@.+-- | Sequence multiple actions, for example with @f = []@ or @f = Vector@. 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))+pureAction a = Action V.empty (const (return a))  infixr 6 <+> -- | Combine two actions to get a new one. (<+>) :: (i -> Action i a) -> (i -> Action i b) -> i -> Action i (a :*: b) a <+> b = runActionB $ (:*:) <$> ActionB a <*> ActionB b -data AllAction i a = AllAction i String (i -> Action i a)+data AllAction i a = AllAction +    i  -- ^ Dummy index+    T.Text -- ^ Function call+    (V.Vector Param) -- ^ Parameters +    (i -> Action i a) -- ^ Action at each index -makeMultiCall :: [(String, [Param])] -> [String]-makeMultiCall = ("" :) +makeMultiCallStr :: [(String, [Param])] -> [String]+makeMultiCallStr = ("" :)               . map (\(cmd, params) -> cmd ++ "=" ++ makeList params)   where     makeList :: Show a => [a] -> String     makeList params = ('{' :) . go params $ "}"       where         go :: Show a => [a] -> ShowS-        go [x] = shows x +        go [x] = shows x         go (x:xs) = shows x . (',' :) . go xs         go [] = id -wrapForParse :: Monad m => Value -> m [Value]-wrapForParse = mapM ( -                 return . ValueArray -                 . map (ValueArray . (:[])) -                 <=< getArray) -               <=< getArray <=< single <=< single+makeMultiCall :: V.Vector (T.Text, V.Vector Param) -> V.Vector T.Text+makeMultiCall = V.map (\(cmd, params) -> cmd <> "=" <> makeList params)+  where+    makeList :: Show a => V.Vector a -> T.Text+    makeList = T.cons '{' . flip T.snoc '}' . T.intercalate "," . V.toList . V.map (T.pack . show) -allToMulti :: AllAction i a -> j -> Action j [a]-allToMulti (AllAction emptyId multicall action) = -    Action [(multicall, map PString $ makeMultiCall cmds)] -           (mapM parse <=< wrapForParse)-  where +-- | Turn an 'AllAction' to a regular 'Action'.+allToMulti :: AllAction i a -> j -> Action j (V.Vector a)+allToMulti (AllAction emptyId multicall filt action) j =+    Action {+        actionCmds = V.singleton (multicall,+                (filt <>)+                . V.map PString $ makeMultiCall cmds),+        actionParse = let +            deconstructArray = if length cmds > 1 then return else single+            in mapM (parse <=< deconstructArray)+                <=< getArray+        ,+        actionIndex = j+    }+  where     Action cmds parse _ = action emptyId-    + instance Command (AllAction i a) where-    type Ret (AllAction i a) = [a]-    commandCall (AllAction emptyId multicall action) = +    type Ret (AllAction i a) = V.Vector a+    commandCall (AllAction emptyId multicall filt action) =                       mkRTMethodCall multicall-                    . map ValueString-                    . makeMultiCall +                    . (V.map toValue filt <>)+                    . V.map ValueString+                    . makeMultiCall                     $ cmds       where         Action cmds _ _ = action emptyId -    commandValue (AllAction emptyId _ action) = -        mapM parse <=< wrapForParse+    commandValue (AllAction emptyId _ filt action) =+        mapM (parse+              <=< deconstructArray)+            <=< getArray+            <=< single       where-        Action _ parse _ = action emptyId-+        Action cmds parse _ = action emptyId+        deconstructArray = if length cmds > 1 then return else single

@@ -12,24 +12,29 @@     , convertChunksPad ) where +import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+ -- | 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]+                 -> T.Text -- ^ A bitfield represented in hexadecimals+                 -> Maybe (V.Vector 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+    pad :: Int -> V.Vector Bool -> V.Vector Bool+    pad i v = +        if i > V.length v +        then v <> V.replicate (i - V.length v) False+        else v  -- | 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+convertChunks :: T.Text -- ^ A bitfield represented in hexadecimals+                -> Maybe (V.Vector Bool)+convertChunks str = if T.null str +    then Nothing+    else fmap V.concat . mapM (fmap V.fromList . convert) $ T.unpack str   where     base2 = reverse . map (toEnum . (`mod` 2)) . take 4 . iterate (`div` 2)     convert = fmap base2 . num

@@ -1,10 +1,11 @@ {-# LANGUAGE TypeOperators, TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GADTs #-}  {-| Module      : Command.Internals-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -17,113 +18,83 @@     , AnyCommand (..)          , RTMethodCall (..)-    , runRTMethodCall     , mkRTMethodCall     , parseSingle+    , parseValue     , getArray-    , getArray'     , single-    , decodeUtf8 ) where  import Control.Applicative-import Control.DeepSeq-import Control.Monad.Except import Control.Monad.Identity -import qualified Codec.Binary.UTF8.String as U+import Control.Monad ((<=<), zipWithM) -import Data.List.Split (splitPlaces)+import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T -import Network.XmlRpc.Internals+import Data.Vector.Split (splitPlaces)+import Network.RTorrent.Value  -- | A strict 2-tuple for easy combining of commands. data (:*:) a b = (:*:) !a !b infixr 6 :*: -instance (NFData a, NFData b) => NFData (a :*: b) where-    rnf (a :*: b) = rnf a `seq` rnf b- instance (Show a, Show b) => Show (a :*: b) where     show (a :*: b) = show a ++ " :*: " ++ show b  instance (Command a, Command b) => Command (a :*: b) where     type Ret (a :*: b) = Ret a :*: Ret b -    commandCall (a :*: b) = RTMethodCall $ ValueArray (val a ++ val b)+    commandCall (a :*: b) = RTMethodCall (val a <> val b)         where-          val :: Command c => c -> [Value]-          val = getArray' . runRTMethodCall . commandCall+          val :: Command c => c -> V.Vector (T.Text, V.Vector Value)+          val = runRTMethodCall . commandCall      commandValue (a :*: b) (ValueArray xs) =            (:*:) <$> (commandValue a . ValueArray $ as)                 <*> (commandValue b . ValueArray $ bs)         where-            (as, bs) = splitAt (levels a) xs+            (as, bs) = V.splitAt (levels a) xs     commandValue _ _ = fail "commandValue in Command (a :*: b) instance failed"                  levels (a :*: b) = levels a + levels b   -- Helpers for values-getArray :: Monad m => Value -> m [Value]+getArray :: (Monad m, MonadFail m) => Value -> m (V.Vector Value) getArray (ValueArray ar) = return ar getArray _ = fail "getArray in Network.RTorrent.Commands failed" -getArray' :: Value -> [Value]-getArray' (ValueArray ar) = ar-getArray' _ = error "getArray' in Network.RTorrent.Commands failed"- -- | Extract a value from a singleton array.-single :: Monad m => Value -> m Value-single (ValueArray [ar]) = return ar-single v@(ValueStruct vars) = maybe -    err-    (\(c, s) -> do-        i <- int c-        s' <- str s-        fail $ "Server returned error " ++ show i ++ -                                ": " ++ s')-    (liftA2 (,) (lookup "faultCode" vars)-                (lookup "faultString" vars))-  where-    int (ValueInt i) = return i-    int _ = err-    str (ValueString s) = return s-    str _ = err-    err :: Monad m => m a-    err = fail $ "Failed to match a singleton array, got: " ++ show v+single :: (Monad m, MonadFail m)  => Value -> m Value+single (ValueArray ar) = if V.null ar +        then fail "Array has no values"+        else return $ V.head ar single v = fail $ "Failed to match a singleton array, got: " ++ show v -parseValue :: (Monad m, XmlRpcType a) => Value -> m a-parseValue = fromRight . runIdentity . runExceptT . fromValue -  where-    fromRight (Right r) = return r-    fromRight (Left e) = fail $ "parseValue failed: " ++ e---- | Parse a value wrapped in two singleton arrays.-parseSingle :: (Monad m, XmlRpcType a) => Value -> m a-parseSingle = parseValue <=< single <=< single+-- | Try to parse a 'Value' as any 'RpcType a'.+parseValue :: (Monad m, MonadFail m, RpcType a) => Value -> m a+parseValue = handleError (\e -> fail $ "parseValue failed: " ++ e) . fromValue -decodeUtf8 :: String -> String-decodeUtf8 = U.decodeString+-- | Parse a 'Value' wrapped in a singleton array.+parseSingle :: (Monad m, MonadFail m, RpcType a) => Value -> m a+parseSingle = parseValue <=< single  -- | A newtype wrapper for method calls.  --  -- You shouldn't directly use the constructor  -- if you don't know what you are doing.-newtype RTMethodCall = RTMethodCall Value+newtype RTMethodCall = RTMethodCall {+    runRTMethodCall :: V.Vector (T.Text, V.Vector Value)+}     deriving Show -runRTMethodCall :: RTMethodCall -> Value-runRTMethodCall (RTMethodCall v) = v- -- | Make a command that should be used when defining 'commandCall'.-mkRTMethodCall :: String -- ^ The name of the method (i.e. get_up_rate)-        -> [Value] -- ^ List of parameters+mkRTMethodCall :: T.Text -- ^ The name of the method (i.e. get_up_rate)+        -> V.Vector Value -- ^ List of parameters         -> RTMethodCall-mkRTMethodCall name params = RTMethodCall $ ValueArray [ValueStruct -                        [ ("methodName", ValueString name)-                        , ("params", ValueArray params)]]+mkRTMethodCall name params = RTMethodCall . V.singleton $ (name, params)  -- | A typeclass for commands that can be send to RTorrent. class Command a where@@ -133,7 +104,7 @@     -- | Construct a request.     commandCall :: a -> RTMethodCall      -- | Parse the resulting value.-    commandValue :: (Applicative m, Monad m) => +    commandValue :: (Applicative m, Monad m, MonadFail m) =>          a -> Value -> m (Ret a)      levels :: a -> Int@@ -151,17 +122,28 @@ instance Command AnyCommand where     type Ret AnyCommand = Value     commandCall (AnyCommand cmd) = commandCall cmd-    commandValue _ = single <=< single+    commandValue _ = single     levels (AnyCommand cmd) = levels cmd +instance Command a => Command (V.Vector a) where+    type Ret (V.Vector a) = V.Vector (Ret a)+    commandCall = RTMethodCall . V.concatMap (runRTMethodCall . commandCall)+    commandValue cmds = +        V.zipWithM (\cmd -> commandValue cmd . ValueArray) cmds+        . V.fromList +        . splitPlaces (map levels (V.toList cmds))+        <=< getArray+    levels = sum . V.map levels ++ instance Command a => Command [a] where     type Ret [a] = [Ret a]-    commandCall = RTMethodCall . ValueArray -                . concatMap ( getArray'-                            . runRTMethodCall . commandCall)+    commandCall = RTMethodCall +                . V.concatMap (runRTMethodCall . commandCall)+                . V.fromList     commandValue cmds =          zipWithM (\cmd -> commandValue cmd . ValueArray) cmds         . splitPlaces (map levels cmds) -        <=< getArray +        <=< getArray     levels = sum . map levels  

@@ -1,8 +1,8 @@-{-# LANGUAGE TypeFamilies, RankNTypes #-}+{-# LANGUAGE TypeFamilies, RankNTypes, OverloadedStrings #-}  {-| Module      : Commands-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -59,12 +59,17 @@   )   where -import Network.XmlRpc.Internals  import Control.Applicative  import Data.ByteString (ByteString)+import Data.ByteString.Base64 as B64+import Data.Text.Encoding (decodeLatin1) +import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+ import Network.RTorrent.Action import Network.RTorrent.Command.Internals import Network.RTorrent.File@@ -72,88 +77,96 @@ import Network.RTorrent.Priority import Network.RTorrent.Torrent import Network.RTorrent.Tracker+import Network.RTorrent.Value  -- | Run a command with no arguments.-commandSimple :: XmlRpcType a => String -> Global a+commandSimple :: RpcType a => T.Text -> Global a commandSimple cmd = commandArgs cmd []  -- | Run a command with the given arguments.-commandArgs :: XmlRpcType a => String -> [Value] -> Global a+commandArgs :: RpcType a => T.Text -> [Value] -> Global a commandArgs = flip $ Global parseSingle  -- | Run a command with the @Int@ given as an argument.-commandInt :: XmlRpcType a => String -> Int -> Global a+commandInt :: RpcType a => T.Text -> Int -> Global a commandInt cmd i = commandArgs cmd [ValueInt i]  -- | Run a command with the @String@ given as an argument.-commandString :: XmlRpcType a => -    String  -- ^ Command-    -> String -- ^ Argument+commandString :: RpcType a => +    T.Text  -- ^ Command+    -> T.Text -- ^ Argument     -> Global a commandString cmd s = commandArgs cmd [ValueString s]  -- | Get the current up rate, in bytes per second. getUpRate :: Global Int-getUpRate = commandSimple "get_up_rate"+getUpRate = commandSimple "throttle.global_up.rate"  -- | Get the current down rate, in bytes per second. getDownRate :: Global Int-getDownRate = commandSimple "get_down_rate"+getDownRate = commandSimple "throttle.global_down.rate"  -- | Get the default download directory.-getDirectory :: Global String-getDirectory = fmap decodeUtf8 $ commandSimple "get_directory"+getDirectory :: Global T.Text+getDirectory = commandSimple "directory.default"  -- | Get the maximum upload rate, in bytes per second. -- -- @0@ means no limit. getUploadRate :: Global Int-getUploadRate = commandSimple "get_upload_rate"+getUploadRate = commandSimple "throttle.global_up.max_rate"  -- | Get the maximum download rate, in bytes per second. -- -- @0@ means no limit. getDownloadRate :: Global Int-getDownloadRate = commandSimple "get_download_rate"+getDownloadRate = commandSimple "throttle.global_down.max_rate"  -- | Set the maximum upload rate, in bytes per second. setUploadRate :: Int -> Global Int-setUploadRate = commandInt "set_upload_rate"+setUploadRate = commandInt "throttle.global_up.max_rate.set"  -- | Set the maximum download rate, in bytes per second. setDownloadRate :: Int -> Global Int-setDownloadRate = commandInt "set_download_rate"+setDownloadRate = commandInt "throttle.global_down.max_rate.set"  -- | Get the process id. getPid :: Global Int getPid = commandSimple "system.pid"  -- | Load a torrent file.-loadTorrent :: String -- ^ A path / URL+loadTorrent :: T.Text -- ^ A path / URL         -> Global Int loadTorrent = commandString "load" +encodeB64ByteString :: ByteString -> T.Text+encodeB64ByteString = decodeLatin1 . B64.encode+ -- | Load a torrent file. loadTorrentRaw :: ByteString -- ^ A torrent file as data         -> Global Int-loadTorrentRaw torrentData = commandArgs "load_raw" [ValueBase64 torrentData] +--loadTorrentRaw torrentData = commandArgs "load_raw" [ValueBase64 torrentData] +loadTorrentRaw torrentData = commandArgs "load.raw" +    [ValueString . encodeB64ByteString $ torrentData]   -- | Load a torrent file and start downloading it.-loadStartTorrent :: String -- ^ A path / URL+loadStartTorrent :: T.Text -- ^ A path / URL         -> Global Int-loadStartTorrent = commandString "load_start"+loadStartTorrent = commandString "load.start"  -- | Load a torrent file and start downloading it. loadStartTorrentRaw :: ByteString -- ^ A torrent file as data         -> Global Int-loadStartTorrentRaw torrentData = commandArgs "load_raw_start" [ValueBase64 torrentData] +--loadStartTorrentRaw torrentData = commandArgs "load_raw_start" ["ValueBase64 torrentData] +loadStartTorrentRaw torrentData = commandArgs "load.raw_start" +    [ValueString . encodeB64ByteString $ torrentData]        -- | Execute a command with a result type @t@.-data Global t = Global (forall m. (Monad m, Applicative m) => Value -> m t) [Value] String+data Global t = Global (forall m. (Monad m, MonadFail m) => Value -> m t) [Value] T.Text instance Command (Global a) where     type Ret (Global a) = a-    commandCall (Global _ args cmd) = mkRTMethodCall cmd args+    commandCall (Global _ args cmd) = mkRTMethodCall cmd (V.fromList args)     commandValue (Global parse _ _) = parse  instance Functor Global where

@@ -1,8 +1,8 @@-{-# LANGUAGE TypeOperators, TypeFamilies #-}+{-# LANGUAGE TypeOperators, TypeFamilies, OverloadedStrings #-}  {-| Module      : File-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -13,10 +13,12 @@ module Network.RTorrent.File (     FileId (..)   , FileInfo (..)-  , FileAction +  , FileAction   , getFilePartial-  , getTorrentFiles+  , getTorrentFileInfo+  , getTorrentFileInfoFiltered   , allFiles+  , allFilesFiltered    -- * Functions dealing with a single variable   , getFilePath@@ -30,70 +32,66 @@ ) where  import Control.Applicative-import Control.DeepSeq +import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+ 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+import Network.RTorrent.Value -import Data.List.Split (splitOn)+--import Data.List.Split (splitOn)  data FileId = FileId !TorrentId !Int deriving Show -instance XmlRpcType FileId where-    toValue (FileId (TorrentId tid) i) = ValueString $ tid ++ ":f" ++ show i-    fromValue v = return . uncurry FileId =<< parse =<< fromValue v+instance RpcType FileId where+    toValue (FileId (TorrentId tid) i) = ValueString $ tid <> ":f" <> T.pack (show i)+    fromValue v = uncurry FileId <$> (parse =<< fromValue v)       where-        parse :: Monad m => String -> m (TorrentId, Int)+        parse :: (Monad m, MonadFail m) => T.Text -> m (TorrentId, Int)         parse str = do-            [hash, i] <- return $ splitOn ":f" str-            return (TorrentId hash, read i)-    getType _ = TString+            [hash, i] <- return $ T.splitOn ":f" str+            return (TorrentId hash, read (T.unpack i))  data FileInfo = FileInfo {-    filePath :: String+    filePath :: !T.Text   , fileSizeBytes :: !Int   , fileSizeChunks :: !Int   , fileCompletedChunks :: !Int   , filePriority :: !FilePriority   , fileOffset :: !Int-  , fileId :: FileId+  , fileId :: !FileId } deriving Show -instance NFData FileId where-    rnf (FileId tid i) = rnf tid `seq` rnf i--instance NFData FileInfo where-    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 --- | Run the file action on all files that a torrent has.-allFiles :: (FileId -> FileAction a) -> TorrentId -> TorrentAction [FileId :*: a]-allFiles f = fmap addId . (getTorrentId <+> allToMulti (allF f))+-- | Run the file action on all files that a torrent has selected by a list of regexps.+--+-- Note that the currently (as of 0.15.5) RTorrent regexps are very limited and only supports the wildcard @*@ matching any number of any characters.+allFilesFiltered :: [T.Text] -> (FileId -> FileAction a) -> TorrentId -> TorrentAction (V.Vector (FileId :*: a))+allFilesFiltered filters f = fmap addId . (getTorrentId <+> allToMulti (allF f))   where-    addId (hash :*: files) = -        zipWith (\index -> (:*:) (FileId hash index)) [0..] files +    addId (hash :*: files) =+        V.imap (\index -> (:*:) (FileId hash index)) files     allF :: (FileId -> FileAction a) -> AllAction FileId a-    allF = AllAction (FileId (TorrentId "") 0) "f.multicall"+    allF = AllAction (FileId (TorrentId "") 0) "f.multicall" (V.singleton fs)+    fs = if null filters then PString "" else PFilter filters+--+-- | Run the file action on all files that a torrent has.+allFiles :: (FileId -> FileAction a) -> TorrentId -> TorrentAction (V.Vector (FileId :*: a))+allFiles = allFilesFiltered []  -- | Get the file name relative to the torrent base directory.-getFilePath :: FileId -> FileAction String-getFilePath = fmap decodeUtf8 . simpleAction "f.path" []+getFilePath :: FileId -> FileAction T.Text+getFilePath = simpleAction "f.path" []  -- | Get the absolute path.-getFileAbsolutePath :: FileId -> FileAction String-getFileAbsolutePath = fmap decodeUtf8 . simpleAction "f.frozen_path" []+getFileAbsolutePath :: FileId -> FileAction T.Text+getFileAbsolutePath = simpleAction "f.frozen_path" []  getFileSizeBytes :: FileId -> FileAction Int getFileSizeBytes = simpleAction "f.size_bytes" []@@ -115,7 +113,7 @@ setFilePriority :: FilePriority -> FileId -> FileAction Int setFilePriority pr = simpleAction "f.priority.set" [PFilePriority pr] --- | Get a file except for @FileId@. The @FileId@ can be got by running @allFiles@.+-- | Get @FileInfo@ for @FileId@. The @FileId@ can be got by running @allFiles@. getFilePartial :: FileId -> FileAction (FileId -> FileInfo) getFilePartial = runActionB $ FileInfo            <$> b getFilePath@@ -123,12 +121,16 @@            <*> b getFileSizeChunks            <*> b getFileCompletedChunks            <*> b getFilePriority-           <*> b getFileOffset +           <*> b getFileOffset   where     b = ActionB -getTorrentFiles :: TorrentId -> TorrentAction [FileInfo]-getTorrentFiles = fmap (map contract) . allFiles getFilePartial+-- | Get FileInfo for all files in a torrent filtered by a list of regexps.+getTorrentFileInfoFiltered :: [T.Text] -> TorrentId -> TorrentAction (V.Vector FileInfo)+getTorrentFileInfoFiltered filters = fmap (V.map contract) . allFilesFiltered filters getFilePartial   where     contract (x :*: f) = f x +-- | Get FileInfo for all files in a torrent.+getTorrentFileInfo :: TorrentId -> TorrentAction (V.Vector FileInfo)+getTorrentFileInfo = getTorrentFileInfoFiltered []

@@ -0,0 +1,69 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : JSONRPC+Copyright   : (c) Kai Lindholm, 2025+License     : MIT+Maintainer  : megantti@gmail.com+Stability   : experimental++JSON-RPC message encoding and decoding.+-}++module Network.RTorrent.JSONRPC (jsonRPCcall, jsonRPCdecode) where++import Control.Monad+import qualified Data.Map as M+import qualified Data.IntMap.Strict as IM+import qualified Data.Vector as V+import qualified Data.Text as T+import qualified Data.ByteString.Lazy as LB++import Network.RTorrent.CommandList+import Network.RTorrent.Value+import qualified Network.RTorrent.Command.Internals as C+import Data.Aeson.Encode.Pretty (encodePretty)++-- | Construct a JSON-RPC call. +-- This constructs a batch request.+jsonRPCcall :: C.RTMethodCall -> Value+jsonRPCcall = ValueArray . V.imap call . C.runRTMethodCall+  where+    call i (method, params) =+        ValueStruct (M.fromList [+        ("jsonrpc", ValueString "2.0"),+        ("method", ValueString method),+        ("id", ValueInt i),+        ("params", ValueArray params)+        ])++-- | Decode a JSON-RPC batch response.+jsonRPCdecode :: Value -> Either String Value+jsonRPCdecode (ValueArray val) = do+      im <- V.sequence items+      let m = maximum . V.toList . V.map fst $ im+      let v = V.replicate (m+1) (Left "JSON-RPC response is missing a part.")+      let vs = V.update v im+      ValueArray <$> sequence vs+  where+    --step im +    decodeItem :: Value -> Either String (Int, Either String Value)+    decodeItem (ValueStruct a) = do+        js <- maybe (Left "Invalid JSON-RPC response.") Right $ M.lookup "jsonrpc" a+        when (js /= ValueString "2.0") $ Left "Invalid JSON-RPC response."+        maybe (Right ()) +            (\e -> Left ("JSON-RPC error: " +                        ++ map (toEnum . fromEnum) (LB.unpack (encodePretty e)))) +            $ M.lookup "error" a+        res <- maybe (Left "Invalid JSON-RPC response.") Right $ M.lookup "result" a+        iv <- maybe (Left "Invalid JSON-RPC response.") Right $ M.lookup "id" a+        let i = case iv of+                ValueInt i -> Right i+                _ -> Left "Invalid JSON-RPC response."+        (\j -> (j, Right res)) <$> i+    decodeItem _ = Left "Invalid JSON-RPC response."+    items :: V.Vector (Either String (Int, Either String Value))+    items = V.map decodeItem val+jsonRPCdecode _ = Left "Invalid JSON-RPC response."

@@ -1,8 +1,8 @@-{-# LANGUAGE TypeOperators, TypeFamilies #-}+{-# LANGUAGE TypeOperators, TypeFamilies, OverloadedStrings #-}  {-| Module      : Peer-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -13,7 +13,7 @@ module Network.RTorrent.Peer (     PeerId (..)   , PeerInfo (..)-  , PeerAction +  , PeerAction    , getPeerPartial   , allPeers@@ -38,34 +38,31 @@ ) where  import Control.Applicative-import Control.DeepSeq +import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+ import Network.RTorrent.Action.Internals import Network.RTorrent.Torrent import Network.RTorrent.Command-import Network.XmlRpc.Internals--import Data.List.Split (splitOn)+import Network.RTorrent.Value -data PeerId = PeerId !TorrentId !String +data PeerId = PeerId !TorrentId !T.Text     deriving Show -instance XmlRpcType PeerId where-    toValue (PeerId (TorrentId tid) i) = ValueString $ tid ++ ":p" ++ i-    fromValue v = return . uncurry PeerId =<< parse =<< fromValue v+instance RpcType PeerId where+    toValue (PeerId (TorrentId tid) i) = ValueString $ tid <> ":p" <> i+    fromValue v = uncurry PeerId <$> (parse =<< fromValue v)       where-        parse :: Monad m => String -> m (TorrentId, String)+        parse :: (Monad m, MonadFail m) => T.Text -> m (TorrentId, T.Text)         parse str = do-            [hash, s] <- return $ splitOn ":p" str+            [hash, s] <- return $ T.splitOn ":p" str             return (TorrentId hash, s)-    getType _ = TString -instance NFData PeerId where-    rnf (PeerId tid i) = rnf tid `seq` rnf i- data PeerInfo = PeerInfo {-    peerClientVersion :: String-  , peerIp :: String+    peerClientVersion :: !T.Text+  , peerIp :: !T.Text   , peerUpRate :: !Int   , peerDownRate :: !Int   , peerUpTotal :: !Int@@ -73,51 +70,38 @@   , peerEncrypted :: !Bool   , peerCompletedPercent :: !Int   , peerPort :: !Int-  , peerId :: PeerId+  , peerId :: !PeerId } deriving Show -instance NFData PeerInfo where-    rnf (PeerInfo a0 a1 a2 a3 a4 a5 a6 a7 a8 a9) =-              rnf a0-        `seq` rnf a1 -        `seq` rnf a2-        `seq` rnf a3-        `seq` rnf a4-        `seq` rnf a5-        `seq` rnf a6-        `seq` rnf a7-        `seq` rnf a8-        `seq` rnf a9--getPeerHash :: PeerId -> PeerAction String-getPeerHash = simpleAction "p.get_id" []+getPeerHash :: PeerId -> PeerAction T.Text+getPeerHash = simpleAction "p.id" [] -getPeerIp :: PeerId -> PeerAction String-getPeerIp = simpleAction "p.get_address" []+getPeerIp :: PeerId -> PeerAction T.Text+getPeerIp = simpleAction "p.address" [] -getPeerClientVersion :: PeerId -> PeerAction String-getPeerClientVersion = simpleAction "p.get_client_version" []+getPeerClientVersion :: PeerId -> PeerAction T.Text+getPeerClientVersion = simpleAction "p.client_version" []  getPeerUpRate :: PeerId -> PeerAction Int-getPeerUpRate = simpleAction "p.get_up_rate" []+getPeerUpRate = simpleAction "p.up_rate" []  getPeerDownRate :: PeerId -> PeerAction Int-getPeerDownRate = simpleAction "p.get_down_rate" []+getPeerDownRate = simpleAction "p.down_rate" []  getPeerUpTotal :: PeerId -> PeerAction Int-getPeerUpTotal = simpleAction "p.get_up_total" []+getPeerUpTotal = simpleAction "p.up_total" []  getPeerDownTotal :: PeerId -> PeerAction Int-getPeerDownTotal = simpleAction "p.get_down_total" []+getPeerDownTotal = simpleAction "p.down_total" []  getPeerEncrypted :: PeerId -> PeerAction Bool-getPeerEncrypted = fmap toEnum . simpleAction "p.is_encrypted" []+getPeerEncrypted = simpleAction "p.is_encrypted" []  getPeerCompletedPercent :: PeerId -> PeerAction Int-getPeerCompletedPercent = simpleAction "p.get_completed_percent" []+getPeerCompletedPercent = simpleAction "p.completed_percent" []  getPeerPort :: PeerId -> PeerAction Int-getPeerPort = simpleAction "p.get_port" []+getPeerPort = simpleAction "p.port" []  -- | Get a partial peer. @PeerId@ can be gotten by running @allPeers@. getPeerPartial :: PeerId -> PeerAction (PeerId -> PeerInfo)@@ -142,16 +126,16 @@  type PeerAction = Action PeerId -getTorrentPeers :: TorrentId -> TorrentAction [PeerInfo]-getTorrentPeers = fmap (map contract) . allPeers getPeerPartial+getTorrentPeers :: TorrentId -> TorrentAction (V.Vector PeerInfo)+getTorrentPeers = fmap (V.map contract) . allPeers getPeerPartial   where     contract (x :*: f) = f x  -- | Run the peer action on all peers that a torrent has.-allPeers :: (PeerId -> PeerAction a) -> TorrentId -> TorrentAction [PeerId :*: a]+allPeers :: (PeerId -> PeerAction a) -> TorrentId -> TorrentAction (V.Vector (PeerId :*: a)) allPeers p = fmap addId . (getTorrentId <+> allToMulti (allP (getPeerHash <+> p)))   where-    addId (hash :*: peers) = -        map (\(phash :*: f) -> PeerId hash phash :*: f) peers+    addId (hash :*: peers) =+        V.map (\(phash :*: f) -> PeerId hash phash :*: f) peers     allP :: (PeerId -> PeerAction a) -> AllAction PeerId a-    allP = AllAction (PeerId (TorrentId "") "") "p.multicall"+    allP = AllAction (PeerId (TorrentId "") "") "p.multicall" (V.fromList [PString ""])

@@ -1,6 +1,6 @@ {-| Module      : Priority-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -11,18 +11,15 @@   , FilePriority (..) ) where -import Control.DeepSeq-import Network.XmlRpc.Internals+import Network.RTorrent.Value -data TorrentPriority = +data TorrentPriority =       TorrentPriorityOff     | TorrentPriorityLow     | TorrentPriorityNormal     | TorrentPriorityHigh   deriving (Show, Eq, Ord) -instance NFData TorrentPriority- instance Enum TorrentPriority where     toEnum 0 = TorrentPriorityOff     toEnum 1 = TorrentPriorityLow@@ -35,23 +32,20 @@     fromEnum TorrentPriorityNormal = 2     fromEnum TorrentPriorityHigh = 3 -instance XmlRpcType TorrentPriority where+instance RpcType TorrentPriority where     toValue = toValue . fromEnum-    fromValue v = return . toEnum =<< check =<< fromValue v+    fromValue v = toEnum <$> (check =<< fromValue v)       where-        check i +        check i           | 0 <= i && i <= 3 = return i           | otherwise = fail $ "Invalid TorrentPriority, got : " ++ show i-    getType _ = TInt -data FilePriority = +data FilePriority =       FilePriorityOff     | FilePriorityNormal     | FilePriorityHigh   deriving (Show, Eq, Ord) -instance NFData FilePriority- instance Enum FilePriority where     toEnum 0 = FilePriorityOff     toEnum 1 = FilePriorityNormal@@ -62,11 +56,10 @@     fromEnum FilePriorityNormal = 1     fromEnum FilePriorityHigh = 2 -instance XmlRpcType FilePriority where+instance RpcType FilePriority where     toValue = toValue . fromEnum-    fromValue v = return . toEnum =<< check =<< fromValue v+    fromValue v = toEnum <$> (check =<< fromValue v)       where-        check i +        check i           | 0 <= i && i <= 2 = return i           | otherwise = fail $ "Invalid FilePriority, got : " ++ show i-    getType _ = TInt

@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Query+Copyright   : (c) Kai Lindholm, 2014, 2025+License     : MIT+Maintainer  : megantti@gmail.com+Stability   : experimental++An internal module for establishing a connection with RTorrent.+-}++module Network.RTorrent.Query (Headers, Body(..), query) where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+import Blaze.Text+import Control.Applicative+import Data.Char (ord)+import Data.Either (partitionEithers)+import Data.Functor (($>))+import Data.Monoid+import Network.Socket+import Network.URI (URI(..), URIAuth(..), parseURIReference)+import System.IO ( IOMode (..) )+import System.Directory (makeAbsolute, getHomeDirectory)++import qualified Data.Attoparsec.ByteString.Lazy as AT+import Data.Attoparsec.ByteString.Lazy (Parser)++import qualified Data.Aeson as A+import qualified Data.ByteString as BS+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LB++import Network.RTorrent.Value++type Headers = [(ByteString, ByteString)]++data Body = Body {+      headers :: Headers+    , body :: LB.ByteString+} deriving Show++makeRequest :: Body -> LB.ByteString+makeRequest (Body hd bd) = res+  where+    res = toLazyByteString . mconcat $ [+        integral len+      , fromChar ':'+      , fromByteString hdbs+      , fromChar ','+      , fromLazyByteString bd+      ]+    fromBS0 bs = fromWrite $ writeByteString bs <> writeWord8 0+    hdbs = toByteString . mconcat $+           (fromBS0 "CONTENT_LENGTH" <> integral (LB.length bd) <> fromWord8 0):+            map (\(a, b) -> fromBS0 a <> fromBS0 b) hd+    len = BS.length hdbs++parseResponse :: Parser Body+parseResponse = parseBody+  where+    lineChange :: Parser ByteString+    lineChange = AT.string "\r\n"+    lineParser :: Parser ByteString+    lineParser =+        mappend <$> AT.takeTill (== (fromIntegral $ ord '\r')) <*> ((lineChange $> "") <|> lineParser)+    headerParser = (,) <$> AT.takeTill (==  (fromIntegral . ord $ ':')) <*> (AT.string ": " *> 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 = lineChange *> AT.takeLazyByteString+    parseBody = do+        (headers, content) <- takeUntil headerParser contentParser+        return $ Body headers content++querySCGI :: URI -> Body -> IO (Either String Body)+querySCGI uri queryBody = do+    let hints = if uriScheme uri == "tcp:"+        then defaultHints { addrSocketType = Stream, addrFamily = AF_INET }+        else defaultHints { addrSocketType = Stream, addrFamily = AF_UNIX }+    addr <- if uriScheme uri == "tcp:"+        then return $ maybe "" uriRegName (uriAuthority uri)+        else if (uriRegName <$> uriAuthority uri) == Just "~"+                then (++ uriPath uri) <$> getHomeDirectory +                else return $ uriPath uri+    let port = if uriScheme uri == "tcp:"+        then drop 1 . uriPort <$> uriAuthority uri+        else Nothing+    addrl <- if uriScheme uri == "tcp:"+        then do+            getAddrInfo (Just hints) (Just addr) port+        else do+            return [AddrInfo [] AF_UNIX Stream 0 (SockAddrUnix addr) Nothing]+    case addrl of+        [] -> return (Left "Couldn't resolve SCGI address.")+        (addr:_) -> do+            sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+            connect sock (addrAddress addr)+            h <- socketToHandle sock ReadWriteMode++            LB.hPut h (makeRequest queryBody)+            AT.parseOnly parseResponse <$> LB.hGetContents h++scgi :: URI -> Value -> IO (Either String Value)+scgi addr call = do+    let request = Body [] (A.encode call)+    resp <- querySCGI addr request+    return $ case resp of+        Left err -> Left err+        Right (Body _ content) -> A.eitherDecode content++-- | Send a query in @Value@ to the address and return the response or an error.+query :: String -> Value -> IO (Either String Value)+query addr call =+    case parseURIReference addr of+        Nothing -> return (Left "Invalid URI.")+        Just uri -> maybe (return $ Left "Unsupported URI protocol.")+                        (\f -> f uri call) $ lookup (uriScheme uri) schemes+    where+        schemes = [("tcp:", scgi), ("unix:", scgi)]+            --("http:", http), "https:", http)]

@@ -2,17 +2,17 @@  {-| Module      : RPC-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental -This package can be used for communicating with RTorrent over its XML-RPC interface.+This package can be used for communicating with RTorrent over its JSON-RPC interface.  For example, you can request torrent info and bandwidth usage:  @-result <- callRTorrent "localhost" 5000 $ +result <- callRTorrent "tcp://localhost:5000" $      'getTorrents' 'Network.RTorrent.Command.:*:' 'getUpRate' 'Network.RTorrent.Command.:*:' 'getDownRate' case result of    Right (torrentInfo :*: uploadRate :*: downloadRate) -> ...@@ -20,12 +20,21 @@ where  >>> :t torrentInfo-[TorrentInfo]+Vector TorrentInfo >>> :t uploadRate Int -This requires you to have set @scgi_port = localhost:5000@ in your @.rtorrent.rc@.+This requires you to have set @network.scgi.open_port = "127.0.0.1:5000"@ in your @.rtorrent.rc@,+but this comes with security implications if your computer has multiple users.  +Alternatively, you can setup RTorrent to open a UNIX socket with @network.scgi.open_local@ , and then call++@+result <- callRTorrent "unix:\/\/~/.rtorrent\/.session\/socket.rpc" $ +    ...+@++ Note that 'Network.RTorrent.Command.:*:' is both a data constructor and a type constructor, and therefore: @@ -43,39 +52,44 @@ {&#45;\# LANGUAGE TypeOperators \#&#45;}  import Control.Monad+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Text (Text)+import qualified Data.Text as T+ import Network.RTorrent  -- This is an action, and they can be combined with ('<+>'). torrentInfo :: 'TorrentId'-                -> 'TorrentAction' (String :*: [FileId :*: String :*: Int])+                -> 'TorrentAction' (Text :*: Vector (FileId :*: Text :*: Int)) torrentInfo = 'getTorrentName' -               '<+>' 'allFiles' ('getFilePath' '<+>' 'getFileSizeBytes')+               '<+>' 'allFiles' ('getFilePath' <+> 'getFileSizeBytes') -    -- 'allFiles' takes a file action ('FileId' -> 'FileAction' a)-    -- and returns a torrent action: TorrentId -> 'TorrentAction' [FileId :*: a].-    -- Note that it automatically adds 'FileId's to all elements.+-- 'allFiles' takes a file action ('FileId' -> 'FileAction' a)+-- and returns a torrent action: TorrentId -> 'TorrentAction' (Vector (FileId :*: a)).+-- Note that it automatically adds 'FileId's to all elements.  main :: IO () main = do-    Right torrents <- callRTorrent "localhost" 5000 $+    Right torrents <- callRTorrent "tcp://localhost:5000" $                         'allTorrents' torrentInfo     let largeFiles = -                filter (\\(_ :*: _ :*: _ :*: size) -> size > 10^8)-                . concatMap (\\(tName :*: fileList) -> -                                map ((:*:) tName) fileList) +                V.filter (\\(_ :*: _ :*: _ :*: size) -> size > 10^8)+                . V.concatMap (\\(tName :*: fileList) -> +                                V.map ((:*:) tName) fileList)                               -- Move the torrent name into the list                 $ torrents      putStrLn "Large files:"-    forM_ largeFiles $ \\(torrent :*: _ :*: fPath :*: _) ->-        putStrLn $ "\\t" ++ torrent ++ ": " ++ fPath+    V.forM_ largeFiles $ \\(torrent :*: _ :*: fPath :*: _) ->+        putStrLn $ "\\t" ++ T.unpack torrent ++ ": " ++ T.unpack fPath      -- There is instance ('Network.RTorrent.Command.Command' cmdA, 'Network.RTorrent.Command.Command' cmdB) => 'Network.RTorrent.Command.Command' (cmdA :*: cmdB)     -- The return value for the command cmdA is 'Network.RTorrent.Command.Ret' cmdA, which is an associated type     -- in the Command type class.     -- The return value for the command cmdA :*: cmdB is Ret cmdA :*: Ret cmdB.                      -    let cmd :: String :*: FileId :*: String :*: Int +    let cmd :: Text :*: FileId :*: Text :*: Int                  -> FileAction FilePriority :*: FileAction Int         cmd (_ :*: fid :*: _ :*: _) =              'getFilePriority' fid :*: 'setFilePriority' 'FilePriorityHigh' fid@@ -83,60 +97,65 @@             -- Get the old priority and set the new one to high.             -- setFilePriority returns a not-so-useful Int. -    -- There is also an instance Command a => Command [a],-    -- and the return value for [a] is [Ret a].+    -- There is also an instance Command a => Command (Vector a),+    -- and the return value for Vector a is Vector (Ret a).     -    Right ret <- callRTorrent "localhost" 5000 $ map cmd largeFiles+    Right ret <- callRTorrent "tcp://localhost:5000" $ V.map cmd largeFiles      putStrLn "Old priorities:"-    forM_ ret $ \\(oldPriority :*: _) -> do+    V.forM_ ret $ \\(oldPriority :*: _) -> do         putStrLn $ "\\t" ++ show oldPriority @ -}  module Network.RTorrent.RPC (       module Network.RTorrent.CommandList-    , callRTorrent +    , callRTorrent     ) where -import Control.Monad.Except (ExceptT(..), throwError, runExceptT)+import Control.Monad.Except (ExceptT(..), throwError, runExceptT, liftEither)+import Control.Monad.IO.Class import Control.Exception+ import Data.Monoid import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LB-import Network-import Network.XmlRpc.Internals -import qualified Network.RTorrent.Command.Internals as C+import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+import qualified Data.Aeson as A+import Data.Aeson.Encode.Pretty++import Network.Socket import Network.RTorrent.CommandList-import Network.RTorrent.SCGI+import Network.RTorrent.Value+import Network.RTorrent.JSONRPC+import Network.RTorrent.Query+import qualified Network.RTorrent.Command.Internals as C -callRTorrentRaw :: HostName -> Int -> C.RTMethodCall -> ExceptT String IO Value-callRTorrentRaw host port calls = do-    let request = Body [] . mconcat . LB.toChunks $ renderCall call -    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 $ "Got value of type " ++ show (getType val)-        Fault code err -> throwError $ show code ++ ": " ++ err-  where-    call = MethodCall "system.multicall" [C.runRTMethodCall calls]+callRTorrentRaw :: String -> C.RTMethodCall -> ExceptT String IO Value+callRTorrentRaw addr calls = do+    let call = jsonRPCcall calls+    response <- ExceptT $ query addr call+    liftEither $ jsonRPCdecode response  -- | Call RTorrent with a command. -- Only one connection is opened even when combining commands -- for example by using ':*:' or lists.+--+-- Examples of currently supported address types: +--+--     * @tcp:\/\/localhost:5000@                      +--     * @unix:\/\/~\/.rtorrent\/.session\/rpc.socket@  callRTorrent :: Command a =>-    HostName-    -> Int-    -> a +    String   -- ^ Address+    -> a     -- ^ Command     -> IO (Either String (Ret a))-callRTorrent host port command = -    (runExceptT $ do-        ret <- callRTorrentRaw host port (C.commandCall command)-        C.commandValue command ret) +callRTorrent addr command = do+    runExceptT (do+        ret <- callRTorrentRaw addr (C.commandCall command)+        C.commandValue command ret)         `catches` [ Handler (\e -> return . Left $ show (e :: IOException))                   , Handler (\e -> return . Left $ show (e :: PatternMatchFail))]-    +

@@ -1,79 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{-# OPTIONS_HADDOCK hide #-}--{-|-Module      : SCGI-Copyright   : (c) Kai Lindholm, 2014-License     : MIT-Maintainer  : megantti@gmail.com-Stability   : experimental--An internal module for establishing a connection with RTorrent.--}--module Network.RTorrent.SCGI (Headers, Body(..), query) where--import Control.Applicative-import Data.Either (partitionEithers)-import Data.Monoid--import Blaze.ByteString.Builder-import Blaze.ByteString.Builder.Char8-import Blaze.Text-import Data.Attoparsec.ByteString.Char8 (Parser)-import qualified Data.Attoparsec.ByteString.Char8 as A-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS--import Network--type Headers = [(ByteString, ByteString)]--data Body = Body {-      headers :: Headers-    , body :: ByteString-} deriving Show--makeRequest :: Body -> ByteString-makeRequest (Body hd bd) = res -  where-    res = toByteString . mconcat $ [ -        integral len-      , fromChar ':'-      , fromByteString hdbs-      , fromChar ','-      , fromByteString bd-      ]-    fromBS0 bs = fromWrite $ writeByteString bs <> writeWord8 0-    hdbs = toByteString . mconcat $ -           (fromBS0 "CONTENT_LENGTH" <> integral (BS.length bd) <> fromWord8 0): -            map (\(a, b) -> fromBS0 a <> fromBS0 b) hd-    len = BS.length hdbs--parseResponse :: Parser Body-parseResponse = parseBody-  where-    lineParser :: Parser ByteString-    lineParser = -        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-        (headers, content) <- takeUntil headerParser contentParser-        return $ Body headers content--query :: HostName -> Int -> Body -> IO (Either String Body)-query host port queryBody = do-    h <- connectTo host (PortNumber (toEnum port))-    BS.hPut h (makeRequest queryBody) -    A.parseOnly parseResponse <$> BS.hGetContents h-

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-| Module      : Torrent Copyright   : (c) Kai Lindholm, 2014-2015@@ -47,54 +48,40 @@   where  import Control.Applicative-import Control.DeepSeq-import Network.XmlRpc.Internals +import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+ import Network.RTorrent.Action.Internals import Network.RTorrent.Command.Internals import Network.RTorrent.Chunk import Network.RTorrent.Priority+import Network.RTorrent.Value  -- | A newtype wrapper for torrent identifiers.-newtype TorrentId = TorrentId String +newtype TorrentId = TorrentId T.Text     deriving Show  type TorrentAction = Action TorrentId -instance NFData TorrentId where-    rnf (TorrentId str) = rnf str--instance XmlRpcType TorrentId where+instance RpcType TorrentId where     toValue (TorrentId s) = ValueString s-    fromValue v = return . TorrentId =<< fromValue v-    getType _ = TString+    fromValue v = TorrentId <$> fromValue v  data TorrentInfo = TorrentInfo {-      torrentId :: TorrentId-    , torrentName :: String+      torrentId :: !TorrentId+    , torrentName :: !T.Text     , torrentOpen :: !Bool     , torrentDownRate :: !Int     , torrentUpRate :: !Int     , torrentSize :: !Int     , torrentBytesLeft :: !Int-    , torrentPath :: String-    , torrentDir :: String+    , torrentPath :: !T.Text+    , torrentDir :: !T.Text     , torrentTorrentPriority :: !TorrentPriority     } deriving Show -instance NFData TorrentInfo where-    rnf (TorrentInfo i a0 a1 a2 a3 a4 a5 a6 a7 a8) = -        rnf i  `seq`-        rnf a0 `seq`-        rnf a1 `seq`-        rnf a2 `seq`-        rnf a3 `seq`-        rnf a4 `seq`-        rnf a5 `seq`-        rnf a6 `seq`-        rnf a7 `seq`-        rnf a8- -- | Get a TorrentInfo for a torrent. getTorrent :: TorrentId -> TorrentAction TorrentInfo getTorrent = runActionB $ TorrentInfo@@ -141,45 +128,45 @@ getTorrentId :: TorrentId -> TorrentAction TorrentId getTorrentId = simpleAction "d.hash" [] -getTorrentName :: TorrentId -> TorrentAction String-getTorrentName = fmap decodeUtf8 . simpleAction "d.get_name" []+getTorrentName :: TorrentId -> TorrentAction T.Text+getTorrentName = simpleAction "d.name" []  -- | Get the absolute path to the torrent's directory or file.-getTorrentPath :: TorrentId -> TorrentAction String-getTorrentPath = fmap decodeUtf8 . simpleAction "d.get_base_path" []+getTorrentPath :: TorrentId -> TorrentAction T.Text+getTorrentPath = simpleAction "d.base_path" []  -- | Get the absolute path to the directory in which the torrent's directory or -- file resides.-getTorrentDir :: TorrentId -> TorrentAction String-getTorrentDir = fmap decodeUtf8 . simpleAction "d.get_directory" []+getTorrentDir :: TorrentId -> TorrentAction T.Text+getTorrentDir = simpleAction "d.directory" [] -setTorrentDir :: String -> TorrentId -> TorrentAction Int-setTorrentDir dir = simpleAction "d.set_directory" [PString dir]+setTorrentDir :: T.Text -> TorrentId -> TorrentAction Int+setTorrentDir dir = simpleAction "d.directory.set" [PString dir]  getTorrentOpen :: TorrentId -> TorrentAction Bool-getTorrentOpen = fmap toEnum . simpleAction "d.is_open" []+getTorrentOpen = simpleAction "d.is_open" []  getTorrentUpRate :: TorrentId -> TorrentAction Int-getTorrentUpRate = simpleAction "d.get_up_rate" []+getTorrentUpRate = simpleAction "d.up.rate" []  getTorrentDownRate :: TorrentId -> TorrentAction Int-getTorrentDownRate = simpleAction "d.get_down_rate" []+getTorrentDownRate = simpleAction "d.down.rate" []  getTorrentSizeBytes :: TorrentId -> TorrentAction Int-getTorrentSizeBytes = simpleAction "d.get_size_bytes" []+getTorrentSizeBytes = simpleAction "d.size_bytes" []  getTorrentLeftBytes :: TorrentId -> TorrentAction Int-getTorrentLeftBytes = simpleAction "d.get_left_bytes" []+getTorrentLeftBytes = simpleAction "d.left_bytes" []  getTorrentPriority :: TorrentId -> TorrentAction TorrentPriority getTorrentPriority = simpleAction "d.priority" []  -- | Get the ratio (which is multiplied by a thousand) getTorrentRatio :: TorrentId -> TorrentAction Int-getTorrentRatio = simpleAction "d.get_ratio" []+getTorrentRatio = simpleAction "d.ratio" []  getTorrentFileCount :: TorrentId -> TorrentAction Int-getTorrentFileCount = simpleAction "d.get_size_files" []+getTorrentFileCount = simpleAction "d.size_files" []  -- | A total number of chunks. getTorrentSizeChunks :: TorrentId -> TorrentAction Int@@ -187,11 +174,11 @@  -- | 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 :: TorrentId -> TorrentAction (Maybe (V.Vector Bool)) getTorrentChunks = fmap combine . (getTorrentSizeChunks <+> chunks)   where     combine (count :*: ch) = convertChunksPad count ch-    chunks :: TorrentId -> TorrentAction String+    chunks :: TorrentId -> TorrentAction T.Text     chunks = simpleAction "d.bitfield" []      -- | Get the size of a chunk.@@ -204,7 +191,7 @@ -- > allTorrents (setTorrentPriority TorrentPriorityNormal) -- will set the priority of all torrents to normal. allTorrents :: (TorrentId -> TorrentAction a) -> AllAction TorrentId a-allTorrents = AllAction (TorrentId "") "d.multicall"+allTorrents = AllAction (TorrentId "") "d.multicall2" (V.fromList [PString "", PString ""])  -- | A command for getting torrent info for all torrents. getTorrents :: AllAction TorrentId TorrentInfo

@@ -1,8 +1,8 @@-{-# LANGUAGE TypeOperators, TypeFamilies #-}+{-# LANGUAGE TypeOperators, TypeFamilies, OverloadedStrings #-}  {-| Module      : Tracker-Copyright   : (c) Kai Lindholm, 2014+Copyright   : (c) Kai Lindholm, 2014, 2025 License     : MIT Maintainer  : megantti@gmail.com Stability   : experimental@@ -14,7 +14,7 @@     TrackerId (..)   , TrackerType (..)   , TrackerInfo (..)-  , TrackerAction +  , TrackerAction   , getTrackerPartial   , getTorrentTrackers   , allTrackers@@ -28,28 +28,30 @@ ) where  import Control.Applicative-import Control.DeepSeq +import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+ import Network.RTorrent.Action.Internals import Network.RTorrent.Torrent import Network.RTorrent.Command-import Network.XmlRpc.Internals+import Network.RTorrent.Value -import Data.List.Split (splitOn)+-- import Data.List.Split (splitOn)  data TrackerId = TrackerId !TorrentId !Int deriving Show -instance XmlRpcType TrackerId where-    toValue (TrackerId (TorrentId tid) i) = ValueString $ tid ++ ":t" ++ show i-    fromValue v = return . uncurry TrackerId =<< parse =<< fromValue v+instance RpcType TrackerId where+    toValue (TrackerId (TorrentId tid) i) = ValueString $ tid <> ":t" <> T.pack (show i)+    fromValue v = uncurry TrackerId <$> (parse =<< fromValue v)       where-        parse :: Monad m => String -> m (TorrentId, Int)+        parse :: (Monad m, MonadFail m) => T.Text -> m (TorrentId, Int)         parse str = do-            [hash, i] <- return $ splitOn ":t" str-            return (TorrentId hash, read i)-    getType _ = TString+            [hash, i] <- return $ T.splitOn ":t" str+            return (TorrentId hash, read $ T.unpack i) -data TrackerType = +data TrackerType =       TrackerHTTP     | TrackerUDP     | TrackerDHT@@ -65,63 +67,49 @@     fromEnum TrackerUDP = 2     fromEnum TrackerDHT = 3 -instance XmlRpcType TrackerType where+instance RpcType TrackerType where     toValue = toValue . fromEnum-    fromValue v = return . toEnum =<< check =<< fromValue v+    fromValue v = toEnum <$> (check =<< fromValue v)       where-        check i +        check i           | 1 <= i && i <= 3 = return i           | otherwise = fail $ "Invalid TrackerType, got : " ++ show i-    getType _ = TInt -instance NFData TrackerType- data TrackerInfo = TrackerInfo {-    trackerUrl :: String+    trackerUrl :: !T.Text   , trackerType :: !TrackerType   , trackerEnabled :: !Bool   , trackerOpen :: !Bool-  , trackerId :: TrackerId+  , trackerId :: !TrackerId } deriving Show -instance NFData TrackerId where-    rnf (TrackerId tid i) = rnf tid `seq` rnf i--instance NFData TrackerInfo where-    rnf (TrackerInfo a0 a1 a2 a3 a4) = -              rnf a0 -        `seq` rnf a1-        `seq` rnf a2-        `seq` rnf a3-        `seq` rnf a4- type TrackerAction = Action TrackerId  -- | Run the tracker action on all trackers that a torrent has.-allTrackers :: (TrackerId -> TrackerAction a) -> TorrentId -> TorrentAction [TrackerId :*: a]+allTrackers :: (TrackerId -> TrackerAction a) -> TorrentId -> TorrentAction (V.Vector (TrackerId :*: a)) allTrackers t = fmap addId . (getTorrentId <+> allToMulti (allT t))   where-    addId (hash :*: trackers) = -        zipWith (\index -> (:*:) (TrackerId hash index)) [0..] trackers +    addId (hash :*: trackers) =+        V.imap (\index -> (:*:) (TrackerId hash index)) trackers     allT :: (TrackerId -> TrackerAction a) -> AllAction TrackerId a-    allT = AllAction (TrackerId (TorrentId "") 0) "t.multicall"+    allT = AllAction (TrackerId (TorrentId "") 0) "t.multicall" (V.fromList [PString ""]) -getTrackerUrl :: TrackerId -> TrackerAction String-getTrackerUrl = simpleAction "t.get_url" []+getTrackerUrl :: TrackerId -> TrackerAction T.Text+getTrackerUrl = simpleAction "t.url" []  getTrackerEnabled :: TrackerId -> TrackerAction Bool getTrackerEnabled = fmap toEnum . simpleAction "t.is_enabled" []  setTrackerEnabled :: Bool -> TrackerId -> TrackerAction Int-setTrackerEnabled i = simpleAction "t.is_enabled" [PInt (fromEnum i)]+setTrackerEnabled i = simpleAction "t.is_enabled.set" [PInt (fromEnum i)]  getTrackerType :: TrackerId -> TrackerAction TrackerType-getTrackerType = simpleAction "t.get_type" []+getTrackerType = simpleAction "t.type" []  getTrackerOpen :: TrackerId -> TrackerAction Bool getTrackerOpen = fmap toEnum . simpleAction "t.is_open" [] --- | Get a tracker except for @TrackerId@. The @TrackerId@ can be got by running @allTrackers@.+-- | Get @TrackerInfo@ for @TrackerId@. The @TrackerId@ can be got by running @allTrackers@. getTrackerPartial :: TrackerId -> TrackerAction (TrackerId -> TrackerInfo) getTrackerPartial = runActionB $ TrackerInfo            <$> b getTrackerUrl@@ -131,8 +119,8 @@   where     b = ActionB -getTorrentTrackers :: TorrentId -> TorrentAction [TrackerInfo]-getTorrentTrackers = fmap (map contract) . allTrackers getTrackerPartial+getTorrentTrackers :: TorrentId -> TorrentAction (V.Vector TrackerInfo)+getTorrentTrackers = fmap (V.map contract) . allTrackers getTrackerPartial   where     contract (x :*: f) = f x 

@@ -0,0 +1,95 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}++{-|+Module      : Value+Copyright   : (c) Kai Lindholm, 2025+License     : MIT+Maintainer  : megantti@gmail.com+Stability   : experimental++Data types and classes for values we use to communicate over JSON-RPC.+-}++module Network.RTorrent.Value (+    Value(..), ValueVector, KeyMap, +    RpcType(..), Err(..), handleError) where++import Control.Monad.Except (ExceptT, MonadError(..), runExceptT)+import Control.Monad.Trans+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.Map as M++import Data.Aeson (ToJSON, FromJSON)+import qualified Data.Aeson as A+import qualified Data.Aeson.KeyMap as AK+import Data.Scientific++-- | ExceptT with an error message.+type Err m a = ExceptT String m a+handleError h m = do+    Right x <- runExceptT (catchError m (lift . h))+    return x++type ValueVector = V.Vector Value+type KeyMap = M.Map T.Text Value++-- | Values we use to communicate with RTorrent.+-- These are a subset of JSON.+data Value = ValueArray !ValueVector | +             ValueInt !Int |+             ValueString !T.Text | +             ValueStruct !KeyMap+    deriving (Show, Eq)++instance ToJSON Value where+    toJSON (ValueArray a) = A.Array (V.map A.toJSON a)+    toJSON (ValueString t) = A.String t+    toJSON (ValueInt i) = A.Number (scientific (toEnum i) 0)+    toJSON (ValueStruct v) = A.Object (AK.fromMapText (M.map A.toJSON v))++instance FromJSON Value where+    parseJSON (A.String s) = return (ValueString s)+    parseJSON (A.Object o) = ValueStruct <$> traverse A.parseJSON (AK.toMapText o)+    parseJSON (A.Number n) = +        if isInteger n +        then return . ValueInt . fromEnum $ coefficient n+        else fail "Number is not an integer."+    parseJSON (A.Array a) = ValueArray <$> V.mapM A.parseJSON a+    parseJSON _ = fail "Not supported type in JSON."++-- | A class for converting between @Value@s and other types we use.+class RpcType a where+    toValue :: a -> Value+    fromValue :: MonadFail m => Value -> Err m a++instance RpcType Value where+    toValue = id+    fromValue = error "abc"++instance RpcType Int where+    toValue = ValueInt+    fromValue (ValueInt a) = return a+    fromValue v = throwError $ "RpcType fromValue failed: not an integer: " ++ show v++instance RpcType Bool where+    toValue v = ValueInt (if v then 1 else 0)+    fromValue (ValueInt a) +        | a == 0    = return False+        | a == 1    = return True+        | otherwise = throwError $ "RpcType fromValue failed: not a boolean: " ++ show a+    fromValue v = throwError $ "RpcType fromValue failed: not an integer: " ++ show v++instance RpcType T.Text where+    toValue = ValueString+    fromValue (ValueString a) = return a+    fromValue v = throwError $ "RpcType fromValue failed: not a string: " ++ show v++instance RpcType a => RpcType (V.Vector a) where+    toValue v = ValueArray (V.map toValue v)+    fromValue (ValueArray v) = V.mapM fromValue v+    fromValue v = throwError $ "RpcType fromValue failed: not an array: " ++ show v+    

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,14 +1,14 @@ name:                rtorrent-rpc-version:             0.2.2.0-synopsis:            A library for communicating with RTorrent over its XML-RPC interface.+version:             0.3.0.0+synopsis:            A library for communicating with RTorrent over its JSON-RPC interface. description:         -    A library for communicating with RTorrent over its XML-RPC interface.+    A library for communicating with RTorrent over its JSON-RPC interface. license:             MIT license-file:        LICENSE author:              Kai Lindholm maintainer:          megantti@gmail.com homepage:            https://github.com/megantti/rtorrent-rpc-copyright:           (c) Kai Lindholm, 2014-2015+copyright:           (c) Kai Lindholm, 2014-2015, 2025 category:            Network build-type:          Simple -- extra-source-files:  @@ -23,26 +23,34 @@                        Network.RTorrent.Command.Internals                        Network.RTorrent.CommandList                         Network.RTorrent.File+                       Network.RTorrent.JSONRPC                        Network.RTorrent.Peer                         Network.RTorrent.Priority+                       Network.RTorrent.Query                        Network.RTorrent.RPC                        Network.RTorrent.Torrent                        Network.RTorrent.Tracker--  other-modules:       Network.RTorrent.SCGI+                       Network.RTorrent.Value   other-extensions:    TypeFamilies, OverloadedStrings, TypeOperators, ScopedTypeVariables,                         GADTs, FlexibleContexts, RankNTypes-  build-depends:       base >=4.7 && <4.8,-                       mtl >=2.1 && <2.3,-                       bytestring >=0.10 && <0.11 ,-                       network >=2.6,-                       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,-                       deepseq >= 1.3.0.0,-                       split >=0.2.0.0,-                       utf8-string >= 0.3 && <0.4+  build-depends:       aeson >= 2.2.3 && < 2.3,+                       aeson-pretty >= 0.8.10 && < 0.9,+                       attoparsec >= 0.14.4 && < 0.15,+                       base >= 4.16 && < 4.22,+                       base64-bytestring >= 1.2.1 && < 1.3,+                       blaze-builder >= 0.4.4 && < 0.5,+                       blaze-textual >= 0.2.3 && < 0.3,+                       bytestring >= 0.11.4 && < 0.13,+                       containers >= 0.6.5 && < 0.8,+                       directory >= 1.3.6 && < 1.4,+                       mtl >= 2.2.2 && < 2.4,+                       network >= 3.2.7 && < 3.3,+                       network-uri >= 2.6.4 && < 2.7,+                       scientific >= 0.3.8 && < 0.4,+                       text >= 1.2.5 && < 2.2,+                       vector >= 0.13.2 && < 0.14,+                       vector-split >= 1.0.0 && < 1.1+   -- hs-source-dirs:         default-language:    Haskell2010   ghc-options:         -O2