summaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/Torrent/Block.hs23
-rw-r--r--src/Data/Torrent/InfoHash.hs16
2 files changed, 8 insertions, 31 deletions
diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs
index 987de653..37889a7a 100644
--- a/src/Data/Torrent/Block.hs
+++ b/src/Data/Torrent/Block.hs
@@ -37,9 +37,6 @@ import Data.Aeson.TH
37import qualified Data.ByteString.Lazy as Lazy 37import qualified Data.ByteString.Lazy as Lazy
38import Data.Char 38import Data.Char
39import Data.List as L 39import Data.List as L
40import Data.Binary as B
41import Data.Binary.Get as B
42import Data.Binary.Put as B
43import Data.Serialize as S 40import Data.Serialize as S
44import Text.PrettyPrint 41import Text.PrettyPrint
45import Text.PrettyPrint.Class 42import Text.PrettyPrint.Class
@@ -110,14 +107,6 @@ putInt :: S.Putter Int
110putInt = S.putWord32be . fromIntegral 107putInt = S.putWord32be . fromIntegral
111{-# INLINE putInt #-} 108{-# INLINE putInt #-}
112 109
113getIntB :: B.Get Int
114getIntB = fromIntegral <$> B.getWord32be
115{-# INLINE getIntB #-}
116
117putIntB :: Int -> B.Put
118putIntB = B.putWord32be . fromIntegral
119{-# INLINE putIntB #-}
120
121instance Serialize BlockIx where 110instance Serialize BlockIx where
122 {-# SPECIALIZE instance Serialize BlockIx #-} 111 {-# SPECIALIZE instance Serialize BlockIx #-}
123 get = BlockIx <$> getInt 112 get = BlockIx <$> getInt
@@ -131,18 +120,6 @@ instance Serialize BlockIx where
131 putInt ixLength 120 putInt ixLength
132 {-# INLINE put #-} 121 {-# INLINE put #-}
133 122
134instance Binary BlockIx where
135 {-# SPECIALIZE instance Binary BlockIx #-}
136 get = BlockIx <$> getIntB
137 <*> getIntB
138 <*> getIntB
139 {-# INLINE get #-}
140
141 put BlockIx {..} = do
142 putIntB ixPiece
143 putIntB ixOffset
144 putIntB ixLength
145
146instance Pretty BlockIx where 123instance Pretty BlockIx where
147 pretty BlockIx {..} = 124 pretty BlockIx {..} =
148 "piece = " <> int ixPiece <> "," <+> 125 "piece = " <> int ixPiece <> "," <+>
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
index 6313948b..15682250 100644
--- a/src/Data/Torrent/InfoHash.hs
+++ b/src/Data/Torrent/InfoHash.hs
@@ -125,21 +125,21 @@ instance Convertible BS.ByteString InfoHash where
125-- | Parse infohash from base16\/base32\/base64 encoded string. 125-- | Parse infohash from base16\/base32\/base64 encoded string.
126instance Convertible Text InfoHash where 126instance Convertible Text InfoHash where
127 safeConvert t 127 safeConvert t
128 | hashLen <= 28 = 128 | 26 <= hashLen && hashLen <= 28 =
129 case Base64.decode hashStr of 129 case Base64.decode hashStr of
130 Left msg -> convError ("invalid base64 encoding " ++ msg) t 130 Left msg -> convError ("invalid base64 encoding " ++ msg) t
131 Right ihStr -> pure $ InfoHash ihStr 131 Right ihStr -> safeConvert ihStr
132 132
133 | hashLen == 32 = 133 | hashLen == 32 =
134 case Base32.decode hashStr of 134 case Base32.decode hashStr of
135 Left msg -> convError msg t 135 Left msg -> convError msg t
136 Right ihStr -> pure $ InfoHash ihStr 136 Right ihStr -> safeConvert ihStr
137 137
138 | hashLen == 40 = 138 | hashLen == 40 =
139 let (ihStr, inv) = Base16.decode hashStr 139 let (ihStr, inv) = Base16.decode hashStr
140 in if BS.length inv == 0 140 in if BS.length inv /= 0
141 then pure $ InfoHash ihStr 141 then convError "invalid base16 encoding" t
142 else convError "invalid base16 encoding" t 142 else safeConvert ihStr
143 143
144 | otherwise = convError "invalid length" t 144 | otherwise = convError "invalid length" t
145 where 145 where
@@ -156,8 +156,8 @@ instance ToJSON InfoHash where
156 156
157-- | Convert from base16\/base32\/base64 encoded JSON string. 157-- | Convert from base16\/base32\/base64 encoded JSON string.
158instance FromJSON InfoHash where 158instance FromJSON InfoHash where
159 parseJSON = withText "JSON" $ -- TODO 159 parseJSON = withText "InfoHash" $
160 maybe (fail "could not parse InfoHash") pure . textToInfoHash 160 either (fail . prettyConvertError) pure . safeConvert
161 161
162ignoreErrorMsg :: Either a b -> Maybe b 162ignoreErrorMsg :: Either a b -> Maybe b
163ignoreErrorMsg = either (const Nothing) Just 163ignoreErrorMsg = either (const Nothing) Just