ServerCommand.hs

{-# LANGUAGE OverloadedStrings #-}
module Periodic.Types.ServerCommand
  ( ServerCommand (..)
  , isSuccess
  , isPong
  ) where

import           Periodic.Types.Internal
import           Periodic.Types.Job      (Job)

import           Data.Binary
import           Data.Binary.Get         (getRemainingLazyByteString,
                                          getWord32be)
import           Data.Binary.Put         (putByteString, putWord32be)
import           Data.ByteString         (ByteString)
import           Data.ByteString.Lazy    (toStrict)

data ServerCommand = Noop
    | JobAssign Job
    | NoJob
    | Pong
    | Unknown
    | Success
    | Config Int
    | Acquired Bool
    | NoWorker
    | Data ByteString
    deriving (Show)

instance Binary ServerCommand where
  get = do
    tp <- getWord8
    case tp of
      0 -> pure Noop
      5 -> JobAssign <$> get
      6 -> pure NoJob
      10 -> pure Pong
      12 -> pure Unknown
      16 -> pure Success
      24 -> do
        val <- getWord32be
        pure . Config $ fromIntegral val
      26 -> do
        v <- getWord8
        pure $ Acquired $ v == 1
      29 -> pure NoWorker
      30 -> Data . toStrict <$> getRemainingLazyByteString
      _  -> error $ "Error ServerCommand" ++ show tp

  put Noop            = putWord8 0
  put (JobAssign job) = do
    putWord8 5
    put job
  put NoJob           = putWord8 6
  put Pong            = putWord8 10
  put Unknown         = putWord8 12
  put Success         = putWord8 16
  put (Config v)      = do
    putWord8 24
    putWord32be $ fromIntegral v
  put (Acquired True)    = do
    putWord8 26
    putWord8 1
  put (Acquired False)    = do
    putWord8 26
    putWord8 0
  put NoWorker            = putWord8 29
  put (Data bs)           = do
    putWord8 30
    putByteString bs

instance Validatable ServerCommand where
  validate (JobAssign job) = validate job
  validate (Config v)      = validateNum "ConfigValue" 0 0xFFFFFFFF v
  validate _               = Right ()


isSuccess :: ServerCommand -> Bool
isSuccess Success = True
isSuccess _       = False

isPong :: ServerCommand -> Bool
isPong Pong = True
isPong _    = False