Automatic testing for schema

backend/backend.cabal

@@ -86,3 +86,20 @@ executable backend
                      , NoImplicitPrelude
                      , OverloadedStrings
                      , RecordWildCards
+
+test-suite spec
+  type:                exitcode-stdio-1.0
+  main-is:             Spec.hs
+  hs-source-dirs:      src
+  build-depends:       base >=4.10
+                     , classy-prelude
+                     , http-api-data
+                     , selda
+                     , selda-postgresql
+                     , aeson
+                     , text
+                     , validity
+                     , genvalidity-hspec
+                     , genvalidity-property
+                     , genvalidity-text
+                     , hspec

backend/src/Database/Schema.hs

@@ -14,13 +14,13 @@ import Data.Aeson
 import Web.HttpApiData
 
 -- | User type
-newtype PlainPassword = PlainPassword Text deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Eq)
+newtype PlainPassword = PlainPassword Text deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Eq, Generic)
 newtype HashedPassword = HashedPassword {unHashed :: ByteString}
 data NoPassword = NoPassword
 
-newtype Email = Email { unEmail :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData)
+newtype Email = Email { unEmail :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Generic, Eq)
 
-newtype Username = Username { unUsername :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData)
+newtype Username = Username { unUsername :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Eq, Generic)
 
 instance SqlType HashedPassword where
   mkLit = LCustom . LBlob . unHashed
@@ -42,9 +42,9 @@ instance SqlType Username where
 
 newtype UserID = UserID {unUserID :: Int} deriving (Show)
 
-newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord, ToHttpApiData)
+newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord, ToHttpApiData, Generic)
 
-newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON)
+newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON, Eq, Generic)
 
 newtype TagID = TagID {unTagID :: Int} deriving (Show)
 
@@ -77,7 +77,7 @@ data User pass = User { identifier :: UserID
                       , password :: pass }
           deriving (Show, Generic)
 
-data Role = UserRole | AdminRole deriving (Show, Read, Enum, Bounded, Typeable, Generic)
+data Role = UserRole | AdminRole deriving (Show, Read, Enum, Bounded, Typeable, Generic, Eq)
 
 instance ToJSON Role
 instance FromJSON Role
@@ -125,7 +125,7 @@ data Tag = Tag { identifier :: TagID
          deriving (Show, Generic)
 
 data Visibility = Public | Private | Followers
-                deriving (Show, Read, Generic)
+                deriving (Show, Read, Generic, Eq)
 
 instance ToJSON Visibility
 instance FromJSON Visibility

backend/src/Spec.hs

@@ -0,0 +1,53 @@
+{-# Language TypeApplications #-}
+module Main where
+
+import qualified Data.Aeson as A
+import           Data.Char (isPrint)
+import           Data.GenValidity.Text ()
+import qualified Data.Text as T
+import           Database.Schema
+import           Test.Hspec
+import           Test.Validity
+
+instance GenUnchecked PlainPassword
+instance GenValid PlainPassword
+instance GenInvalid PlainPassword
+instance Validity PlainPassword
+instance GenUnchecked Email
+instance GenValid Email
+instance GenInvalid Email
+instance Validity Email
+instance GenUnchecked Username
+instance GenValid Username
+instance GenInvalid Username
+instance Validity Username
+instance GenUnchecked BookID
+instance GenValid BookID
+instance GenInvalid BookID
+instance Validity BookID
+instance GenUnchecked ChannelID
+instance GenValid ChannelID
+instance GenInvalid ChannelID
+instance Validity ChannelID
+instance GenUnchecked Role
+instance GenValid Role
+instance GenInvalid Role
+instance Validity Role
+instance GenUnchecked Visibility
+instance GenValid Visibility
+instance GenInvalid Visibility
+instance Validity Visibility
+
+spec :: Spec
+spec = do
+  describe "JSON encoding" $ do
+    it "Works for PlainPassword" $ inverseFunctionsIfSecondSucceedsOnValid (A.encode @PlainPassword) A.decode
+    it "Works for Email" $ inverseFunctionsIfSecondSucceedsOnValid (A.encode @Email) A.decode
+    it "Username" $ inverseFunctionsIfSecondSucceedsOnValid (A.encode @Username) A.decode
+    it "Works for BookID" $ inverseFunctionsIfSecondSucceedsOnValid (A.encode @BookID) A.decode
+    it "Works for ChannelID" $ inverseFunctionsIfSecondSucceedsOnValid (A.encode @ChannelID) A.decode
+    it "Works for Role" $ inverseFunctionsIfSecondSucceedsOnValid (A.encode @Role) A.decode
+    it "Works for Visibility" $ inverseFunctionsIfSecondSucceedsOnValid (A.encode @Visibility) A.decode
+
+main :: IO ()
+main = hspec spec