From 12cbb3af2413dc28838ed271351dda16df8f7bdb Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Fri, 15 Sep 2017 06:22:10 -0400
Subject: Separating dht-client library from bittorrent package.

---
 bittorrent/tests/Network/KRPC/MessageSpec.hs | 72 ++++++++++++++++++++++++++++
 bittorrent/tests/Network/KRPC/MethodSpec.hs  | 52 ++++++++++++++++++++
 2 files changed, 124 insertions(+)
 create mode 100644 bittorrent/tests/Network/KRPC/MessageSpec.hs
 create mode 100644 bittorrent/tests/Network/KRPC/MethodSpec.hs

(limited to 'bittorrent/tests/Network/KRPC')

diff --git a/bittorrent/tests/Network/KRPC/MessageSpec.hs b/bittorrent/tests/Network/KRPC/MessageSpec.hs
new file mode 100644
index 00000000..498ef679
--- /dev/null
+++ b/bittorrent/tests/Network/KRPC/MessageSpec.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Network.KRPC.MessageSpec (spec) where
+import Control.Applicative
+import Data.ByteString.Lazy as BL
+import Test.Hspec
+import Test.QuickCheck
+import Test.QuickCheck.Instances ()
+
+import Data.BEncode as BE
+import Network.KRPC.Message
+
+instance Arbitrary ErrorCode where
+  arbitrary = arbitraryBoundedEnum
+
+instance Arbitrary KError where
+  arbitrary = KError <$> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary KQuery where
+  arbitrary = KQuery <$> pure (BInteger 0) <*> arbitrary <*> arbitrary
+
+instance Arbitrary KResponse where
+  -- TODO: Abitrary instance for ReflectedIP
+  arbitrary = KResponse <$> pure (BList []) <*> arbitrary <*> pure Nothing
+
+instance Arbitrary KMessage where
+  arbitrary = frequency
+    [ (1, Q <$> arbitrary)
+    , (1, R <$> arbitrary)
+    , (1, E <$> arbitrary)
+    ]
+
+spec :: Spec
+spec = do
+  describe "error message" $ do
+    it "properly bencoded (iso)" $ property $ \ ke ->
+      BE.decode (BL.toStrict (BE.encode ke)) `shouldBe` Right (ke :: KError)
+
+    it "properly bencoded" $ do
+      BE.decode "d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee"
+        `shouldBe` Right (KError GenericError "A Generic Error Ocurred" "aa")
+
+      BE.decode "d1:eli202e22:A Server Error Ocurrede1:t2:bb1:y1:ee"
+        `shouldBe` Right (KError ServerError "A Server Error Ocurred" "bb")
+
+      BE.decode "d1:eli203e24:A Protocol Error Ocurrede1:t2:cc1:y1:ee"
+        `shouldBe` Right (KError ProtocolError "A Protocol Error Ocurred" "cc")
+
+      BE.decode "d1:eli204e30:Attempt to call unknown methode1:t2:dd1:y1:ee"
+        `shouldBe` Right
+          (KError MethodUnknown "Attempt to call unknown method" "dd")
+
+  describe "query message" $ do
+    it "properly bencoded (iso)" $ property $ \ kq ->
+      BE.decode (BL.toStrict (BE.encode kq)) `shouldBe` Right (kq :: KQuery)
+
+    it "properly bencoded" $ do
+      BE.decode "d1:ale1:q4:ping1:t2:aa1:y1:qe" `shouldBe`
+        Right (KQuery (BList []) "ping" "aa")
+
+
+  describe "response message" $ do
+    it "properly bencoded (iso)" $ property $ \ kr ->
+      BE.decode (BL.toStrict (BE.encode kr)) `shouldBe` Right (kr :: KResponse)
+
+    it "properly bencoded" $ do
+      BE.decode "d1:rle1:t2:aa1:y1:re" `shouldBe`
+        Right (KResponse (BList []) "aa" Nothing)
+
+  describe "generic message" $ do
+    it "properly bencoded (iso)" $ property $ \ km ->
+      BE.decode (BL.toStrict (BE.encode km)) `shouldBe` Right (km :: KMessage)
diff --git a/bittorrent/tests/Network/KRPC/MethodSpec.hs b/bittorrent/tests/Network/KRPC/MethodSpec.hs
new file mode 100644
index 00000000..c1c58282
--- /dev/null
+++ b/bittorrent/tests/Network/KRPC/MethodSpec.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+module Network.KRPC.MethodSpec where
+import Control.Applicative
+import Data.BEncode
+import Data.ByteString as BS
+import Data.Typeable
+import Network.KRPC
+import Test.Hspec
+
+
+data Ping = Ping
+  deriving (Show, Eq, Typeable)
+
+instance BEncode Ping where
+  toBEncode Ping = toBEncode ()
+  fromBEncode b  = Ping <$ (fromBEncode b :: Result ())
+
+instance KRPC Ping Ping
+
+ping :: Monad h => Handler h
+ping = handler $ \ _ Ping -> return Ping
+
+newtype Echo a = Echo a
+  deriving (Show, Eq, BEncode, Typeable)
+
+echo :: Monad h => Handler h
+echo = handler $ \ _ (Echo a) -> return (Echo (a :: ByteString))
+
+instance (Typeable a, BEncode a) => KRPC (Echo a) (Echo a)
+
+spec :: Spec
+spec = do
+  describe "ping method" $ do
+    it "name is ping" $ do
+      (method :: Method Ping Ping) `shouldBe` "ping"
+
+    it "has pretty Show instance" $ do
+      show (method :: Method Ping Ping) `shouldBe` "ping :: Ping -> Ping"
+
+  describe "echo method" $ do
+    it "is overloadable" $ do
+      (method :: Method (Echo Int ) (Echo Int )) `shouldBe` "echo int"
+      (method :: Method (Echo Bool) (Echo Bool)) `shouldBe` "echo bool"
+
+    it "has pretty Show instance" $ do
+      show (method :: Method (Echo Int) (Echo Int))
+        `shouldBe` "echo int :: Echo Int -> Echo Int"
\ No newline at end of file
-- 
cgit v1.2.3