src/Advent.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 module Advent (runAdvent, getDay, cacheAllDays) where
   3
   4 import Control.Concurrent (threadDelay)
   5
   6 import Data.ByteString.Char8 (pack)
   7 import Data.ByteString.Lazy (ByteString)
   8 import qualified Data.Text.Lazy as L
   9 import qualified Data.Text.Lazy.IO as L
  10 import qualified Data.Text.Lazy.Encoding as L
  11
  12 import Data.Time.Clock
  13 import Data.Time.Calendar
  14 import Data.Time.LocalTime
  15 import Data.Time.Format
  16
  17 import Control.Monad.Catch
  18 import Control.Monad.Reader
  19
  20 import System.Directory
  21 import System.Environment
  22
  23 import Network.HTTP.Conduit
  24 import Network.HTTP.Types
  25 import Data.Time (ZonedTime(ZonedTime))
  26
  27 import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)
  28
  29 import Data.Version (showVersion)
  30 import Paths_advlib (version)
  31
  32 runAdvent :: MonadIO m => ReaderT Manager m b -> m b
  33 runAdvent f = do
  34   liftIO $ hSetBuffering stdout NoBuffering
  35   man <- liftIO $ newManager tlsManagerSettings
  36   runReaderT f man
  37
  38 download :: (MonadReader Manager m, MonadIO m, MonadThrow m) => String -> m (Response ByteString)
  39 download url = do
  40   man <- ask
  41   urlreq <- parseRequest url
  42   let req = urlreq
  43         { requestHeaders =
  44           ("User-Agent", "advlib " <> pack (show version) <> " <jlagarespo@protonmail.com>") : requestHeaders urlreq }
  45   session <- liftIO $ getEnv "AOC_SESSION"
  46   let sessionCookie = Cookie
  47         { cookie_name = "session"
  48         , cookie_value = pack session
  49         , cookie_expiry_time = future
  50         , cookie_domain = "adventofcode.com"
  51         , cookie_path = "/"
  52         , cookie_creation_time = past
  53         , cookie_last_access_time = past
  54         , cookie_persistent = False
  55         , cookie_host_only = False
  56         , cookie_secure_only = False
  57         , cookie_http_only = False
  58         }
  59   httpLbs req {cookieJar = Just $ createCookieJar [sessionCookie]} man
  60
  61   where
  62     past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
  63     future = UTCTime (ModifiedJulianDay 562000) (secondsToDiffTime 0)
  64
  65 getDay :: (MonadReader Manager m, MonadIO m, MonadThrow m) => Int -> Int -> m String
  66 getDay year day = do
  67   cached <- liftIO $ doesFileExist dayCache
  68   if cached
  69     then liftIO $ readFile dayCache
  70     else do
  71       liftIO $ putStrLn $ "Caching " <> show year <> "/" <> show day
  72       liftIO $ createDirectoryIfMissing True cacheDir
  73       day <- retreiveDay
  74       liftIO $ writeFile dayCache day
  75       pure day
  76
  77   where
  78     cacheDir   = "aocache/"
  79     dayCache   = cacheDir <> show year <> "." <> show day
  80
  81     retreiveDay = do
  82       day <- download $ "https://adventofcode.com/" <> show year <> "/day/" <> show day <> "/input"
  83       if statusCode (responseStatus day) == 200
  84         then do
  85           let body = L.unpack . L.decodeUtf8 . responseBody
  86           pure $ body day
  87         else do
  88           currentTime <- liftIO getCurrentTime
  89           let estTime = utcToZonedTime (hoursToTimeZone (-5)) currentTime
  90               dayTime = zonedTimeToUTC $ estTime { zonedTimeToLocalTime = (zonedTimeToLocalTime estTime) { localTimeOfDay = midnight } }
  91               dayTime' | currentTime > dayTime = addUTCTime nominalDay dayTime
  92                        | otherwise = dayTime
  93           countdown dayTime'
  94           retreiveDay
  95
  96     countdown dest = do
  97       current <- liftIO getCurrentTime
  98       when (current <= dest) $ do
  99         let remaining = dest `diffUTCTime` current
 100         liftIO $ putStr $ formatTime defaultTimeLocale "%H:%M:%S\r" remaining
 101         liftIO $ threadDelay 1000000
 102         countdown dest
 103
 104 cacheAllDays :: (MonadReader Manager m, MonadIO m, MonadThrow m) => m ()
 105 cacheAllDays = sequence_ [getDay year day | year <- [2015..2021], day <- [1..25]]