Check server network status via icmp once api down.

src/Lib.hs

 module Lib
-    ( someFunc
+    ( someFunc,
+      checkServerConn
     ) where
 
 import Data.Time.Clock
@@ -7,6 +8,7 @@ import Data.Time.Clock
 import Data.Time.Calendar.OrdinalDate
 import Network.HTTP
 import System.Process
+import System.Exit (ExitCode(ExitSuccess))
 import Control.Monad
 import Control.Exception
 import Control.Concurrent (threadDelay)
@@ -46,6 +48,12 @@ buildCMD wh msg =
   "}" ++
   "}'"
 
+checkServerConn :: IO Bool
+checkServerConn = system "ping -q -c 1 -w 10 69.234.216.199"
+  >>= \code -> case code of
+                 ExitSuccess -> return True
+                 _ -> return False
+
 onFailure :: MonitorItem -> IO MonitorItem
 onFailure mi = do
   needNotify <- notifyRequire
@@ -63,9 +71,14 @@ onFailure mi = do
 
     doNotify :: IO MonitorItem
     doNotify = do
-      let cmd = buildCMD webHook ("Fail to access api " ++ url mi)
+
+      connected <- checkServerConn
+      let cmd = if connected
+            then buildCMD webHook ("Fail to access api " ++ url mi)
+            else buildCMD webHook "Server (69.234.216.199) down"
+
       current <- getCurrentTime
-      -- FIXME: system may failed need to check it's return code
+            -- FIXME: system may failed need to check it's return code
       system cmd >> return (MI (url mi) False current)
 
 onSuccess :: MonitorItem -> IO MonitorItem

stack.yaml

@@ -31,6 +31,7 @@ resolver:
 #   - wai
 packages:
 - .
+
 # Dependency packages to be pulled from upstream that are not in the resolver.
 # These entries can reference officially published versions as well as
 # forks / in-progress versions pinned to a git hash. For example:
@@ -40,7 +41,8 @@ packages:
 # - git: https://github.com/commercialhaskell/stack.git
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
 #
-extra-deps: ["Cabal-syntax-3.8.1.0@sha256:4936765e9a7a8ecbf8fdbe9067f6d972bc0299220063abb2632a9950af64b966,7619"]
+extra-deps:
+- Cabal-syntax-3.8.1.0@sha256:4936765e9a7a8ecbf8fdbe9067f6d972bc0299220063abb2632a9950af64b966,7619
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

test/Spec.hs

+import Lib
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = do
+  connected <- checkServerConn
+  print connected