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.hs84
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 #-}
9module Data.Torrent.InfoHash
10 ( InfoHash (getInfoHash)
11 , addHashToURI
12
13 -- * Construction
14 , hash, hashlazy
15
16 -- * Extra
17 , ppHex
18 ) where
19
20import Control.Applicative
21import Data.BEncode
22import Data.Char
23import Data.List as L
24import Data.Foldable
25import Data.Map (Map)
26import qualified Data.Map as M
27import Data.ByteString (ByteString)
28import qualified Data.ByteString as B
29import qualified Data.ByteString.Char8 as BC
30import qualified Data.ByteString.Builder as B
31import qualified Data.ByteString.Builder.Prim as B
32import qualified Data.ByteString.Lazy as Lazy
33import Data.Serialize
34import qualified Crypto.Hash.SHA1 as C
35import Network.URI
36import Numeric
37
38
39-- | Exactly 20 bytes long SHA1 hash.
40newtype InfoHash = InfoHash { getInfoHash :: ByteString }
41 deriving (Eq, Ord, BEncodable)
42
43instance Show InfoHash where
44 show = BC.unpack . ppHex
45
46instance Serialize InfoHash where
47 put = putByteString . getInfoHash
48 get = InfoHash <$> getBytes 20
49
50instance 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
58hash :: ByteString -> InfoHash
59hash = InfoHash . C.hash
60
61hashlazy :: Lazy.ByteString -> InfoHash
62hashlazy = InfoHash . C.hashlazy
63
64ppHex :: InfoHash -> ByteString
65ppHex = Lazy.toStrict . B.toLazyByteString .
66 foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash
67
68addHashToURI :: URI -> InfoHash -> URI
69addHashToURI 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