summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Torrent.hs5
-rw-r--r--src/Data/Torrent/JSON.hs31
-rw-r--r--src/Data/Torrent/Layout.hs6
-rw-r--r--src/Data/Torrent/Piece.hs9
-rw-r--r--src/Data/Torrent/Progress.hs4
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs3
-rw-r--r--src/Network/BitTorrent/Exchange/Block.hs3
-rw-r--r--src/Network/BitTorrent/Exchange/Status.hs7
-rw-r--r--src/Network/BitTorrent/Tracker/Message.hs12
9 files changed, 61 insertions, 19 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index ce919907..a511d6c1 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -92,6 +92,7 @@ import Text.PrettyPrint.Class
92import System.FilePath 92import System.FilePath
93 93
94import Data.Torrent.InfoHash as IH 94import Data.Torrent.InfoHash as IH
95import Data.Torrent.JSON
95import Data.Torrent.Layout 96import Data.Torrent.Layout
96import Data.Torrent.Piece 97import Data.Torrent.Piece
97 98
@@ -123,7 +124,7 @@ data InfoDict = InfoDict
123 -- BEP 27: <http://www.bittorrent.org/beps/bep_0027.html> 124 -- BEP 27: <http://www.bittorrent.org/beps/bep_0027.html>
124 } deriving (Show, Read, Eq, Typeable) 125 } deriving (Show, Read, Eq, Typeable)
125 126
126$(deriveJSON defaultOptions { fieldLabelModifier = (L.map Char.toLower . L.dropWhile isLower) } ''InfoDict) 127$(deriveJSON omitRecordPrefix ''InfoDict)
127 128
128makeLensesFor 129makeLensesFor
129 [ ("idInfoHash" , "infohash" ) 130 [ ("idInfoHash" , "infohash" )
@@ -239,7 +240,7 @@ instance ToJSON NominalDiffTime where
239instance FromJSON NominalDiffTime where 240instance FromJSON NominalDiffTime where
240 parseJSON v = utcTimeToPOSIXSeconds <$> parseJSON v 241 parseJSON v = utcTimeToPOSIXSeconds <$> parseJSON v
241 242
242$(deriveJSON defaultOptions { fieldLabelModifier = (L.map Char.toLower . L.dropWhile isLower) } ''Torrent) 243$(deriveJSON omitRecordPrefix ''Torrent)
243 244
244makeLensesFor 245makeLensesFor
245 [ ("tAnnounce" , "announce" ) 246 [ ("tAnnounce" , "announce" )
diff --git a/src/Data/Torrent/JSON.hs b/src/Data/Torrent/JSON.hs
new file mode 100644
index 00000000..3fa8973d
--- /dev/null
+++ b/src/Data/Torrent/JSON.hs
@@ -0,0 +1,31 @@
1module Data.Torrent.JSON
2 ( omitLensPrefix
3 , omitRecordPrefix
4 ) where
5
6import Data.Aeson.TH
7import Data.Char
8import Data.List as L
9
10
11-- | Ignore '_' prefix.
12omitLensPrefix :: Options
13omitLensPrefix = defaultOptions
14 { fieldLabelModifier = L.dropWhile (== '_')
15 , constructorTagModifier = id
16 , allNullaryToStringTag = True
17 , omitNothingFields = True
18 }
19
20mapWhile :: (a -> Bool) -> (a -> a) -> [a] -> [a]
21mapWhile p f = go
22 where
23 go [] = []
24 go (x : xs)
25 | p x = f x : go xs
26 | otherwise = xs
27
28omitRecordPrefix :: Options
29omitRecordPrefix = omitLensPrefix
30 { fieldLabelModifier = mapWhile isUpper toLower . L.dropWhile isLower
31 } \ No newline at end of file
diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs
index a32d74fa..453c0d4f 100644
--- a/src/Data/Torrent/Layout.hs
+++ b/src/Data/Torrent/Layout.hs
@@ -70,7 +70,6 @@ import Data.BEncode.Types
70import Data.ByteString as BS 70import Data.ByteString as BS
71import Data.ByteString.Base16 as Base16 71import Data.ByteString.Base16 as Base16
72import Data.ByteString.Char8 as BC 72import Data.ByteString.Char8 as BC
73import Data.Char as Char
74import Data.Foldable as F 73import Data.Foldable as F
75import Data.List as L 74import Data.List as L
76import Data.Text as T 75import Data.Text as T
@@ -81,6 +80,7 @@ import Text.PrettyPrint.Class
81import System.FilePath 80import System.FilePath
82import System.Posix.Types 81import System.Posix.Types
83 82
83import Data.Torrent.JSON
84 84
85{----------------------------------------------------------------------- 85{-----------------------------------------------------------------------
86-- File attribytes 86-- File attribytes
@@ -123,7 +123,7 @@ data FileInfo a = FileInfo {
123 , Functor, Foldable 123 , Functor, Foldable
124 ) 124 )
125 125
126$(deriveJSON defaultOptions { fieldLabelModifier = (L.map Char.toLower . L.dropWhile isLower) } ''FileInfo) 126$(deriveJSON omitRecordPrefix ''FileInfo)
127 127
128makeLensesFor 128makeLensesFor
129 [ ("fiLength", "fileLength") 129 [ ("fiLength", "fileLength")
@@ -208,7 +208,7 @@ data LayoutInfo
208 , liDirName :: !ByteString 208 , liDirName :: !ByteString
209 } deriving (Show, Read, Eq, Typeable) 209 } deriving (Show, Read, Eq, Typeable)
210 210
211$(deriveJSON defaultOptions { fieldLabelModifier = (L.map Char.toLower . L.dropWhile isLower) } ''LayoutInfo) 211$(deriveJSON omitRecordPrefix ''LayoutInfo)
212 212
213makeLensesFor 213makeLensesFor
214 [ ("liFile" , "singleFile" ) 214 [ ("liFile" , "singleFile" )
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs
index 00d4b843..d79da2ee 100644
--- a/src/Data/Torrent/Piece.hs
+++ b/src/Data/Torrent/Piece.hs
@@ -54,14 +54,15 @@ import Data.Bits.Extras
54import Data.ByteString as BS 54import Data.ByteString as BS
55import qualified Data.ByteString.Lazy as BL 55import qualified Data.ByteString.Lazy as BL
56import qualified Data.ByteString.Base64 as Base64 56import qualified Data.ByteString.Base64 as Base64
57import Data.Char
58import Data.Int 57import Data.Int
59import Data.List as L
60import Data.Text.Encoding as T 58import Data.Text.Encoding as T
61import Data.Typeable 59import Data.Typeable
62import Text.PrettyPrint 60import Text.PrettyPrint
63import Text.PrettyPrint.Class 61import Text.PrettyPrint.Class
64 62
63import Data.Torrent.JSON
64
65
65-- TODO add torrent file validation 66-- TODO add torrent file validation
66class Lint a where 67class Lint a where
67 lint :: a -> Either String a 68 lint :: a -> Either String a
@@ -129,7 +130,7 @@ data Piece a = Piece
129 , pieceData :: !a 130 , pieceData :: !a
130 } deriving (Show, Read, Eq, Functor, Typeable) 131 } deriving (Show, Read, Eq, Functor, Typeable)
131 132
132$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''Piece) 133$(deriveJSON omitRecordPrefix ''Piece)
133 134
134instance NFData (Piece a) 135instance NFData (Piece a)
135 136
@@ -166,7 +167,7 @@ data PieceInfo = PieceInfo
166 -- ^ Concatenation of all 20-byte SHA1 hash values. 167 -- ^ Concatenation of all 20-byte SHA1 hash values.
167 } deriving (Show, Read, Eq, Typeable) 168 } deriving (Show, Read, Eq, Typeable)
168 169
169$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''PieceInfo) 170$(deriveJSON omitRecordPrefix ''PieceInfo)
170 171
171-- | Number of bytes in each piece. 172-- | Number of bytes in each piece.
172makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo 173makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
index 34f8f299..ffcbf2aa 100644
--- a/src/Data/Torrent/Progress.hs
+++ b/src/Data/Torrent/Progress.hs
@@ -49,6 +49,8 @@ import Network.HTTP.Types.QueryLike
49import Text.PrettyPrint as PP 49import Text.PrettyPrint as PP
50import Text.PrettyPrint.Class 50import Text.PrettyPrint.Class
51 51
52import Data.Torrent.JSON
53
52 54
53-- | Progress data is considered as dynamic within one client 55-- | Progress data is considered as dynamic within one client
54-- session. This data also should be shared across client application 56-- session. This data also should be shared across client application
@@ -62,7 +64,7 @@ data Progress = Progress
62 } deriving (Show, Read, Eq) 64 } deriving (Show, Read, Eq)
63 65
64$(makeLenses ''Progress) 66$(makeLenses ''Progress)
65$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''Progress) 67$(deriveJSON omitLensPrefix ''Progress)
66 68
67-- | UDP tracker compatible encoding. 69-- | UDP tracker compatible encoding.
68instance Serialize Progress where 70instance Serialize Progress where
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 846a14f9..e7a4ea61 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -41,6 +41,7 @@ import Text.PrettyPrint.Class
41import Text.Read (readMaybe) 41import Text.Read (readMaybe)
42import System.IO.Unsafe 42import System.IO.Unsafe
43 43
44import Data.Torrent.JSON
44import Network.BitTorrent.Core.PeerId 45import Network.BitTorrent.Core.PeerId
45 46
46 47
@@ -68,7 +69,7 @@ data PeerAddr = PeerAddr
68 , peerPort :: {-# UNPACK #-} !PortNumber 69 , peerPort :: {-# UNPACK #-} !PortNumber
69 } deriving (Show, Eq, Ord, Typeable) 70 } deriving (Show, Eq, Ord, Typeable)
70 71
71$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''PeerAddr) 72$(deriveJSON omitRecordPrefix ''PeerAddr)
72 73
73peer_id_key, peer_ip_key, peer_port_key :: BKey 74peer_id_key, peer_ip_key, peer_port_key :: BKey
74peer_id_key = "peer id" 75peer_id_key = "peer id"
diff --git a/src/Network/BitTorrent/Exchange/Block.hs b/src/Network/BitTorrent/Exchange/Block.hs
index 5ab73b65..d06fe727 100644
--- a/src/Network/BitTorrent/Exchange/Block.hs
+++ b/src/Network/BitTorrent/Exchange/Block.hs
@@ -41,6 +41,7 @@ import Data.Typeable
41import Text.PrettyPrint 41import Text.PrettyPrint
42import Text.PrettyPrint.Class 42import Text.PrettyPrint.Class
43 43
44import Data.Torrent.JSON
44import Data.Torrent.Piece 45import Data.Torrent.Piece
45 46
46{----------------------------------------------------------------------- 47{-----------------------------------------------------------------------
@@ -84,7 +85,7 @@ data BlockIx = BlockIx {
84 , ixLength :: {-# UNPACK #-} !BlockSize 85 , ixLength :: {-# UNPACK #-} !BlockSize
85 } deriving (Show, Eq, Typeable) 86 } deriving (Show, Eq, Typeable)
86 87
87$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''BlockIx) 88$(deriveJSON omitRecordPrefix ''BlockIx)
88 89
89getInt :: S.Get Int 90getInt :: S.Get Int
90getInt = fromIntegral <$> S.getWord32be 91getInt = fromIntegral <$> S.getWord32be
diff --git a/src/Network/BitTorrent/Exchange/Status.hs b/src/Network/BitTorrent/Exchange/Status.hs
index 42766428..8472e575 100644
--- a/src/Network/BitTorrent/Exchange/Status.hs
+++ b/src/Network/BitTorrent/Exchange/Status.hs
@@ -36,14 +36,15 @@ module Network.BitTorrent.Exchange.Status
36import Control.Lens 36import Control.Lens
37import Data.Aeson.TH 37import Data.Aeson.TH
38import Data.Default 38import Data.Default
39import Data.List as L
40import Data.Maybe 39import Data.Maybe
41import Data.Monoid 40import Data.Monoid
42import Text.PrettyPrint as PP hiding ((<>)) 41import Text.PrettyPrint as PP hiding ((<>))
43import Text.PrettyPrint.Class 42import Text.PrettyPrint.Class
44 43
44import Data.Torrent.JSON
45import Network.BitTorrent.Exchange.Message 45import Network.BitTorrent.Exchange.Message
46 46
47
47{----------------------------------------------------------------------- 48{-----------------------------------------------------------------------
48-- Peer status 49-- Peer status
49-----------------------------------------------------------------------} 50-----------------------------------------------------------------------}
@@ -60,7 +61,7 @@ data PeerStatus = PeerStatus
60 } deriving (Show, Eq, Ord) 61 } deriving (Show, Eq, Ord)
61 62
62$(makeLenses ''PeerStatus) 63$(makeLenses ''PeerStatus)
63$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''PeerStatus) 64$(deriveJSON omitLensPrefix ''PeerStatus)
64 65
65instance Pretty PeerStatus where 66instance Pretty PeerStatus where
66 pretty PeerStatus {..} = 67 pretty PeerStatus {..} =
@@ -103,7 +104,7 @@ data SessionStatus = SessionStatus
103 } deriving (Show, Eq) 104 } deriving (Show, Eq)
104 105
105$(makeLenses ''SessionStatus) 106$(makeLenses ''SessionStatus)
106$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''SessionStatus) 107$(deriveJSON omitRecordPrefix ''SessionStatus)
107 108
108instance Pretty SessionStatus where 109instance Pretty SessionStatus where
109 pretty SessionStatus {..} = 110 pretty SessionStatus {..} =
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 212181b9..943c3af5 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -34,6 +34,9 @@ module Network.BitTorrent.Tracker.Message
34 34
35 -- ** Request 35 -- ** Request
36 , AnnounceQueryExt (..) 36 , AnnounceQueryExt (..)
37 , renderAnnounceQueryExt
38 , parseAnnounceQueryExt
39
37 , AnnounceRequest (..) 40 , AnnounceRequest (..)
38 , parseAnnounceRequest 41 , parseAnnounceRequest
39 , renderAnnounceRequest 42 , renderAnnounceRequest
@@ -87,6 +90,7 @@ import Network.Socket
87import Text.Read (readMaybe) 90import Text.Read (readMaybe)
88 91
89import Data.Torrent.InfoHash 92import Data.Torrent.InfoHash
93import Data.Torrent.JSON
90import Data.Torrent.Progress 94import Data.Torrent.Progress
91import Network.BitTorrent.Core 95import Network.BitTorrent.Core
92 96
@@ -104,7 +108,7 @@ data Event = Started
104 -- ^ To be sent when the peer completes a download. 108 -- ^ To be sent when the peer completes a download.
105 deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) 109 deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable)
106 110
107$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''Event) 111$(deriveJSON omitRecordPrefix ''Event)
108 112
109-- | HTTP tracker protocol compatible encoding. 113-- | HTTP tracker protocol compatible encoding.
110instance QueryValueLike Event where 114instance QueryValueLike Event where
@@ -174,7 +178,7 @@ data AnnounceQuery = AnnounceQuery
174 , reqEvent :: Maybe Event 178 , reqEvent :: Maybe Event
175 } deriving (Show, Eq, Typeable) 179 } deriving (Show, Eq, Typeable)
176 180
177$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''AnnounceQuery) 181$(deriveJSON omitRecordPrefix ''AnnounceQuery)
178 182
179-- | UDP tracker protocol compatible encoding. 183-- | UDP tracker protocol compatible encoding.
180instance Serialize AnnounceQuery where 184instance Serialize AnnounceQuery where
@@ -480,7 +484,7 @@ data AnnounceInfo =
480 , respWarning :: !(Maybe Text) 484 , respWarning :: !(Maybe Text)
481 } deriving (Show, Typeable) 485 } deriving (Show, Typeable)
482 486
483$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''AnnounceInfo) 487$(deriveJSON omitRecordPrefix ''AnnounceInfo)
484 488
485-- | HTTP tracker protocol compatible encoding. 489-- | HTTP tracker protocol compatible encoding.
486instance BEncode AnnounceInfo where 490instance BEncode AnnounceInfo where
@@ -630,7 +634,7 @@ data ScrapeEntry = ScrapeEntry {
630 , siName :: !(Maybe Text) 634 , siName :: !(Maybe Text)
631 } deriving (Show, Eq, Typeable) 635 } deriving (Show, Eq, Typeable)
632 636
633$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''ScrapeEntry) 637$(deriveJSON omitRecordPrefix ''ScrapeEntry)
634 638
635-- | HTTP tracker protocol compatible encoding. 639-- | HTTP tracker protocol compatible encoding.
636instance BEncode ScrapeEntry where 640instance BEncode ScrapeEntry where