Fix InfoHash json encoding

2 files changed, 28 insertions, 16 deletions

diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
index 71ea0260..5ec429b5 100644
--- a/src/Data/Torrent/InfoHash.hs
+++ b/src/Data/Torrent/InfoHash.hs
@@ -3,10 +3,10 @@
 module Data.Torrent.InfoHash
        ( -- * Info hash
          InfoHash(..)
+       , textToInfoHash
        , addHashToURI
        , ppInfoHash
 
-
        , Data.Torrent.InfoHash.hash
        , Data.Torrent.InfoHash.hashlazy
        ) where
@@ -20,6 +20,7 @@ import Data.ByteString as BS
 import Data.ByteString.Char8 as BC
 import Data.ByteString.Lazy  as BL
 import Data.ByteString.Base16 as Base16
+import Data.ByteString.Base32 as Base32
 import qualified Data.ByteString.Lazy.Builder as B
 import qualified Data.ByteString.Lazy.Builder.ASCII as B
 import Data.Char
@@ -28,6 +29,8 @@ import Data.Hashable   as Hashable
 import Data.URLEncoded as URL
 import Data.Serialize
 import Data.String
+import Data.Text
+import Data.Text.Encoding as T
 import Network.URI
 import Numeric
 import Text.ParserCombinators.ReadP as P
@@ -36,7 +39,7 @@ import Text.PrettyPrint
 
 -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.
 newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString }
-                   deriving (Eq, Ord, ToJSON, FromJSON)
+                   deriving (Eq, Ord)
 
 -- | for hex encoded strings
 instance Show InfoHash where
@@ -74,9 +77,31 @@ instance Serialize InfoHash where
   put = putByteString . getInfoHash
   get = InfoHash <$> getBytes 20
 
+-- | Represented as base16 encoded string.
+instance ToJSON InfoHash where
+  toJSON (InfoHash ih) = String $ T.decodeUtf8 $ Base16.encode ih
+
+-- | Can be base16 or base32 encoded string.
+instance FromJSON InfoHash where
+  parseJSON = withText "JSON" $
+    maybe (fail "could not parse InfoHash") pure . textToInfoHash
+
 instance URLShow InfoHash where
   urlShow = show
 
+-- | Tries both base16 and base32 while decoding info hash.
+textToInfoHash :: Text -> Maybe InfoHash
+textToInfoHash text
+    |      hashLen == 32   = Just $ InfoHash $ Base32.decode hashStr
+    |      hashLen == 40   = let (ihStr, inv) = Base16.decode hashStr
+                             in if BS.length inv == 0
+                                then Just $ InfoHash ihStr
+                                else Nothing
+    |        otherwise     = Nothing
+  where
+    hashLen = BS.length hashStr
+    hashStr = T.encodeUtf8 text
+
 -- | Hash strict bytestring using SHA1 algorithm.
 hash :: BS.ByteString -> InfoHash
 hash = InfoHash . C.hash
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs
index df928b66..34a7bbc5 100644
--- a/src/Data/Torrent/Magnet.hs
+++ b/src/Data/Torrent/Magnet.hs
@@ -27,16 +27,12 @@ module Data.Torrent.Magnet
 
 import Control.Applicative
 import Control.Monad
-import Data.ByteString as BS
-import Data.ByteString.Base16 as Base16
-import Data.ByteString.Base32 as Base32
 import Data.Map as M
 import Data.Maybe
 import Data.List as L
 import Data.URLEncoded as URL
 import Data.String
 import Data.Text as T
-import Data.Text.Encoding as T
 import Network.URI
 import Text.Read
 
@@ -90,16 +86,7 @@ renderURN URN {..}
 urnToInfoHash :: URN -> Maybe InfoHash
 urnToInfoHash  (URN {..})
   | urnNamespace /= btih = Nothing
-  |      hashLen == 20   = Just $ InfoHash hashStr
-  |      hashLen == 32   = Just $ InfoHash $ Base32.decode hashStr
-  |      hashLen == 40   = let (ihStr, inv) = Base16.decode hashStr
-                           in if BS.length inv == 0
-                              then Just $ InfoHash ihStr
-                              else Nothing
-  |        otherwise     = Nothing
-  where
-    hashLen = BS.length hashStr
-    hashStr = T.encodeUtf8 urnString
+  |       otherwise      = textToInfoHash urnString
 
 infoHashToURN :: InfoHash -> URN
 infoHashToURN = URN btih . T.pack . show