summaryrefslogtreecommitdiff
path: root/src/Data/Torrent/URN.hs
blob: feb18f48eb693982682cdd5ca1d2d937d7c7fa4b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  provisional
--   Portability :  portable
--
--   URN is pesistent location-independent identifier for
--   resources. In particular, URNs are used represent torrent names
--   as a part of magnet link, see 'Data.Torrent.Magnet.Magnet' for
--   more info.
--
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable    #-}
module Data.Torrent.URN
       ( -- * Namespaces
         NamespaceId
       , btih

         -- * URN
       , URN (..)

         -- ** Construction
       , infohashURN

         -- ** Conversion
       , parseURN
       , renderURN
       ) where

import Control.Applicative
import Data.Convertible
import Data.Default
import Data.List as L
import Data.String
import Data.Text as T
import Data.Typeable
import Network.HTTP.Types.QueryLike
import Text.PrettyPrint
import Text.PrettyPrint.Class

import Data.Torrent.InfoHash


-- | Namespace identifier determines the syntactic interpretation of
-- namespace-specific string.
type NamespaceId = [Text]

-- | BitTorrent Info Hash (hence the name) namespace
-- identifier. Namespace-specific string /should/ be a base16\/base32
-- encoded SHA1 hash of the corresponding torrent /info/ dictionary.
--
btih :: NamespaceId
btih  = ["btih"]

-- | Uniform Resource Name - location-independent, resource
-- identifier.
--
data URN = URN
  { urnNamespace :: NamespaceId -- ^ a namespace identifier;
  , urnString    :: Text        -- ^ a corresponding
                                -- namespace-specific string.
  } deriving (Eq, Ord, Typeable)

{-----------------------------------------------------------------------
--  Infohash convertion
-----------------------------------------------------------------------}

instance Convertible URN InfoHash where
  safeConvert u @ URN {..}
    | urnNamespace /= btih = convError "invalid namespace" u
    |       otherwise      = safeConvert urnString

-- | Make resource name for torrent with corresponding
-- infohash. Infohash is base16 (hex) encoded.
--
infohashURN :: InfoHash -> URN
infohashURN = URN btih . longHex

-- | Meaningless placeholder value.
instance Default URN where
  def = infohashURN def

{-----------------------------------------------------------------------
--  Rendering
-----------------------------------------------------------------------}

-- | Render URN to its text representation.
renderURN :: URN -> Text
renderURN URN {..}
  = T.intercalate ":" $ "urn" : urnNamespace ++ [urnString]

instance Pretty URN where
  pretty = text . T.unpack . renderURN

instance Show URN where
  showsPrec n = showsPrec n . T.unpack . renderURN

instance QueryValueLike URN where
  toQueryValue = toQueryValue . renderURN
  {-# INLINE toQueryValue #-}

{-----------------------------------------------------------------------
--  Parsing
-----------------------------------------------------------------------}

unsnoc :: [a] -> Maybe ([a], a)
unsnoc [] = Nothing
unsnoc xs = Just (L.init xs, L.last xs)

instance Convertible Text URN where
  safeConvert t = case T.split (== ':') t of
    uriScheme : body
      | T.toLower uriScheme == "urn" ->
        case unsnoc body of
          Just (namespace, val) -> pure URN
            { urnNamespace = namespace
            , urnString    = val
            }
          Nothing -> convError "missing URN string" body
      | otherwise -> convError "invalid URN scheme" uriScheme
    []            -> convError "missing URN scheme" t

instance IsString URN where
  fromString = either (error . prettyConvertError) id
             . safeConvert . T.pack

-- | Try to parse an URN from its text representation.
--
--  Use 'safeConvert' for detailed error messages.
--
parseURN :: Text -> Maybe URN
parseURN = either (const Nothing) pure . safeConvert