src/Advent.hs

   1 -- | The 'AOC_SESSION' environment variable must be set to the "session" cookie that
   2 -- adventofcode.com gives you upon logging in.
   3 {-# LANGUAGE FlexibleContexts #-}
   4 module Advent (Advent, runAdvent, getDay, cacheAllDays) where
   5
   6 import Control.Concurrent (threadDelay)
   7
   8 import Data.ByteString.Char8 (pack)
   9 import Data.ByteString.Lazy (ByteString)
  10 import qualified Data.Text.Lazy as L
  11 import qualified Data.Text.Lazy.IO as L
  12 import qualified Data.Text.Lazy.Encoding as L
  13
  14 import Data.Time.Clock
  15 import Data.Time.Calendar
  16 import Data.Time.LocalTime
  17 import Data.Time.Format
  18
  19 import Control.Monad.Catch
  20 import Control.Monad.Reader
  21
  22 import System.Directory
  23 import System.Environment
  24
  25 import Network.HTTP.Conduit
  26 import Network.HTTP.Types
  27 import Data.Time (ZonedTime(ZonedTime))
  28
  29 import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)
  30
  31 import Data.Version (showVersion)
  32 import Paths_advlib (version)
  33
  34 -- | The 'Advent' monad carries all the necessary information to communicate with the Advent of Code
  35 -- website.
  36 type Advent = ReaderT Manager
  37
  38 -- | Run an 'Advent' monad 'f' in a MonadIO context.
  39 runAdvent :: MonadIO m => Advent m b -> m b
  40 runAdvent f = do
  41   liftIO $ hSetBuffering stdout NoBuffering
  42   man <- liftIO $ newManager tlsManagerSettings
  43   runReaderT f man
  44
  45 download :: (MonadReader Manager m, MonadIO m, MonadThrow m) => String -> m (Response ByteString)
  46 download url = do
  47   man <- ask
  48   urlreq <- parseRequest url
  49   let req = urlreq
  50         { requestHeaders =
  51           ("User-Agent", "advlib " <> pack (show version) <> " <jlagarespo@protonmail.com>") : requestHeaders urlreq }
  52   session <- liftIO $ getEnv "AOC_SESSION"
  53   let sessionCookie = Cookie
  54         { cookie_name = "session"
  55         , cookie_value = pack session
  56         , cookie_expiry_time = future
  57         , cookie_domain = "adventofcode.com"
  58         , cookie_path = "/"
  59         , cookie_creation_time = past
  60         , cookie_last_access_time = past
  61         , cookie_persistent = False
  62         , cookie_host_only = False
  63         , cookie_secure_only = False
  64         , cookie_http_only = False
  65         }
  66   httpLbs req {cookieJar = Just $ createCookieJar [sessionCookie]} man
  67
  68   where
  69     past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
  70     future = UTCTime (ModifiedJulianDay 562000) (secondsToDiffTime 0)
  71
  72 -- | Retrieve the input for 'day' from 'year'.
  73 getDay :: (MonadReader Manager m, MonadIO m, MonadThrow m) => Int -> Int -> m String
  74 getDay year day = do
  75   cached <- liftIO $ doesFileExist dayCache
  76   if cached
  77     then liftIO $ readFile dayCache
  78     else do
  79       liftIO $ putStrLn $ "Caching " <> show year <> "/" <> show day
  80       liftIO $ createDirectoryIfMissing True cacheDir
  81       day <- retreiveDay
  82       liftIO $ writeFile dayCache day
  83       pure day
  84
  85   where
  86     cacheDir = "aocache/"
  87     dayCache = cacheDir <> show year <> "." <> show day
  88
  89     retreiveDay = do
  90       day <- download $ "https://adventofcode.com/" <> show year <> "/day/" <> show day <> "/input"
  91       if statusCode (responseStatus day) == 200
  92         then do
  93           let body = L.unpack . L.decodeUtf8 . responseBody
  94           pure $ body day
  95         else do
  96           currentTime <- liftIO getCurrentTime
  97           let estTime = utcToZonedTime (hoursToTimeZone (-5)) currentTime
  98               dayTime = zonedTimeToUTC $ estTime { zonedTimeToLocalTime = (zonedTimeToLocalTime estTime) { localTimeOfDay = midnight } }
  99               dayTime' | currentTime > dayTime = addUTCTime nominalDay dayTime
 100                        | otherwise = dayTime
 101           countdown dayTime'
 102           retreiveDay
 103
 104     countdown dest = do
 105       current <- liftIO getCurrentTime
 106       when (current <= dest) $ do
 107         let remaining = dest `diffUTCTime` current
 108         liftIO $ putStr $ formatTime defaultTimeLocale "%H:%M:%S\r" remaining
 109         liftIO $ threadDelay 1000000
 110         countdown dest
 111
 112 -- | Download and cache all days from all years. Not recommended in general since 'getDay' will
 113 -- already download the appropriate files whenever necessary. You may use this function if, for
 114 -- example, you're not going to have internet access in the future, and would like to cache all the
 115 -- days in advance for offline use.
 116 cacheAllDays :: (MonadReader Manager m, MonadIO m, MonadThrow m) => m ()
 117 cacheAllDays = sequence_ [getDay year day | year <- [2015..2021], day <- [1..25]]