+ tests

3 files changed, 135 insertions, 0 deletions

diff --git a/tests/client.hs b/tests/client.hs
new file mode 100644
index 00000000..5697d18a
--- /dev/null
+++ b/tests/client.hs
@@ -0,0 +1,27 @@
+module Main (main) where
+
+import Data.Torrent
+import Network.Torrent.THP
+import System.Environment
+import Data.ByteString as B
+import Data.ByteString.Lazy as L
+import Data.BEncode
+
+main :: IO ()
+main = do
+  [path] <- getArgs
+  contents <- B.readFile path
+
+  let Right contents' = decode contents >>= return . L.toStrict . encode
+  print (contents' == contents)
+--  let (a, b) = showInfos contents
+--  print b
+--  print a
+--  print (encode b == encoded a)
+
+  let Right b = decode contents
+  let Right t = fromBEncode b
+
+  let req = defaultRequest (tAnnounce t) (tInfoHash t)
+  resp <- sendRequest req
+  print resp
diff --git a/tests/encoding.hs b/tests/encoding.hs
new file mode 100644
index 00000000..9141a1ba
--- /dev/null
+++ b/tests/encoding.hs
@@ -0,0 +1,59 @@
+{-# OPTIONS -fno-warn-orphans #-}
+module Main (main) where
+
+import Control.Applicative
+import Data.Word
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Data.Serialize
+
+import Test.Framework (defaultMain)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
+
+import Network.Torrent.PWP
+
+positive :: Gen Int
+positive = fromIntegral <$> (arbitrary :: Gen Word32)
+
+instance Arbitrary ByteString where
+  arbitrary = B.pack <$> arbitrary
+
+instance Arbitrary BlockIx where
+  arbitrary = BlockIx <$> positive <*> positive <*> positive
+
+instance Arbitrary Block where
+  arbitrary = Block <$> positive <*> positive <*> arbitrary
+
+instance Arbitrary Message where
+  arbitrary = oneof
+    [ pure KeepAlive
+    , pure Choke
+    , pure Unchoke
+    , pure Interested
+    , pure NotInterested
+    , Have <$> positive
+    , Bitfield <$> arbitrary
+    , Request <$> arbitrary
+    , Piece <$> arbitrary
+    , Cancel <$> arbitrary
+    , Port <$> choose (0, fromIntegral (maxBound :: Word16))
+    ]
+
+
+encodeMessages :: [Message] -> ByteString
+encodeMessages xs = runPut (mapM_ put xs)
+
+decodeMessages :: ByteString -> Either String [Message]
+decodeMessages = runGet (many get)
+
+-- | TODO move tests
+prop_encoding :: [Message] -> Bool
+prop_encoding msgs = decodeMessages (encodeMessages msgs) == Right msgs
+
+
+main :: IO ()
+main = do
+  defaultMain
+       [ testProperty "encode <-> decode" prop_encoding
+       ]
\ No newline at end of file
diff --git a/tests/info-hash.hs b/tests/info-hash.hs
new file mode 100644
index 00000000..1e511e43
--- /dev/null
+++ b/tests/info-hash.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import Control.Applicative
+import Data.Foldable
+import Data.Maybe
+import qualified Data.Map as M
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Builder.Prim as B
+
+import System.Environment
+
+import Data.Torrent
+import Data.BEncode
+
+
+checkInfo :: B.ByteString
+checkInfo = "0221caf96aa3cb94f0f58d458e78b0fc344ad8bf"
+
+-- | _should_ be 'id' if content is correct
+reencode :: B.ByteString -> Result L.ByteString
+reencode content = (encode . toBEncode . (`asTypeOf` (undefined :: Torrent)))
+            `fmap` (fromBEncode =<< decode content)
+
+ppHex :: B.ByteString -> B.ByteString
+ppHex = L.toStrict . B.toLazyByteString . foldMap (B.primFixed B.word8HexFixed) . B.unpack
+
+chunk :: Int -> B.ByteString -> [B.ByteString]
+chunk size b | B.length b == 0 = [b]
+             | otherwise       =
+               let (x, xs) = B.splitAt size b
+               in x : chunk size xs
+
+showInfos :: ByteString -> (TorrentInfo, BEncode)
+showInfos bs =
+  let Right (be@(BDict dict)) = decode bs
+      Right t = tInfo <$> (fromBEncode be)
+      orig = BDict $ let BDict info = fromJust (M.lookup "info" dict)
+                     in M.insert "pieces" (BString "") info
+  in (t { tPieces = "" }, orig)
+
+main :: IO ()
+main = do
+  [path] <- getArgs
+  Right t <- fromFile path
+  B.putStrLn (ppHex (tInfoHash t))