Add auth api test

hie.yaml

@@ -4,3 +4,5 @@ cradle:
       component: "conduit-server:lib"
     - path: "./app"
       component: "conduit-server:exe:conduit-server-exe"
+    - path: "./test"
+      component: "conduit-server:test:conduit-server-test"

package.yaml

@@ -75,4 +75,8 @@ tests:
     - -rtsopts
     - -with-rtsopts=-N
     dependencies:
+    - http-types
+    - hspec
+    - hspec-wai
+    - QuickCheck
     - conduit-server

src/Conduit/Api/Auth.hs

@@ -45,11 +45,14 @@ data LoginResponse = LoginResponse
     , loginRespToken    :: Text
     , loginRespBio      :: Text
     , loginRespImage    :: Text
-    } deriving (Show, Generic)
+    } deriving (Eq, Show, Generic)
 
 instance ToJSON LoginResponse where
     toJSON = genericToJSON $ toJsonOptions 9
 
+instance FromJSON LoginResponse where
+    parseJSON = genericParseJSON $ toJsonOptions 9
+
 mapUserToLoginResponse :: User -> Text -> LoginResponse
 mapUserToLoginResponse user token = LoginResponse
     { loginRespUsername = getUsername $ userName user

src/Conduit/Api/Common.hs

@@ -8,7 +8,7 @@ import Conduit.Util
 import Conduit.Core.User
 
 newtype UserData a = UserData { userData :: a }
-    deriving (Show, Generic)
+    deriving (Eq, Show, Generic)
 
 instance ToJSON a => ToJSON (UserData a) where
     toJSON (UserData a) = object ["user" .= a]
@@ -29,7 +29,7 @@ instance FromJSON a => FromJSON (Profile a) where
         a <- o .: "profile"
         return (Profile a)
 
-data UserProfile = UserProfile 
+data UserProfile = UserProfile
     { profileUsername  :: Text
     , profileBio       :: Text
     , profileImage     :: Text
@@ -45,4 +45,4 @@ mapUserToUserProfile user following = UserProfile
     , profileBio       = userBio user
     , profileImage     = userImage user
     , profileFollowing = following
-    }
+    }

test/Conduit/Api/AuthApiSpec.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE RankNTypes #-}
+module Conduit.Api.AuthApiSpec where
+
+import RIO
+import Data.Aeson
+import Data.Maybe
+import Test.Hspec
+import Test.Hspec.Wai (get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
+                 with, (<:>))
+import qualified Test.Hspec.Wai as THW
+import Network.Wai.Test
+import Network.HTTP.Types
+import qualified Data.Text as T
+
+import Conduit
+import Conduit.App
+import Conduit.Config
+import Conduit.TestHelper
+import Conduit.Api.Common
+import Conduit.Api.Auth
+
+registerNewUser :: forall st . Text -> THW.WaiSession st SResponse
+registerNewUser username =
+    THW.request
+        methodPost
+        "/api/users"
+        [("Content-Type", "application/json")]
+        registerRequestData
+    where
+        newUser = NewUser username (T.append username "@test.com") (T.append username "password")
+        registerRequestData = encode $ UserData newUser
+
+loginWith :: forall st . Text -> THW.WaiSession st SResponse
+loginWith username =
+    THW.request
+        methodPost
+        "/api/users/login"
+        [("Content-Type", "application/json")]
+        loginRequestData
+    where
+        loginUser = LoginUser (T.append username "@test.com") (T.append username "password")
+        loginRequestData = encode $ UserData loginUser
+
+spec :: Spec
+spec =
+     context "Login/Register user" $ do
+        withApplication $ do
+            it "should register a new user" $ do
+                response <- registerNewUser "test001"
+                liftIO $ statusCode (simpleStatus response) `shouldBe` 200
+                let mbBody = decode (simpleBody response) :: Maybe (UserData LoginResponse)
+                liftIO $ mbBody `shouldNotBe` Nothing
+                let (UserData loginResponse) = fromJust mbBody
+                liftIO $ loginRespToken loginResponse `shouldNotBe` ""
+
+            it "should login and response token" $ do
+                _ <- registerNewUser "test002"
+                response <- loginWith "test002"
+                liftIO $ statusCode (simpleStatus response) `shouldBe` 200
+                let mbBody = decode (simpleBody response) :: Maybe (UserData LoginResponse)
+                liftIO $ mbBody `shouldNotBe` Nothing
+                let (UserData loginResponse) = fromJust mbBody
+                liftIO $ loginRespToken loginResponse `shouldNotBe` ""
+

test/Conduit/TestHelper.hs

@@ -0,0 +1,37 @@
+module Conduit.TestHelper where
+
+import RIO
+import Dhall
+import Crypto.JOSE.JWK
+import qualified Network.Wai.Handler.Warp as Warp
+import Network.Wai
+import Test.Hspec
+import Test.Hspec.Wai
+import Hasql.Connection
+
+import Conduit
+import Conduit.App
+import Conduit.Config
+
+loadTestEnv :: IO AppEnv
+loadTestEnv = do
+    cfg <- input auto "./conduit.dhall"
+    let postgresSettings = mapDbConfigToSettings $ cfgDb cfg
+    let jwtKey = fromOctets . encodeUtf8 . cfgJwtSecret $ cfg
+    conn <- acquire postgresSettings
+    case conn of
+        Right _conn -> do
+            let env = AppEnv
+                        { envConn = _conn
+                        , envJwtKey = jwtKey
+                        }
+            return env
+        _ ->
+            error "Failed to connect to database"
+
+loadApplication :: IO Application
+loadApplication = do
+    mkApp <$> loadTestEnv
+
+withApplication :: SpecWith ((), Application) -> Spec
+withApplication = with loadApplication

test/Spec.hs

@@ -1,2 +1 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}