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 some miscellaneous machinery to communicate with adventofcode.com.
  35 type Advent = ReaderT Manager
  36
  37 -- | Run an 'Advent' monad in a MonadIO context.
  38 runAdvent :: MonadIO m => Advent m b -> m b
  39 runAdvent f = do
  40   liftIO $ hSetBuffering stdout NoBuffering
  41   man <- liftIO $ newManager tlsManagerSettings
  42   runReaderT f man
  43
  44 download :: (MonadReader Manager m, MonadIO m, MonadThrow m) => String -> m (Response ByteString)
  45 download url = do
  46   man <- ask
  47   urlreq <- parseRequest url
  48   let req = urlreq
  49         { requestHeaders =
  50           ("User-Agent", "advlib " <> pack (show version) <> " <jlagarespo@protonmail.com>") : requestHeaders urlreq }
  51   session <- liftIO $ getEnv "AOC_SESSION"
  52   let sessionCookie = Cookie
  53         { cookie_name = "session"
  54         , cookie_value = pack session
  55         , cookie_expiry_time = future
  56         , cookie_domain = "adventofcode.com"
  57         , cookie_path = "/"
  58         , cookie_creation_time = past
  59         , cookie_last_access_time = past
  60         , cookie_persistent = False
  61         , cookie_host_only = False
  62         , cookie_secure_only = False
  63         , cookie_http_only = False
  64         }
  65   httpLbs req {cookieJar = Just $ createCookieJar [sessionCookie]} man
  66
  67   where
  68     past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
  69     future = UTCTime (ModifiedJulianDay 562000) (secondsToDiffTime 0)
  70
  71 -- | Retrieve the input for 'day' from 'year', caching it afterwards in the "aocache" directory, if
  72 -- not already.
  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]]