summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Torrent/Magnet.hs119
-rw-r--r--src/Data/Torrent/URN.hs133
2 files changed, 114 insertions, 138 deletions
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs
index 097f4b8e..ae4e134b 100644
--- a/src/Data/Torrent/Magnet.hs
+++ b/src/Data/Torrent/Magnet.hs
@@ -29,14 +29,28 @@ module Data.Torrent.Magnet
29 ( -- * Magnet 29 ( -- * Magnet
30 Magnet(..) 30 Magnet(..)
31 31
32 -- * Construction 32 -- ** Construction
33 , nullMagnet 33 , nullMagnet
34 , simpleMagnet 34 , simpleMagnet
35 , detailedMagnet 35 , detailedMagnet
36 36
37 -- * Conversion 37 -- ** Conversion
38 , parseMagnet 38 , parseMagnet
39 , renderMagnet 39 , renderMagnet
40
41 -- * URN
42 , URN (..)
43
44 -- ** Namespaces
45 , NamespaceId
46 , btih
47
48 -- ** Construction
49 , infohashURN
50
51 -- ** Conversion
52 , parseURN
53 , renderURN
40 ) where 54 ) where
41 55
42import Control.Applicative 56import Control.Applicative
@@ -61,9 +75,104 @@ import Text.PrettyPrint.Class
61import Data.Torrent 75import Data.Torrent
62import Data.Torrent.InfoHash 76import Data.Torrent.InfoHash
63import Data.Torrent.Layout 77import Data.Torrent.Layout
64import Data.Torrent.URN
65 78
66 79
80-- | Namespace identifier determines the syntactic interpretation of
81-- namespace-specific string.
82type NamespaceId = [Text]
83
84-- | BitTorrent Info Hash (hence the name) namespace
85-- identifier. Namespace-specific string /should/ be a base16\/base32
86-- encoded SHA1 hash of the corresponding torrent /info/ dictionary.
87--
88btih :: NamespaceId
89btih = ["btih"]
90
91-- | URN is pesistent location-independent identifier for
92-- resources. In particular, URNs are used represent torrent names
93-- as a part of magnet link, see 'Data.Torrent.Magnet.Magnet' for
94-- more info.
95--
96data URN = URN
97 { urnNamespace :: NamespaceId -- ^ a namespace identifier;
98 , urnString :: Text -- ^ a corresponding
99 -- namespace-specific string.
100 } deriving (Eq, Ord, Typeable)
101
102{-----------------------------------------------------------------------
103-- URN to infohash convertion
104-----------------------------------------------------------------------}
105
106instance Convertible URN InfoHash where
107 safeConvert u @ URN {..}
108 | urnNamespace /= btih = convError "invalid namespace" u
109 | otherwise = safeConvert urnString
110
111-- | Make resource name for torrent with corresponding
112-- infohash. Infohash is base16 (hex) encoded.
113--
114infohashURN :: InfoHash -> URN
115infohashURN = URN btih . longHex
116
117-- | Meaningless placeholder value.
118instance Default URN where
119 def = infohashURN def
120
121{-----------------------------------------------------------------------
122-- URN Rendering
123-----------------------------------------------------------------------}
124
125-- | Render URN to its text representation.
126renderURN :: URN -> Text
127renderURN URN {..}
128 = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString]
129
130instance Pretty URN where
131 pretty = text . T.unpack . renderURN
132
133instance Show URN where
134 showsPrec n = showsPrec n . T.unpack . renderURN
135
136instance QueryValueLike URN where
137 toQueryValue = toQueryValue . renderURN
138 {-# INLINE toQueryValue #-}
139
140{-----------------------------------------------------------------------
141-- URN Parsing
142-----------------------------------------------------------------------}
143
144unsnoc :: [a] -> Maybe ([a], a)
145unsnoc [] = Nothing
146unsnoc xs = Just (L.init xs, L.last xs)
147
148instance Convertible Text URN where
149 safeConvert t = case T.split (== ':') t of
150 uriScheme : body
151 | T.toLower uriScheme == "urn" ->
152 case unsnoc body of
153 Just (namespace, val) -> pure URN
154 { urnNamespace = namespace
155 , urnString = val
156 }
157 Nothing -> convError "missing URN string" body
158 | otherwise -> convError "invalid URN scheme" uriScheme
159 [] -> convError "missing URN scheme" t
160
161instance IsString URN where
162 fromString = either (error . prettyConvertError) id
163 . safeConvert . T.pack
164
165-- | Try to parse an URN from its text representation.
166--
167-- Use 'safeConvert' for detailed error messages.
168--
169parseURN :: Text -> Maybe URN
170parseURN = either (const Nothing) pure . safeConvert
171
172{-----------------------------------------------------------------------
173-- Magnet
174-----------------------------------------------------------------------}
175
67-- TODO multiple exact topics 176-- TODO multiple exact topics
68-- TODO render/parse supplement for URI/query 177-- TODO render/parse supplement for URI/query
69 178
@@ -172,7 +281,7 @@ instance Convertible String Magnet where
172 | otherwise = convError "unable to parse uri" str 281 | otherwise = convError "unable to parse uri" str
173 282
174{----------------------------------------------------------------------- 283{-----------------------------------------------------------------------
175-- Construction 284-- Magnet Construction
176-----------------------------------------------------------------------} 285-----------------------------------------------------------------------}
177 286
178-- | Meaningless placeholder value. 287-- | Meaningless placeholder value.
@@ -221,7 +330,7 @@ detailedMagnet t @ Torrent {tInfoDict = InfoDict {..}, tAnnounce}
221 } 330 }
222 331
223{----------------------------------------------------------------------- 332{-----------------------------------------------------------------------
224-- Conversion 333-- Magnet Conversion
225-----------------------------------------------------------------------} 334-----------------------------------------------------------------------}
226 335
227parseMagnetStr :: String -> Maybe Magnet 336parseMagnetStr :: String -> Maybe Magnet
diff --git a/src/Data/Torrent/URN.hs b/src/Data/Torrent/URN.hs
deleted file mode 100644
index feb18f48..00000000
--- a/src/Data/Torrent/URN.hs
+++ /dev/null
@@ -1,133 +0,0 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : provisional
6-- Portability : portable
7--
8-- URN is pesistent location-independent identifier for
9-- resources. In particular, URNs are used represent torrent names
10-- as a part of magnet link, see 'Data.Torrent.Magnet.Magnet' for
11-- more info.
12--
13{-# LANGUAGE MultiParamTypeClasses #-}
14{-# LANGUAGE DeriveDataTypeable #-}
15module Data.Torrent.URN
16 ( -- * Namespaces
17 NamespaceId
18 , btih
19
20 -- * URN
21 , URN (..)
22
23 -- ** Construction
24 , infohashURN
25
26 -- ** Conversion
27 , parseURN
28 , renderURN
29 ) where
30
31import Control.Applicative
32import Data.Convertible
33import Data.Default
34import Data.List as L
35import Data.String
36import Data.Text as T
37import Data.Typeable
38import Network.HTTP.Types.QueryLike
39import Text.PrettyPrint
40import Text.PrettyPrint.Class
41
42import Data.Torrent.InfoHash
43
44
45-- | Namespace identifier determines the syntactic interpretation of
46-- namespace-specific string.
47type NamespaceId = [Text]
48
49-- | BitTorrent Info Hash (hence the name) namespace
50-- identifier. Namespace-specific string /should/ be a base16\/base32
51-- encoded SHA1 hash of the corresponding torrent /info/ dictionary.
52--
53btih :: NamespaceId
54btih = ["btih"]
55
56-- | Uniform Resource Name - location-independent, resource
57-- identifier.
58--
59data URN = URN
60 { urnNamespace :: NamespaceId -- ^ a namespace identifier;
61 , urnString :: Text -- ^ a corresponding
62 -- namespace-specific string.
63 } deriving (Eq, Ord, Typeable)
64
65{-----------------------------------------------------------------------
66-- Infohash convertion
67-----------------------------------------------------------------------}
68
69instance Convertible URN InfoHash where
70 safeConvert u @ URN {..}
71 | urnNamespace /= btih = convError "invalid namespace" u
72 | otherwise = safeConvert urnString
73
74-- | Make resource name for torrent with corresponding
75-- infohash. Infohash is base16 (hex) encoded.
76--
77infohashURN :: InfoHash -> URN
78infohashURN = URN btih . longHex
79
80-- | Meaningless placeholder value.
81instance Default URN where
82 def = infohashURN def
83
84{-----------------------------------------------------------------------
85-- Rendering
86-----------------------------------------------------------------------}
87
88-- | Render URN to its text representation.
89renderURN :: URN -> Text
90renderURN URN {..}
91 = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString]
92
93instance Pretty URN where
94 pretty = text . T.unpack . renderURN
95
96instance Show URN where
97 showsPrec n = showsPrec n . T.unpack . renderURN
98
99instance QueryValueLike URN where
100 toQueryValue = toQueryValue . renderURN
101 {-# INLINE toQueryValue #-}
102
103{-----------------------------------------------------------------------
104-- Parsing
105-----------------------------------------------------------------------}
106
107unsnoc :: [a] -> Maybe ([a], a)
108unsnoc [] = Nothing
109unsnoc xs = Just (L.init xs, L.last xs)
110
111instance Convertible Text URN where
112 safeConvert t = case T.split (== ':') t of
113 uriScheme : body
114 | T.toLower uriScheme == "urn" ->
115 case unsnoc body of
116 Just (namespace, val) -> pure URN
117 { urnNamespace = namespace
118 , urnString = val
119 }
120 Nothing -> convError "missing URN string" body
121 | otherwise -> convError "invalid URN scheme" uriScheme
122 [] -> convError "missing URN scheme" t
123
124instance IsString URN where
125 fromString = either (error . prettyConvertError) id
126 . safeConvert . T.pack
127
128-- | Try to parse an URN from its text representation.
129--
130-- Use 'safeConvert' for detailed error messages.
131--
132parseURN :: Text -> Maybe URN
133parseURN = either (const Nothing) pure . safeConvert
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 21:43:47 +0000