{-# LANGUAGE OverloadedStrings #-} module Periodic.Types.ClientCommand ( ClientCommand (..) ) where import Data.Binary import Data.Binary.Get (getWord32be) import Data.Binary.Put (putWord32be) import Periodic.Types.Internal import Periodic.Types.Job (FuncName, Job, JobName) data ClientCommand = SubmitJob Job | Status | Ping | DropFunc FuncName | RemoveJob FuncName JobName | ConfigGet ConfigKey | ConfigSet ConfigKey Int | Dump | Load [Job] | Shutdown | RunJob Job deriving (Show) instance Binary ClientCommand where get = do tp <- getWord8 case tp of 13 -> SubmitJob <$> get 14 -> pure Status 9 -> pure Ping 15 -> DropFunc <$> get 17 -> do fn <- get RemoveJob fn <$> get 20 -> pure Shutdown 22 -> ConfigGet <$> get 23 -> do key <- get val <- getWord32be pure . ConfigSet key $ fromIntegral val 18 -> pure Dump 19 -> Load <$> get 25 -> RunJob <$> get _ -> error $ "Error ClientCommand" ++ show tp put (SubmitJob job) = do putWord8 13 put job put Status = putWord8 14 put Ping = putWord8 9 put (DropFunc func) = do putWord8 15 put func put (RemoveJob fn jn) = do putWord8 17 put fn put jn put Shutdown = putWord8 20 put (ConfigGet key) = do putWord8 22 put key put (ConfigSet k v) = do putWord8 23 put k putWord32be $ fromIntegral v put Dump = putWord8 18 put (Load jobs) = do putWord8 19 put jobs put (RunJob job) = do putWord8 25 put job instance Validatable ClientCommand where validate (SubmitJob job) = validate job validate (DropFunc func) = validate func validate (RemoveJob fn jn) = do validate fn validate jn validate (ConfigGet key) = validate key validate (ConfigSet k v) = do validate k validateNum "ConfigValue" 0 0xFFFFFFFF v validate (Load jobs) = validate jobs validate (RunJob job) = validate job validate _ = Right ()