1 files changed, 114 insertions, 5 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
        ( -- * Magnet
          Magnet(..)
 
-         -- * Construction
+         -- ** Construction
        , nullMagnet
        , simpleMagnet
        , detailedMagnet
 
-         -- * Conversion
+         -- ** Conversion
        , parseMagnet
        , renderMagnet
+
+         -- * URN
+       , URN (..)
+
+         -- ** Namespaces
+       , NamespaceId
+       , btih
+
+         -- ** Construction
+       , infohashURN
+
+         -- ** Conversion
+       , parseURN
+       , renderURN
        ) where
 
 import Control.Applicative
@@ -61,9 +75,104 @@ import Text.PrettyPrint.Class
 import Data.Torrent
 import Data.Torrent.InfoHash
 import Data.Torrent.Layout
-import Data.Torrent.URN
 
 
+-- | 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"]
+
+-- | 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.
+--
+data URN = URN
+  { urnNamespace :: NamespaceId -- ^ a namespace identifier;
+  , urnString    :: Text        -- ^ a corresponding
+                                -- namespace-specific string.
+  } deriving (Eq, Ord, Typeable)
+
+{-----------------------------------------------------------------------
+--  URN to 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
+
+{-----------------------------------------------------------------------
+--  URN 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 #-}
+
+{-----------------------------------------------------------------------
+--  URN 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
+
+{-----------------------------------------------------------------------
+--  Magnet
+-----------------------------------------------------------------------}
+
 -- TODO multiple exact topics
 -- TODO render/parse supplement for URI/query
 
@@ -172,7 +281,7 @@ instance Convertible String Magnet where
     |        otherwise         = convError "unable to parse uri" str
 
 {-----------------------------------------------------------------------
---  Construction
+--  Magnet Construction
 -----------------------------------------------------------------------}
 
 -- | Meaningless placeholder value.
@@ -221,7 +330,7 @@ detailedMagnet t @ Torrent {tInfoDict = InfoDict {..}, tAnnounce}
     }
 
 {-----------------------------------------------------------------------
---  Conversion
+--  Magnet Conversion
 -----------------------------------------------------------------------}
 
 parseMagnetStr :: String -> Maybe Magnet