Merge pull request #48 from 21-23/feature/solution-sync

Feature/solution sync

app/Main.hs

@@ -66,7 +66,7 @@ stopRound stateVar pool connection sessionId = do
   state <- readMVar stateVar
   case State.getSession sessionId state of
     Just session -> do
-      updateState stateVar (State.clearSandboxTransactions . State.setRoundPhase sessionId End)
+      updateState stateVar (State.resetSyncSolutions sessionId . State.clearSandboxTransactions . State.setRoundPhase sessionId End)
       mongo $ update sessionId [RoundPhase =. End, Rounds =. Session.rounds session]
       case State.getSandboxStatus sessionId state of
         Just (Ready sandboxIdentity) -> do
@@ -137,6 +137,9 @@ roundCountdownAction timer stateVar pool sessionId connection = do
       case countdownValue of
         Just 0 -> do
           stopRound stateVar pool connection sessionId
+          case State.getSolutionSyncTimer sessionId state of
+            Just solutionSyncTimer -> stopTimer solutionSyncTimer
+            Nothing -> putStrLn $ "SolutionSyncTimer not found: " ++ show sessionId
           stopTimer timer -- has to be the last statement because it kills the thread
 
         Just value -> do
@@ -148,6 +151,16 @@ roundCountdownAction timer stateVar pool sessionId connection = do
         Nothing -> return ()
     Nothing -> putStrLn $ "Session not found: " ++ show sessionId
 
+solutionSyncAction :: MVar State -> SessionId -> WS.Connection -> IO ()
+solutionSyncAction stateVar sessionId connection = do
+  state <- readMVar stateVar
+  case State.getSession sessionId state of
+    Just session ->
+      unless (State.syncSolutionsEmpty sessionId state) $ do
+        sendMessage connection (AnyOfType FrontService) $ SolutionSync sessionId session
+        updateState stateVar $ State.resetSyncSolutions sessionId
+    Nothing      -> putStrLn $ "Session not found: " ++ show sessionId
+
 requestSandbox :: WS.Connection -> MVar State -> SessionId -> Game -> IO ()
 requestSandbox connection stateVar sessionId game = do
   updateState stateVar $ State.setSandboxStatus sessionId Requested
@@ -268,9 +281,13 @@ app config stateVar pool connection = do
                       let countdownValue = 2
                       updateState stateVar $ State.setStartCountdown sessionId countdownValue
                       mongo $ update sessionId [StartCountdown =. countdownValue]
-                      case State.getStartTimer sessionId state of
-                        Just timer -> do
-                          _ <- repeatedStart timer (startCountdownAction timer stateVar pool sessionId connection) (sDelay 1)
+                      let timers = (,)
+                                    <$> State.getStartTimer sessionId state
+                                    <*> State.getSolutionSyncTimer sessionId state
+                      case timers of
+                        Just (startTimer, solutionSyncTimer) -> do
+                          _ <- repeatedStart startTimer (startCountdownAction startTimer stateVar pool sessionId connection) (sDelay 1)
+                          _ <- repeatedStart solutionSyncTimer (solutionSyncAction stateVar sessionId connection) (msDelay 200)
                           sendMessage connection (AnyOfType FrontService) $ StartCountdownChanged sessionId $ countdownValue + 1
                         Nothing -> putStrLn $ "Timer error for session " ++ show sessionId
                     Nothing -> putStrLn $ "Puzzle not found: index " ++ show puzzleIndex

src/Message.hs

@@ -6,6 +6,7 @@ module Message where
 
 import Control.Monad
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)
 import Data.Aeson
 import Data.Semigroup
@@ -27,6 +28,7 @@ import SolutionCorrectness (SolutionCorrectness(..))
 import Game (Game)
 import ServiceIdentity (ServiceIdentity, ServiceType)
 import SandboxStatus (toSimpleJSON)
+import Solution(Solution(..))
 
 type ConnectionId = String
 
@@ -65,6 +67,7 @@ data OutgoingMessage
   | GameMasterSessionState SessionId ParticipantUid Session
   | ServiceRequest ServiceIdentity ServiceType
   | SessionSandboxReady SessionId
+  | SolutionSync SessionId Session
 
 toName :: OutgoingMessage -> Text
 toName ArnauxCheckin {}           = "checkin"
@@ -88,6 +91,7 @@ toName PlayerSessionState {}      = "player.sessionState"
 toName GameMasterSessionState {}  = "gameMaster.sessionState"
 toName ServiceRequest {}          = "service.request"
 toName SessionSandboxReady {}     = "sandbox.status"
+toName SolutionSync {}            = "solution.sync"
 
 instance ToJSON OutgoingMessage where
   toJSON message = object $ ["name" .= toName message] <> toValue message
@@ -196,6 +200,17 @@ instance ToJSON OutgoingMessage where
         [ "sessionId" .= sessionId
         , "status"    .= String "ready"
         ]
+      toValue (SolutionSync sessionId session) =
+        [ "sessionId" .= sessionId
+        , "solutions" .= (transform <$> syncSolutions session)
+        ]
+        where
+          transform Solution {code, time, correct} =
+            object
+              [ "length"  .= Text.length code
+              , "time"    .= time
+              , "correct" .= correct
+              ]
 
 getPuzzleForSessionState :: Session -> Maybe Puzzle
 getPuzzleForSessionState session =

src/Session.hs

@@ -61,6 +61,7 @@ Session json
     startCountdown Int
     roundCountdown Int
     alias          SessionAlias
+    syncSolutions  (Map ParticipantUid Solution)
 |]
 
 addParticipant :: Participant -> Session -> Session
@@ -115,11 +116,14 @@ getSolutionTime time session =
     Nothing -> 0
 
 addSolution :: ParticipantUid -> Solution -> Session -> Session
-addSolution participantId solution session@Session{rounds} =
+addSolution participantId solution session@Session{rounds, syncSolutions} =
   case getCurrentRound session of
     Nothing -> session
     Just currentRound@Round{solutions} ->
-      session { rounds = Seq.update (Seq.length rounds - 1) updatedRound rounds }
+      session
+        { rounds = Seq.update (Seq.length rounds - 1) updatedRound rounds
+        , syncSolutions = Map.insert participantId solution syncSolutions
+        }
         where updatedRound = currentRound { solutions = Map.insert participantId solution solutions }
 
 getSolution :: ParticipantUid -> Session -> Maybe Solution

src/State.hs

@@ -6,7 +6,7 @@ import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Sequence as Seq
 import           Data.Maybe (fromMaybe)
-import           Control.Concurrent.Timer
+import           Control.Concurrent.Timer (TimerIO, newTimer, stopTimer)
 import           Data.UUID (UUID)
 import           Data.UUID.V4 (nextRandom)
 import           Data.Text (Text)
@@ -38,8 +38,9 @@ data State = State
   }
 
 data SessionTimers = SessionTimers
-  { startTimer :: TimerIO
-  , roundTimer :: TimerIO
+  { startTimer        :: TimerIO
+  , roundTimer        :: TimerIO
+  , solutionSyncTimer :: TimerIO
   }
 
 empty :: State
@@ -65,13 +66,15 @@ createSession game gameMasterId alias puzzleList = Session
   , startCountdown = 0
   , roundCountdown = 0
   , alias
+  , syncSolutions  = Map.empty
   }
 
 createTimers :: IO SessionTimers
 createTimers = do
   startTmr <- newTimer
   roundTmr <- newTimer
-  return $ SessionTimers startTmr roundTmr
+  solutionSyncTimer <- newTimer
+  return $ SessionTimers startTmr roundTmr solutionSyncTimer
 
 createSandboxTransaction :: SessionId -> ParticipantUid -> Text -> UTCTime -> IO SandboxTransaction
 createSandboxTransaction sessionId participantId input time = do
@@ -95,9 +98,13 @@ getStartTimer sessionId State{timers} = startTimer <$> Map.lookup sessionId time
 getRoundTimer :: SessionId -> State -> Maybe TimerIO
 getRoundTimer sessionId State{timers} = roundTimer <$> Map.lookup sessionId timers
 
+getSolutionSyncTimer :: SessionId -> State -> Maybe TimerIO
+getSolutionSyncTimer sessionId State{timers} = solutionSyncTimer <$> Map.lookup sessionId timers
+
 stopTimers :: SessionId -> State -> IO ()
 stopTimers sessionId state = do
   fromMaybe (return ()) $ stopTimer <$> getStartTimer sessionId state
+  fromMaybe (return ()) $ stopTimer <$> getSolutionSyncTimer sessionId state
   fromMaybe (return ()) $ stopTimer <$> getRoundTimer sessionId state
 
 addSession :: Session -> SessionId -> SessionTimers -> State -> State
@@ -205,3 +212,13 @@ getSessionForSandbox :: State -> ServiceType -> Maybe SessionId
 getSessionForSandbox State{sessions} (SandboxService sandboxGame) =
   fst <$> find (\(_, Session{game}) -> game == sandboxGame) (Map.toList sessions)
 getSessionForSandbox _ _ = Nothing
+
+syncSolutionsEmpty :: SessionId -> State -> Bool
+syncSolutionsEmpty sessionId State{sessions} = fromMaybe False $ do
+  session <- Map.lookup sessionId sessions
+  return $ Map.null $ syncSolutions session
+
+resetSyncSolutions :: SessionId -> State -> State
+resetSyncSolutions sessionId state@State{sessions} =
+  state { sessions = Map.adjust modify sessionId sessions }
+    where modify session = session { syncSolutions = Map.empty }