diff options
Diffstat (limited to 'src/Data/Torrent/InfoHash.hs')
-rw-r--r-- | src/Data/Torrent/InfoHash.hs | 81 |
1 files changed, 43 insertions, 38 deletions
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs index 25fd3e49..7442c61c 100644 --- a/src/Data/Torrent/InfoHash.hs +++ b/src/Data/Torrent/InfoHash.hs | |||
@@ -70,62 +70,52 @@ newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString } | |||
70 | infoHashLen :: Int | 70 | infoHashLen :: Int |
71 | infoHashLen = 20 | 71 | infoHashLen = 20 |
72 | 72 | ||
73 | -- | Meaningless placeholder value. | ||
73 | instance Default InfoHash where | 74 | instance Default InfoHash where |
74 | def = "0123456789012345678901234567890123456789" | 75 | def = "0123456789012345678901234567890123456789" |
75 | 76 | ||
76 | -- | for hex encoded strings | 77 | -- | Hash raw bytes. (no encoding) |
77 | instance Show InfoHash where | ||
78 | show = render . pretty | ||
79 | |||
80 | -- | for hex encoded strings | ||
81 | instance Read InfoHash where | ||
82 | readsPrec _ = readP_to_S $ do | ||
83 | str <- replicateM 40 (satisfy isHexDigit) | ||
84 | return $ InfoHash $ decodeIH str | ||
85 | where | ||
86 | decodeIH = BS.pack . L.map fromHex . pair | ||
87 | fromHex (a, b) = read $ '0' : 'x' : a : b : [] | ||
88 | |||
89 | pair (a : b : xs) = (a, b) : pair xs | ||
90 | pair _ = [] | ||
91 | |||
92 | -- | for base16/base32 encoded strings | ||
93 | instance IsString InfoHash where | ||
94 | fromString str = fromMaybe err $ textToInfoHash $ T.pack str | ||
95 | where | ||
96 | err = error $ "fromString: invalid infohash string" ++ str | ||
97 | |||
98 | instance Hashable InfoHash where | 78 | instance Hashable InfoHash where |
99 | hash = Hashable.hash . getInfoHash | 79 | hash (InfoHash ih) = Hashable.hash ih |
100 | {-# INLINE hash #-} | 80 | {-# INLINE hash #-} |
101 | 81 | ||
102 | -- | Raw bytes. | 82 | -- | Convert to\/from raw bencoded string. (no encoding) |
103 | instance BEncode InfoHash where | 83 | instance BEncode InfoHash where |
104 | toBEncode = toBEncode . getInfoHash | 84 | toBEncode = toBEncode . getInfoHash |
105 | fromBEncode be = InfoHash <$> fromBEncode be | 85 | fromBEncode be = InfoHash <$> fromBEncode be |
106 | 86 | ||
107 | -- | Raw bytes. | 87 | -- | Convert to\/from raw bytestring. (no encoding) |
108 | instance Serialize InfoHash where | 88 | instance Serialize InfoHash where |
109 | put = putByteString . getInfoHash | 89 | put (InfoHash ih) = putByteString ih |
110 | get = InfoHash <$> getBytes 20 | 90 | {-# INLINE put #-} |
111 | 91 | ||
112 | -- | base16 encoded string. | 92 | get = InfoHash <$> getBytes 20 |
113 | instance ToJSON InfoHash where | 93 | {-# INLINE get #-} |
114 | toJSON (InfoHash ih) = String $ T.decodeUtf8 $ Base16.encode ih | ||
115 | |||
116 | -- | Can be base16 or base32 encoded string. | ||
117 | instance FromJSON InfoHash where | ||
118 | parseJSON = withText "JSON" $ -- TODO | ||
119 | maybe (fail "could not parse InfoHash") pure . textToInfoHash | ||
120 | 94 | ||
121 | -- | Raw bytes. | 95 | -- | Convert to raw query value. (no encoding) |
122 | instance QueryValueLike InfoHash where | 96 | instance QueryValueLike InfoHash where |
123 | toQueryValue (InfoHash ih) = Just ih | 97 | toQueryValue (InfoHash ih) = Just ih |
124 | {-# INLINE toQueryValue #-} | 98 | {-# INLINE toQueryValue #-} |
125 | 99 | ||
126 | -- | base16 encoded. | 100 | -- | Convert to base16 encoded string. |
101 | instance Show InfoHash where | ||
102 | show (InfoHash ih) = BC.unpack (Base16.encode ih) | ||
103 | |||
104 | -- | Convert to base16 encoded Doc string. | ||
127 | instance Pretty InfoHash where | 105 | instance Pretty InfoHash where |
128 | pretty = text . T.unpack . longHex | 106 | pretty = text . show |
107 | |||
108 | -- | Read base16 encoded string. | ||
109 | instance Read InfoHash where | ||
110 | readsPrec _ = readP_to_S $ do | ||
111 | str <- replicateM 40 (satisfy isHexDigit) | ||
112 | return $ InfoHash $ decodeIH str | ||
113 | where | ||
114 | decodeIH = BS.pack . L.map fromHex . pair | ||
115 | fromHex (a, b) = read $ '0' : 'x' : a : b : [] | ||
116 | |||
117 | pair (a : b : xs) = (a, b) : pair xs | ||
118 | pair _ = [] | ||
129 | 119 | ||
130 | -- | Convert raw bytes to info hash. | 120 | -- | Convert raw bytes to info hash. |
131 | instance Convertible BS.ByteString InfoHash where | 121 | instance Convertible BS.ByteString InfoHash where |
@@ -155,6 +145,21 @@ instance Convertible Text InfoHash where | |||
155 | hashLen = BS.length hashStr | 145 | hashLen = BS.length hashStr |
156 | hashStr = T.encodeUtf8 t | 146 | hashStr = T.encodeUtf8 t |
157 | 147 | ||
148 | -- | Decode from base16\/base32\/base64 encoded string. | ||
149 | instance IsString InfoHash where | ||
150 | fromString str = fromMaybe err $ textToInfoHash $ T.pack str | ||
151 | where | ||
152 | err = error $ "fromString: invalid infohash string" ++ str | ||
153 | |||
154 | -- | Convert to base16 encoded JSON string. | ||
155 | instance ToJSON InfoHash where | ||
156 | toJSON (InfoHash ih) = String $ T.decodeUtf8 $ Base16.encode ih | ||
157 | |||
158 | -- | Convert from base16\/base32\/base64 encoded JSON string. | ||
159 | instance FromJSON InfoHash where | ||
160 | parseJSON = withText "JSON" $ -- TODO | ||
161 | maybe (fail "could not parse InfoHash") pure . textToInfoHash | ||
162 | |||
158 | ignoreErrorMsg :: Either a b -> Maybe b | 163 | ignoreErrorMsg :: Either a b -> Maybe b |
159 | ignoreErrorMsg = either (const Nothing) Just | 164 | ignoreErrorMsg = either (const Nothing) Just |
160 | 165 | ||