diff options
author | William Carroll <wpcarro@gmail.com> | 2020-03-28T19·36+0000 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2020-03-28T19·36+0000 |
commit | 37bb04eb5d7c9ccd77926f107ca685039a010e43 (patch) | |
tree | f2e5dc3cb330c62741422ef8436f2845d125d6e4 | |
parent | 778114e6a8930017b82ed8c1a68240a534a1bef5 (diff) |
Start social-fasting app
I'd like to ensure that my /etc/hosts file blocks websites at certains times. I use this to allow / disallow websites at various times of the day. TODO: - Add project README - Add tests - Publish - Create a Nix derivation - Run as a systemd timer unit - Figure out if I can run this as a user rather than root
-rw-r--r-- | tools/website-blocker/main.hs | 110 | ||||
-rw-r--r-- | tools/website-blocker/rules.json | 26 | ||||
-rw-r--r-- | tools/website-blocker/shell.nix | 7 |
3 files changed, 143 insertions, 0 deletions
diff --git a/tools/website-blocker/main.hs b/tools/website-blocker/main.hs new file mode 100644 index 000000000000..47b26a0a2734 --- /dev/null +++ b/tools/website-blocker/main.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE NamedFieldPuns #-} +module Main + ( main + )where + +-------------------------------------------------------------------------------- +-- Dependencies +-------------------------------------------------------------------------------- + +import qualified Data.Maybe as Maybe +import Data.Time.Calendar as Calendar + +-- I'm running this as a systemd timer that runs once per minute. + +-------------------------------------------------------------------------------- +-- Types +-------------------------------------------------------------------------------- + +newtype URL = URL { getURL :: String } deriving (Show) + +newtype IPAddress = IPAddress { getIPAddress :: String } deriving (Show) + +newtype Domain = Domain { getDomain :: String } deriving (Show) + +newtype Hour = Hour { getHour :: Integer } + +newtype Minute = Minute { getMinute :: Integer } + +data EtcHostEntry = EtcHostEntry { ip :: IPAddress + , domains :: [Domain] + } deriving (Show) + + +data TimeRange = TimeRange { beg :: (Hour, Minute) + , end :: (Hour, Minute) + } + +data Allowance = Allowance { day :: Calendar.DayOfWeek + , timeslots :: [TimeRange] + } + +data Rule = Rule { urls :: [URL] + , allowed :: [Allowance] + } + +-------------------------------------------------------------------------------- +-- Functions +-------------------------------------------------------------------------------- + +-- create the current /etc/hosts file +-- schedule the script to run again at the next relevant time + +isToday :: Calendar.DayOfWeek -> Bool +isToday Monday = True +isToday _ = False + +isAllowed :: [Allowance] -> Bool +isAllowed [] = False +isAllowed xs = do + let rules = filter (isToday . day) xs + case rules of + [day] -> True + [] -> False + -- Error when more than one rule per day + _ -> False + +serializeEntry :: EtcHostEntry -> String +serializeEntry EtcHostEntry{ip, domains} = + (getIPAddress ip) ++ "\t" ++ (unwords $ fmap getDomain domains) + +toEtcHostEntry :: Rule -> Maybe EtcHostEntry +toEtcHostEntry Rule{urls, allowed} = + if isAllowed allowed then + Nothing + else + Just $ EtcHostEntry { ip = IPAddress "127.0.0.1" + , domains = fmap (Domain . getURL) urls + } + +-- | Location of the rules.json file. +rulesFile :: FilePath +rulesFile = + "~/.config/website-blocker/rules.json" + +-- | Reads and parses JSON from `rulesFile` and returns the result. +getRules :: IO [Rule] +getRules = pure $ + [ Rule { urls = [ URL "facebook.com" + , URL "twitter.com" + , URL "youtube.com" + , URL "instagram.com" + ] + , allowed = [] + } + , Rule { urls = [ URL "chat.googleplex.com" ] + , allowed = [ Allowance { day = Tuesday + , timeslots = [ TimeRange { beg = (Hour 0, Minute 0) + , end = (Hour 0, Minute 0) + } + ] + } + ] + } + ] + +main :: IO () +main = do + rules <- getRules + let etcHosts = unlines . fmap serializeEntry . Maybe.catMaybes $ fmap toEtcHostEntry rules + putStrLn etcHosts diff --git a/tools/website-blocker/rules.json b/tools/website-blocker/rules.json new file mode 100644 index 000000000000..42094a7cdd14 --- /dev/null +++ b/tools/website-blocker/rules.json @@ -0,0 +1,26 @@ +[ + { + "urls": [ + "facebook.com", + "www.facebook.com", + "twitter.com", + "www.twitter.com", + "youtube.com" + "www.youtube.com" + "instagram.com" + "www.instagram.com" + ], + "allowed": [] + }, + { + "urls": [ + "chat.googleplex.com" + ], + "allowed": [ + { + "day": "Tuesday", + "timeslots": [] + } + ] + } +] diff --git a/tools/website-blocker/shell.nix b/tools/website-blocker/shell.nix new file mode 100644 index 000000000000..fd1889dd891f --- /dev/null +++ b/tools/website-blocker/shell.nix @@ -0,0 +1,7 @@ +let + pkgs = import <nixpkgs> {}; +in pkgs.mkShell { + buildInputs = with pkgs; [ + ghc + ]; +} |