{-# LANGUAGE CPP                #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE KindSignatures     #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE PatternSynonyms    #-}
{-# LANGUAGE PolyKinds          #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections      #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE ViewPatterns       #-}

-- |
-- Module      : Advent
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Haskell bindings for Advent of Code 2018 API.  Caches and throttles
-- requests automatically.
--
-- Specify your requests with 'AoC' and 'AoCOpts', and run them with
-- 'runAoC'.
--
-- Examples:
--
-- @
-- -- Fetch prompts for day 5
-- 'runAoC' myOpts $ 'AoCPrompt' ('mkDay_' 5)
--
-- -- Fetch input for day 8
-- 'runAoC' myOpts $ 'AoCInput' ('mkDay_' 8)
--
-- -- Submit answer "hello" for Day 10, Part 1
-- 'runAoC' myOpts $ 'AoCSubmit' ('mkDay_' 10) 'Part1' "hello"
-- @
--
-- Please use responsibly.  All actions are by default rate limited to one
-- per three seconds, but this can be adjusted to a hard-limited cap of one
-- per second.

module Advent (
  -- * API
    AoC(..)
  , Part(..)
  , Day(..)
  , NextDayTime(..)
  , AoCOpts(..)
  , SubmitRes(..), showSubmitRes
  , runAoC
  , runAoC_
  , defaultAoCOpts
  , AoCError(..)
  -- ** Calendar
  , challengeReleaseTime
  , timeToRelease
  , challengeReleased
  -- * Utility
  -- ** Day
  , mkDay, mkDay_, dayInt, pattern DayInt, _DayInt
  , aocDay
  , aocServerTime
  -- ** Part
  , partChar, partInt
  -- ** Leaderboard
  , fullDailyBoard
  -- ** Throttler
  , setAoCThrottleLimit, getAoCThrottleLimit
  -- * Internal
  , 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_mtl(2,3,0)
import           Control.Monad.IO.Class (liftIO)
#endif

#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 = forall a. IO a -> a
Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b
$ Int -> IO Throttler
newThrottler Int
initialThrottleLimit
{-# NOINLINE aocThrottler #-}

-- | Set the internal throttler maximum queue capacity.  Default is 100.
setAoCThrottleLimit :: Int -> IO ()
setAoCThrottleLimit :: Int -> IO ()
setAoCThrottleLimit = Throttler -> Int -> IO ()
setLimit Throttler
aocThrottler

-- | Get the internal throttler maximum queue capacity.
getAoCThrottleLimit :: IO Int
getAoCThrottleLimit :: IO Int
getAoCThrottleLimit = Throttler -> IO Int
getLimit Throttler
aocThrottler

-- | An API command.  An @'AoC' a@ an AoC API request that returns
-- results of type @a@.
--
-- A lot of these commands take 'Day', which represents a day of December
-- up to and including Christmas Day (December 25th).  You can convert an
-- integer day (1 - 25) into a 'Day' using 'mkDay' or 'mkDay_'.
data AoC :: Type -> Type where
    -- | Fetch prompts for a given day.  Returns a 'Map' of 'Part's and
    -- their associated promps, as HTML.
    --
    -- _Cacheing rules_: Is cached on a per-day basis.  An empty session
    -- key is given, it will be happy with only having Part 1 cached.  If
    -- a non-empty session key is given, it will trigger a cache
    -- invalidation on every request until both Part 1 and Part 2 are
    -- received.
    AoCPrompt
        :: Day
        -> AoC (Map Part Text)

    -- | Fetch input, as plaintext.  Returned verbatim.  Be aware that
    -- input might contain trailing newlines.
    --
    -- /Cacheing rules/: Is cached forever, per day per session key.
    AoCInput :: Day -> AoC Text

    -- | Submit a plaintext answer (the 'String') to a given day and part.
    -- Receive a server reponse (as HTML) and a response code 'SubmitRes'.
    --
    -- __WARNING__: Answers are not length-limited.  Answers are stripped
    -- of leading and trailing whitespace and run through 'URI.encode'
    -- before submitting.
    --
    -- /Cacheing rules/: Is never cached.
    AoCSubmit
        :: Day
        -> Part
        -> String
        -> AoC (Text, SubmitRes)

    -- | Fetch the leaderboard for a given leaderboard public code (owner
    -- member ID).  Requires session key.
    --
    -- The public code can be found in the URL of the leaderboard:
    --
    -- > https://adventofcode.com/2019/leaderboard/private/view/12345
    --
    -- (the @12345@ above)
    --
    -- __NOTE__: This is the most expensive and taxing possible API call,
    -- and makes up the majority of bandwidth to the Advent of Code
    -- servers.  As a courtesy to all who are participating in Advent of
    -- Code, please use this super respectfully, especially in December: if
    -- you set up automation for this, please do not use it more than once
    -- per day.
    --
    -- /Cacheing rules/: Is never cached, so please use responsibly (see
    -- note above).
    --
    -- @since 0.2.0.0
    AoCLeaderboard
        :: Integer
        -> AoC Leaderboard

    -- | Fetch the daily leaderboard for a given day.  Does not require
    -- a session key.
    --
    -- Leaderboard API calls tend to be expensive, so please be respectful
    -- when using this.  If you automate this, please do not fetch any more
    -- often than necessary.
    --
    -- /Cacheing rules/: Will be cached if a full leaderboard is observed.
    --
    -- @since 0.2.3.0
    AoCDailyLeaderboard
        :: Day
        -> AoC DailyLeaderboard

    -- | Fetch the global leaderboard.  Does not require
    -- a session key.
    --
    -- Leaderboard API calls tend to be expensive, so please be respectful
    -- when using this.  If you automate this, please do not fetch any more
    -- often than necessary.
    --
    -- /Cacheing rules/: Will not cache if an event is ongoing, but will be
    -- cached if received after the event is over.
    --
    -- @since 0.2.3.0
    AoCGlobalLeaderboard
        :: AoC GlobalLeaderboard

    -- | From the calendar, fetch the next release's day and the
    -- number of seconds util its release, if there is any at all.
    --
    -- This does an actual request to the AoC servers, and is only accurate
    -- to the second; to infer this information (to the millisecond level)
    -- from the system clock, you should probably use 'timeToRelease' and
    -- 'aocServerTime' instead, which requires no network requests.
    --
    -- @since 0.2.8.0
    AoCNextDayTime
        :: AoC NextDayTime

deriving instance Show (AoC a)
deriving instance Typeable (AoC a)

-- | Get the day associated with a given API command, if there is one.
aocDay :: AoC a -> Maybe Day
aocDay :: forall a. AoC a -> Maybe Day
aocDay (AoCPrompt Day
d     ) = forall a. a -> Maybe a
Just Day
d
aocDay (AoCInput  Day
d     ) = forall a. a -> Maybe a
Just Day
d
aocDay (AoCSubmit Day
d Part
_ String
_ ) = forall a. a -> Maybe a
Just Day
d
aocDay (AoCLeaderboard Integer
_) = forall a. Maybe a
Nothing
aocDay (AoCDailyLeaderboard Day
d) = forall a. a -> Maybe a
Just Day
d
aocDay AoC a
AoCGlobalLeaderboard = forall a. Maybe a
Nothing
aocDay AoC a
AoCNextDayTime       = forall a. Maybe a
Nothing

-- | A possible (syncronous, logical, pure) error returnable from 'runAoC'.
-- Does not cover any asynchronous or IO errors.
data AoCError
    -- | An error in the http request itself
    --
    -- Note that if you are building this with servant-client-core <= 0.16,
    -- this will contain @ServantError@ instead of @ClientError@, which was
    -- the previous name of ths type.
#if MIN_VERSION_servant_client_core(0,16,0)
    = AoCClientError ClientError
#else
    = AoCClientError ServantError
#endif
    -- | Tried to interact with a challenge that has not yet been
    -- released.  Contains the amount of time until release.
    | AoCReleaseError NominalDiffTime
    -- | The throttler limit is full.  Either make less requests, or adjust
    -- it with 'setAoCThrottleLimit'.
    | AoCThrottleError
  deriving (Int -> AoCError -> ShowS
[AoCError] -> ShowS
AoCError -> String
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. 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

-- | Setings for running an API request.
--
-- Session keys are required for all commands, but if you enter a bogus key
-- you should be able to get at least Part 1 from 'AoCPrompt'.
--
-- The session key can be found by logging in on a web client and checking
-- the cookies.  You can usually check these with in-browser developer
-- tools.
--
-- Throttling is hard-limited to a minimum of 1 second between calls.
-- Please be respectful and do not try to bypass this.
data AoCOpts = AoCOpts
    { -- | Session key
      AoCOpts -> String
_aSessionKey :: String
      -- | Year of challenge
    , AoCOpts -> Integer
_aYear       :: Integer
      -- | Cache directory.  If 'Nothing' is given, one will be allocated
      -- using 'getTemporaryDirectory'.
    , AoCOpts -> Maybe String
_aCache      :: Maybe FilePath
      -- | Fetch results even if cached.  Still subject to throttling.
      -- Default is False.
    , AoCOpts -> Bool
_aForce      :: Bool
      -- | Throttle delay, in milliseconds.  Minimum is 1000000.  Default
      -- is 3000000 (3 seconds).
    , AoCOpts -> Int
_aThrottle   :: Int
    }
  deriving (Int -> AoCOpts -> ShowS
[AoCOpts] -> ShowS
AoCOpts -> String
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. 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)

-- | Sensible defaults for 'AoCOpts' for a given year and session key.
--
-- Use system temporary directory as cache, and throttle requests to one
-- request per three seconds.
defaultAoCOpts
    :: Integer
    -> String
    -> AoCOpts
defaultAoCOpts :: Integer -> String -> AoCOpts
defaultAoCOpts Integer
y String
s = AoCOpts
    { _aSessionKey :: String
_aSessionKey = String
s
    , _aYear :: Integer
_aYear       = Integer
y
    , _aCache :: Maybe String
_aCache      = forall a. Maybe a
Nothing
    , _aForce :: Bool
_aForce      = Bool
False
    , _aThrottle :: Int
_aThrottle   = Int
3000000
    }

-- | HTTPS base of Advent of Code API.
aocBase :: BaseUrl
aocBase :: BaseUrl
aocBase = Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
"adventofcode.com" Int
443 String
""

-- | 'ClientM' request for a given 'AoC' API call.
aocReq :: Integer -> AoC a -> ClientM a
aocReq :: forall a. 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 (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 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) 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 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 NextDayTime
r


-- | Cache file for a given 'AoC' command
apiCache
    :: Maybe String           -- ^ session key
    -> Integer                -- ^ year
    -> AoC a
    -> Maybe FilePath
apiCache :: forall a. Maybe String -> Integer -> AoC a -> Maybe String
apiCache Maybe String
sess Integer
yr = \case
    AoCPrompt Day
d      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"prompt/%04d/%02d.html"        Integer
yr (Day -> Integer
dayInt Day
d)
    AoCInput  Day
d      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"input/%s%04d/%02d.txt" String
keyDir Integer
yr (Day -> Integer
dayInt Day
d)
    AoCSubmit{}      -> forall a. Maybe a
Nothing
    AoCLeaderboard{} -> forall a. Maybe a
Nothing
    AoCDailyLeaderboard Day
d  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"daily/%04d/%02d.json" Integer
yr (Day -> Integer
dayInt Day
d)
    AoCGlobalLeaderboard{} -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"global/%04d.json" Integer
yr
    AoC a
AoCNextDayTime         -> 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 forall a. [a] -> [a] -> [a]
++ String
"/"

-- | Run an 'AoC' command with a given 'AoCOpts' to produce the result
-- or a list of (lines of) errors.
--
-- __WARNING__: Answers are not length-limited.  Answers are stripped
-- of leading and trailing whitespace and run through 'URI.encode'
-- before submitting.
runAoC :: AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC :: forall a. 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  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, String
c)
      Maybe String
Nothing -> (forall a. a -> Maybe a
Just String
_aSessionKey,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
</> String
"advent-of-code-api") 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
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Day
localDay
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime (forall a. Read a => String -> a
read String
"EST")
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
    let eventOver :: Bool
eventOver = Integer
yy forall a. Ord a => a -> a -> Bool
> Integer
_aYear
                 Bool -> Bool -> Bool
|| (Int
mm forall a. Eq a => a -> a -> Bool
== Int
12 Bool -> Bool -> Bool
&& Int
dd forall a. Ord a => a -> a -> Bool
> Int
25)
        cacher :: IO (Either AoCError a) -> IO (Either AoCError a)
cacher = case forall a. Maybe String -> Integer -> AoC a -> Maybe String
apiCache Maybe String
keyMayb Integer
_aYear AoC a
a of
          Maybe String
Nothing -> forall a. a -> a
id
          Just String
fp -> forall (m :: * -> *) a.
MonadIO m =>
String -> SaverLoader a -> m a -> m a
cacheing (String
cacheDir String -> ShowS
</> String
fp) forall a b. (a -> b) -> a -> b
$
                       if Bool
_aForce
                         then forall a. SaverLoader a
noCache
                         else forall a. Bool -> Bool -> AoC a -> SaverLoader (Either AoCError a)
saverLoader
                                (Bool -> Bool
not (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. AoC a -> Maybe Day
aocDay AoC a
a) forall a b. (a -> b) -> a -> b
$ \Day
d -> do
        NominalDiffTime
rel <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Integer -> Day -> IO NominalDiffTime
timeToRelease Integer
_aYear Day
d
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NominalDiffTime
rel forall a. Ord a => a -> a -> Bool
> NominalDiffTime
0) forall a b. (a -> b) -> a -> b
$
          forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> AoCError
AoCReleaseError NominalDiffTime
rel

      Maybe (Either ClientError a)
mtr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Throttler -> Int -> IO a -> IO (Maybe a)
throttling Throttler
aocThrottler (forall a. Ord a => a -> a -> a
max Int
1000000 Int
_aThrottle)
           forall a b. (a -> b) -> a -> b
$ forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (forall a. Integer -> AoC a -> ClientM a
aocReq Integer
_aYear AoC a
a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ClientEnv
aocClientEnv String
_aSessionKey
      Either ClientError a
mcr <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AoCError
AoCThrottleError) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either ClientError a)
mtr
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> AoCError
AoCClientError) forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ClientError a
mcr

-- | A version of 'runAoC' that throws an IO exception (of type 'AoCError')
-- upon failure, instead of an 'Either'.
--
-- @since 0.2.5.0
runAoC_ :: AoCOpts -> AoC a -> IO a
runAoC_ :: forall a. AoCOpts -> AoC a -> IO a
runAoC_ AoCOpts
o = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 <- forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$ [Cookie] -> CookieJar
createCookieJar [UTCTime -> Cookie
c UTCTime
t]
    Manager
mgr <- forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
mgr BaseUrl
aocBase)
        { cookieJar :: Maybe (TVar CookieJar)
Servant.cookieJar = forall a. a -> Maybe a
Just TVar CookieJar
v }
  where
    c :: UTCTime -> Cookie
c UTCTime
t = Cookie
      { cookie_name :: ByteString
cookie_name             = ByteString
"session"
      , cookie_value :: ByteString
cookie_value            = Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack 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 forall a. Num a => a -> a -> a
* NominalDiffTime
60 forall a. Num a => a -> a -> a
* NominalDiffTime
24 forall a. Num a => a -> a -> a
* NominalDiffTime
356.25


saverLoader
    :: Bool             -- ^ is there a non-empty session token?
    -> Bool             -- ^ is the event ongoing (True) or over (False)?
    -> AoC a
    -> SaverLoader (Either AoCError a)
saverLoader :: forall a. Bool -> Bool -> AoC a -> SaverLoader (Either AoCError a)
saverLoader Bool
validToken Bool
evt = \case
    AoCPrompt{} -> SL { _slSave :: Either AoCError (Map Part Text) -> Maybe Text
_slSave = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Part Text -> Text
encodeMap)
                      , _slLoad :: Text -> Maybe (Either AoCError (Map Part Text))
_slLoad = \Text
str ->
                          let mp :: Map Part Text
mp     = Text -> Map Part Text
decodeMap Text
str
                              hasAll :: Bool
hasAll = forall a. Set a -> Bool
S.null (Set Part
expectedParts forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall k a. Map k a -> Set k
M.keysSet Map Part Text
mp)
                          in  forall a b. b -> Either a b
Right Map Part Text
mp forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasAll
                      }
    AoCInput{}  -> SL { _slSave :: Either AoCError Text -> Maybe Text
_slSave = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
                      , _slLoad :: Text -> Maybe (Either AoCError Text)
_slLoad = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
                      }
    AoCSubmit{} -> forall a. SaverLoader a
noCache
    AoCLeaderboard{} -> forall a. SaverLoader a
noCache
    AoCDailyLeaderboard{} -> SL
        { _slSave :: Either AoCError DailyLeaderboard -> Maybe Text
_slSave = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
A.encode)
        , _slLoad :: Text -> Maybe (Either AoCError DailyLeaderboard)
_slLoad = \Text
str -> do
            DailyLeaderboard
r <- forall a. FromJSON a => ByteString -> Maybe a
A.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$ Text
str
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ DailyLeaderboard -> Bool
fullDailyBoard DailyLeaderboard
r
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right DailyLeaderboard
r
        }
    AoCGlobalLeaderboard{} -> SL
        { _slSave :: Either AoCError GlobalLeaderboard -> Maybe Text
_slSave = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                        (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
                        (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
A.encode @(Bool, GlobalLeaderboard) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
evt,))
        , _slLoad :: Text -> Maybe (Either AoCError GlobalLeaderboard)
_slLoad = \Text
str -> do
            (Bool
evt', GlobalLeaderboard
lb) <- forall a. FromJSON a => ByteString -> Maybe a
A.decode @(Bool, GlobalLeaderboard) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$ Text
str
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
evt'        -- only load cache if evt' is false: it was saved in a non-evt time
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right GlobalLeaderboard
lb
        }
    AoCNextDayTime{} -> forall a. SaverLoader a
noCache
  where
    expectedParts :: Set Part
    expectedParts :: Set Part
expectedParts
      | Bool
validToken = forall a. [a] -> Set a
S.fromDistinctAscList [Part
Part1 ..]
      | Bool
otherwise  = 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
                            [ forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Part
Part1 Map Part Text
mp
                            , [Text
sep]
                            , forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ 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 = forall {k}. k -> [Text] -> Map k Text
mkMap Part
Part1 [Text]
part1 forall a. Semigroup a => a -> a -> a
<> forall {k}. k -> [Text] -> Map k Text
mkMap Part
Part2 [Text]
part2
      where
        ([Text]
part1, forall a. Int -> [a] -> [a]
drop Int
1 -> [Text]
part2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (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) = forall k a. Map k a
M.empty
          | Bool
otherwise           = forall k a. k -> a -> Map k a
M.singleton k
p Text
ln

-- | Get time until release of a given challenge.
timeToRelease
    :: Integer              -- ^ year
    -> Day                  -- ^ 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`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

-- | Check if a challenge has been released yet.
challengeReleased
    :: Integer              -- ^ year
    -> Day                  -- ^ day
    -> IO Bool
challengeReleased :: Integer -> Day -> IO Bool
challengeReleased Integer
y = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Ord a => a -> a -> Bool
<= NominalDiffTime
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day -> IO NominalDiffTime
timeToRelease Integer
y

-- | Utility to get the current time on AoC servers.  Basically just gets the current
-- time in Eastern Standard Time.  This is only as accurate as your
-- machine's actual time --- it doesn't actually do anything networked.
--
-- @since 0.2.6.0
aocServerTime :: IO LocalTime
aocServerTime :: IO LocalTime
aocServerTime = TimeZone -> UTCTime -> LocalTime
utcToLocalTime (forall a. Read a => String -> a
read String
"EST") 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack