diff options
Diffstat (limited to 'src/Data/Torrent/InfoHash.hs')
-rw-r--r-- | src/Data/Torrent/InfoHash.hs | 84 |
1 files changed, 0 insertions, 84 deletions
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs deleted file mode 100644 index 51ce0ecd..00000000 --- a/src/Data/Torrent/InfoHash.hs +++ /dev/null | |||
@@ -1,84 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam T. 2013 | ||
3 | -- License : MIT | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} | ||
9 | module Data.Torrent.InfoHash | ||
10 | ( InfoHash (getInfoHash) | ||
11 | , addHashToURI | ||
12 | |||
13 | -- * Construction | ||
14 | , hash, hashlazy | ||
15 | |||
16 | -- * Extra | ||
17 | , ppHex | ||
18 | ) where | ||
19 | |||
20 | import Control.Applicative | ||
21 | import Data.BEncode | ||
22 | import Data.Char | ||
23 | import Data.List as L | ||
24 | import Data.Foldable | ||
25 | import Data.Map (Map) | ||
26 | import qualified Data.Map as M | ||
27 | import Data.ByteString (ByteString) | ||
28 | import qualified Data.ByteString as B | ||
29 | import qualified Data.ByteString.Char8 as BC | ||
30 | import qualified Data.ByteString.Builder as B | ||
31 | import qualified Data.ByteString.Builder.Prim as B | ||
32 | import qualified Data.ByteString.Lazy as Lazy | ||
33 | import Data.Serialize | ||
34 | import qualified Crypto.Hash.SHA1 as C | ||
35 | import Network.URI | ||
36 | import Numeric | ||
37 | |||
38 | |||
39 | -- | Exactly 20 bytes long SHA1 hash. | ||
40 | newtype InfoHash = InfoHash { getInfoHash :: ByteString } | ||
41 | deriving (Eq, Ord, BEncodable) | ||
42 | |||
43 | instance Show InfoHash where | ||
44 | show = BC.unpack . ppHex | ||
45 | |||
46 | instance Serialize InfoHash where | ||
47 | put = putByteString . getInfoHash | ||
48 | get = InfoHash <$> getBytes 20 | ||
49 | |||
50 | instance BEncodable a => BEncodable (Map InfoHash a) where | ||
51 | {-# SPECIALIZE instance BEncodable a => BEncodable (Map InfoHash a) #-} | ||
52 | fromBEncode b = M.mapKeys InfoHash <$> fromBEncode b | ||
53 | {-# INLINE fromBEncode #-} | ||
54 | |||
55 | toBEncode = toBEncode . M.mapKeys getInfoHash | ||
56 | {-# INLINE toBEncode #-} | ||
57 | |||
58 | hash :: ByteString -> InfoHash | ||
59 | hash = InfoHash . C.hash | ||
60 | |||
61 | hashlazy :: Lazy.ByteString -> InfoHash | ||
62 | hashlazy = InfoHash . C.hashlazy | ||
63 | |||
64 | ppHex :: InfoHash -> ByteString | ||
65 | ppHex = Lazy.toStrict . B.toLazyByteString . | ||
66 | foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash | ||
67 | |||
68 | addHashToURI :: URI -> InfoHash -> URI | ||
69 | addHashToURI uri s = uri { | ||
70 | uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++ | ||
71 | "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s)) | ||
72 | } | ||
73 | where | ||
74 | mkPref [] = "?" | ||
75 | mkPref ('?' : _) = "&" | ||
76 | mkPref _ = error "addHashToURI" | ||
77 | |||
78 | rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c) | ||
79 | where | ||
80 | unreservedS = (`L.elem` chars) | ||
81 | chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./" | ||
82 | encodeHex c = '%' : pHex c | ||
83 | pHex c = let p = (showHex . ord $ c) "" | ||
84 | in if L.length p == 1 then '0' : p else p | ||