Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Keep boxxy state

See #39
  • Loading branch information...
commit 9cdd47be90a87754c50bcb819622860ce2aa3898 1 parent ec65091
@jaspervdj jaspervdj authored
View
5 count-von-count/count-von-count.yaml
@@ -61,3 +61,8 @@ boxxies:
port: 8080
path: ""
key: "tetten"
+
+ - host: "10.1.1.200"
+ port: 8120
+ path: ""
+ key: "sup"
View
57 count-von-count/src/CountVonCount/Boxxy.hs
@@ -5,19 +5,21 @@ module CountVonCount.Boxxy
BoxxyConfig (..)
, defaultBoxxyConfig
- -- * State
- , Boxxies
- , newBoxxies
-
-- * Talking to boxxy
, putConfig
, putLaps
, putPosition
+
+ -- * Stateful talking
+ , Boxxies
+ , newBoxxies
+ , withBoxxies
) where
-import Control.Applicative ((<$>),(<*>))
-import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, readMVar)
-import Control.Monad (mzero)
+import Control.Applicative (pure, (<$>),(<*>))
+import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_)
+import Control.Monad (mzero, when)
+import Data.Maybe (isNothing)
import Data.Time (UTCTime)
import Data.Aeson (FromJSON (..), ToJSON (..), (.=), (.:?), (.!=))
@@ -28,8 +30,11 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Conduit as Http
+import CountVonCount.Log (Log)
import CountVonCount.Persistence
import CountVonCount.Types
+import CountVonCount.Util
+import qualified CountVonCount.Log as Log
data BoxxyConfig = BoxxyConfig
{ boxxyHost :: Text
@@ -67,11 +72,6 @@ defaultBoxxyConfig = BoxxyConfig
, boxxyKey = "tetten"
}
-type Boxxies = MVar [(BoxxyConfig, Bool)]
-
-newBoxxies :: [BoxxyConfig] -> IO Boxxies
-newBoxxies = newMVar . map (flip (,) False)
-
makeRequest :: ToJSON a => BoxxyConfig -> Text -> a -> IO ()
makeRequest config path body = do
let rq = Http.def
@@ -128,3 +128,36 @@ putPosition config team time station speed = makeRequest config path $ A.object
]
where
path = T.concat ["/", teamId team, "/position"]
+
+data State = Up | Down
+ deriving (Eq, Show)
+
+data Boxxies = Boxxies
+ { boxxiesState :: MVar [(BoxxyConfig, State)]
+ , boxxiesInit :: BoxxyConfig -> IO ()
+ }
+
+newBoxxies :: [BoxxyConfig] -> (BoxxyConfig -> IO ()) -> IO Boxxies
+newBoxxies configs init' = Boxxies
+ <$> newMVar (map (flip (,) Down) configs)
+ <*> pure init'
+
+withBoxxies :: Log
+ -> Boxxies
+ -> (BoxxyConfig -> IO ())
+ -> IO ()
+withBoxxies logger bs f = modifyMVar_ (boxxiesState bs) $ mapM $ \(c, s) -> do
+ Log.string logger $ "Calling " ++ show c ++ ", currently " ++ show s
+ -- Try to init if needed
+ r <- case s of
+ Down -> isolate logger "boxxy init" $ boxxiesInit bs c
+ Up -> return Nothing
+
+ -- Make the call if up
+ r' <- case r of
+ Nothing -> isolate logger "boxxy call" $ f c
+ Just _ -> return r
+
+ let s' = if isNothing r' then Up else Down
+ when (s /= s') $ Log.string logger $ show c ++ " is now " ++ show s'
+ return (c, if isNothing r' then Up else Down)
View
25 count-von-count/src/CountVonCount/Main.hs
@@ -20,7 +20,6 @@ import CountVonCount.Persistence (Team (..), getAllTeams, runPersistence)
import CountVonCount.Sensor
import CountVonCount.Sensor.Filter
import CountVonCount.Types
-import CountVonCount.Util
import qualified CountVonCount.Log as Log
import qualified CountVonCount.Sensor as Sensor
import qualified CountVonCount.Web as Web
@@ -38,10 +37,9 @@ main = do
pubSub <- WS.newPubSub
-- Initialize boxxy
- isolate_ logger "Initialize boxxy" $ do
- teams <- map snd <$> runPersistence getAllTeams
- forM_ (configBoxxies config) $ \boxxy -> putConfig boxxy
- (configCircuitLength config) (configStations config) teams
+ boxxies <- newBoxxies (configBoxxies config) $ \b -> do
+ ts <- map snd <$> runPersistence getAllTeams
+ putConfig b (configCircuitLength config) (configStations config) ts
-- Connecting the sensor to the counter
sensorChan <- newChan
@@ -61,7 +59,7 @@ main = do
_ <- forkIO $ runCounter counter (configCircuitLength config)
(configMaxSpeed config) (Log.setModule "Counter" logger)
(counterHandler (configCircuitLength config) logger
- (configBoxxies config) pubSub) sensorChan
+ boxxies pubSub) sensorChan
-- Start the baton watchdog
_ <- forkIO $ watchdog counter logger (configBatonWatchdogInterval config)
@@ -69,14 +67,14 @@ main = do
(handler "batonHandler" $
WS.publish pubSub . WS.textData . A.encode . Views.deadBatons)
- Web.listen config (Log.setModule "Web" logger) pubSub counter
+ Web.listen config (Log.setModule "Web" logger) pubSub counter boxxies
putStrLn "Closing..."
Log.close replayLog
Log.close logger
counterHandler :: WS.TextProtocol p
- => Double -> Log -> [BoxxyConfig] -> WS.PubSub p
+ => Double -> Log -> Boxxies -> WS.PubSub p
-> Handler (Team, CounterState, CounterEvent)
counterHandler circuitLength logger boxxies pubSub = handler "counterHandler" $
\(team, cstate, event) -> do
@@ -84,11 +82,10 @@ counterHandler circuitLength logger boxxies pubSub = handler "counterHandler" $
publish $ Views.counterState circuitLength team (Just cstate)
-- Send to boxxies
- forM_ boxxies $ \boxxy -> isolate logger ("Boxxy " ++ show boxxy) $
- case event of
- Lap time speed ->
- putLaps boxxy team time 1 (Just speed) Nothing
- Progression time station speed ->
- putPosition boxxy team time station speed
+ withBoxxies logger boxxies $ \b -> case event of
+ Lap time speed ->
+ putLaps b team time 1 (Just speed) Nothing
+ Progression time station speed ->
+ putPosition b team time station speed
where
publish = WS.publish pubSub . WS.textData . A.encode
View
16 count-von-count/src/CountVonCount/Web.hs
@@ -4,7 +4,7 @@ module CountVonCount.Web
) where
import Control.Applicative (pure, (<$>), (<*>), (<|>))
-import Control.Monad (forM, unless, forM_)
+import Control.Monad (forM, unless)
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Control.Monad.Trans (liftIO)
import Data.Char (isDigit, isLower)
@@ -32,7 +32,6 @@ import CountVonCount.Management
import CountVonCount.Persistence
import CountVonCount.Web.Util
import CountVonCount.Boxxy
-import CountVonCount.Util
import qualified CountVonCount.Log as Log
import qualified CountVonCount.Web.Views as Views
@@ -41,6 +40,7 @@ data WebEnv = WebEnv
, webLog :: Log
, webPubSub :: WS.PubSub WS.Hybi00
, webCounter :: Counter
+ , webBoxxies :: Boxxies
}
type Web = ReaderT WebEnv Snap.Snap
@@ -142,14 +142,13 @@ teamBonus = do
(view, result) <- runForm "bonus" bonusForm
case result of
Just (BonusForm laps' reason) -> do
- boxxies <- configBoxxies . webConfig <$> ask
+ boxxies <- webBoxxies <$> ask
logger <- webLog <$> ask
timestamp <- liftIO getCurrentTime
team' <- runPersistence $ addLaps teamRef timestamp reason laps'
- liftIO $ forM_ boxxies $ \boxxy ->
- isolate logger ("Boxxy " ++ show boxxy ++ " (bonus)") $
- putLaps boxxy team' timestamp laps' Nothing (Just reason)
+ liftIO $ withBoxxies logger boxxies $ \b ->
+ putLaps b team' timestamp laps' Nothing (Just reason)
Snap.redirect "/management"
_ -> Snap.blaze $ Views.teamBonus teamRef team view
@@ -185,8 +184,8 @@ site = Snap.route
, ("/team/:id/reset", teamReset)
] <|> Snap.serveDirectory "static"
-listen :: Config -> Log -> WS.PubSub WS.Hybi00 -> Counter -> IO ()
-listen conf logger pubSub counter =
+listen :: Config -> Log -> WS.PubSub WS.Hybi00 -> Counter -> Boxxies -> IO ()
+listen conf logger pubSub counter boxxies =
Snap.httpServe snapConfig $ runReaderT site env
where
env = WebEnv
@@ -194,6 +193,7 @@ listen conf logger pubSub counter =
, webLog = logger
, webPubSub = pubSub
, webCounter = counter
+ , webBoxxies = boxxies
}
snapConfig = Snap.setPort (configWebPort conf) Snap.defaultConfig
View
2  count-von-count/tests/CountVonCount/Util/Tests.hs
@@ -14,6 +14,6 @@ tests :: Test
tests = testGroup "CountVonCount.Util.Tests"
[ testCase "isolate test" $ assert $ do
logger <- Log.open "/dev/null" False
- isolate logger "isolate test" $ fail "Sup guys"
+ isolate_ logger "isolate test" $ fail "Sup guys"
return True
]
Please sign in to comment.
Something went wrong with that request. Please try again.