From 5241033cb3a8498377a71c8b1f9c017fcd218cc1 Mon Sep 17 00:00:00 2001
From: flavis <christian@flavigny.de>
Date: Sun, 29 Mar 2020 17:04:25 +0200
Subject: [PATCH] validate bidder responses

---
 package.yaml            |  2 +-
 skat.cabal              |  4 ++--
 src/Skat/Bidding.hs     |  8 +++++++-
 src/Skat/Preperation.hs | 17 +++++++++++++++--
 4 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/package.yaml b/package.yaml
index 5e810a4..eafde5b 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                skat
-version:             0.1.0.1
+version:             0.1.0.5
 github:              "githubuser/skat"
 license:             BSD3
 author:              "flavis"
diff --git a/skat.cabal b/skat.cabal
index 9566bdd..c6fc91f 100644
--- a/skat.cabal
+++ b/skat.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 0b9b42e767fdfcdc821bfc31f5c002e1f6752ba6af032ff402339ef667f60209
+-- hash: 625d9f93a3dec23993347bdccc3746fdf28ac4b67c85ec04a99f505ff61a171f
 
 name:           skat
-version:        0.1.0.1
+version:        0.1.0.5
 description:    Please see the README on Gitea at <https://git.flavigny.de/christian/skat>
 homepage:       https://github.com/githubuser/skat#readme
 bug-reports:    https://github.com/githubuser/skat/issues
diff --git a/src/Skat/Bidding.hs b/src/Skat/Bidding.hs
index 8c613d7..6b5191f 100644
--- a/src/Skat/Bidding.hs
+++ b/src/Skat/Bidding.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Skat.Bidding (
-    biddingScore, Game(..), Modifier(..)
+    biddingScore, Game(..), Modifier(..), isHand
 ) where
 
 import Data.Aeson hiding (Null)
@@ -64,6 +64,12 @@ instance FromJSON Modifier where
                 _ -> return Hand
         else return Einfach
 
+isHand :: Modifier -> Bool
+isHand Einfach   = False
+isHand Schneider = False
+isHand Schwarz   = False
+isHand _         = True
+
 -- | calculate the value of a game with given cards
 biddingScore :: HasCard c => Game -> [c] -> Int
 biddingScore game@(Grand           mod) cards = (spitzen game cards + modifierFactor mod) * 24
diff --git a/src/Skat/Preperation.hs b/src/Skat/Preperation.hs
index 4220bb3..db30d32 100644
--- a/src/Skat/Preperation.hs
+++ b/src/Skat/Preperation.hs
@@ -95,14 +95,27 @@ initGame single bid = do
     -- either return piles or ask for skat cards and modify piles
     ps' <- if noSkat then return ps else handleSkat (bidder bds single) bid ps
     -- ask for game kind
-    (Colour col _) <- askGame (bidder bds single) bid
+    game <- handleGame (bidder bds single) bid noSkat
     -- construct skat env
-    return $ mkSkatEnv ps Nothing col (toPlayers single bds) Hand1
+    return $ mkSkatEnv ps' Nothing Spades (toPlayers single bds) Hand1
+
+handleGame :: BD -> Bid -> Bool -> Preperation Game
+handleGame bd bid noSkat = do
+    -- ask bidder for game
+    proposal <- askGame bd bid
+    -- check if proposal is allowed
+    case proposal of
+        g@(Colour col mod) -> if isHand mod == noSkat
+            then return g else handleGame bd bid noSkat
+        g@(Grand mod) -> if isHand mod == noSkat
+            then return g else handleGame bd bid noSkat
+        g -> return g
 
 handleSkat :: BD -> Bid -> Piles -> Preperation Piles
 handleSkat bd bid ps = do
     let skat = skatCards ps
     skat' <- askSkat bd bid skat
+    liftIO $ putStrLn $ "received skat " ++ show skat'
     case moveToSkat (hand bd) skat' ps of
         Just correct -> return correct
         Nothing -> handleSkat bd bid ps