diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/BEncode/Pretty.hs | 17 | ||||
-rw-r--r-- | src/Network/KRPC/Manager.hs | 4 |
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 = ' ' | |||
38 | quote :: Text -> Text | 38 | quote :: Text -> Text |
39 | quote t = quote_chr `T.cons` t `T.snoc` quote_chr | 39 | quote t = quote_chr `T.cons` t `T.snoc` quote_chr |
40 | 40 | ||
41 | encodeByteString :: BS.ByteString -> Text | ||
42 | encodeByteString s = either (const $ hex s) quote $ decodeUtf8' s | ||
43 | |||
44 | decodeByteString :: Text -> BS.ByteString | ||
45 | decodeByteString s | ||
46 | | T.head s==quote_chr = encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s) | ||
47 | | otherwise = unhex s | ||
41 | 48 | ||
42 | instance ToJSON BValue where | 49 | instance 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 | ||
48 | instance ToJSON a => ToJSON (BDictMap a) where | 55 | instance 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 | ||
53 | instance FromJSON BValue where | 60 | instance 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 | |||
63 | instance FromJSON v => FromJSON (BDictMap v) where | 68 | instance 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 | |||
52 | import Control.Monad.Trans.Control | 52 | import Control.Monad.Trans.Control |
53 | import Data.BEncode as BE | 53 | import Data.BEncode as BE |
54 | import Data.BEncode.Internal as BE | 54 | import Data.BEncode.Internal as BE |
55 | import Data.BEncode.Pretty (showBEncode) | 55 | import Data.BEncode.Pretty (showBEncode, hex) |
56 | import Data.ByteString as BS | 56 | import Data.ByteString as BS |
57 | import Data.ByteString.Char8 as BC | 57 | import Data.ByteString.Char8 as BC |
58 | import Data.ByteString.Lazy as BL | 58 | import Data.ByteString.Lazy as BL |
@@ -218,7 +218,7 @@ withManager opts addr hs = bracket (newManager opts addr hs) closeManager | |||
218 | querySignature :: MethodName -> TransactionId -> SockAddr -> Text | 218 | querySignature :: MethodName -> TransactionId -> SockAddr -> Text |
219 | querySignature name transaction addr = T.concat | 219 | querySignature 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 | ||