diff --git a/backend/backend.cabal b/backend/backend.cabal index 1a231f3..4ddb780 100644 --- a/backend/backend.cabal +++ b/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 diff --git a/backend/src/Database/Schema.hs b/backend/src/Database/Schema.hs index 598abdb..e08b215 100644 --- a/backend/src/Database/Schema.hs +++ b/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 diff --git a/backend/src/Spec.hs b/backend/src/Spec.hs new file mode 100644 index 0000000..9063ad2 --- /dev/null +++ b/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