summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Data/BEncode/Pretty.hs17
-rw-r--r--src/Network/KRPC/Manager.hs4
2 files changed, 13 insertions, 8 deletions
diff --git a/src/Data/BEncode/Pretty.hs b/src/Data/BEncode/Pretty.hs
index 7b0d46a0..63efc61c 100644
--- a/src/Data/BEncode/Pretty.hs
+++ b/src/Data/BEncode/Pretty.hs
@@ -38,24 +38,29 @@ quote_chr = ' '
38quote :: Text -> Text 38quote :: Text -> Text
39quote t = quote_chr `T.cons` t `T.snoc` quote_chr 39quote t = quote_chr `T.cons` t `T.snoc` quote_chr
40 40
41encodeByteString :: BS.ByteString -> Text
42encodeByteString s = either (const $ hex s) quote $ decodeUtf8' s
43
44decodeByteString :: Text -> BS.ByteString
45decodeByteString s
46 | T.head s==quote_chr = encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s)
47 | otherwise = unhex s
41 48
42instance ToJSON BValue where 49instance ToJSON BValue where
43 toJSON (BInteger x) = Number $ fromIntegral x 50 toJSON (BInteger x) = Number $ fromIntegral x
44 toJSON (BString s) = String $ either (const $ hex s) quote $ decodeUtf8' s 51 toJSON (BString s) = String $ encodeByteString s
45 toJSON (BList xs) = Array $ Vector.fromList $ map toJSON xs 52 toJSON (BList xs) = Array $ Vector.fromList $ map toJSON xs
46 toJSON (BDict d) = toJSON d 53 toJSON (BDict d) = toJSON d
47 54
48instance ToJSON a => ToJSON (BDictMap a) where 55instance ToJSON a => ToJSON (BDictMap a) where
49 toJSON d = Object $ HashMap.fromList $ map convert $ toAscList d 56 toJSON d = Object $ HashMap.fromList $ map convert $ toAscList d
50 where 57 where
51 convert (k,v) = (decodeUtf8 k,toJSON v) 58 convert (k,v) = (encodeByteString k,toJSON v)
52 59
53instance FromJSON BValue where 60instance FromJSON BValue where
54 parseJSON (Number x) = pure $ BInteger (truncate x) 61 parseJSON (Number x) = pure $ BInteger (truncate x)
55 parseJSON (Bool x) = pure $ BInteger $ if x then 1 else 0 62 parseJSON (Bool x) = pure $ BInteger $ if x then 1 else 0
56 parseJSON (String s) 63 parseJSON (String s) = pure $ BString $ decodeByteString s
57 | T.head s==quote_chr = pure $ BString $ encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s)
58 | otherwise = pure $ BString $ unhex s
59 parseJSON (Array v) = BList <$> traverse parseJSON (Foldable.toList v) 64 parseJSON (Array v) = BList <$> traverse parseJSON (Foldable.toList v)
60 parseJSON (Object d) = BDict <$> parseJSON (Object d) 65 parseJSON (Object d) = BDict <$> parseJSON (Object d)
61 parseJSON (Null) = pure $ BDict Nil 66 parseJSON (Null) = pure $ BDict Nil
@@ -63,7 +68,7 @@ instance FromJSON BValue where
63instance FromJSON v => FromJSON (BDictMap v) where 68instance FromJSON v => FromJSON (BDictMap v) where
64 parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d) 69 parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d)
65 where 70 where
66 convert (k,v) = (,) (encodeUtf8 k) <$> parseJSON v 71 convert (k,v) = (,) (decodeByteString k) <$> parseJSON v
67 parseJSON _ = fail "Not a BDict" 72 parseJSON _ = fail "Not a BDict"
68#endif 73#endif
69 74
diff --git a/src/Network/KRPC/Manager.hs b/src/Network/KRPC/Manager.hs
index c90c92f9..7a2120cb 100644
--- a/src/Network/KRPC/Manager.hs
+++ b/src/Network/KRPC/Manager.hs
@@ -52,7 +52,7 @@ import Control.Monad.Reader
52import Control.Monad.Trans.Control 52import Control.Monad.Trans.Control
53import Data.BEncode as BE 53import Data.BEncode as BE
54import Data.BEncode.Internal as BE 54import Data.BEncode.Internal as BE
55import Data.BEncode.Pretty (showBEncode) 55import Data.BEncode.Pretty (showBEncode, hex)
56import Data.ByteString as BS 56import Data.ByteString as BS
57import Data.ByteString.Char8 as BC 57import Data.ByteString.Char8 as BC
58import Data.ByteString.Lazy as BL 58import Data.ByteString.Lazy as BL
@@ -218,7 +218,7 @@ withManager opts addr hs = bracket (newManager opts addr hs) closeManager
218querySignature :: MethodName -> TransactionId -> SockAddr -> Text 218querySignature :: MethodName -> TransactionId -> SockAddr -> Text
219querySignature name transaction addr = T.concat 219querySignature name transaction addr = T.concat
220 [ "&", T.decodeUtf8 name 220 [ "&", T.decodeUtf8 name
221 , " #", T.decodeUtf8 transaction 221 , " #", hex transaction -- T.decodeUtf8 transaction
222 , " @", T.pack (show addr) 222 , " @", T.pack (show addr)
223 ] 223 ]
224 224