summaryrefslogtreecommitdiff
path: root/src/Data/Torrent/InfoHash.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Torrent/InfoHash.hs')
-rw-r--r--src/Data/Torrent/InfoHash.hs35
1 files changed, 3 insertions, 32 deletions
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
index 15682250..d840ac87 100644
--- a/src/Data/Torrent/InfoHash.hs
+++ b/src/Data/Torrent/InfoHash.hs
@@ -20,8 +20,6 @@ module Data.Torrent.InfoHash
20 -- * Rendering 20 -- * Rendering
21 , longHex 21 , longHex
22 , shortHex 22 , shortHex
23
24 , addHashToURI
25 ) where 23 ) where
26 24
27import Control.Applicative 25import Control.Applicative
@@ -37,7 +35,6 @@ import Data.Char
37import Data.Convertible.Base 35import Data.Convertible.Base
38import Data.Default 36import Data.Default
39import Data.List as L 37import Data.List as L
40import Data.Maybe
41import Data.Hashable as Hashable 38import Data.Hashable as Hashable
42import Data.Serialize 39import Data.Serialize
43import Data.String 40import Data.String
@@ -45,8 +42,6 @@ import Data.Text as T
45import Data.Text.Encoding as T 42import Data.Text.Encoding as T
46import Data.Typeable 43import Data.Typeable
47import Network.HTTP.Types.QueryLike 44import Network.HTTP.Types.QueryLike
48import Network.URI
49import Numeric
50import Text.ParserCombinators.ReadP as P 45import Text.ParserCombinators.ReadP as P
51import Text.PrettyPrint 46import Text.PrettyPrint
52import Text.PrettyPrint.Class 47import Text.PrettyPrint.Class
@@ -88,7 +83,7 @@ instance Serialize InfoHash where
88 put (InfoHash ih) = putByteString ih 83 put (InfoHash ih) = putByteString ih
89 {-# INLINE put #-} 84 {-# INLINE put #-}
90 85
91 get = InfoHash <$> getBytes 20 86 get = InfoHash <$> getBytes infoHashLen
92 {-# INLINE get #-} 87 {-# INLINE get #-}
93 88
94-- | Convert to raw query value. (no encoding) 89-- | Convert to raw query value. (no encoding)
@@ -107,7 +102,7 @@ instance Pretty InfoHash where
107-- | Read base16 encoded string. 102-- | Read base16 encoded string.
108instance Read InfoHash where 103instance Read InfoHash where
109 readsPrec _ = readP_to_S $ do 104 readsPrec _ = readP_to_S $ do
110 str <- replicateM 40 (satisfy isHexDigit) 105 str <- replicateM (infoHashLen * 2) (satisfy isHexDigit)
111 return $ InfoHash $ decodeIH str 106 return $ InfoHash $ decodeIH str
112 where 107 where
113 decodeIH = BS.pack . L.map fromHex . pair 108 decodeIH = BS.pack . L.map fromHex . pair
@@ -173,30 +168,6 @@ textToInfoHash = ignoreErrorMsg . safeConvert
173longHex :: InfoHash -> Text 168longHex :: InfoHash -> Text
174longHex = T.decodeUtf8 . Base16.encode . getInfoHash 169longHex = T.decodeUtf8 . Base16.encode . getInfoHash
175 170
176-- | The same as 'longHex', but 7 character long. 171-- | The same as 'longHex', but only first 7 characters.
177shortHex :: InfoHash -> Text 172shortHex :: InfoHash -> Text
178shortHex = T.take 7 . longHex 173shortHex = T.take 7 . longHex
179
180-- | TODO remove from API
181--
182-- Add query info hash parameter to uri.
183--
184-- > info_hash=<url_encoded_info_hash>
185--
186addHashToURI :: URI -> InfoHash -> URI
187addHashToURI uri s = uri {
188 uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++
189 "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s))
190 }
191 where
192 mkPref [] = "?"
193 mkPref ('?' : _) = "&"
194 mkPref _ = error "addHashToURI"
195
196 rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c)
197 where
198 unreservedS = (`L.elem` chars)
199 chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./"
200 encodeHex c = '%' : pHex c
201 pHex c = let p = (showHex . ord $ c) ""
202 in if L.length p == 1 then '0' : p else p