summaryrefslogtreecommitdiff
path: root/src/Data/BEncode
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2019-09-28 13:43:29 -0400
committerJoe Crayne <joe@jerkface.net>2020-01-01 19:27:53 -0500
commit11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch)
tree5716463275c2d3e902889db619908ded2a73971c /src/Data/BEncode
parentadd2c76bced51fde5e9917e7449ef52be70faf87 (diff)
Factor out some new libraries
word64-map: Data.Word64Map network-addr: Network.Address tox-crypto: Crypto.Tox lifted-concurrent: Control.Concurrent.Lifted.Instrument Control.Concurrent.Async.Lifted.Instrument psq-wrap: Data.Wrapper.PSQInt Data.Wrapper.PSQ minmax-psq: Data.MinMaxPSQ tasks: Control.Concurrent.Tasks kad: Network.Kademlia Network.Kademlia.Bootstrap Network.Kademlia.Routing Network.Kademlia.CommonAPI Network.Kademlia.Persistence Network.Kademlia.Search
Diffstat (limited to 'src/Data/BEncode')
-rw-r--r--src/Data/BEncode/Pretty.hs81
1 files changed, 0 insertions, 81 deletions
diff --git a/src/Data/BEncode/Pretty.hs b/src/Data/BEncode/Pretty.hs
deleted file mode 100644
index 8beb101b..00000000
--- a/src/Data/BEncode/Pretty.hs
+++ /dev/null
@@ -1,81 +0,0 @@
1{-# LANGUAGE CPP #-}
2module Data.BEncode.Pretty where -- (showBEncode) where
3
4import Data.BEncode.Types
5import qualified Data.ByteString as BS
6import qualified Data.ByteString.Lazy as BL
7import Data.Text (Text)
8import qualified Data.Text as T
9import Data.Text.Encoding
10import qualified Data.ByteString.Base16 as Base16
11#ifdef BENCODE_AESON
12import Data.BEncode.BDict hiding (map)
13import Data.Aeson.Types hiding (parse)
14import Data.Aeson.Encode.Pretty
15import qualified Data.HashMap.Strict as HashMap
16import qualified Data.Vector as Vector
17import Data.Foldable as Foldable
18#endif
19
20{-
21unhex :: Text -> BS.ByteString
22unhex t = BS.pack $ map unhex1 [0 .. BS.length nibs `div` 2]
23 where
24 nibs = encodeUtf8 t
25 unhex1 i = unnib (BS.index nibs (i * 2)) * 0x10
26 + unnib (BS.index nibs (i * 2 + 1))
27 unnib a | a <= 0x39 = a - 0x30
28 | otherwise = a - (0x41 - 10)
29
30hex :: BS.ByteString -> Text
31hex bs = T.concat $ map (T.pack . printf "%02X") $ BS.unpack bs
32-}
33
34#ifdef BENCODE_AESON
35
36quote_chr :: Char
37quote_chr = ' '
38
39quote :: Text -> Text
40quote t = quote_chr `T.cons` t `T.snoc` quote_chr
41
42encodeByteString :: BS.ByteString -> Text
43encodeByteString s = either (const . decodeUtf8 $ Base16.encode s) quote $ decodeUtf8' s
44
45decodeByteString :: Text -> BS.ByteString
46decodeByteString s
47 | T.head s==quote_chr = encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s)
48 | otherwise = fst (Base16.decode (encodeUtf8 s))
49
50instance ToJSON BValue where
51 toJSON (BInteger x) = Number $ fromIntegral x
52 toJSON (BString s) = String $ encodeByteString s
53 toJSON (BList xs) = Array $ Vector.fromList $ map toJSON xs
54 toJSON (BDict d) = toJSON d
55
56instance ToJSON a => ToJSON (BDictMap a) where
57 toJSON d = Object $ HashMap.fromList $ map convert $ toAscList d
58 where
59 convert (k,v) = (encodeByteString k,toJSON v)
60
61instance FromJSON BValue where
62 parseJSON (Number x) = pure $ BInteger (truncate x)
63 parseJSON (Bool x) = pure $ BInteger $ if x then 1 else 0
64 parseJSON (String s) = pure $ BString $ decodeByteString s
65 parseJSON (Array v) = BList <$> traverse parseJSON (Foldable.toList v)
66 parseJSON (Object d) = BDict <$> parseJSON (Object d)
67 parseJSON (Null) = pure $ BDict Nil
68
69instance FromJSON v => FromJSON (BDictMap v) where
70 parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d)
71 where
72 convert (k,v) = (,) (decodeByteString k) <$> parseJSON v
73 parseJSON _ = fail "Not a BDict"
74#endif
75
76showBEncode :: BValue -> BL.ByteString
77#ifdef BENCODE_AESON
78showBEncode b = encodePretty $ toJSON b
79#else
80showBEncode b = BL8.pack (show b)
81#endif