{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ViewPatterns #-}
module Advent (
AoC(..)
, Part(..)
, Day(..)
, NextDayTime(..)
, AoCOpts(..)
, SubmitRes(..), showSubmitRes
, runAoC
, runAoC_
, defaultAoCOpts
, AoCError(..)
, challengeReleaseTime
, timeToRelease
, challengeReleased
, mkDay, mkDay_, dayInt, pattern DayInt, _DayInt
, aocDay
, aocServerTime
, partChar, partInt
, fullDailyBoard
, setAoCThrottleLimit, getAoCThrottleLimit
, aocReq
, aocBase
) where
import Advent.API
import Advent.Cache
import Advent.Throttle
import Advent.Types
import Control.Concurrent.STM
import Control.Exception
import Control.Monad
import Control.Monad.Except
import Data.Kind
import Data.Map (Map)
import Data.Maybe
import Data.Set (Set)
import Data.Text (Text)
import Data.Time hiding (Day)
import Data.Typeable
import GHC.Generics (Generic)
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Servant.API
import Servant.Client
import System.Directory
import System.FilePath
import Text.Printf
import qualified Data.Aeson as A
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Servant.Client as Servant
import qualified System.IO.Unsafe as Unsafe
#if MIN_VERSION_base(4,11,0)
import Data.Functor
#else
import Data.Semigroup ((<>))
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip fmap
#endif
initialThrottleLimit :: Int
initialThrottleLimit :: Int
initialThrottleLimit = Int
100
aocThrottler :: Throttler
aocThrottler :: Throttler
aocThrottler = IO Throttler -> Throttler
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Throttler -> Throttler) -> IO Throttler -> Throttler
forall a b. (a -> b) -> a -> b
$ Int -> IO Throttler
newThrottler Int
initialThrottleLimit
{-# NOINLINE aocThrottler #-}
setAoCThrottleLimit :: Int -> IO ()
setAoCThrottleLimit :: Int -> IO ()
setAoCThrottleLimit = Throttler -> Int -> IO ()
setLimit Throttler
aocThrottler
getAoCThrottleLimit :: IO Int
getAoCThrottleLimit :: IO Int
getAoCThrottleLimit = Throttler -> IO Int
getLimit Throttler
aocThrottler
data AoC :: Type -> Type where
AoCPrompt
:: Day
-> AoC (Map Part Text)
AoCInput :: Day -> AoC Text
AoCSubmit
:: Day
-> Part
-> String
-> AoC (Text, SubmitRes)
AoCLeaderboard
:: Integer
-> AoC Leaderboard
AoCDailyLeaderboard
:: Day
-> AoC DailyLeaderboard
AoCGlobalLeaderboard
:: AoC GlobalLeaderboard
AoCNextDayTime
:: AoC NextDayTime
deriving instance Show (AoC a)
deriving instance Typeable (AoC a)
aocDay :: AoC a -> Maybe Day
aocDay :: AoC a -> Maybe Day
aocDay (AoCPrompt Day
d ) = Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
aocDay (AoCInput Day
d ) = Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
aocDay (AoCSubmit Day
d Part
_ String
_ ) = Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
aocDay (AoCLeaderboard Integer
_) = Maybe Day
forall a. Maybe a
Nothing
aocDay (AoCDailyLeaderboard Day
d) = Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
aocDay AoC a
AoCGlobalLeaderboard = Maybe Day
forall a. Maybe a
Nothing
aocDay AoC a
AoCNextDayTime = Maybe Day
forall a. Maybe a
Nothing
data AoCError
#if MIN_VERSION_servant_client_core(0,16,0)
= AoCClientError ClientError
#else
= AoCClientError ServantError
#endif
| AoCReleaseError NominalDiffTime
| AoCThrottleError
deriving (Int -> AoCError -> ShowS
[AoCError] -> ShowS
AoCError -> String
(Int -> AoCError -> ShowS)
-> (AoCError -> String) -> ([AoCError] -> ShowS) -> Show AoCError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AoCError] -> ShowS
$cshowList :: [AoCError] -> ShowS
show :: AoCError -> String
$cshow :: AoCError -> String
showsPrec :: Int -> AoCError -> ShowS
$cshowsPrec :: Int -> AoCError -> ShowS
Show, Typeable, (forall x. AoCError -> Rep AoCError x)
-> (forall x. Rep AoCError x -> AoCError) -> Generic AoCError
forall x. Rep AoCError x -> AoCError
forall x. AoCError -> Rep AoCError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AoCError x -> AoCError
$cfrom :: forall x. AoCError -> Rep AoCError x
Generic)
instance Exception AoCError
data AoCOpts = AoCOpts
{
AoCOpts -> String
_aSessionKey :: String
, AoCOpts -> Integer
_aYear :: Integer
, AoCOpts -> Maybe String
_aCache :: Maybe FilePath
, AoCOpts -> Bool
_aForce :: Bool
, AoCOpts -> Int
_aThrottle :: Int
}
deriving (Int -> AoCOpts -> ShowS
[AoCOpts] -> ShowS
AoCOpts -> String
(Int -> AoCOpts -> ShowS)
-> (AoCOpts -> String) -> ([AoCOpts] -> ShowS) -> Show AoCOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AoCOpts] -> ShowS
$cshowList :: [AoCOpts] -> ShowS
show :: AoCOpts -> String
$cshow :: AoCOpts -> String
showsPrec :: Int -> AoCOpts -> ShowS
$cshowsPrec :: Int -> AoCOpts -> ShowS
Show, Typeable, (forall x. AoCOpts -> Rep AoCOpts x)
-> (forall x. Rep AoCOpts x -> AoCOpts) -> Generic AoCOpts
forall x. Rep AoCOpts x -> AoCOpts
forall x. AoCOpts -> Rep AoCOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AoCOpts x -> AoCOpts
$cfrom :: forall x. AoCOpts -> Rep AoCOpts x
Generic)
defaultAoCOpts
:: Integer
-> String
-> AoCOpts
defaultAoCOpts :: Integer -> String -> AoCOpts
defaultAoCOpts Integer
y String
s = AoCOpts :: String -> Integer -> Maybe String -> Bool -> Int -> AoCOpts
AoCOpts
{ _aSessionKey :: String
_aSessionKey = String
s
, _aYear :: Integer
_aYear = Integer
y
, _aCache :: Maybe String
_aCache = Maybe String
forall a. Maybe a
Nothing
, _aForce :: Bool
_aForce = Bool
False
, _aThrottle :: Int
_aThrottle = Int
3000000
}
aocBase :: BaseUrl
aocBase :: BaseUrl
aocBase = Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
"adventofcode.com" Int
443 String
""
aocReq :: Integer -> AoC a -> ClientM a
aocReq :: Integer -> AoC a -> ClientM a
aocReq Integer
yr = \case
AoCPrompt Day
i -> let ClientM (Map Part Text)
r :<|> ClientM Text :<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))
_ = Integer
-> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
adventAPIPuzzleClient Integer
yr Day
i in ClientM a
ClientM (Map Part Text)
r
AoCInput Day
i -> let ClientM (Map Part Text)
_ :<|> ClientM Text
r :<|> SubmitInfo -> ClientM (Text :<|> SubmitRes)
_ = Integer
-> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
adventAPIPuzzleClient Integer
yr Day
i in ClientM a
ClientM Text
r
AoCSubmit Day
i Part
p String
ans -> let ClientM (Map Part Text)
_ :<|> ClientM Text
_ :<|> SubmitInfo -> ClientM (Text :<|> SubmitRes)
r = Integer
-> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
adventAPIPuzzleClient Integer
yr Day
i
in SubmitInfo -> ClientM (Text :<|> SubmitRes)
r (Part -> String -> SubmitInfo
SubmitInfo Part
p String
ans) ClientM (Text :<|> SubmitRes)
-> ((Text :<|> SubmitRes) -> (Text, SubmitRes))
-> ClientM (Text, SubmitRes)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Text
x :<|> SubmitRes
y) -> (Text
x, SubmitRes
y)
AoCLeaderboard Integer
c -> let ClientM NextDayTime
_ :<|> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
_ :<|> ClientM GlobalLeaderboard
_ :<|> Day -> ClientM DailyLeaderboard
_ :<|> PublicCode -> ClientM Leaderboard
r = Integer
-> ClientM NextDayTime
:<|> ((Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
:<|> (ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard))))
adventAPIClient Integer
yr
in PublicCode -> ClientM Leaderboard
r (Integer -> PublicCode
PublicCode Integer
c)
AoCDailyLeaderboard Day
d -> let ClientM NextDayTime
_ :<|> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
_ :<|> ClientM GlobalLeaderboard
_ :<|> Day -> ClientM DailyLeaderboard
r :<|> PublicCode -> ClientM Leaderboard
_ = Integer
-> ClientM NextDayTime
:<|> ((Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
:<|> (ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard))))
adventAPIClient Integer
yr
in Day -> ClientM DailyLeaderboard
r Day
d
AoC a
AoCGlobalLeaderboard -> let ClientM NextDayTime
_ :<|> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
_ :<|> ClientM GlobalLeaderboard
r :<|> (Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard)
_ = Integer
-> ClientM NextDayTime
:<|> ((Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
:<|> (ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard))))
adventAPIClient Integer
yr
in ClientM a
ClientM GlobalLeaderboard
r
AoC a
AoCNextDayTime -> let ClientM NextDayTime
r :<|> (Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
:<|> (ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard)))
_ = Integer
-> ClientM NextDayTime
:<|> ((Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
:<|> (ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard))))
adventAPIClient Integer
yr
in ClientM a
ClientM NextDayTime
r
apiCache
:: Maybe String
-> Integer
-> AoC a
-> Maybe FilePath
apiCache :: Maybe String -> Integer -> AoC a -> Maybe String
apiCache Maybe String
sess Integer
yr = \case
AoCPrompt Day
d -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> Integer -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"prompt/%04d/%02d.html" Integer
yr (Day -> Integer
dayInt Day
d)
AoCInput Day
d -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String -> Integer -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"input/%s%04d/%02d.txt" String
keyDir Integer
yr (Day -> Integer
dayInt Day
d)
AoCSubmit{} -> Maybe String
forall a. Maybe a
Nothing
AoCLeaderboard{} -> Maybe String
forall a. Maybe a
Nothing
AoCDailyLeaderboard Day
d -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> Integer -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"daily/%04d/%02d.json" Integer
yr (Day -> Integer
dayInt Day
d)
AoCGlobalLeaderboard{} -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"global/%04d.json" Integer
yr
AoC a
AoCNextDayTime -> Maybe String
forall a. Maybe a
Nothing
where
keyDir :: String
keyDir = case Maybe String
sess of
Maybe String
Nothing -> String
""
Just String
s -> ShowS
strip String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"
runAoC :: AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC :: AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC AoCOpts{Bool
Int
Integer
String
Maybe String
_aThrottle :: Int
_aForce :: Bool
_aCache :: Maybe String
_aYear :: Integer
_aSessionKey :: String
_aThrottle :: AoCOpts -> Int
_aForce :: AoCOpts -> Bool
_aCache :: AoCOpts -> Maybe String
_aYear :: AoCOpts -> Integer
_aSessionKey :: AoCOpts -> String
..} AoC a
a = do
(Maybe String
keyMayb, String
cacheDir) <- case Maybe String
_aCache of
Just String
c -> (Maybe String, String) -> IO (Maybe String, String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String
forall a. Maybe a
Nothing, String
c)
Maybe String
Nothing -> (String -> Maybe String
forall a. a -> Maybe a
Just String
_aSessionKey,) (String -> (Maybe String, String))
-> ShowS -> String -> (Maybe String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
</> String
"advent-of-code-api") (String -> (Maybe String, String))
-> IO String -> IO (Maybe String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getTemporaryDirectory
(Integer
yy,Int
mm,Int
dd) <- Day -> (Integer, Int, Int)
toGregorian
(Day -> (Integer, Int, Int))
-> (UTCTime -> Day) -> UTCTime -> (Integer, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Day
localDay
(LocalTime -> Day) -> (UTCTime -> LocalTime) -> UTCTime -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime (String -> TimeZone
forall a. Read a => String -> a
read String
"EST")
(UTCTime -> (Integer, Int, Int))
-> IO UTCTime -> IO (Integer, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
let eventOver :: Bool
eventOver = Integer
yy Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
_aYear
Bool -> Bool -> Bool
|| (Int
mm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12 Bool -> Bool -> Bool
&& Int
dd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
25)
cacher :: IO (Either AoCError a) -> IO (Either AoCError a)
cacher = case Maybe String -> Integer -> AoC a -> Maybe String
forall a. Maybe String -> Integer -> AoC a -> Maybe String
apiCache Maybe String
keyMayb Integer
_aYear AoC a
a of
Maybe String
Nothing -> IO (Either AoCError a) -> IO (Either AoCError a)
forall a. a -> a
id
Just String
fp -> String
-> SaverLoader (Either AoCError a)
-> IO (Either AoCError a)
-> IO (Either AoCError a)
forall (m :: * -> *) a.
MonadIO m =>
String -> SaverLoader a -> m a -> m a
cacheing (String
cacheDir String -> ShowS
</> String
fp) (SaverLoader (Either AoCError a)
-> IO (Either AoCError a) -> IO (Either AoCError a))
-> SaverLoader (Either AoCError a)
-> IO (Either AoCError a)
-> IO (Either AoCError a)
forall a b. (a -> b) -> a -> b
$
if Bool
_aForce
then SaverLoader (Either AoCError a)
forall a. SaverLoader a
noCache
else Bool -> Bool -> AoC a -> SaverLoader (Either AoCError a)
forall a. Bool -> Bool -> AoC a -> SaverLoader (Either AoCError a)
saverLoader
(Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
_aSessionKey))
(Bool -> Bool
not Bool
eventOver)
AoC a
a
IO (Either AoCError a) -> IO (Either AoCError a)
cacher (IO (Either AoCError a) -> IO (Either AoCError a))
-> (ExceptT AoCError IO a -> IO (Either AoCError a))
-> ExceptT AoCError IO a
-> IO (Either AoCError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT AoCError IO a -> IO (Either AoCError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT AoCError IO a -> IO (Either AoCError a))
-> ExceptT AoCError IO a -> IO (Either AoCError a)
forall a b. (a -> b) -> a -> b
$ do
Maybe Day
-> (Day -> ExceptT AoCError IO ()) -> ExceptT AoCError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (AoC a -> Maybe Day
forall a. AoC a -> Maybe Day
aocDay AoC a
a) ((Day -> ExceptT AoCError IO ()) -> ExceptT AoCError IO ())
-> (Day -> ExceptT AoCError IO ()) -> ExceptT AoCError IO ()
forall a b. (a -> b) -> a -> b
$ \Day
d -> do
NominalDiffTime
rel <- IO NominalDiffTime -> ExceptT AoCError IO NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NominalDiffTime -> ExceptT AoCError IO NominalDiffTime)
-> IO NominalDiffTime -> ExceptT AoCError IO NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> IO NominalDiffTime
timeToRelease Integer
_aYear Day
d
Bool -> ExceptT AoCError IO () -> ExceptT AoCError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NominalDiffTime
rel NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
0) (ExceptT AoCError IO () -> ExceptT AoCError IO ())
-> ExceptT AoCError IO () -> ExceptT AoCError IO ()
forall a b. (a -> b) -> a -> b
$
AoCError -> ExceptT AoCError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AoCError -> ExceptT AoCError IO ())
-> AoCError -> ExceptT AoCError IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> AoCError
AoCReleaseError NominalDiffTime
rel
Maybe (Either ClientError a)
mtr <- IO (Maybe (Either ClientError a))
-> ExceptT AoCError IO (Maybe (Either ClientError a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (Maybe (Either ClientError a))
-> ExceptT AoCError IO (Maybe (Either ClientError a)))
-> (IO (Either ClientError a) -> IO (Maybe (Either ClientError a)))
-> IO (Either ClientError a)
-> ExceptT AoCError IO (Maybe (Either ClientError a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Throttler
-> Int
-> IO (Either ClientError a)
-> IO (Maybe (Either ClientError a))
forall a. Throttler -> Int -> IO a -> IO (Maybe a)
throttling Throttler
aocThrottler (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1000000 Int
_aThrottle)
(IO (Either ClientError a)
-> ExceptT AoCError IO (Maybe (Either ClientError a)))
-> IO (Either ClientError a)
-> ExceptT AoCError IO (Maybe (Either ClientError a))
forall a b. (a -> b) -> a -> b
$ ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Integer -> AoC a -> ClientM a
forall a. Integer -> AoC a -> ClientM a
aocReq Integer
_aYear AoC a
a) (ClientEnv -> IO (Either ClientError a))
-> IO ClientEnv -> IO (Either ClientError a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ClientEnv
aocClientEnv String
_aSessionKey
Either ClientError a
mcr <- ExceptT AoCError IO (Either ClientError a)
-> (Either ClientError a
-> ExceptT AoCError IO (Either ClientError a))
-> Maybe (Either ClientError a)
-> ExceptT AoCError IO (Either ClientError a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AoCError -> ExceptT AoCError IO (Either ClientError a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AoCError
AoCThrottleError) Either ClientError a -> ExceptT AoCError IO (Either ClientError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either ClientError a)
mtr
(ClientError -> ExceptT AoCError IO a)
-> (a -> ExceptT AoCError IO a)
-> Either ClientError a
-> ExceptT AoCError IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (AoCError -> ExceptT AoCError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AoCError -> ExceptT AoCError IO a)
-> (ClientError -> AoCError)
-> ClientError
-> ExceptT AoCError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> AoCError
AoCClientError) a -> ExceptT AoCError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ClientError a
mcr
runAoC_ :: AoCOpts -> AoC a -> IO a
runAoC_ :: AoCOpts -> AoC a -> IO a
runAoC_ AoCOpts
o = (AoCError -> IO a) -> (a -> IO a) -> Either AoCError a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either AoCError -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AoCError a -> IO a)
-> (AoC a -> IO (Either AoCError a)) -> AoC a -> IO a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AoCOpts -> AoC a -> IO (Either AoCError a)
forall a. AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC AoCOpts
o
aocClientEnv :: String -> IO ClientEnv
aocClientEnv :: String -> IO ClientEnv
aocClientEnv String
s = do
UTCTime
t <- IO UTCTime
getCurrentTime
TVar CookieJar
v <- STM (TVar CookieJar) -> IO (TVar CookieJar)
forall a. STM a -> IO a
atomically (STM (TVar CookieJar) -> IO (TVar CookieJar))
-> (CookieJar -> STM (TVar CookieJar))
-> CookieJar
-> IO (TVar CookieJar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CookieJar -> STM (TVar CookieJar)
forall a. a -> STM (TVar a)
newTVar (CookieJar -> IO (TVar CookieJar))
-> CookieJar -> IO (TVar CookieJar)
forall a b. (a -> b) -> a -> b
$ [Cookie] -> CookieJar
createCookieJar [UTCTime -> Cookie
c UTCTime
t]
Manager
mgr <- IO Manager
forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
ClientEnv -> IO ClientEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientEnv -> IO ClientEnv) -> ClientEnv -> IO ClientEnv
forall a b. (a -> b) -> a -> b
$ (Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
mgr BaseUrl
aocBase)
{ cookieJar :: Maybe (TVar CookieJar)
Servant.cookieJar = TVar CookieJar -> Maybe (TVar CookieJar)
forall a. a -> Maybe a
Just TVar CookieJar
v }
where
c :: UTCTime -> Cookie
c UTCTime
t = Cookie :: ByteString
-> ByteString
-> UTCTime
-> ByteString
-> ByteString
-> UTCTime
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Bool
-> Cookie
Cookie
{ cookie_name :: ByteString
cookie_name = ByteString
"session"
, cookie_value :: ByteString
cookie_value = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
s
, cookie_expiry_time :: UTCTime
cookie_expiry_time = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
oneYear UTCTime
t
, cookie_domain :: ByteString
cookie_domain = ByteString
"adventofcode.com"
, cookie_path :: ByteString
cookie_path = ByteString
"/"
, cookie_creation_time :: UTCTime
cookie_creation_time = UTCTime
t
, cookie_last_access_time :: UTCTime
cookie_last_access_time = UTCTime
t
, cookie_persistent :: Bool
cookie_persistent = Bool
True
, cookie_host_only :: Bool
cookie_host_only = Bool
True
, cookie_secure_only :: Bool
cookie_secure_only = Bool
True
, cookie_http_only :: Bool
cookie_http_only = Bool
True
}
oneYear :: NominalDiffTime
oneYear = NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
356.25
saverLoader
:: Bool
-> Bool
-> AoC a
-> SaverLoader (Either AoCError a)
saverLoader :: Bool -> Bool -> AoC a -> SaverLoader (Either AoCError a)
saverLoader Bool
validToken Bool
evt = \case
AoCPrompt{} -> SL :: forall a. (a -> Maybe Text) -> (Text -> Maybe a) -> SaverLoader a
SL { _slSave :: Either AoCError a -> Maybe Text
_slSave = (AoCError -> Maybe Text)
-> (Map Part Text -> Maybe Text)
-> Either AoCError (Map Part Text)
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> AoCError -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (Map Part Text -> Text) -> Map Part Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Part Text -> Text
encodeMap)
, _slLoad :: Text -> Maybe (Either AoCError a)
_slLoad = \Text
str ->
let mp :: Map Part Text
mp = Text -> Map Part Text
decodeMap Text
str
hasAll :: Bool
hasAll = Set Part -> Bool
forall a. Set a -> Bool
S.null (Set Part
expectedParts Set Part -> Set Part -> Set Part
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Map Part Text -> Set Part
forall k a. Map k a -> Set k
M.keysSet Map Part Text
mp)
in Map Part Text -> Either AoCError (Map Part Text)
forall a b. b -> Either a b
Right Map Part Text
mp Either AoCError (Map Part Text)
-> Maybe () -> Maybe (Either AoCError (Map Part Text))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasAll
}
AoCInput{} -> SL :: forall a. (a -> Maybe Text) -> (Text -> Maybe a) -> SaverLoader a
SL { _slSave :: Either AoCError a -> Maybe Text
_slSave = (AoCError -> Maybe Text)
-> (Text -> Maybe Text) -> Either AoCError Text -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> AoCError -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just
, _slLoad :: Text -> Maybe (Either AoCError a)
_slLoad = Either AoCError a -> Maybe (Either AoCError a)
forall a. a -> Maybe a
Just (Either AoCError a -> Maybe (Either AoCError a))
-> (a -> Either AoCError a) -> a -> Maybe (Either AoCError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either AoCError a
forall a b. b -> Either a b
Right
}
AoCSubmit{} -> SaverLoader (Either AoCError a)
forall a. SaverLoader a
noCache
AoCLeaderboard{} -> SaverLoader (Either AoCError a)
forall a. SaverLoader a
noCache
AoCDailyLeaderboard{} -> SL :: forall a. (a -> Maybe Text) -> (Text -> Maybe a) -> SaverLoader a
SL
{ _slSave :: Either AoCError a -> Maybe Text
_slSave = (AoCError -> Maybe Text)
-> (a -> Maybe Text) -> Either AoCError a -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> AoCError -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (a -> Text) -> a -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode)
, _slLoad :: Text -> Maybe (Either AoCError a)
_slLoad = \Text
str -> do
DailyLeaderboard
r <- ByteString -> Maybe DailyLeaderboard
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe DailyLeaderboard)
-> (Text -> ByteString) -> Text -> Maybe DailyLeaderboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict (Text -> Maybe DailyLeaderboard) -> Text -> Maybe DailyLeaderboard
forall a b. (a -> b) -> a -> b
$ Text
str
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ DailyLeaderboard -> Bool
fullDailyBoard DailyLeaderboard
r
Either AoCError DailyLeaderboard
-> Maybe (Either AoCError DailyLeaderboard)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AoCError DailyLeaderboard
-> Maybe (Either AoCError DailyLeaderboard))
-> Either AoCError DailyLeaderboard
-> Maybe (Either AoCError DailyLeaderboard)
forall a b. (a -> b) -> a -> b
$ DailyLeaderboard -> Either AoCError DailyLeaderboard
forall a b. b -> Either a b
Right DailyLeaderboard
r
}
AoCGlobalLeaderboard{} -> SL :: forall a. (a -> Maybe Text) -> (Text -> Maybe a) -> SaverLoader a
SL
{ _slSave :: Either AoCError a -> Maybe Text
_slSave = (AoCError -> Maybe Text)
-> (GlobalLeaderboard -> Maybe Text)
-> Either AoCError GlobalLeaderboard
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(Maybe Text -> AoCError -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing)
(Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (GlobalLeaderboard -> Text) -> GlobalLeaderboard -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text)
-> (GlobalLeaderboard -> Text) -> GlobalLeaderboard -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 (ByteString -> Text)
-> (GlobalLeaderboard -> ByteString) -> GlobalLeaderboard -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToJSON (Bool, GlobalLeaderboard) =>
(Bool, GlobalLeaderboard) -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode @(Bool, GlobalLeaderboard) ((Bool, GlobalLeaderboard) -> ByteString)
-> (GlobalLeaderboard -> (Bool, GlobalLeaderboard))
-> GlobalLeaderboard
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
evt,))
, _slLoad :: Text -> Maybe (Either AoCError a)
_slLoad = \Text
str -> do
(Bool
evt', GlobalLeaderboard
lb) <- FromJSON (Bool, GlobalLeaderboard) =>
ByteString -> Maybe (Bool, GlobalLeaderboard)
forall a. FromJSON a => ByteString -> Maybe a
A.decode @(Bool, GlobalLeaderboard) (ByteString -> Maybe (Bool, GlobalLeaderboard))
-> (Text -> ByteString) -> Text -> Maybe (Bool, GlobalLeaderboard)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict (Text -> Maybe (Bool, GlobalLeaderboard))
-> Text -> Maybe (Bool, GlobalLeaderboard)
forall a b. (a -> b) -> a -> b
$ Text
str
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
evt'
Either AoCError GlobalLeaderboard
-> Maybe (Either AoCError GlobalLeaderboard)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AoCError GlobalLeaderboard
-> Maybe (Either AoCError GlobalLeaderboard))
-> Either AoCError GlobalLeaderboard
-> Maybe (Either AoCError GlobalLeaderboard)
forall a b. (a -> b) -> a -> b
$ GlobalLeaderboard -> Either AoCError GlobalLeaderboard
forall a b. b -> Either a b
Right GlobalLeaderboard
lb
}
AoCNextDayTime{} -> SaverLoader (Either AoCError a)
forall a. SaverLoader a
noCache
where
expectedParts :: Set Part
expectedParts :: Set Part
expectedParts
| Bool
validToken = [Part] -> Set Part
forall a. [a] -> Set a
S.fromDistinctAscList [Part
Part1 ..]
| Bool
otherwise = Part -> Set Part
forall a. a -> Set a
S.singleton Part
Part1
sep :: Text
sep = Text
">>>>>>>>>"
encodeMap :: Map Part Text -> Text
encodeMap Map Part Text
mp = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> Text) -> [[Text]] -> Text
forall a b. (a -> b) -> a -> b
$
[ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Part -> Map Part Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Part
Part1 Map Part Text
mp
, [Text
sep]
, Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Part -> Map Part Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Part
Part2 Map Part Text
mp
]
decodeMap :: Text -> Map Part Text
decodeMap Text
xs = Part -> [Text] -> Map Part Text
forall k. k -> [Text] -> Map k Text
mkMap Part
Part1 [Text]
part1 Map Part Text -> Map Part Text -> Map Part Text
forall a. Semigroup a => a -> a -> a
<> Part -> [Text] -> Map Part Text
forall k. k -> [Text] -> Map k Text
mkMap Part
Part2 [Text]
part2
where
([Text]
part1, Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 -> [Text]
part2) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
sep) (Text -> [Text]
T.lines Text
xs)
mkMap :: k -> [Text] -> Map k Text
mkMap k
p (Text -> [Text] -> Text
T.intercalate Text
"\n"->Text
ln)
| Text -> Bool
T.null (Text -> Text
T.strip Text
ln) = Map k Text
forall k a. Map k a
M.empty
| Bool
otherwise = k -> Text -> Map k Text
forall k a. k -> a -> Map k a
M.singleton k
p Text
ln
timeToRelease
:: Integer
-> Day
-> IO NominalDiffTime
timeToRelease :: Integer -> Day -> IO NominalDiffTime
timeToRelease Integer
y Day
d = (ZonedTime -> UTCTime
zonedTimeToUTC (Integer -> Day -> ZonedTime
challengeReleaseTime Integer
y Day
d) UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime`) (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
challengeReleased
:: Integer
-> Day
-> IO Bool
challengeReleased :: Integer -> Day -> IO Bool
challengeReleased Integer
y = (NominalDiffTime -> Bool) -> IO NominalDiffTime -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= NominalDiffTime
0) (IO NominalDiffTime -> IO Bool)
-> (Day -> IO NominalDiffTime) -> Day -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day -> IO NominalDiffTime
timeToRelease Integer
y
aocServerTime :: IO LocalTime
aocServerTime :: IO LocalTime
aocServerTime = TimeZone -> UTCTime -> LocalTime
utcToLocalTime (String -> TimeZone
forall a. Read a => String -> a
read String
"EST") (UTCTime -> LocalTime) -> IO UTCTime -> IO LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
strip :: String -> String
strip :: ShowS
strip = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack