Add spec for Message module

4 files changed, 97 insertions, 10 deletions

diff --git a/krpc.cabal b/krpc.cabal
index 908fd770..fb7b01fe 100644
--- a/krpc.cabal
+++ b/krpc.cabal
@@ -59,25 +59,39 @@ library
 
   ghc-options:         -Wall
 
-
-test-suite test-client
+test-suite spec
   type:                exitcode-stdio-1.0
   default-language:    Haskell2010
   hs-source-dirs:      tests
-  main-is:             Client.hs
-  other-modules:       Shared
+  main-is:             Spec.hs
   build-depends:       base        == 4.*
                      , bytestring
-                     , process
-                     , filepath
+
+                     , hspec
+                     , QuickCheck
+                     , quickcheck-instances
 
                      , bencoding
                      , krpc
-                     , network
 
-                     , HUnit
-                     , test-framework
-                     , test-framework-hunit
+--test-suite test-client
+--  type:                exitcode-stdio-1.0
+--  default-language:    Haskell2010
+--  hs-source-dirs:      tests
+--  main-is:             Client.hs
+--  other-modules:       Shared
+--  build-depends:       base        == 4.*
+--                     , bytestring
+--                     , process
+--                     , filepath
+--
+--                     , bencoding
+--                     , krpc
+--                     , network
+--
+--                     , HUnit
+--                     , test-framework
+--                     , test-framework-hunit
 
 
 --executable test-server
diff --git a/src/Network/KRPC/Message.hs b/src/Network/KRPC/Message.hs
index 0bd34400..1e1dc065 100644
--- a/src/Network/KRPC/Message.hs
+++ b/src/Network/KRPC/Message.hs
@@ -227,6 +227,7 @@ data KMessage
   = Q KQuery
   | R KResponse
   | E KError
+    deriving (Show, Eq)
 
 instance BEncode KMessage where
   toBEncode (Q q) = toBEncode q
diff --git a/tests/Network/KRPC/MessageSpec.hs b/tests/Network/KRPC/MessageSpec.hs
new file mode 100644
index 00000000..7aca4489
--- /dev/null
+++ b/tests/Network/KRPC/MessageSpec.hs
@@ -0,0 +1,71 @@
+{-# 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
+  arbitrary = KResponse <$> pure (BList []) <*> arbitrary
+
+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")
+
+  describe "generic message" $ do
+    it "properly bencoded (iso)" $ property $ \ km ->
+      BE.decode (BL.toStrict (BE.encode km)) `shouldBe` Right (km :: KMessage)
\ No newline at end of file
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
index 00000000..52ef578f
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
\ No newline at end of file