summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/test/Minilang
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/test/Minilang')
-rw-r--r--lambda-calcul/haskell/test/Minilang/ServerSpec.hs39
1 files changed, 33 insertions, 6 deletions
diff --git a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
index 962dcdc..6a3b6d5 100644
--- a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
@@ -3,18 +3,25 @@
module Minilang.ServerSpec where
-import Data.Aeson (FromJSON, eitherDecode)
+import Control.Concurrent.STM (newTVarIO)
+import Data.Aeson (FromJSON, eitherDecode, encode)
import Data.ByteString (isInfixOf, toStrict)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64.Lazy as Base64
+import Data.ByteString.Lazy (ByteString)
import Data.Data (Proxy (..))
-import Minilang.API (Score)
+import Minilang.API (Score, User (..), newToken)
+import Minilang.App (Env (..))
import Minilang.Server (serveAPI)
import Network.Wai (Application)
+import Network.Wai.Test (SResponse)
+import System.Random (StdGen, mkStdGen64)
import Test.Hspec (Spec, it)
-import Test.Hspec.Wai (get, matchBody, shouldRespondWith, with)
+import Test.Hspec.Wai (WaiSession, get, matchBody, post, request, shouldRespondWith, with)
import Test.Hspec.Wai.Matcher (MatchBody (..))
spec :: Spec
-spec = with app $ do
+spec = with (app testSeed) $ do
it "GET / returns 'index.html'" $ do
get "/"
`shouldRespondWith` 200
@@ -28,6 +35,21 @@ spec = with app $ do
get "/api/leaderboard"
`shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 2}
+ it "POST /api/register returns registration token given user is not registered" $ do
+ let token = "{\"token\":\"" <> Base64.encode (fst $ newToken testSeed) <> "\"}"
+ let user = encode $ User "alice"
+ postJSON "/api/register" user
+ `shouldRespondWith` 201
+ { matchBody = MatchBody $ \_ t ->
+ if t == token
+ then
+ Nothing
+ else Just ("Expected token " ++ show token ++ ", but got " ++ show t)
+ }
+
+postJSON :: BS.ByteString -> ByteString -> WaiSession () SResponse
+postJSON url = request "POST" url [("Content-Type", "application/json")]
+
arrayOfLengthOf :: forall elem proxy. (FromJSON elem) => proxy elem -> Int -> MatchBody
arrayOfLengthOf _ len = MatchBody $ \_ actual ->
case eitherDecode actual of
@@ -37,5 +59,10 @@ arrayOfLengthOf _ len = MatchBody $ \_ actual ->
else Just $ "Expected array of length " ++ show len ++ ", but got " ++ show (length scores)
Left err -> Just $ "Failed to decode JSON: " ++ err
-app :: IO Application
-app = pure serveAPI
+app :: StdGen -> IO Application
+app g = do
+ env <- Env <$> newTVarIO g
+ pure $ serveAPI env
+
+testSeed :: StdGen
+testSeed = mkStdGen64 42