├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── advent-of-code-api.cabal ├── src ├── Advent.hs └── Advent │ ├── API.hs │ ├── Cache.hs │ ├── Throttle.hs │ └── Types.hs ├── stack.yaml ├── stack.yaml.lock ├── test-data ├── correct-rank.txt ├── correct.txt ├── incorrect-high.txt ├── incorrect-low.txt ├── incorrect-wait.txt ├── incorrect.txt ├── invalid.txt ├── wait.txt └── wait2.txt └── test └── Spec.hs /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | # Haskell stack project Github Actions template 2 | # https://gist.github.com/mstksg/11f753d891cee5980326a8ea8c865233 3 | # 4 | # To use, mainly change the list in 'plans' and modify 'include' for 5 | # any OS package manager deps. 6 | # 7 | # Currently not working for cabal-install >= 3 8 | # 9 | # Based on https://raw.githubusercontent.com/commercialhaskell/stack/stable/doc/travis-complex.yml 10 | 11 | name: Haskell Stack Project CI 12 | 13 | on: 14 | push: 15 | schedule: 16 | - cron: "0 0 * * 1" 17 | 18 | jobs: 19 | build: 20 | strategy: 21 | matrix: 22 | os: [ubuntu-latest, macOS-latest] 23 | # use this to specify what resolvers and ghc to use 24 | plan: 25 | # - { build: stack, resolver: "--resolver lts-9" } 26 | # - { build: stack, resolver: "--resolver lts-11" } 27 | - { build: stack, resolver: "--resolver lts-12" } 28 | - { build: stack, resolver: "--resolver lts-14" } 29 | - { build: stack, resolver: "--resolver lts-16" } 30 | - { build: stack, resolver: "--resolver lts-18" } 31 | - { build: stack, resolver: "--resolver lts-19" } 32 | - { build: stack, resolver: "--resolver lts-20" } 33 | - { build: stack, resolver: "--resolver lts-21" } 34 | - { build: stack, resolver: "--resolver nightly" } 35 | - { build: stack, resolver: "" } 36 | - { build: cabal, ghc: 8.0.2, cabal-install: "2.0" } # setup-haskell doesn't support 1.24 37 | - { build: cabal, ghc: 8.2.2, cabal-install: "2.0" } 38 | - { build: cabal, ghc: 8.4.4, cabal-install: "2.2" } 39 | - { build: cabal, ghc: 8.6.5, cabal-install: "2.4" } 40 | - { build: cabal, ghc: 8.8.4, cabal-install: "2.4" } # currently not working for >= 3.0 41 | - { build: cabal, ghc: 8.10.7, cabal-install: "2.4" } # currently not working for >= 3.0 42 | - { build: cabal, ghc: 9.0.2, cabal-install: "2.4" } # currently not working for >= 3.0 43 | - { build: cabal, ghc: 9.2.8, cabal-install: "2.4" } # currently not working for >= 3.0 44 | - { build: cabal, ghc: 9.4.8, cabal-install: "2.4" } # currently not working for >= 3.0 45 | - { build: cabal, ghc: 9.6.3, cabal-install: "2.4" } # currently not working for >= 3.0 46 | # include: [] 47 | 48 | exclude: 49 | - os: macOS-latest 50 | plan: 51 | build: cabal 52 | 53 | runs-on: ${{ matrix.os }} 54 | steps: 55 | - name: Install OS Packages 56 | uses: mstksg/get-package@v1 57 | with: 58 | apt-get: ${{ matrix.apt-get }} 59 | brew: ${{ matrix.brew }} 60 | - uses: actions/checkout@v1 61 | 62 | - name: Setup stack 63 | uses: mstksg/setup-stack@v1 64 | 65 | - name: Setup cabal-install 66 | uses: actions/setup-haskell@v1 67 | with: 68 | ghc-version: ${{ matrix.plan.ghc }} 69 | cabal-version: ${{ matrix.plan.cabal-install }} 70 | if: matrix.plan.build == 'cabal' 71 | 72 | - name: Install dependencies 73 | run: | 74 | set -ex 75 | case "$BUILD" in 76 | stack) 77 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 78 | ;; 79 | cabal) 80 | cabal --version 81 | cabal update 82 | PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 83 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 84 | ;; 85 | esac 86 | set +ex 87 | env: 88 | ARGS: ${{ matrix.plan.resolver }} 89 | BUILD: ${{ matrix.plan.build }} 90 | 91 | - name: Build 92 | run: | 93 | set -ex 94 | case "$BUILD" in 95 | stack) 96 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps 97 | ;; 98 | cabal) 99 | PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 100 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 101 | 102 | ORIGDIR=$(pwd) 103 | for dir in $PACKAGES 104 | do 105 | cd $dir 106 | cabal check || [ "$CABALVER" == "1.16" ] 107 | cabal sdist 108 | PKGVER=$(cabal info . | awk '{print $2;exit}') 109 | SRC_TGZ=$PKGVER.tar.gz 110 | cd dist 111 | tar zxfv "$SRC_TGZ" 112 | cd "$PKGVER" 113 | cabal configure --enable-tests --ghc-options -O0 114 | cabal build 115 | if [ "$CABALVER" = "1.16" ] || [ "$CABALVER" = "1.18" ]; then 116 | cabal test 117 | else 118 | cabal test --show-details=streaming --log=/dev/stdout 119 | fi 120 | cd $ORIGDIR 121 | done 122 | ;; 123 | esac 124 | set +ex 125 | env: 126 | ARGS: ${{ matrix.plan.resolver }} 127 | BUILD: ${{ matrix.plan.build }} 128 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | .ghc* 3 | dist-newstyle/ 4 | *~ 5 | tmp-test-data 6 | *.dump-hi 7 | cabal.project.local 8 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | script: 2 | - | 3 | set -ex 4 | case "$BUILD" in 5 | stack) 6 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps 7 | ;; 8 | cabal) 9 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 10 | 11 | ORIGDIR=$(pwd) 12 | for dir in $PACKAGES 13 | do 14 | cd $dir 15 | cabal check || [ "$CABALVER" == "1.16" ] 16 | cabal sdist 17 | PKGVER=$(cabal info . | awk '{print $2;exit}') 18 | SRC_TGZ=$PKGVER.tar.gz 19 | cd dist 20 | tar zxfv "$SRC_TGZ" 21 | cd "$PKGVER" 22 | cabal configure --enable-tests --ghc-options -O0 23 | cabal build 24 | if [ "$CABALVER" = "1.16" ] || [ "$CABALVER" = "1.18" ]; then 25 | cabal test 26 | else 27 | cabal test --show-details=streaming --log=/dev/stdout 28 | fi 29 | cd $ORIGDIR 30 | done 31 | ;; 32 | esac 33 | set +ex 34 | matrix: 35 | include: 36 | - env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 37 | addons: 38 | apt: 39 | sources: 40 | - hvr-ghc 41 | packages: 42 | - cabal-install-1.24 43 | - ghc-8.0.2 44 | - happy-1.19.5 45 | - alex-3.1.7 46 | compiler: ': #GHC 8.0.2' 47 | - env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 48 | addons: 49 | apt: 50 | sources: 51 | - hvr-ghc 52 | packages: 53 | - cabal-install-2.0 54 | - ghc-8.2.2 55 | - happy-1.19.5 56 | - alex-3.1.7 57 | compiler: ': #GHC 8.2.2' 58 | - env: BUILD=cabal GHCVER=8.4.4 CABALVER=2.2 HAPPYVER=1.19.5 ALEXVER=3.1.7 59 | addons: 60 | apt: 61 | sources: 62 | - hvr-ghc 63 | packages: 64 | - cabal-install-2.2 65 | - ghc-8.4.4 66 | - happy-1.19.5 67 | - alex-3.1.7 68 | compiler: ': #GHC 8.4.4' 69 | - env: BUILD=cabal GHCVER=8.6.5 CABALVER=2.4 HAPPYVER=1.19.5 ALEXVER=3.1.7 70 | addons: 71 | apt: 72 | sources: 73 | - hvr-ghc 74 | packages: 75 | - cabal-install-2.4 76 | - ghc-8.6.5 77 | - happy-1.19.5 78 | - alex-3.1.7 79 | compiler: ': #GHC 8.6.5' 80 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 81 | addons: 82 | apt: 83 | sources: 84 | - hvr-ghc 85 | packages: 86 | - cabal-install-head 87 | - ghc-head 88 | - happy-1.19.5 89 | - alex-3.1.7 90 | compiler: ': #GHC HEAD' 91 | - env: BUILD=stack ARGS="" 92 | addons: 93 | apt: 94 | packages: 95 | - libgmp-dev 96 | compiler: ': #stack default' 97 | - env: BUILD=stack ARGS="--resolver lts-9" 98 | addons: 99 | apt: 100 | packages: 101 | - libgmp-dev 102 | compiler: ': #stack 8.0.2' 103 | - env: BUILD=stack ARGS="--resolver lts-11" 104 | addons: 105 | apt: 106 | packages: 107 | - libgmp-dev 108 | compiler: ': #stack 8.2.2' 109 | - env: BUILD=stack ARGS="--resolver lts-12" 110 | addons: 111 | apt: 112 | packages: 113 | - libgmp-dev 114 | compiler: ': #stack 8.4.4' 115 | - env: BUILD=stack ARGS="--resolver lts-13" 116 | addons: 117 | apt: 118 | packages: 119 | - libgmp-dev 120 | compiler: ': #stack 8.6.5' 121 | - env: BUILD=stack ARGS="--resolver nightly" 122 | addons: 123 | apt: 124 | packages: 125 | - libgmp-dev 126 | compiler: ': #stack nightly' 127 | - env: BUILD=stack ARGS="" 128 | os: osx 129 | compiler: ': #stack default osx' 130 | - env: BUILD=stack ARGS="--resolver lts-9" 131 | os: osx 132 | compiler: ': #stack 8.0.2 osx' 133 | - env: BUILD=stack ARGS="--resolver lts-11" 134 | os: osx 135 | compiler: ': #stack 8.2.2 osx' 136 | - env: BUILD=stack ARGS="--resolver lts-12" 137 | os: osx 138 | compiler: ': #stack 8.4.4 osx' 139 | - env: BUILD=stack ARGS="--resolver lts-13" 140 | os: osx 141 | compiler: ': #stack 8.6.5 osx' 142 | - env: BUILD=stack ARGS="--resolver nightly" 143 | os: osx 144 | compiler: ': #stack nightly osx' 145 | allow_failures: 146 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 147 | - env: BUILD=stack ARGS="--resolver nightly" 148 | install: 149 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo 150 | '?')]" 151 | - if [ -f configure.ac ]; then autoreconf -i; fi 152 | - | 153 | set -ex 154 | case "$BUILD" in 155 | stack) 156 | # Add in extra-deps for older snapshots, as necessary 157 | # 158 | # This is disabled by default, as relying on the solver like this can 159 | # make builds unreliable. Instead, if you have this situation, it's 160 | # recommended that you maintain multiple stack-lts-X.yaml files. 161 | 162 | #stack --no-terminal --install-ghc $ARGS test --bench --dry-run || ( \ 163 | # stack --no-terminal $ARGS build cabal-install && \ 164 | # stack --no-terminal $ARGS solver --update-config) 165 | 166 | # Build the dependencies 167 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 168 | ;; 169 | cabal) 170 | cabal --version 171 | travis_retry cabal update 172 | 173 | # Get the list of packages from the stack.yaml file. Note that 174 | # this will also implicitly run hpack as necessary to generate 175 | # the .cabal files needed by cabal-install. 176 | PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 177 | 178 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 179 | ;; 180 | esac 181 | set +ex 182 | cache: 183 | directories: 184 | - $HOME/.ghc 185 | - $HOME/.cabal 186 | - $HOME/.stack 187 | - $TRAVIS_BUILD_DIR/.stack-work 188 | before_install: 189 | - unset CC 190 | - CABALARGS="" 191 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 192 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH 193 | - mkdir -p ~/.local/bin 194 | - | 195 | if [ `uname` = "Darwin" ] 196 | then 197 | travis_retry curl --insecure -L https://get.haskellstack.org/stable/osx-x86_64.tar.gz | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 198 | else 199 | travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 200 | fi 201 | 202 | # Use the more reliable S3 mirror of Hackage 203 | mkdir -p $HOME/.cabal 204 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 205 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 206 | language: generic 207 | sudo: false 208 | 209 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | Changelog 2 | ========= 3 | 4 | Version 0.2.9.1 5 | --------------- 6 | 7 | *December 11, 2023* 8 | 9 | 10 | 11 | * Re-export `AoCUserAgent` from `Advent`. 12 | 13 | Version 0.2.9.0 14 | --------------- 15 | 16 | *December 11, 2023* 17 | 18 | 19 | 20 | * All API requests now require providing a structured user agent data type, 21 | to follow 22 | . 23 | This is not enforced in the raw servant API, but is enforced in the 24 | "regulated" `Advent` module. 25 | 26 | Version 0.2.8.5 27 | --------------- 28 | 29 | *December 11, 2023* 30 | 31 | 32 | 33 | * Compatibility with ghc-9.6 / mtl-2.3 34 | 35 | Version 0.2.8.4 36 | --------------- 37 | 38 | *December 14, 2022* 39 | 40 | 41 | 42 | * Whoops, the member id is a number now too. 43 | 44 | Version 0.2.8.3 45 | --------------- 46 | 47 | *December 13, 2022* 48 | 49 | 50 | 51 | * Properly adjust for AoC private leaderboard json: it uses a number instead 52 | of a string, but the parser was not properly fixed by hand. 53 | 54 | Version 0.2.8.2 55 | --------------- 56 | 57 | *December 9, 2022* 58 | 59 | 60 | 61 | * As of 2022 AoC, private leaderboard json payload uses a string instead of a 62 | number for owner_id. 63 | 64 | Version 0.2.8.1 65 | --------------- 66 | 67 | *November 30, 2021* 68 | 69 | 70 | 71 | * Account for new json schema for private leaderboard stats 72 | 73 | Version 0.2.8.0 74 | --------------- 75 | 76 | *December 14, 2020* 77 | 78 | 79 | 80 | * Add servant endpoint to query calendar page for a year to infer next puzzle 81 | and time to puzzle in seconds, backed by the `NextDayTime` data type. 82 | * Add `AoCNextDayTime` to `AoC` to support the above operation. 83 | 84 | Version 0.2.7.1 85 | --------------- 86 | 87 | *November 28, 2020* 88 | 89 | 90 | 91 | * Work with servant 0.17 and above. 92 | 93 | Version 0.2.7.0 94 | --------------- 95 | 96 | *December 4, 2019* 97 | 98 | 99 | 100 | * Throughout the library, change from `UTCTime` to `ZonedTime`, except for 101 | situations where the official site uses actual UTCTime. The main change is 102 | in `challengeReleaseTime`. 103 | * `challengeReleaseTime` moved to *Advent.Types* but re-exported from 104 | *Advent*. 105 | * `dlbmTime` changed from `UTCTime` to `NominalDiffTime` `dlbmDecTime`, which 106 | is time from December 1st. This is because we don't have information about 107 | the year from the HTML returned alone. This fixes a bug where the time 108 | would always be in 1970. 109 | * To convert `dlbmDecTime` back into a useful time,added `dlbmCompleteTime` 110 | to get the actual time of completion (as a `ZonedTime`), and `dlbmTime` to 111 | get the `NominalDiffTime` representing how long the challenge took. 112 | 113 | Version 0.2.6.0 114 | --------------- 115 | 116 | *December 3, 2019* 117 | 118 | 119 | 120 | * Add `aocServerTime` to get the current time for AoC servers. 121 | * Fix cacheing rules for global leaderboard (was previously not saving or 122 | invalidating cache properly) also for prompt (will not invalidate 123 | part1-only caches if there is no session key) 124 | * **0.2.6.1 Bugfix**: Fix bug in prompt cache invalidation 125 | * **0.2.6.2 Bugfix**: HTML parser for articles (for prompt API calls) now 126 | more robust, adjusting for more malformed HTML from site. 127 | 128 | Version 0.2.5.0 129 | --------------- 130 | 131 | *December 2, 2019* 132 | 133 | 134 | 135 | * Add `runAoC_`, which is `runAoC` but throwing an IO exception instead of 136 | returning an `Either`. 137 | 138 | Version 0.2.4.2 139 | --------------- 140 | 141 | *November 23, 2019* 142 | 143 | 144 | 145 | * Added instances of `ToJSONKey Day`, `ToJSON Day`, `ToJSONKey Part`, `ToJSON 146 | Part`. 147 | 148 | Version 0.2.4.1 149 | --------------- 150 | 151 | *November 21, 2019* 152 | 153 | 154 | 155 | * Export `DayInt` and `_DayInt` from *Advent* module 156 | 157 | Version 0.2.4.0 158 | --------------- 159 | 160 | *November 21, 2019* 161 | 162 | 163 | 164 | * Fixed caching behavior and documentation to reflect that Day 25 actually 165 | does have 2 stars, like normal. 166 | * Some extra smart constructors for moving between `Day` and `Integer`, in 167 | the form of a `Prism` and a pattern synonym. 168 | 169 | Version 0.2.3.0 170 | --------------- 171 | 172 | *November 21, 2019* 173 | 174 | 175 | 176 | * Add API commands for daily and global leaderboards. 177 | * In the process, the Servant API is reshuffled a bit: `Articles` has been 178 | generalized to `HTMLTags "article"`, to also support `HTMLTags "div"`. 179 | `FromArticle` is now `FromTags "article"`. 180 | * Move some of the data types to be in their own module, *Advent.Types*. 181 | 182 | Version 0.2.2.1 183 | --------------- 184 | 185 | *November 19, 2019* 186 | 187 | 188 | 189 | * Fixed prompt parser that would fail on 2016 Day 2 Part 2 because of a 190 | malformed `...` tag pair in the prompt HTML 191 | 192 | Version 0.2.2.0 193 | --------------- 194 | 195 | *November 9, 2019* 196 | 197 | 198 | 199 | * Rewrote submission response parser using megaparsec for better errors 200 | 201 | Version 0.2.1.0 202 | --------------- 203 | 204 | *November 5, 2019* 205 | 206 | 207 | 208 | * Export `Day` constructor from *Advent* 209 | 210 | Version 0.2.0.0 211 | --------------- 212 | 213 | *November 4, 2019* 214 | 215 | 216 | 217 | * Switch from libcurl to servant, which allows for shedding of external 218 | dependencies. 219 | * Support leaderboard API with data type. 220 | * Expose raw servant API and client functions, for those who want to build 221 | documentation or a mock server or low-level client. 222 | 223 | Version 0.1.2.X 224 | --------------- 225 | 226 | * *December 8, 2018*: *BUGFIX* Switched from *taggy* to *tagsoup*, after observing that *taggy* 227 | had some issues parsing 2018's Day 8 challenge prompt. 228 | 229 | 230 | 231 | * *December 8, 2018*: *BUGFIX* Add CPP to deal with building issues on GHC 8.2 232 | 233 | 234 | 235 | * *December 8, 2018*: *BUGFIX* Fix cache directory to separate by year 236 | 237 | 238 | 239 | Version 0.1.2.0 240 | --------------- 241 | 242 | *December 7, 2018* 243 | 244 | 245 | 246 | * Fixed cache to store prompts at `.html` instead of `.yaml` 247 | * `SubIncorrect` and `SubWait` now include fields for wait times. 248 | * Re-implemented submission result parsers using *attoparsec* 249 | 250 | Version 0.1.1.0 251 | --------------- 252 | 253 | *December 7, 2018* 254 | 255 | 256 | 257 | * More robust parser for submission results. Also now reports "hints" if 258 | possible. 259 | 260 | Version 0.1.0.0 261 | --------------- 262 | 263 | *December 5, 2018* 264 | 265 | 266 | 267 | * Initial Release 268 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Justin Le (c) 2018 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Justin Le nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [advent-of-code-api][] 2 | ====================== 3 | 4 | [![advent-of-code-api on Hackage](https://img.shields.io/hackage/v/advent-of-code-api.svg?maxAge=86400)](https://hackage.haskell.org/package/advent-of-code-api) 5 | [![Build Status](https://travis-ci.org/mstksg/advent-of-code-api.svg?branch=master)](https://travis-ci.org/mstksg/advent-of-code-api) 6 | 7 | Haskell bindings for Advent of Code REST API. Caches and throttles requests 8 | automatically, and parses responses into meaningful data types. 9 | 10 | [advent-of-code-api]: https://hackage.haskell.org/package/advent-of-code-api 11 | 12 | Specify your requests with `AoC` and `AoCOpts`, and run them with 13 | `runAoC`. 14 | 15 | Examples: 16 | 17 | ```haskell 18 | -- Fetch prompts for day 5 19 | runAoC myOpts $ AoCPrompt (mkDay_ 5) 20 | 21 | -- Fetch input for day 8 22 | runAoC myOpts $ AoCInput (mkDay_ 8) 23 | 24 | -- Submit answer "hello" for Day 10, Part 1 25 | runAoC myOpts $ AoCSubmit (mkDay_ 10) Part1 "hello" 26 | ``` 27 | 28 | Please use responsibly. All actions are rate-limited to a default of one 29 | request every three seconds, with ability to adjust up to as fast as a 30 | hard-coded limit of one request per second. 31 | 32 | The neatly exported bindings (handling cookies/authentication, cacheing, 33 | throttling) are in *Advent*. 34 | 35 | Session Keys 36 | ------------ 37 | 38 | Session keys are required for most commands, but if you enter a bogus key 39 | you should be able to get at least Part 1 from `AoCPrompt`. Session keys are 40 | also not needed for daily and global leaderboards. 41 | 42 | The session key can be found by logging in on a web client and checking 43 | the cookies. You can usually check these with in-browser developer 44 | tools. 45 | 46 | Servant API 47 | ----------- 48 | 49 | A Servant API (for integrating with *servant* for features like mock servers, 50 | documentation and low-level client methods) is also exported in *Advent.API*. 51 | The Servant API also parses into meaningful types, but lacks management of 52 | cookies/auth, cacheing, and throttling. Please use especially responsibly. 53 | 54 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /advent-of-code-api.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: advent-of-code-api 8 | version: 0.2.9.1 9 | synopsis: Advent of Code REST API bindings and servant API 10 | description: Haskell bindings for Advent of Code REST API and a servant API. Please use 11 | responsibly! See README.md or "Advent" module for an introduction and 12 | tutorial. 13 | category: Web 14 | homepage: https://github.com/mstksg/advent-of-code-api#readme 15 | bug-reports: https://github.com/mstksg/advent-of-code-api/issues 16 | author: Justin Le 17 | maintainer: justin@jle.im 18 | copyright: (c) Justin Le 2018 19 | license: BSD3 20 | license-file: LICENSE 21 | build-type: Simple 22 | tested-with: 23 | GHC >= 8.0 24 | extra-source-files: 25 | README.md 26 | CHANGELOG.md 27 | test-data/correct-rank.txt 28 | test-data/correct.txt 29 | test-data/incorrect-high.txt 30 | test-data/incorrect-low.txt 31 | test-data/incorrect-wait.txt 32 | test-data/incorrect.txt 33 | test-data/invalid.txt 34 | test-data/wait.txt 35 | test-data/wait2.txt 36 | 37 | source-repository head 38 | type: git 39 | location: https://github.com/mstksg/advent-of-code-api 40 | 41 | library 42 | exposed-modules: 43 | Advent 44 | Advent.API 45 | Advent.Types 46 | other-modules: 47 | Advent.Throttle 48 | Advent.Cache 49 | hs-source-dirs: 50 | src 51 | ghc-options: -Wall -Wcompat -Werror=incomplete-patterns 52 | build-depends: 53 | aeson 54 | , base >=4.9 && <5 55 | , bytestring 56 | , containers 57 | , deepseq 58 | , directory 59 | , filepath 60 | , finite-typelits 61 | , http-api-data 62 | , http-client 63 | , http-client-tls 64 | , http-media 65 | , megaparsec >=7 66 | , mtl 67 | , profunctors 68 | , servant 69 | , servant-client 70 | , servant-client-core 71 | , stm 72 | , tagsoup 73 | , text 74 | , time 75 | , time-compat >=1.9 76 | default-language: Haskell2010 77 | 78 | test-suite advent-of-code-api-test 79 | type: exitcode-stdio-1.0 80 | main-is: Spec.hs 81 | other-modules: 82 | Paths_advent_of_code_api 83 | hs-source-dirs: 84 | test 85 | ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -threaded -rtsopts -with-rtsopts=-N 86 | build-depends: 87 | HUnit 88 | , advent-of-code-api 89 | , base >=4.9 && <5 90 | , directory 91 | , filepath 92 | , text 93 | default-language: Haskell2010 94 | -------------------------------------------------------------------------------- /src/Advent.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE DeriveDataTypeable #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE GADTs #-} 6 | {-# LANGUAGE KindSignatures #-} 7 | {-# LANGUAGE LambdaCase #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE PatternSynonyms #-} 10 | {-# LANGUAGE PolyKinds #-} 11 | {-# LANGUAGE RecordWildCards #-} 12 | {-# LANGUAGE StandaloneDeriving #-} 13 | {-# LANGUAGE TupleSections #-} 14 | {-# LANGUAGE TypeApplications #-} 15 | {-# LANGUAGE ViewPatterns #-} 16 | 17 | -- | 18 | -- Module : Advent 19 | -- Copyright : (c) Justin Le 2019 20 | -- License : BSD3 21 | -- 22 | -- Maintainer : justin@jle.im 23 | -- Stability : experimental 24 | -- Portability : non-portable 25 | -- 26 | -- Haskell bindings for Advent of Code 2018 API. Caches and throttles 27 | -- requests automatically. 28 | -- 29 | -- Specify your requests with 'AoC' and 'AoCOpts', and run them with 30 | -- 'runAoC'. 31 | -- 32 | -- Examples: 33 | -- 34 | -- @ 35 | -- -- Fetch prompts for day 5 36 | -- 'runAoC' myOpts $ 'AoCPrompt' ('mkDay_' 5) 37 | -- 38 | -- -- Fetch input for day 8 39 | -- 'runAoC' myOpts $ 'AoCInput' ('mkDay_' 8) 40 | -- 41 | -- -- Submit answer "hello" for Day 10, Part 1 42 | -- 'runAoC' myOpts $ 'AoCSubmit' ('mkDay_' 10) 'Part1' "hello" 43 | -- @ 44 | -- 45 | -- Please use responsibly. All actions are by default rate limited to one 46 | -- per three seconds, but this can be adjusted to a hard-limited cap of one 47 | -- per second. 48 | 49 | module Advent ( 50 | -- * API 51 | AoC(..) 52 | , Part(..) 53 | , Day(..) 54 | , NextDayTime(..) 55 | , AoCOpts(..) 56 | , AoCUserAgent(..) 57 | , SubmitRes(..), showSubmitRes 58 | , runAoC 59 | , runAoC_ 60 | , defaultAoCOpts 61 | , AoCError(..) 62 | -- ** Calendar 63 | , challengeReleaseTime 64 | , timeToRelease 65 | , challengeReleased 66 | -- * Utility 67 | -- ** Day 68 | , mkDay, mkDay_, dayInt, pattern DayInt, _DayInt 69 | , aocDay 70 | , aocServerTime 71 | -- ** Part 72 | , partChar, partInt 73 | -- ** Leaderboard 74 | , fullDailyBoard 75 | -- ** Throttler 76 | , setAoCThrottleLimit, getAoCThrottleLimit 77 | -- * Internal 78 | , aocReq 79 | , aocBase 80 | ) where 81 | 82 | import Advent.API 83 | import Advent.Cache 84 | import Advent.Throttle 85 | import Advent.Types 86 | import Control.Concurrent.STM 87 | import Control.Exception 88 | import Control.Monad 89 | import Control.Monad.Except 90 | import Data.Kind 91 | import Data.Map (Map) 92 | import Data.Maybe 93 | import Data.Set (Set) 94 | import Data.Text (Text) 95 | import Data.Time hiding (Day) 96 | import Data.Typeable 97 | import GHC.Generics (Generic) 98 | import Network.HTTP.Client 99 | import Network.HTTP.Client.TLS 100 | import Servant.API 101 | import Servant.Client 102 | import System.Directory 103 | import System.FilePath 104 | import Text.Printf 105 | import qualified Data.Aeson as A 106 | import qualified Data.Map as M 107 | import qualified Data.Set as S 108 | import qualified Data.Text as T 109 | import qualified Data.Text.Encoding as T 110 | import qualified Data.Text.Lazy as TL 111 | import qualified Data.Text.Lazy.Encoding as TL 112 | import qualified Servant.Client as Servant 113 | import qualified System.IO.Unsafe as Unsafe 114 | 115 | #if MIN_VERSION_mtl(2,3,0) 116 | import Control.Monad.IO.Class (liftIO) 117 | #endif 118 | 119 | #if MIN_VERSION_base(4,11,0) 120 | import Data.Functor 121 | #else 122 | import Data.Semigroup ((<>)) 123 | 124 | (<&>) :: Functor f => f a -> (a -> b) -> f b 125 | (<&>) = flip fmap 126 | #endif 127 | 128 | initialThrottleLimit :: Int 129 | initialThrottleLimit = 100 130 | 131 | aocThrottler :: Throttler 132 | aocThrottler = Unsafe.unsafePerformIO $ newThrottler initialThrottleLimit 133 | {-# NOINLINE aocThrottler #-} 134 | 135 | -- | Set the internal throttler maximum queue capacity. Default is 100. 136 | setAoCThrottleLimit :: Int -> IO () 137 | setAoCThrottleLimit = setLimit aocThrottler 138 | 139 | -- | Get the internal throttler maximum queue capacity. 140 | getAoCThrottleLimit :: IO Int 141 | getAoCThrottleLimit = getLimit aocThrottler 142 | 143 | -- | An API command. An @'AoC' a@ an AoC API request that returns 144 | -- results of type @a@. 145 | -- 146 | -- A lot of these commands take 'Day', which represents a day of December 147 | -- up to and including Christmas Day (December 25th). You can convert an 148 | -- integer day (1 - 25) into a 'Day' using 'mkDay' or 'mkDay_'. 149 | data AoC :: Type -> Type where 150 | -- | Fetch prompts for a given day. Returns a 'Map' of 'Part's and 151 | -- their associated promps, as HTML. 152 | -- 153 | -- _Cacheing rules_: Is cached on a per-day basis. An empty session 154 | -- key is given, it will be happy with only having Part 1 cached. If 155 | -- a non-empty session key is given, it will trigger a cache 156 | -- invalidation on every request until both Part 1 and Part 2 are 157 | -- received. 158 | AoCPrompt 159 | :: Day 160 | -> AoC (Map Part Text) 161 | 162 | -- | Fetch input, as plaintext. Returned verbatim. Be aware that 163 | -- input might contain trailing newlines. 164 | -- 165 | -- /Cacheing rules/: Is cached forever, per day per session key. 166 | AoCInput :: Day -> AoC Text 167 | 168 | -- | Submit a plaintext answer (the 'String') to a given day and part. 169 | -- Receive a server reponse (as HTML) and a response code 'SubmitRes'. 170 | -- 171 | -- __WARNING__: Answers are not length-limited. Answers are stripped 172 | -- of leading and trailing whitespace and run through 'URI.encode' 173 | -- before submitting. 174 | -- 175 | -- /Cacheing rules/: Is never cached. 176 | AoCSubmit 177 | :: Day 178 | -> Part 179 | -> String 180 | -> AoC (Text, SubmitRes) 181 | 182 | -- | Fetch the leaderboard for a given leaderboard public code (owner 183 | -- member ID). Requires session key. 184 | -- 185 | -- The public code can be found in the URL of the leaderboard: 186 | -- 187 | -- > https://adventofcode.com/2019/leaderboard/private/view/12345 188 | -- 189 | -- (the @12345@ above) 190 | -- 191 | -- __NOTE__: This is the most expensive and taxing possible API call, 192 | -- and makes up the majority of bandwidth to the Advent of Code 193 | -- servers. As a courtesy to all who are participating in Advent of 194 | -- Code, please use this super respectfully, especially in December: if 195 | -- you set up automation for this, please do not use it more than once 196 | -- per day. 197 | -- 198 | -- /Cacheing rules/: Is never cached, so please use responsibly (see 199 | -- note above). 200 | -- 201 | -- @since 0.2.0.0 202 | AoCLeaderboard 203 | :: Integer 204 | -> AoC Leaderboard 205 | 206 | -- | Fetch the daily leaderboard for a given day. Does not require 207 | -- a session key. 208 | -- 209 | -- Leaderboard API calls tend to be expensive, so please be respectful 210 | -- when using this. If you automate this, please do not fetch any more 211 | -- often than necessary. 212 | -- 213 | -- /Cacheing rules/: Will be cached if a full leaderboard is observed. 214 | -- 215 | -- @since 0.2.3.0 216 | AoCDailyLeaderboard 217 | :: Day 218 | -> AoC DailyLeaderboard 219 | 220 | -- | Fetch the global leaderboard. Does not require 221 | -- a session key. 222 | -- 223 | -- Leaderboard API calls tend to be expensive, so please be respectful 224 | -- when using this. If you automate this, please do not fetch any more 225 | -- often than necessary. 226 | -- 227 | -- /Cacheing rules/: Will not cache if an event is ongoing, but will be 228 | -- cached if received after the event is over. 229 | -- 230 | -- @since 0.2.3.0 231 | AoCGlobalLeaderboard 232 | :: AoC GlobalLeaderboard 233 | 234 | -- | From the calendar, fetch the next release's day and the 235 | -- number of seconds util its release, if there is any at all. 236 | -- 237 | -- This does an actual request to the AoC servers, and is only accurate 238 | -- to the second; to infer this information (to the millisecond level) 239 | -- from the system clock, you should probably use 'timeToRelease' and 240 | -- 'aocServerTime' instead, which requires no network requests. 241 | -- 242 | -- @since 0.2.8.0 243 | AoCNextDayTime 244 | :: AoC NextDayTime 245 | 246 | deriving instance Show (AoC a) 247 | deriving instance Typeable (AoC a) 248 | 249 | -- | Get the day associated with a given API command, if there is one. 250 | aocDay :: AoC a -> Maybe Day 251 | aocDay (AoCPrompt d ) = Just d 252 | aocDay (AoCInput d ) = Just d 253 | aocDay (AoCSubmit d _ _ ) = Just d 254 | aocDay (AoCLeaderboard _) = Nothing 255 | aocDay (AoCDailyLeaderboard d) = Just d 256 | aocDay AoCGlobalLeaderboard = Nothing 257 | aocDay AoCNextDayTime = Nothing 258 | 259 | -- | A possible (syncronous, logical, pure) error returnable from 'runAoC'. 260 | -- Does not cover any asynchronous or IO errors. 261 | data AoCError 262 | -- | An error in the http request itself 263 | -- 264 | -- Note that if you are building this with servant-client-core <= 0.16, 265 | -- this will contain @ServantError@ instead of @ClientError@, which was 266 | -- the previous name of ths type. 267 | #if MIN_VERSION_servant_client_core(0,16,0) 268 | = AoCClientError ClientError 269 | #else 270 | = AoCClientError ServantError 271 | #endif 272 | -- | Tried to interact with a challenge that has not yet been 273 | -- released. Contains the amount of time until release. 274 | | AoCReleaseError NominalDiffTime 275 | -- | The throttler limit is full. Either make less requests, or adjust 276 | -- it with 'setAoCThrottleLimit'. 277 | | AoCThrottleError 278 | deriving (Show, Typeable, Generic) 279 | instance Exception AoCError 280 | 281 | -- | Setings for running an API request. 282 | -- 283 | -- Session keys are required for all commands, but if you enter a bogus key 284 | -- you should be able to get at least Part 1 from 'AoCPrompt'. 285 | -- 286 | -- The session key can be found by logging in on a web client and checking 287 | -- the cookies. You can usually check these with in-browser developer 288 | -- tools. 289 | -- 290 | -- Throttling is hard-limited to a minimum of 1 second between calls. 291 | -- Please be respectful and do not try to bypass this. 292 | data AoCOpts = AoCOpts 293 | { -- | Session key 294 | _aSessionKey :: String 295 | -- | Year of challenge 296 | , _aYear :: Integer 297 | -- | Structured user agent to use. See 298 | -- 299 | , _aUserAgent :: AoCUserAgent 300 | -- | Cache directory. If 'Nothing' is given, one will be allocated 301 | -- using 'getTemporaryDirectory'. 302 | , _aCache :: Maybe FilePath 303 | -- | Fetch results even if cached. Still subject to throttling. 304 | -- Default is False. 305 | , _aForce :: Bool 306 | -- | Throttle delay, in milliseconds. Minimum is 1000000. Default 307 | -- is 3000000 (3 seconds). 308 | , _aThrottle :: Int 309 | } 310 | deriving (Show, Typeable, Generic) 311 | 312 | -- | Sensible defaults for 'AoCOpts' for a given user agent, year and session 313 | -- key. 314 | -- 315 | -- Use system temporary directory as cache, and throttle requests to one 316 | -- request per three seconds. 317 | defaultAoCOpts 318 | :: AoCUserAgent 319 | -> Integer 320 | -> String 321 | -> AoCOpts 322 | defaultAoCOpts aua y s = AoCOpts 323 | { _aSessionKey = s 324 | , _aYear = y 325 | , _aUserAgent = aua 326 | , _aCache = Nothing 327 | , _aForce = False 328 | , _aThrottle = 3000000 329 | } 330 | 331 | -- | HTTPS base of Advent of Code API. 332 | aocBase :: BaseUrl 333 | aocBase = BaseUrl Https "adventofcode.com" 443 "" 334 | 335 | -- | 'ClientM' request for a given 'AoC' API call. 336 | aocReq :: Maybe AoCUserAgent -> Integer -> AoC a -> ClientM a 337 | aocReq aua yr = \case 338 | AoCPrompt i -> let r :<|> _ = adventAPIPuzzleClient aua yr i in r 339 | AoCInput i -> let _ :<|> r :<|> _ = adventAPIPuzzleClient aua yr i in r 340 | AoCSubmit i p ans -> let _ :<|> _ :<|> r = adventAPIPuzzleClient aua yr i 341 | in r (SubmitInfo p ans) <&> \(x :<|> y) -> (x, y) 342 | AoCLeaderboard c -> let _ :<|> _ :<|> _ :<|> _ :<|> r = adventAPIClient aua yr 343 | in r (PublicCode c) 344 | AoCDailyLeaderboard d -> let _ :<|> _ :<|> _ :<|> r :<|> _ = adventAPIClient aua yr 345 | in r d 346 | AoCGlobalLeaderboard -> let _ :<|> _ :<|> r :<|> _ = adventAPIClient aua yr 347 | in r 348 | AoCNextDayTime -> let r :<|> _ = adventAPIClient aua yr 349 | in r 350 | 351 | 352 | -- | Cache file for a given 'AoC' command 353 | apiCache 354 | :: Maybe String -- ^ session key 355 | -> Integer -- ^ year 356 | -> AoC a 357 | -> Maybe FilePath 358 | apiCache sess yr = \case 359 | AoCPrompt d -> Just $ printf "prompt/%04d/%02d.html" yr (dayInt d) 360 | AoCInput d -> Just $ printf "input/%s%04d/%02d.txt" keyDir yr (dayInt d) 361 | AoCSubmit{} -> Nothing 362 | AoCLeaderboard{} -> Nothing 363 | AoCDailyLeaderboard d -> Just $ printf "daily/%04d/%02d.json" yr (dayInt d) 364 | AoCGlobalLeaderboard{} -> Just $ printf "global/%04d.json" yr 365 | AoCNextDayTime -> Nothing 366 | where 367 | keyDir = case sess of 368 | Nothing -> "" 369 | Just s -> strip s ++ "/" 370 | 371 | -- | Run an 'AoC' command with a given 'AoCOpts' to produce the result 372 | -- or a list of (lines of) errors. 373 | -- 374 | -- __WARNING__: Answers are not length-limited. Answers are stripped 375 | -- of leading and trailing whitespace and run through 'URI.encode' 376 | -- before submitting. 377 | runAoC :: AoCOpts -> AoC a -> IO (Either AoCError a) 378 | runAoC AoCOpts{..} a = do 379 | (keyMayb, cacheDir) <- case _aCache of 380 | Just c -> pure (Nothing, c) 381 | Nothing -> (Just _aSessionKey,) . ( "advent-of-code-api") <$> getTemporaryDirectory 382 | 383 | (yy,mm,dd) <- toGregorian 384 | . localDay 385 | . utcToLocalTime (read "EST") 386 | <$> getCurrentTime 387 | let eventOver = yy > _aYear 388 | || (mm == 12 && dd > 25) 389 | cacher = case apiCache keyMayb _aYear a of 390 | Nothing -> id 391 | Just fp -> cacheing (cacheDir fp) $ 392 | if _aForce 393 | then noCache 394 | else saverLoader 395 | (not (null _aSessionKey)) 396 | (not eventOver) 397 | a 398 | 399 | cacher . runExceptT $ do 400 | forM_ (aocDay a) $ \d -> do 401 | rel <- liftIO $ timeToRelease _aYear d 402 | when (rel > 0) $ 403 | throwError $ AoCReleaseError rel 404 | 405 | mtr <- liftIO 406 | . throttling aocThrottler (max 1000000 _aThrottle) 407 | $ runClientM (aocReq (Just _aUserAgent) _aYear a) =<< aocClientEnv _aSessionKey 408 | mcr <- maybe (throwError AoCThrottleError) pure mtr 409 | either (throwError . AoCClientError) pure mcr 410 | 411 | -- | A version of 'runAoC' that throws an IO exception (of type 'AoCError') 412 | -- upon failure, instead of an 'Either'. 413 | -- 414 | -- @since 0.2.5.0 415 | runAoC_ :: AoCOpts -> AoC a -> IO a 416 | runAoC_ o = either throwIO pure <=< runAoC o 417 | 418 | aocClientEnv :: String -> IO ClientEnv 419 | aocClientEnv s = do 420 | t <- getCurrentTime 421 | v <- atomically . newTVar $ createCookieJar [c t] 422 | mgr <- newTlsManager 423 | pure $ (mkClientEnv mgr aocBase) 424 | { Servant.cookieJar = Just v } 425 | where 426 | c t = Cookie 427 | { cookie_name = "session" 428 | , cookie_value = T.encodeUtf8 . T.pack $ s 429 | , cookie_expiry_time = addUTCTime oneYear t 430 | , cookie_domain = "adventofcode.com" 431 | , cookie_path = "/" 432 | , cookie_creation_time = t 433 | , cookie_last_access_time = t 434 | , cookie_persistent = True 435 | , cookie_host_only = True 436 | , cookie_secure_only = True 437 | , cookie_http_only = True 438 | } 439 | oneYear = 60 * 60 * 24 * 356.25 440 | 441 | 442 | saverLoader 443 | :: Bool -- ^ is there a non-empty session token? 444 | -> Bool -- ^ is the event ongoing (True) or over (False)? 445 | -> AoC a 446 | -> SaverLoader (Either AoCError a) 447 | saverLoader validToken evt = \case 448 | AoCPrompt{} -> SL { _slSave = either (const Nothing) (Just . encodeMap) 449 | , _slLoad = \str -> 450 | let mp = decodeMap str 451 | hasAll = S.null (expectedParts `S.difference` M.keysSet mp) 452 | in Right mp <$ guard hasAll 453 | } 454 | AoCInput{} -> SL { _slSave = either (const Nothing) Just 455 | , _slLoad = Just . Right 456 | } 457 | AoCSubmit{} -> noCache 458 | AoCLeaderboard{} -> noCache 459 | AoCDailyLeaderboard{} -> SL 460 | { _slSave = either (const Nothing) (Just . TL.toStrict . TL.decodeUtf8 . A.encode) 461 | , _slLoad = \str -> do 462 | r <- A.decode . TL.encodeUtf8 . TL.fromStrict $ str 463 | guard $ fullDailyBoard r 464 | pure $ Right r 465 | } 466 | AoCGlobalLeaderboard{} -> SL 467 | { _slSave = either 468 | (const Nothing) 469 | (Just . TL.toStrict . TL.decodeUtf8 . A.encode @(Bool, GlobalLeaderboard) . (evt,)) 470 | , _slLoad = \str -> do 471 | (evt', lb) <- A.decode @(Bool, GlobalLeaderboard) . TL.encodeUtf8 . TL.fromStrict $ str 472 | guard $ not evt' -- only load cache if evt' is false: it was saved in a non-evt time 473 | pure $ Right lb 474 | } 475 | AoCNextDayTime{} -> noCache 476 | where 477 | expectedParts :: Set Part 478 | expectedParts 479 | | validToken = S.fromDistinctAscList [Part1 ..] 480 | | otherwise = S.singleton Part1 481 | sep = ">>>>>>>>>" 482 | encodeMap mp = T.intercalate "\n" . concat $ 483 | [ maybeToList $ M.lookup Part1 mp 484 | , [sep] 485 | , maybeToList $ M.lookup Part2 mp 486 | ] 487 | decodeMap xs = mkMap Part1 part1 <> mkMap Part2 part2 488 | where 489 | (part1, drop 1 -> part2) = span (/= sep) (T.lines xs) 490 | mkMap p (T.intercalate "\n"->ln) 491 | | T.null (T.strip ln) = M.empty 492 | | otherwise = M.singleton p ln 493 | 494 | -- | Get time until release of a given challenge. 495 | timeToRelease 496 | :: Integer -- ^ year 497 | -> Day -- ^ day 498 | -> IO NominalDiffTime 499 | timeToRelease y d = (zonedTimeToUTC (challengeReleaseTime y d) `diffUTCTime`) <$> getCurrentTime 500 | 501 | -- | Check if a challenge has been released yet. 502 | challengeReleased 503 | :: Integer -- ^ year 504 | -> Day -- ^ day 505 | -> IO Bool 506 | challengeReleased y = fmap (<= 0) . timeToRelease y 507 | 508 | -- | Utility to get the current time on AoC servers. Basically just gets the current 509 | -- time in Eastern Standard Time. This is only as accurate as your 510 | -- machine's actual time --- it doesn't actually do anything networked. 511 | -- 512 | -- @since 0.2.6.0 513 | aocServerTime :: IO LocalTime 514 | aocServerTime = utcToLocalTime (read "EST") <$> getCurrentTime 515 | 516 | strip :: String -> String 517 | strip = T.unpack . T.strip . T.pack 518 | -------------------------------------------------------------------------------- /src/Advent/API.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE LambdaCase #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE PolyKinds #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TypeApplications #-} 12 | {-# LANGUAGE TypeOperators #-} 13 | {-# LANGUAGE ViewPatterns #-} 14 | 15 | -- | 16 | -- Module : Advent.API 17 | -- Copyright : (c) Justin Le 2019 18 | -- License : BSD3 19 | -- 20 | -- Maintainer : justin@jle.im 21 | -- Stability : experimental 22 | -- Portability : non-portable 23 | -- 24 | -- Raw Servant API for Advent of Code. Can be useful for building mock 25 | -- servers, generating documentation and other servanty things, or 26 | -- low-level raw requests. 27 | -- 28 | -- If you use this to make requests directly, please use responsibly: do 29 | -- not make automated requests more than once per day and throttle all 30 | -- manual requestes. See notes in "Advent". 31 | -- 32 | -- @since 0.2.0.0 33 | -- 34 | 35 | module Advent.API ( 36 | -- * Servant API 37 | AdventAPI 38 | , AoCUserAgent(..) 39 | , adventAPI 40 | , adventAPIClient 41 | , adventAPIPuzzleClient 42 | -- * Types 43 | , HTMLTags 44 | , FromTags(..) 45 | , Articles 46 | , Divs 47 | , Scripts 48 | , RawText 49 | -- * Internal 50 | , processHTML 51 | ) where 52 | 53 | import Advent.Types 54 | import Control.Applicative 55 | import Control.Monad 56 | import Control.Monad.State 57 | import Data.Bifunctor 58 | import Data.Char 59 | import Data.Finite 60 | import Data.Foldable 61 | import Data.List.NonEmpty (NonEmpty(..)) 62 | import Data.Map (Map) 63 | import Data.Maybe 64 | import Data.Ord 65 | import Data.Proxy 66 | import Data.Text (Text) 67 | import Data.Time hiding (Day) 68 | import GHC.TypeLits 69 | import Servant.API 70 | import Servant.Client 71 | import Text.HTML.TagSoup.Tree (TagTree(..)) 72 | import Text.Read (readMaybe) 73 | import qualified Data.ByteString.Lazy as BSL 74 | import qualified Data.List.NonEmpty as NE 75 | import qualified Data.Map as M 76 | import qualified Data.Text as T 77 | import qualified Data.Text.Encoding as T 78 | import qualified Network.HTTP.Media as M 79 | import qualified Text.HTML.TagSoup as H 80 | import qualified Text.HTML.TagSoup.Tree as H 81 | 82 | #if !MIN_VERSION_base(4,11,0) 83 | import Data.Semigroup ((<>)) 84 | #endif 85 | 86 | #if !MIN_VERSION_time(1,9,0) 87 | import Data.Time.LocalTime.Compat 88 | #endif 89 | 90 | -- | Raw "text/plain" MIME type 91 | data RawText 92 | 93 | instance Accept RawText where 94 | contentType _ = "text" M.// "plain" 95 | 96 | instance MimeUnrender RawText Text where 97 | mimeUnrender _ = first show . T.decodeUtf8' . BSL.toStrict 98 | 99 | -- | Interpret repsonse as a list of HTML 'T.Text' found in the given type of 100 | -- tag 101 | -- 102 | -- @since 0.2.3.0 103 | data HTMLTags (tag :: Symbol) 104 | 105 | -- | Interpret a response as a list of HTML 'T.Text' found in @
@ tags. 106 | type Articles = HTMLTags "article" 107 | 108 | -- | Interpret a response as a list of HTML 'T.Text' found in @
@ tags. 109 | -- 110 | -- @since 0.2.3.0 111 | type Divs = HTMLTags "div" 112 | 113 | -- | Interpret a response as a list of HTML 'T.Text' found in @