Register user and return random token

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