-m flag for monitoring a specific domain

README.md

@@ -10,7 +10,7 @@ Create a file `config` which contains a single line representing a HTTPS endpoin
 ```
 > cat config
 https://hooks.slack.com/services/xxxxxxxxxxx/xxxxxxxxxxx/xxxxxxxxxxxxxxxxxxxxxxxx
-> sudo ./dnsflare
+> sudo ./dnsflare --monitor-domain=example.com
 ```
 
 Run the service on at least two internet-routable hosts. Then, configure your DNS records to point to your two new nameservers.
@@ -57,9 +57,10 @@ dnsflare [OPTIONS]
   DNS Flare
 
 Common flags:
-  -c --cache-length=INT
-  -? --help              Display help message
-  -V --version           Print version information
+  -c --cache-length=INT   
+  -m --monitor-domain=ITEM
+  -? --help                 Display help message
+  -V --version              Print version information
 ```
 
 By default, the cache length is 10. You can change it with the `-c` CLI arg.

src/app/Main.hs

@@ -8,6 +8,7 @@ runDns :: Args
 runDns =
   ArgsServer
     { cache_length = 10
+    , monitor_domain = Nothing
     } &= name "dns"
 
 mode :: Mode (CmdArgs Args)

src/src/Args.hs

@@ -7,6 +7,7 @@ import           System.Console.CmdArgs
 data Args =
   ArgsServer
     { cache_length :: Int
+    , monitor_domain :: Maybe String
     }
   deriving (Show, Data, Typeable)
 

src/src/Lib.hs

@@ -8,7 +8,6 @@ import Control.Monad (unless, forever, void)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import           Data.ByteString (ByteString)
-import qualified Data.Text as T
 import Network.Socket
 import Network.Socket.ByteString (recv, sendAll)
 import qualified Network.DNS.IO as DNS.IO
@@ -26,12 +25,12 @@ import           Args
 data Model =
   Model
     { qc :: QC.Model
-    , webhook :: String
+    , webhook :: Slack.Model
     }
 
 init :: Args -> IO Model
 init args = do
-  webhook <- readFile "config" >>= return . T.unpack . T.strip . T.pack
+  webhook <- Slack.init args
   qc <- QC.init $ cache_length args
   return $ Model
     { qc = qc

src/src/SlackHook.hs

@@ -1,43 +1,81 @@
 {-# LANGUAGE OverloadedStrings #-}
 module SlackHook
-  (push) where
+  (Model, SlackHook.init, push) where
 
+import qualified Args
+import qualified Data.Text as T
 import Control.Monad.IO.Class
 import Data.Aeson
-import Network.HTTP.Req
-import Text.URI
+import Data.Maybe
 import Data.Text
+import Text.URI
+import Network.HTTP.Req
+
+data Model =
+  Model
+    { hook :: String
+    , monitor_domain :: Maybe String
+    }
 
-push :: String -> String -> IO ()
-push hookUri domain = do
+init :: Args.Args -> IO Model
+init args = do
+  webhook <- readFile "config" >>= return . T.unpack . T.strip . T.pack
+  return $ Model
+    { hook = webhook
+    , monitor_domain = normalizeMonitorDomain $ Args.monitor_domain args
+    }
+
+normalizeMonitorDomain :: Maybe String -> Maybe String
+normalizeMonitorDomain Nothing = Nothing
+normalizeMonitorDomain (Just s) =
+  Just $ before ++ s ++ after
+  where
+    before = case Prelude.head s == '.' of
+      True -> ""
+      False -> "."
+    after = case Prelude.last s == '.' of
+      True -> ""
+      False -> "."
+
+push :: Model -> String -> IO ()
+push model domain = do
   let payload =
         object
           [ "text" .= ("`" ++ domain ++ "`" :: String)
           , "username" .= ("DNS Flare" :: String)
           ]
-  uri <- mkURI $ Data.Text.pack hookUri
-  case useHttpsURI uri of
-    Nothing -> do
-      putStrLn "Failed to parse URI"
+  case shouldRelayQuery model domain of
+    False ->
       return ()
-    Just (url, option) -> do
-      -- eres <- tryAny $ runReq defaultHttpConfig $ do
-      runReq defaultHttpConfig $ do
-        r <-
-          req
-            POST
-            url
-            (ReqBodyJson payload)
-            ignoreResponse
-            mempty
-        liftIO $ case responseStatusCode r of
-          200 ->
-            return ()
-          x ->
-            putStrLn $ "Slack Failed with status code " ++ show x
-      -- case eres of
-      --   Left e ->
-      --     putStrLn $ show e
-      --   Right io ->
-      --     return io
+    True -> do
+      uri <- mkURI $ Data.Text.pack $ hook model
+      case useHttpsURI uri of
+        Nothing -> do
+          putStrLn "Failed to parse URI"
+          return ()
+        Just (url, option) -> do
+          -- eres <- tryAny $ runReq defaultHttpConfig $ do
+          runReq defaultHttpConfig $ do
+            r <-
+              req
+                POST
+                url
+                (ReqBodyJson payload)
+                ignoreResponse
+                mempty
+            liftIO $ case responseStatusCode r of
+              200 ->
+                return ()
+              x ->
+                putStrLn $ "Slack Failed with status code " ++ show x
+          -- case eres of
+          --   Left e ->
+          --     putStrLn $ show e
+          --   Right io ->
+          --     return io
+
+
 
+shouldRelayQuery :: Model -> String -> Bool
+shouldRelayQuery model domain =
+  fromMaybe True $ (\s -> s `isSuffixOf` (T.pack domain)) <$> T.pack <$> monitor_domain model