├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── Main.hs ├── Setup.hs ├── admins.txt ├── cabal.project ├── client ├── comic.js ├── default.nix ├── loaders │ └── comic-image-loader.js ├── mockups.svg ├── node-env.nix ├── node-packages.nix ├── package.json ├── src │ ├── APIClient.ts │ ├── App.tsx │ ├── Text.tsx │ ├── admin │ │ ├── AdminApp.tsx │ │ ├── Input.tsx │ │ ├── index.ejs │ │ └── index.tsx │ ├── comic │ │ ├── Comic.tsx │ │ ├── MapLoader.ts │ │ ├── MapRender.tsx │ │ ├── useDragPos.ts │ │ └── useMapLoader.ts │ ├── custom.d.ts │ ├── extension │ │ ├── index.ts │ │ └── manifest.json │ ├── index.ejs │ ├── index.tsx │ ├── loot │ │ ├── LootButton.tsx │ │ ├── LootPane.tsx │ │ ├── LootStateController.ts │ │ ├── ParticlePop.tsx │ │ └── useLootState.ts │ ├── lootImageURL.ts │ ├── preloadImg.ts │ ├── types.ts │ ├── useCanvas.ts │ └── useStorage.ts ├── tsconfig.json └── webpack.config.js ├── default.nix ├── doc-gen └── Main.hs ├── loot ├── 1 │ ├── A.png │ ├── B.png │ ├── C.png │ ├── D.png │ ├── E.png │ └── F.png └── 2 │ └── box.png ├── maple.cabal ├── shell.nix ├── snippets ├── src └── Maple │ ├── AABB.hs │ ├── Config.hs │ ├── Loot.hs │ ├── Map.hs │ ├── Session.hs │ ├── Staticize.hs │ ├── Storage │ ├── Redis.hs │ └── Ref.hs │ ├── TextHintParser.hs │ ├── Web.hs │ └── Web │ ├── API.hs │ ├── Admin.hs │ ├── Local.hs │ ├── Server.hs │ └── Session.hs ├── test ├── AABBTest.hs ├── MapleTest.hs └── ParserTests.hs ├── test_grouped.csv ├── test_groups.csv ├── test_loot.csv └── test_loot_combine.csv /.gitignore: -------------------------------------------------------------------------------- 1 | /dist-newstyle 2 | docs.md 3 | *~ 4 | /cabal.project.local 5 | /result 6 | /bin 7 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for maple 2 | 3 | ## 0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, davean 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 davean 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 | -------------------------------------------------------------------------------- /Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Control.Lens 5 | import Control.Monad.State 6 | import Data.Time 7 | import qualified Data.Vector as V 8 | import Data.Word 9 | import Linear 10 | import Linear.Affine 11 | import Maple.AABB 12 | import Maple.Config 13 | import Maple.Loot 14 | import Maple.Map 15 | import Maple.Storage.Ref 16 | import Maple.Web 17 | import Maple.Web.Admin 18 | import Maple.Web.API 19 | import Maple.Web.Local 20 | import Network.Wai.Handler.Warp 21 | import System.Random 22 | import qualified Web.ClientSession as CS 23 | 24 | main :: IO () 25 | main = do 26 | (_, key) <- CS.randomKey 27 | let safeFilePaths = ["loot"] 28 | (mbb, l, adminLoot) <- loadLoot filePath3D [atExactly] safeFilePaths "test_loot.csv" 29 | -- adminCheck <- authCheckFromFile "admins.txt" 30 | let 31 | config = MC 32 | { _mcCSKey = key 33 | , _mcGrigMap = mkMap { _igmMaxBB = mbb } 34 | , _mcLootBoxes = l 35 | , _mcMkLocal = ipv4Local 36 | , _mcPoolSize = 20 37 | , _mcBinListCachePolicy = MapleCacheControl 60 -- 60 second cache policy 38 | , _mcBinContentsCachePolicy = MapleCacheControl 5 -- 5 second cache policy 39 | , _mcImageFolders = safeFilePaths 40 | , _mcCheckAdmin = nullAdminCheck 41 | , _mcAdminLoot = adminLoot 42 | , _mcPaused = False 43 | , _mcAllowedOrigins = [] 44 | , _mcExtra = () 45 | } 46 | let (AABB (V2 minMapX minMapY) (V2 maxMapX maxMapY)) = 47 | config^.mcGrigMap.igmBBs.to (bounding . concatMap (corners . box2d . fst) . concatMap V.toList . V.toList) 48 | let randomPosInBounds = fmap P . liftIO $ V3 <$> randomRIO (minMapX, maxMapX) <*> randomRIO (minMapY, maxMapY) <*> randomRIO (0, 10) 49 | let randomLoot = liftIO $ fmap (\i -> adminLoot!!i) $ randomRIO (0, length adminLoot-1) 50 | cfg <- startBinStore config 51 | runRefBinStore' cfg $ do 52 | forM_ [1..(10000::Word64)] $ \_ -> do 53 | tp <- randomPosInBounds 54 | lt <- randomLoot 55 | now <- liftIO $ getCurrentTime 56 | void $ binTX doesNotOverlap (DBMeta 0 now (lt & pos .~ tp)) 57 | putStrLn "Serving" 58 | run 8000 $ serveMapleAPI cfg (runRefBinStore' cfg) 59 | 60 | mkMap :: IGridMap2 V3 Int Word 61 | mkMap = fst $ 62 | (`runState` 0) $ buildMap (\b -> state (\c -> ((b, c), c+1))) 63 | (AABB (V3 0 0 0) (V3 0 0 0)) 64 | (P (V2 0 0)) 65 | (V2 500 500) 66 | 80 20 67 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /admins.txt: -------------------------------------------------------------------------------- 1 | admin:$2a$10$nn1jDdSrBo7XbhvTPZSakuV7Rg0OE14bL5g/ZcjZzY.nGkXPxsUxe 2 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | source-repository-package 4 | type: git 5 | location: https://code.xkrd.net/davean/hashring.git 6 | tag: ecebf2e 7 | 8 | allow-newer: 9 | base 10 | lens 11 | ghc-prim 12 | template-haskell 13 | 14 | package maple 15 | ghc-options: -Wall -threaded -rtsopts -fprof-auto -fprof-auto-calls 16 | test-show-details:streaming 17 | -------------------------------------------------------------------------------- /client/comic.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | "name": "Collector's Edition", 3 | "alt": "I'm sure you can find some suitable worldbuilding material if you scavenge through the archives.", 4 | "url": "/2288", 5 | "width": 740, 6 | "height": 555, 7 | "apiServerURL": process.env.MAPLE_API_SERVER, 8 | "itemImgBaseURL": process.env.MAPLE_ITEM_IMG_URL, 9 | } 10 | -------------------------------------------------------------------------------- /client/default.nix: -------------------------------------------------------------------------------- 1 | {pkgs ? import { 2 | inherit system; 3 | }, system ? builtins.currentSystem, nodejs ? pkgs."nodejs-12_x"}: 4 | 5 | let 6 | nodeEnv = import ./node-env.nix { 7 | inherit (pkgs) stdenv python2 utillinux runCommand writeTextFile; 8 | inherit nodejs; 9 | libtool = if pkgs.stdenv.isDarwin then pkgs.darwin.cctools else null; 10 | }; 11 | in 12 | import ./node-packages.nix { 13 | inherit (pkgs) fetchurl fetchgit; 14 | inherit nodeEnv; 15 | globalBuildInputs = [ 16 | pkgs.vips 17 | pkgs.glib 18 | pkgs.pkg-config 19 | ]; 20 | } 21 | -------------------------------------------------------------------------------- /client/loaders/comic-image-loader.js: -------------------------------------------------------------------------------- 1 | const {callbackify} = require('util') 2 | const loaderUtils = require('loader-utils') 3 | const sharp = require('sharp') 4 | 5 | async function processImage(inputBuffer) { 6 | const options = loaderUtils.getOptions(this) 7 | 8 | const img = sharp(inputBuffer) 9 | const meta = await img.metadata() 10 | 11 | const { 12 | data: resized2XBuffer, 13 | info: resized2XInfo, 14 | } = await img.resize({ 15 | width: Math.floor(meta.width * options.scale) * 2, 16 | }) 17 | .png({palette: !!options.quant}) 18 | .toBuffer({resolveWithObject: true}) 19 | 20 | const interpolatedName = loaderUtils.interpolateName( 21 | this, 22 | options.name, 23 | {content: resized2XBuffer}, 24 | ) 25 | this.emitFile(interpolatedName, resized2XBuffer) 26 | 27 | const publicPath = options.publicPath ? options.publicPath + '/' : '' 28 | return `module.exports = { 29 | width: ${resized2XInfo.width / 2}, 30 | height: ${Math.floor(resized2XInfo.height / 2)}, 31 | url: { 32 | '2x': __webpack_public_path__ + '${interpolatedName}', 33 | } 34 | }` 35 | } 36 | 37 | const processImageCb = callbackify(processImage) 38 | 39 | module.exports = function downscale(inputBuffer) { 40 | this.cacheable() 41 | const cb = this.async() 42 | processImageCb.call(this, inputBuffer, cb) 43 | } 44 | 45 | module.exports.raw = true 46 | -------------------------------------------------------------------------------- /client/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "maple-client", 3 | "version": "1.0.0", 4 | "description": "Lootboxes are fun, let's make more of those", 5 | "private": true, 6 | "main": "index.js", 7 | "scripts": { 8 | "build": "webpack --mode production", 9 | "build:comic": "npm run build -- --config-name comic", 10 | "build:admin": "npm run build -- --config-name admin", 11 | "build:extension": "npm run build -- --config-name extension", 12 | "start:dev": "webpack-dev-server --mode=development -d -w", 13 | "start:comic": "npm run start:dev -- --config-name comic", 14 | "start:admin": "npm run start:dev -- --config-name admin", 15 | "start:extension": "npm run start:dev -- --config-name extension" 16 | }, 17 | "author": "Max Goodman ", 18 | "license": "MIT", 19 | "devDependencies": { 20 | "@types/lodash": "^4.14.149", 21 | "@types/rbush": "^3.0.0", 22 | "@types/react": "^16.9.26", 23 | "@types/react-dom": "^16.9.5", 24 | "@types/styled-components": "^5.0.1", 25 | "@types/webpack-env": "^1.15.1", 26 | "@types/uuid": "^7.0.2", 27 | "cache-loader": "^4.1.0", 28 | "copy-webpack-plugin": "^5.1.1", 29 | "file-loader": "^6.0.0", 30 | "html-webpack-plugin": "^4.0.2", 31 | "loader-utils": "^2.0.0", 32 | "sharp": "^0.25.2", 33 | "ts-loader": "^6.2.2", 34 | "typescript": "^3.8.3", 35 | "webpack": "^4.42.1", 36 | "webpack-cli": "^3.3.11", 37 | "webpack-dev-server": "^3.10.3", 38 | "zip-webpack-plugin": "^3.0.0" 39 | }, 40 | "dependencies": { 41 | "@servie/events": "^1.0.0", 42 | "lodash": "^4.17.15", 43 | "rbush": "^3.0.1", 44 | "react": "^16.13.1", 45 | "react-async-hook": "^3.6.1", 46 | "react-dom": "^16.13.1", 47 | "ts-polyfill": "^3.8.2", 48 | "styled-components": "^5.0.1", 49 | "uuid": "^7.0.2" 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /client/src/APIClient.ts: -------------------------------------------------------------------------------- 1 | import random from 'lodash/random' 2 | 3 | import type {ServerBinSpace, ServerItems, Loc, BinLoc, ItemLoc, BinData, ViewData, ServerClaim, ServerPlace, InventoryItem, ClaimResult, PlaceResult, ServerBinItemMap} from './types' 4 | 5 | const DEFAULT_VIEW_MAX_AGE = 60000 6 | const DEFAULT_BIN_MAX_AGE = 5000 7 | 8 | function parseMaxAge(cacheControlHeader: string): number { 9 | if (!cacheControlHeader) { 10 | return null 11 | } 12 | const match = cacheControlHeader.match(/max-age=(\d+)/) 13 | if (!match) { 14 | return null 15 | } 16 | return Number(match[1]) 17 | } 18 | 19 | function parseExpiresAt(cacheControlHeader: string, defaultAge: number): number { 20 | const maxAge = parseMaxAge(cacheControlHeader) ?? defaultAge 21 | return Date.now() + 1000 * maxAge 22 | } 23 | 24 | export interface APIClient { 25 | claimLoot: (session: string, path: string) => Promise, 26 | placeItem: (session: string, itemLoc: ItemLoc) => Promise, 27 | fetchView: (viewLoc: Loc) => Promise, 28 | fetchBin: (id: string) => Promise, 29 | } 30 | 31 | export class MockAPIClient implements APIClient { 32 | jitter = 5 33 | binRange = 3 34 | itemCount = 10 35 | binSize = 500 36 | viewBins: Array 37 | binDatas: Map> 38 | 39 | constructor() { 40 | const {jitter, binRange, itemCount, binSize} = this 41 | this.viewBins = [] 42 | this.binDatas = new Map() 43 | const gridSize = binSize / itemCount 44 | let idx = 0 45 | for (let bx = -binRange; bx <= binRange; bx++) { 46 | for (let by = -binRange; by <= binRange; by++) { 47 | const id = String(idx++) 48 | this.viewBins.push({ 49 | kind: 'bin', 50 | id, 51 | minX: bx * binSize, 52 | minY: by * binSize, 53 | maxX: (bx + 1) * binSize, 54 | maxY: (by + 1) * binSize, 55 | }) 56 | 57 | const items: Array = [] 58 | for (let i = 0; i < itemCount; i++) { 59 | items.push({ 60 | kind: 'item', 61 | img: 'test.png', 62 | minX: bx * binSize + i * gridSize, 63 | minY: by * binSize + i * gridSize, 64 | maxX: bx * binSize + (i + 1) * gridSize, 65 | maxY: by * binSize + (i + 1) * gridSize, 66 | minZ: random(0, 4), 67 | }) 68 | } 69 | 70 | this.binDatas.set(id, { 71 | id, 72 | items, 73 | }) 74 | } 75 | } 76 | } 77 | 78 | async claimLoot(session: string, path: string): Promise { 79 | return { 80 | loot: [ 81 | { 82 | img: 'cat.png', 83 | width: 100, 84 | height: 100, 85 | z: 0, 86 | }, 87 | { 88 | img: 'hat.png', 89 | width: 200, 90 | height: 200, 91 | z: 1, 92 | }, 93 | ], 94 | hints: [ 95 | 'Cats can have little a salami, as a treat.', 96 | ], 97 | session: 'opaquesessiondata', 98 | } 99 | } 100 | 101 | async placeItem(session: string, itemLoc: ItemLoc): Promise { 102 | return { 103 | placed: true, 104 | loot: [ 105 | { 106 | img: 'bat.png', 107 | width: 120, 108 | height: 120, 109 | z: 0, 110 | }, 111 | ], 112 | hints: [ 113 | 'Bats can also have little a salami, as a treat.', 114 | ], 115 | binDatas: [], 116 | session: 'opaquesessiondata', 117 | } 118 | } 119 | 120 | async fetchView(viewLoc: Loc): Promise { 121 | console.debug('fetch view', viewLoc) 122 | return { 123 | expiresAt: Date.now() + 10000, 124 | bins: this.viewBins, 125 | } 126 | } 127 | 128 | async fetchBin(id: string): Promise { 129 | console.debug('fetch bin', id) 130 | const {items} = this.binDatas.get(id) 131 | return { 132 | id, 133 | expiresAt: Date.now() + 1000, 134 | items: items.map(({maxX, maxY, ...rest}) => ({ 135 | maxX: maxX + random(this.jitter), 136 | maxY: maxY + random(this.jitter), 137 | ...rest, 138 | })) 139 | } 140 | } 141 | } 142 | 143 | export class MapleClient implements APIClient { 144 | serverURL: string 145 | 146 | constructor(serverURL: string) { 147 | this.serverURL = serverURL 148 | } 149 | 150 | _readServerLoot(loot: ServerItems): Array { 151 | return loot.map(({img, aabb: {min, max}}) => ({ 152 | img, 153 | width: max[0] - min[0], 154 | height: max[1] - min[1], 155 | z: min[2], 156 | })) 157 | } 158 | 159 | _readServerItems(items: ServerItems): Array { 160 | return items.map(({img, aabb}) => ({ 161 | kind: 'item', 162 | img: img, 163 | minX: aabb.min[0], 164 | minY: aabb.min[1], 165 | maxX: aabb.max[0], 166 | maxY: aabb.max[1], 167 | minZ: aabb.min[2], 168 | })) 169 | } 170 | 171 | _readServerBinDatas(binItemsMap: ServerBinItemMap, expiresAt: number): Array { 172 | return Object.entries(binItemsMap).map(([id, items]) => ({ 173 | id, 174 | expiresAt, 175 | items: this._readServerItems(items), 176 | })) 177 | } 178 | 179 | async claimLoot(session: string, path: string): Promise { 180 | const resp = await fetch(`${this.serverURL}claim`, { 181 | method: 'POST', 182 | headers: { 183 | 'Content-Type': 'application/json', 184 | }, 185 | body: JSON.stringify({ 186 | value: path, 187 | session: session ?? '', 188 | }), 189 | }) 190 | const {value: {loot, hints}, session: newSession}: ServerClaim = await resp.json() 191 | return { 192 | loot: this._readServerLoot(loot), 193 | hints, 194 | session: newSession, 195 | } 196 | } 197 | 198 | async placeItem(session: string, itemLoc: ItemLoc): Promise { 199 | const resp = await fetch(`${this.serverURL}place`, { 200 | method: 'POST', 201 | headers: { 202 | 'Content-Type': 'application/json', 203 | }, 204 | body: JSON.stringify({ 205 | value: { 206 | img: itemLoc.img, 207 | aabb: { 208 | min: [itemLoc.minX, itemLoc.minY, itemLoc.minZ], 209 | max: [itemLoc.maxX, itemLoc.maxY, itemLoc.minZ], 210 | }, 211 | }, 212 | session: session ?? '', 213 | }), 214 | }) 215 | const {value: {placed, user: {loot, hints}, bins}, session: newSession}: ServerPlace = await resp.json() 216 | const expiresAt = parseExpiresAt(resp.headers.get('Cache-Control'), DEFAULT_BIN_MAX_AGE) 217 | return { 218 | placed, 219 | loot: this._readServerLoot(loot), 220 | hints, 221 | binDatas: this._readServerBinDatas(bins, expiresAt), 222 | session: newSession, 223 | } 224 | } 225 | 226 | async fetchView(viewLoc: Loc): Promise { 227 | const params = new URLSearchParams({ 228 | minPoint: [viewLoc.minX, viewLoc.minY].join(','), 229 | maxPoint: [viewLoc.maxX, viewLoc.maxY].join(','), 230 | }) 231 | const resp = await fetch(`${this.serverURL}view?${params}`) 232 | const data: ServerBinSpace = await resp.json() 233 | return { 234 | expiresAt: parseExpiresAt(resp.headers.get('Cache-Control'), DEFAULT_VIEW_MAX_AGE), 235 | bins: Object.entries(data).map(([id, aabb]) => ({ 236 | kind: 'bin', 237 | id, 238 | minX: aabb.min[0], 239 | minY: aabb.min[1], 240 | maxX: aabb.max[0], 241 | maxY: aabb.max[1], 242 | })), 243 | } 244 | } 245 | 246 | async fetchBin(id: string): Promise { 247 | const resp = await fetch(`${this.serverURL}bin/${id}`) 248 | const items: ServerItems = await resp.json() 249 | return { 250 | id, 251 | expiresAt: parseExpiresAt(resp.headers.get('Cache-Control'), DEFAULT_BIN_MAX_AGE), 252 | items: this._readServerItems(items), 253 | } 254 | } 255 | } 256 | 257 | export class MapleAdminClient extends MapleClient { 258 | async fetchAllItems(username: string, password: string): Promise> { 259 | const resp = await fetch(`${this.serverURL}mod/loot/all`, { 260 | headers: { 261 | 'Authorization': `Basic ${btoa(`${username}:${password}`)}`, 262 | }, 263 | }) 264 | const data: ServerItems = await resp.json() 265 | return this._readServerLoot(data) 266 | } 267 | 268 | async placeAdminItem(username: string, password: string, itemLoc: ItemLoc): Promise> { 269 | const resp = await fetch(`${this.serverURL}mod/loot/place`, { 270 | method: 'POST', 271 | headers: { 272 | 'Authorization': `Basic ${btoa(`${username}:${password}`)}`, 273 | 'Content-Type': 'application/json', 274 | }, 275 | body: JSON.stringify({ 276 | img: itemLoc.img, 277 | aabb: { 278 | min: [itemLoc.minX, itemLoc.minY, itemLoc.minZ], 279 | max: [itemLoc.maxX, itemLoc.maxY, itemLoc.minZ], 280 | } 281 | }), 282 | }) 283 | const binItemsMap: ServerBinItemMap = await resp.json() 284 | const expiresAt = parseExpiresAt(resp.headers.get('Cache-Control'), DEFAULT_BIN_MAX_AGE) 285 | return this._readServerBinDatas(binItemsMap, expiresAt) 286 | } 287 | 288 | async removeItem(username: string, password: string, itemLoc: ItemLoc): Promise> { 289 | const resp = await fetch(`${this.serverURL}mod/remove`, { 290 | method: 'POST', 291 | headers: { 292 | 'Authorization': `Basic ${btoa(`${username}:${password}`)}`, 293 | 'Content-Type': 'application/json', 294 | }, 295 | body: JSON.stringify({ 296 | img: itemLoc.img, 297 | aabb: { 298 | min: [itemLoc.minX, itemLoc.minY, itemLoc.minZ], 299 | max: [itemLoc.maxX, itemLoc.maxY, itemLoc.minZ], 300 | } 301 | }), 302 | }) 303 | const binItemsMap: ServerBinItemMap = await resp.json() 304 | const expiresAt = parseExpiresAt(resp.headers.get('Cache-Control'), DEFAULT_BIN_MAX_AGE) 305 | return this._readServerBinDatas(binItemsMap, expiresAt) 306 | } 307 | } 308 | -------------------------------------------------------------------------------- /client/src/App.tsx: -------------------------------------------------------------------------------- 1 | import React, {useCallback, useEffect, useState} from 'react' 2 | import ReactDOM from 'react-dom' 3 | import {useAsyncCallback} from 'react-async-hook' 4 | 5 | import type {APIClient} from './APIClient' 6 | import type {ItemPlaceState, ItemLoc} from './types' 7 | import type MapLoader from './comic/MapLoader' 8 | import type LootStateController from './loot/LootStateController' 9 | import comicData from '../comic' 10 | import useStorage from './useStorage' 11 | import useLootState from './loot/useLootState' 12 | import Comic from './comic/Comic' 13 | import LootPane from './loot/LootPane' 14 | 15 | const App: React.FC<{ 16 | api: APIClient, 17 | mapLoader: MapLoader, 18 | lootStateController: LootStateController, 19 | comicEl: null | Element, 20 | }> = ({api, mapLoader, lootStateController, comicEl}) => { 21 | const [lootState, openNewLoot, placeItem] = useLootState(api, lootStateController) 22 | const [selectedItemId, setSelectedItemId] = useState(null) 23 | const [itemPlaceState, setItemPlaceState] = useState(null) 24 | const [paneExpanded, setPaneExpanded] = useStorage('inventoryExpanded', true) 25 | 26 | const itemToPlace = selectedItemId !== null && lootState.loot.find(i => i.id === selectedItemId) 27 | 28 | const handleToggleExpanded = useCallback(() => { 29 | setPaneExpanded(!paneExpanded) 30 | }, [paneExpanded]) 31 | 32 | const asyncPlaceItem = useAsyncCallback(async (itemLoc: ItemLoc) => { 33 | const updateBinDatas = await placeItem(selectedItemId, itemLoc) 34 | if (!updateBinDatas) { 35 | // Placement failed. 36 | return 37 | } 38 | mapLoader.updateBins(updateBinDatas) 39 | setSelectedItemId(null) 40 | }) 41 | 42 | const handleConfirmPlacement = useCallback(() => { 43 | if (!itemPlaceState) { 44 | throw new Error('Missing item place state') 45 | } 46 | const itemLoc: ItemLoc = { 47 | kind: 'item', 48 | img: itemToPlace.img, 49 | ...itemPlaceState.zloc, 50 | } 51 | asyncPlaceItem.execute(itemLoc) 52 | }, [itemPlaceState]) 53 | 54 | let comicPortal 55 | if (comicEl) { 56 | const comic = ( 57 | 66 | ) 67 | comicPortal = ReactDOM.createPortal(comic, comicEl) 68 | } 69 | 70 | return ( 71 | <> 72 | {comicPortal} 73 | 86 | 87 | ) 88 | } 89 | 90 | export default App 91 | -------------------------------------------------------------------------------- /client/src/Text.tsx: -------------------------------------------------------------------------------- 1 | import random from 'lodash/random' 2 | import React, {CSSProperties, ReactNode, useMemo} from 'react' 3 | import styled from 'styled-components' 4 | 5 | function stylizeText(text: string) { 6 | if (!text) { 7 | return '' 8 | } 9 | const transformedText = text.replace(/\bi\b/g, 'I') 10 | return transformedText 11 | } 12 | 13 | function flattenChildren(children: ReactNode) { 14 | const texts: Array = [] 15 | React.Children.forEach(children, c => { 16 | if (typeof c === 'string') { 17 | texts.push(c) 18 | } else if (typeof c === 'number') { 19 | texts.push(String(c)) 20 | } 21 | }) 22 | return texts.join('') 23 | } 24 | 25 | const Text: React.FC<{ 26 | size?: number, 27 | className?: string, 28 | style?: CSSProperties, 29 | }> = ({children, size, className, style}) => { 30 | const baseText = flattenChildren(children) 31 | const content = useMemo(() => { 32 | return stylizeText(baseText) 33 | }, [baseText]) 34 | 35 | return ( 36 | 41 | {content} 42 | 43 | ) 44 | } 45 | 46 | interface SimpleTextProps { 47 | size?: number 48 | } 49 | export const SimpleText = styled.span` 50 | font-family: xkcd-Regular-v3; 51 | font-size: ${({size}) => size ? `${size}px`: null}; 52 | line-height: ${({size}) => size ? `${size}px`: null}; 53 | font-variant: normal; 54 | ` 55 | 56 | export default Text 57 | -------------------------------------------------------------------------------- /client/src/admin/AdminApp.tsx: -------------------------------------------------------------------------------- 1 | import React, {useCallback, useEffect, useState} from 'react' 2 | import styled from 'styled-components' 3 | import {useAsyncCallback} from 'react-async-hook' 4 | 5 | import type {MapleAdminClient} from '../APIClient' 6 | import type MapLoader from '../comic/MapLoader' 7 | import type {ItemPlaceState, ItemLoc} from '../types' 8 | import lootImageURL from '../lootImageURL' 9 | import useStorage from '../useStorage' 10 | import Comic from '../comic/Comic' 11 | import LootPane from '../loot/LootPane' 12 | import Text from '../Text' 13 | import Input from './Input' 14 | 15 | const AdminApp: React.FC<{ 16 | api: MapleAdminClient, 17 | mapLoader: MapLoader, 18 | }> = ({api, mapLoader}) => { 19 | const [username, setUsername] = useStorage('adminUsername', '') 20 | const [password, setPassword] = useStorage('adminPassword', '') 21 | const [scale, setScale] = useState(1) 22 | const [selectedItemId, setSelectedItemId] = useState(null) 23 | const [itemPlaceState, setItemPlaceState] = useState(null) 24 | const [clickedItems, setClickedItems] = useState>([]) 25 | 26 | const asyncFetchAllItems = useAsyncCallback(async () => { 27 | const items = await api.fetchAllItems(username, password) 28 | return items.map(i => ({id: i.img, ...i})) 29 | }) 30 | const allItems = asyncFetchAllItems.result 31 | const itemToPlace = selectedItemId !== null && scale === 1 && allItems && allItems.find(i => i.id === selectedItemId) 32 | 33 | const asyncPlaceItem = useAsyncCallback(async (itemLoc: ItemLoc) => { 34 | const updateBinDatas = await api.placeAdminItem(username, password, itemLoc) 35 | mapLoader.updateBins(updateBinDatas) 36 | setSelectedItemId(null) 37 | }) 38 | 39 | const handleConfirmPlacement = useCallback(() => { 40 | if (!itemPlaceState) { 41 | throw new Error('Missing item place state') 42 | } 43 | const itemLoc: ItemLoc = { 44 | kind: 'item', 45 | img: itemToPlace.img, 46 | ...itemPlaceState.zloc, 47 | } 48 | asyncPlaceItem.execute(itemLoc) 49 | }, [itemPlaceState]) 50 | 51 | const asyncRemoveItem = useAsyncCallback(async (itemLoc: ItemLoc) => { 52 | const updateBinDatas = await api.removeItem(username, password, itemLoc) 53 | mapLoader.updateBins(updateBinDatas) 54 | setClickedItems((clickedItems) => clickedItems.filter(i => i !== itemLoc)) 55 | }) 56 | 57 | const scale1x = useCallback(() => {setScale(1)}, []) 58 | const scaleHalf = useCallback(() => {setScale(.5)}, []) 59 | const scaleThird = useCallback(() => {setScale(.3)}, []) 60 | const scaleQuarter = useCallback(() => {setScale(.25)}, []) 61 | 62 | let selectionContent 63 | if (clickedItems.length) { 64 | selectionContent = ( 65 | <> 66 | Clicked items: 67 | {clickedItems.map(itemLoc => 68 | 69 | 72 | {itemLoc.img}: {itemLoc.minX}, {itemLoc.minY}, {itemLoc.minZ} 73 | {asyncRemoveItem.execute(itemLoc)}} 75 | > 76 | Delete 77 | 78 | 79 | )} 80 | 81 | ) 82 | } else { 83 | selectionContent = Click the map to list items. 84 | } 85 | 86 | return ( 87 | <> 88 |
89 | 99 | 100 | Log in: 101 | 107 | 113 | 116 | Login 117 | 118 | 119 | 120 | 1x 121 | .5x 122 | .3x 123 | .25x 124 | 125 | 126 | {selectionContent} 127 | 128 |
129 | 139 | 140 | ) 141 | } 142 | 143 | const Main = styled.div` 144 | display: flex; 145 | ` 146 | 147 | const StyledComic = styled(Comic) ` 148 | flex-shrink: 0; 149 | ` 150 | 151 | const AdminSidebar = styled.div` 152 | display: flex; 153 | flex-direction: column; 154 | flex: 1; 155 | margin-left: 20px; 156 | 157 | &, & input, & button { 158 | font-size: 20px; 159 | } 160 | 161 | & input, & button { 162 | width: 10em; 163 | } 164 | ` 165 | 166 | const StyledInput = styled(Input)` 167 | margin: 5px 0; 168 | padding: 5px; 169 | font-family: xkcd-Regular-v3; 170 | border: 2px solid black; 171 | ` 172 | 173 | const StyledButton = styled.button` 174 | box-sizing: content-box; 175 | margin: 5px 0; 176 | padding: 5px 10px; 177 | font-family: xkcd-Regular-v3; 178 | border: 2px solid black; 179 | ` 180 | 181 | const Separator = styled.div` 182 | margin-top: 10px; 183 | padding-bottom: 10px; 184 | border-top: 2px solid black 185 | ` 186 | 187 | const ClickedItem = styled.div ` 188 | margin: 10px 0; 189 | 190 | & > * { 191 | margin-right: 20px; 192 | } 193 | 194 | & > button { 195 | width: auto; 196 | } 197 | ` 198 | 199 | const LootIcon = styled.div` 200 | width: 50px; 201 | height: 50px; 202 | padding: 5px; 203 | background: white center center no-repeat; 204 | background-size: contain; 205 | ` 206 | 207 | const ZoomButtons = styled.div` 208 | display: flex; 209 | 210 | & > button { 211 | margin-right: 10px; 212 | width: 5em; 213 | } 214 | ` 215 | 216 | export default AdminApp 217 | -------------------------------------------------------------------------------- /client/src/admin/Input.tsx: -------------------------------------------------------------------------------- 1 | import React, {useCallback} from 'react' 2 | 3 | type InputProps = { 4 | onChangeValue: (value: string) => void, 5 | } & React.HTMLProps 6 | 7 | const Input: React.FC = ({onChangeValue, ...props}) => { 8 | const handleChange = useCallback((ev: React.ChangeEvent) => { 9 | onChangeValue(ev.target.value) 10 | }, []) 11 | return 12 | } 13 | 14 | export default Input 15 | -------------------------------------------------------------------------------- /client/src/admin/index.ejs: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | <%= comic.name %> admin interface 6 | 12 | 13 | 14 | <%= tags.bodyTags %> 15 | 16 | 17 | -------------------------------------------------------------------------------- /client/src/admin/index.tsx: -------------------------------------------------------------------------------- 1 | import React from 'react' 2 | import ReactDOM from 'react-dom' 3 | 4 | import comicData from '../../comic' 5 | import {MapleAdminClient} from '../APIClient' 6 | import AdminApp from './AdminApp' 7 | import MapLoader from '../comic/MapLoader' 8 | 9 | function main() { 10 | const api = new MapleAdminClient(comicData.apiServerURL) 11 | const mapLoader = new MapLoader(api, {renderExtraScreens: 0}) 12 | const app = ( 13 | 17 | ) 18 | ReactDOM.render(app, document.body) 19 | } 20 | 21 | document.addEventListener('DOMContentLoaded', main) 22 | -------------------------------------------------------------------------------- /client/src/comic/Comic.tsx: -------------------------------------------------------------------------------- 1 | import isInteger from 'lodash/isInteger' 2 | import debounce from 'lodash/debounce' 3 | import React, {useCallback, useEffect, useLayoutEffect, useRef, useState, useMemo} from 'react' 4 | import styled from 'styled-components' 5 | 6 | import type MapLoader from './MapLoader' 7 | import type {Loc, ZLoc, StoredInventoryItem, ItemPlaceState, ItemLoc} from '../types' 8 | import type {DragSettings} from './useDragPos' 9 | import lootImageURL from '../lootImageURL' 10 | import Text from '../Text' 11 | import MapRender from './MapRender' 12 | import useDragPos from './useDragPos' 13 | import useMapLoader from './useMapLoader' 14 | 15 | const BORDER_WIDTH = 2 16 | 17 | function locProps(loc?: Loc) { 18 | return [ 19 | loc?.minX, 20 | loc?.minY, 21 | loc?.maxX, 22 | loc?.maxY, 23 | ] 24 | } 25 | 26 | function zlocProps(zloc?: ZLoc) { 27 | return [...locProps(zloc), zloc?.minZ] 28 | } 29 | 30 | function parseHash(hash: string): {x: number, y: number} { 31 | const match = hash.substr(1).match(/(-?\d+),(-?\d+)/) 32 | if (!match) { 33 | return 34 | } 35 | const x = -Number(match[1]) 36 | const y = -Number(match[2]) 37 | if (!isInteger(x) || !isInteger(y)) { 38 | return 39 | } 40 | return {x, y} 41 | } 42 | 43 | function useHashSync(panX: number, panY: number, resetPan: (settings: DragSettings) => void) { 44 | const handleHashChange = useCallback(() => { 45 | const pos = parseHash(location.hash) 46 | if (pos) { 47 | resetPan({pos}) 48 | } 49 | }, []) 50 | 51 | const handlePanChange = useMemo(() => debounce((panX: number, panY: number) => { 52 | location.hash = `${-panX},${-panY}` 53 | }, 500), []) 54 | 55 | useEffect(() => { 56 | window.addEventListener('hashchange', handleHashChange) 57 | return () => { 58 | window.removeEventListener('hashchange', handleHashChange) 59 | } 60 | }) 61 | 62 | useEffect(() => { 63 | handlePanChange(panX, panY) 64 | }, [panX, panY]) 65 | 66 | return parseHash(location.hash) 67 | } 68 | 69 | const Comic: React.FC<{ 70 | className?: string, 71 | mapLoader: MapLoader, 72 | altText: string, 73 | width: number, 74 | height: number, 75 | scale?: number, 76 | itemToPlace: StoredInventoryItem, 77 | showMovementTip?: boolean, 78 | onItemPlaceStateChange: (state: ItemPlaceState) => void, 79 | onClickItems?: (items: Array) => void, 80 | }> = ({className, mapLoader, altText, width, height, scale = 1, itemToPlace, showMovementTip, onItemPlaceStateChange, onClickItems}) => { 81 | const clipElRef = useRef() 82 | const [panState, panEventHandlers, resetPan] = useDragPos({ 83 | pos: parseHash(location.hash) || { 84 | x: Math.floor(width / (2 * scale)), 85 | y: Math.floor(height / (2 * scale)), 86 | }, 87 | }) 88 | useHashSync(panState.x, panState.y, resetPan) 89 | const [placeState, placeEventHandlers, resetPlace] = useDragPos() 90 | const [itemIsColliding, setItemIsColliding] = useState(false) 91 | const [items, metrics, {setView, checkCollision, getItemsAt}] = useMapLoader(mapLoader) 92 | 93 | const innerWidth = width - 2 * BORDER_WIDTH 94 | const innerHeight = height - 2 * BORDER_WIDTH 95 | 96 | useLayoutEffect(() => { 97 | setView(-panState.x, -panState.y, innerWidth, innerHeight, scale) 98 | }, [panState.x, panState.y, scale]) 99 | 100 | useLayoutEffect(() => { 101 | if (!metrics) { 102 | return 103 | } 104 | // Drag coordinate system is inverted from map, so we have to flip the bounds. 105 | resetPan({ 106 | bounds: { 107 | minX: -metrics.viewBounds.maxX, 108 | minY: -metrics.viewBounds.maxY, 109 | maxX: -metrics.viewBounds.minX, 110 | maxY: -metrics.viewBounds.minY, 111 | }, 112 | }) 113 | }, locProps(metrics?.viewBounds)) 114 | 115 | useLayoutEffect(() => { 116 | if (!itemToPlace) { 117 | return 118 | } 119 | const halfItemWidth = Math.floor(itemToPlace.width / 2) 120 | const halfItemHeight = Math.floor(itemToPlace.height / 2) 121 | resetPlace({ 122 | pos: { 123 | x: Math.floor(innerWidth / 2 - halfItemWidth), 124 | y: Math.floor(innerHeight / 2 - halfItemHeight), 125 | }, 126 | bounds: { 127 | minX: -halfItemWidth, 128 | maxX: innerWidth - halfItemWidth, 129 | minY: -halfItemHeight, 130 | maxY: innerHeight - halfItemHeight, 131 | }, 132 | }) 133 | }, [itemToPlace?.id]) 134 | 135 | const itemToPlaceLoc = itemToPlace && { 136 | minX: placeState.x - panState.x, 137 | maxX: placeState.x + itemToPlace.width - panState.x, 138 | minY: placeState.y - panState.y, 139 | maxY: placeState.y + itemToPlace.height - panState.y, 140 | minZ: itemToPlace.z, 141 | } 142 | 143 | useEffect(() => { 144 | if (!itemToPlace) { 145 | return 146 | } 147 | const isColliding = checkCollision(itemToPlaceLoc) 148 | setItemIsColliding(isColliding) 149 | onItemPlaceStateChange({ 150 | zloc: itemToPlaceLoc, 151 | isColliding, 152 | }) 153 | }, [items, ...zlocProps(itemToPlaceLoc)]) 154 | 155 | const handleClickItems = useCallback((ev) => { 156 | if (!metrics) { 157 | return 158 | } 159 | const x = metrics.minX + ev.nativeEvent.offsetX 160 | const y = metrics.minY + (metrics.height - ev.nativeEvent.offsetY) 161 | const zloc = { 162 | minX: x, 163 | maxX: x, 164 | minY: y, 165 | maxY: y, 166 | minZ: itemToPlace.z, 167 | } 168 | onClickItems(getItemsAt(zloc)) 169 | }, [metrics?.minX, metrics?.minY]) 170 | 171 | return ( 172 | 178 | {metrics && 179 | 185 | 195 | 196 | } 197 | {!metrics && [Loading...]} 198 | {itemToPlace && 206 | 219 | } 220 | It's a big world out there! Drag to move around. 221 | 222 | ) 223 | } 224 | 225 | interface LootPlacerProps { 226 | isColliding: boolean, 227 | } 228 | const LootPlacer = styled.div` 229 | position: absolute; 230 | left: 0; 231 | top: 0; 232 | display: flex; 233 | outline: 2px ${({isColliding}) => isColliding ? 'solid red' : 'dotted gray'}; 234 | outline-offset: 3px; 235 | ` 236 | 237 | interface MapClipProps { 238 | width: number, 239 | height: number, 240 | } 241 | const MapClip = styled.div` 242 | width: ${({width}) => width}px; 243 | height: ${({height}) => height}px; 244 | overflow: hidden; 245 | ` 246 | 247 | const LoadingText = styled(Text)` 248 | font-size: 24px; 249 | color: gray; 250 | ` 251 | 252 | interface MovementTipProps { 253 | isShowing: boolean, 254 | } 255 | const MovementTip = styled(Text)` 256 | position: absolute; 257 | bottom: 10px; 258 | font-size: 18px; 259 | background: white; 260 | border: 2px solid black; 261 | padding: 5px 10px; 262 | border-radius: 6px; 263 | opacity: ${({isShowing}) => isShowing ? 1 : 0}; 264 | transition: opacity .5s ease; 265 | pointer-events: none; 266 | ` 267 | 268 | interface ComicOutlineProps { 269 | width: number, 270 | height: number, 271 | } 272 | const ComicOutline = styled.div` 273 | display: inline-flex; 274 | align-items: center; 275 | justify-content: center; 276 | position: relative; 277 | box-sizing: border-box; 278 | background: white; 279 | border: ${BORDER_WIDTH}px solid black; 280 | width: ${({width}) => width}px; 281 | height: ${({height}) => height}px; 282 | user-select: none; 283 | overflow: hidden; 284 | touch-action: none; 285 | ` 286 | 287 | export default Comic 288 | -------------------------------------------------------------------------------- /client/src/comic/MapLoader.ts: -------------------------------------------------------------------------------- 1 | import isEqual from 'lodash/isEqual' 2 | import groupBy from 'lodash/groupBy' 3 | import throttle from 'lodash/throttle' 4 | import sortBy from 'lodash/sortBy' 5 | import RBush from 'rbush' 6 | import {Emitter} from '@servie/events' 7 | 8 | import type {Loc, ZLoc, BinLoc, ItemLoc, BinData, ZItemMap} from '../types' 9 | import {APIClient} from '../APIClient' 10 | 11 | const VIEW_QUANTIZE = 500 12 | const VIEW_EXTRA_SCREENS = 2 13 | const RENDER_EXTRA_SCREENS = .5 14 | const UPDATE_THROTTLE = 50 15 | 16 | function setTimeoutAt(cb: () => void, expiresAt: number, minDelay: number = 0) { 17 | const delay = Math.max(minDelay, expiresAt - Date.now()) 18 | return setTimeout(cb, delay) 19 | } 20 | 21 | function quantizeDown(x: number, unit: number) { 22 | return unit * Math.floor(x / unit) 23 | } 24 | 25 | function quantizeUp(x: number, unit: number) { 26 | return unit * Math.ceil(x / unit) 27 | } 28 | 29 | function mapLocWithin(outer: MapLoc, inner: MapLoc): boolean { 30 | return ( 31 | outer.scale === inner.scale 32 | && outer.minX <= inner.minX 33 | && outer.maxX >= inner.maxX 34 | && outer.minY <= inner.minY 35 | && outer.maxY >= inner.maxY 36 | ) 37 | } 38 | 39 | export class ViewCache { 40 | retryTime: number = 5000 41 | api: APIClient 42 | onExpire: () => void 43 | onUpdate: () => void 44 | immediateValue?: false | RBush 45 | asyncValue?: Promise> 46 | thresholdLoc?: MapLoc 47 | timeout?: number 48 | 49 | constructor({api, onExpire, onUpdate}: {api: APIClient, onExpire: () => void, onUpdate: () => void}) { 50 | this.api = api 51 | this.onExpire = onExpire 52 | this.onUpdate = onUpdate 53 | } 54 | 55 | async getCachedAndRefresh(loc: MapLoc) { 56 | const queuedRefresh = this.refresh(loc) 57 | 58 | if (!this.immediateValue) { 59 | await queuedRefresh 60 | } 61 | 62 | return this.immediateValue 63 | } 64 | 65 | async refresh(loc: MapLoc) { 66 | if (this.asyncValue === undefined || !this.thresholdLoc || !mapLocWithin(this.thresholdLoc, loc)) { 67 | this.asyncValue = this._load(loc) 68 | this.immediateValue = await this.asyncValue 69 | this.onUpdate?.() 70 | } 71 | } 72 | 73 | async _load(loc: MapLoc) { 74 | const width = loc.maxX - loc.minX 75 | const height = loc.maxY - loc.minY 76 | 77 | const threshold = VIEW_EXTRA_SCREENS * .5 78 | this.thresholdLoc = { 79 | minX: quantizeDown(loc.minX - threshold * width, VIEW_QUANTIZE), 80 | minY: quantizeDown(loc.minY - threshold * height, VIEW_QUANTIZE), 81 | maxX: quantizeUp(loc.maxX + threshold * width, VIEW_QUANTIZE), 82 | maxY: quantizeUp(loc.maxY + threshold * height, VIEW_QUANTIZE), 83 | scale: loc.scale, 84 | } 85 | 86 | const viewLoc = { 87 | minX: quantizeDown(loc.minX - VIEW_EXTRA_SCREENS * width, VIEW_QUANTIZE), 88 | minY: quantizeDown(loc.minY - VIEW_EXTRA_SCREENS * height, VIEW_QUANTIZE), 89 | maxX: quantizeUp(loc.maxX + VIEW_EXTRA_SCREENS * width, VIEW_QUANTIZE), 90 | maxY: quantizeUp(loc.maxY + VIEW_EXTRA_SCREENS * height, VIEW_QUANTIZE), 91 | } 92 | 93 | let result 94 | try { 95 | result = await this.api.fetchView(viewLoc) 96 | } catch (err) { 97 | console.error('Error loading view', viewLoc, err) 98 | this._scheduleUpdate(Date.now() + this.retryTime) 99 | return false 100 | } 101 | 102 | const {bins, expiresAt} = result 103 | const binBush: RBush = new RBush() 104 | binBush.load(bins) 105 | 106 | this._scheduleUpdate(expiresAt) 107 | 108 | return binBush 109 | } 110 | 111 | _scheduleUpdate = (expiresAt: number) => { 112 | clearTimeout(this.timeout) 113 | this.timeout = setTimeoutAt(() => { 114 | this.asyncValue = undefined 115 | this.onExpire?.() 116 | }, expiresAt) 117 | } 118 | } 119 | 120 | type VisibleCacheValue = { 121 | renderLoc: Loc, 122 | visibleBins: Set, 123 | } 124 | 125 | export class VisibleCache { 126 | extraScreens: number 127 | value?: VisibleCacheValue 128 | lastBinBush: RBush 129 | thresholdLoc?: MapLoc 130 | 131 | constructor({extraScreens}: {extraScreens: number}) { 132 | this.extraScreens = extraScreens 133 | } 134 | 135 | get(loc: MapLoc, binBush: RBush): [boolean, VisibleCacheValue] { 136 | let changed = false 137 | if (!this.value || binBush !== this.lastBinBush || !this.thresholdLoc || !mapLocWithin(this.thresholdLoc, loc)) { 138 | changed = true 139 | this.value = this._calculate(loc, binBush) 140 | } 141 | return [changed, this.value] 142 | } 143 | 144 | _calculate(loc: MapLoc, binBush: RBush) { 145 | const width = loc.maxX - loc.minX 146 | const height = loc.maxY - loc.minY 147 | 148 | const threshold = this.extraScreens * .5 149 | this.thresholdLoc = { 150 | minX: loc.minX - threshold * width, 151 | minY: loc.minY - threshold * height, 152 | maxX: loc.maxX + threshold * width, 153 | maxY: loc.maxY + threshold * height, 154 | scale: loc.scale, 155 | } 156 | 157 | const renderLoc = { 158 | minX: Math.floor(loc.minX - this.extraScreens * width), 159 | minY: Math.floor(loc.minY - this.extraScreens * height), 160 | maxX: Math.floor(loc.maxX + this.extraScreens * width), 161 | maxY: Math.floor(loc.maxY + this.extraScreens * height), 162 | } 163 | 164 | const binLocs = binBush.search(renderLoc) 165 | const visibleBins = new Set(binLocs.map(b => b.id)) 166 | 167 | this.lastBinBush = binBush 168 | 169 | return {renderLoc, visibleBins} 170 | } 171 | } 172 | 173 | type ZBushMap = Map> 174 | 175 | export class BinItemsCache { 176 | retryTime: number = 5000 177 | api: APIClient 178 | onExpire: (id: string) => void 179 | asyncValueMap: Map> = new Map() 180 | zBushCache: Map, ZBushMap]> = new Map() 181 | timeoutMap: Map = new Map() 182 | 183 | constructor({api, onExpire}: {api: APIClient, onExpire: (id: string) => void}) { 184 | this.api = api 185 | this.onExpire = onExpire 186 | } 187 | 188 | async get(id: string) { 189 | if (!this.asyncValueMap.has(id)) { 190 | this.asyncValueMap.set(id, this._load(id)) 191 | } 192 | return await this.asyncValueMap.get(id) 193 | } 194 | 195 | async _load(id: string) { 196 | let result 197 | try { 198 | result = await this.api.fetchBin(id) 199 | } catch (err) { 200 | console.error('Error loading bin', id, err) 201 | this._scheduleUpdate(id, Date.now() + this.retryTime) 202 | return false 203 | } 204 | 205 | const {items, expiresAt} = result 206 | this._scheduleUpdate(id, expiresAt) 207 | return this._makeZBushMap(id, items) 208 | } 209 | 210 | storeBin(binData: BinData) { 211 | const {id, items, expiresAt} = binData 212 | const bush = this._makeZBushMap(id, items) 213 | this.asyncValueMap.set(id, Promise.resolve(bush)) 214 | this._scheduleUpdate(id, expiresAt) 215 | } 216 | 217 | _makeZBushMap(id: string, items: Array) { 218 | if (this.zBushCache.has(id)) { 219 | const [oldItems, oldMap] = this.zBushCache.get(id) 220 | if (isEqual(oldItems, items)) { 221 | return oldMap 222 | } 223 | } 224 | 225 | const map = new Map() 226 | const zGroups = new Map() 227 | for (const item of items) { 228 | if (!zGroups.has(item.minZ)) { 229 | zGroups.set(item.minZ, []) 230 | } 231 | zGroups.get(item.minZ).push(item) 232 | } 233 | for (const [z, items] of zGroups.entries()) { 234 | const bush = new RBush() 235 | bush.load(items) 236 | map.set(z, bush) 237 | } 238 | 239 | this.zBushCache.set(id, [items, map]) 240 | return map 241 | } 242 | 243 | _scheduleUpdate(id: string, expiresAt: number) { 244 | clearTimeout(this.timeoutMap.get(id)) 245 | this.timeoutMap.set( 246 | id, 247 | setTimeoutAt(() => { 248 | this.asyncValueMap.delete(id) 249 | this.onExpire?.(id) 250 | }, expiresAt), 251 | ) 252 | } 253 | } 254 | 255 | export interface RenderMetrics { 256 | minX: number, 257 | minY: number, 258 | offsetX: number, 259 | offsetY: number, 260 | width: number, 261 | height: number, 262 | viewBounds: Loc, 263 | } 264 | 265 | interface MapLoaderEvents { 266 | metrics: [RenderMetrics], 267 | update: [Array], 268 | } 269 | 270 | interface MapLoc extends Loc { 271 | scale: number, 272 | } 273 | 274 | export default class MapLoader { 275 | events: Emitter 276 | loc: MapLoc 277 | 278 | viewCache: ViewCache 279 | visibleCache: VisibleCache 280 | itemsCache: BinItemsCache 281 | 282 | visibleBins: Set = new Set() 283 | binItems: Map = new Map() 284 | imgs: Map = new Map() 285 | 286 | constructor(api: APIClient, {renderExtraScreens = RENDER_EXTRA_SCREENS}: {renderExtraScreens?: number} = {}) { 287 | this.events = new Emitter() 288 | this.viewCache = new ViewCache({ 289 | api, 290 | onExpire: this.handleViewExpire, 291 | onUpdate: this.handleViewUpdate, 292 | }) 293 | this.visibleCache = new VisibleCache({extraScreens: renderExtraScreens}) 294 | this.itemsCache = new BinItemsCache({ 295 | api, 296 | onExpire: this.handleBinExpire, 297 | }) 298 | } 299 | 300 | emitMetrics(loc: MapLoc, renderLoc: Loc, viewBounds: Loc) { 301 | this.events.emit('metrics', { 302 | minX: renderLoc.minX, 303 | minY: renderLoc.minY, 304 | offsetX: (renderLoc.minX - loc.minX) * loc.scale, 305 | offsetY: (loc.maxY - renderLoc.maxY) * loc.scale, 306 | width: (renderLoc.maxX - renderLoc.minX) * loc.scale, 307 | height: (renderLoc.maxY - renderLoc.minY) * loc.scale, 308 | viewBounds, 309 | }) 310 | } 311 | 312 | emitUpdate = () => { 313 | this.events.emit('update', this.getItems()) 314 | } 315 | 316 | queueUpdate = throttle(this.emitUpdate, UPDATE_THROTTLE, {leading: false}) 317 | 318 | view = async (x: number, y: number, width: number, height: number, scale: number) => { 319 | this.loc = { 320 | minX: x, 321 | minY: y, 322 | maxX: x + width / scale, 323 | maxY: y + height / scale, 324 | scale, 325 | } 326 | this.loadView(this.loc) 327 | } 328 | 329 | checkCollision = (zloc: ZLoc): boolean => { 330 | for (const zBushMap of this.iterVisibleBins()) { 331 | if (zBushMap.get(zloc.minZ)?.collides(zloc)) { 332 | return true 333 | } 334 | } 335 | return false 336 | } 337 | 338 | getItemsAt = (loc: Loc): Array => { 339 | const result: Array = [] 340 | for (const zBushMap of this.iterVisibleBins()) { 341 | for (const bush of zBushMap.values()) { 342 | result.splice(-1, 0, ...bush.search(loc)) 343 | } 344 | } 345 | return result 346 | } 347 | 348 | async loadView(loc: MapLoc) { 349 | const binBush = await this.viewCache.getCachedAndRefresh(loc) 350 | if (!binBush) { 351 | this.visibleBins.clear() 352 | this.events.emit('metrics', null) 353 | return 354 | } 355 | 356 | const viewBounds = { 357 | minX: binBush.data.minX, 358 | minY: binBush.data.minY, 359 | maxX: binBush.data.maxX, 360 | maxY: binBush.data.maxY, 361 | } 362 | const [visibleChanged, {renderLoc, visibleBins}] = this.visibleCache.get(loc, binBush) 363 | this.emitMetrics(loc, renderLoc, viewBounds) 364 | 365 | if (visibleChanged) { 366 | this.visibleBins = visibleBins 367 | this.emitUpdate() 368 | for (const id of visibleBins) { 369 | this.loadBin(id) 370 | } 371 | } 372 | } 373 | 374 | async loadBin(id: string) { 375 | const items = await this.itemsCache.get(id) 376 | if (!items) { 377 | return 378 | } 379 | if (items !== this.binItems.get(id)) { 380 | this.binItems.set(id, items) 381 | this.queueUpdate() 382 | } 383 | } 384 | 385 | handleViewExpire = () => { 386 | this.viewCache.refresh(this.loc) 387 | } 388 | 389 | handleViewUpdate = () => { 390 | this.loadView(this.loc) 391 | } 392 | 393 | handleBinExpire = (id: string) => { 394 | if (this.visibleBins.has(id)) { 395 | this.loadBin(id) 396 | } else { 397 | this.binItems.delete(id) 398 | } 399 | } 400 | 401 | updateBins(binDatas: Array) { 402 | for (const binData of binDatas) { 403 | this.itemsCache.storeBin(binData) 404 | this.loadBin(binData.id) 405 | } 406 | } 407 | 408 | *iterVisibleBins() { 409 | for (const binId of this.visibleBins) { 410 | const zBushMap = this.binItems.get(binId) 411 | if (!zBushMap) { 412 | continue 413 | } 414 | yield zBushMap 415 | } 416 | } 417 | 418 | getItems(): Array { 419 | const zLayers: Map> = new Map() 420 | for (const zBushMap of this.iterVisibleBins()) { 421 | for (const [z, bush] of zBushMap.entries()) { 422 | if (!zLayers.has(z)) { 423 | zLayers.set(z, []) 424 | } 425 | zLayers.get(z).splice(-1, 0, ...bush.all()) 426 | } 427 | } 428 | 429 | const items: Array = [] 430 | const zs = sortBy([...zLayers.keys()], z => -z) 431 | for (const z of zs) { 432 | items.splice(-1, 0, ...zLayers.get(z)) 433 | } 434 | return items 435 | } 436 | } 437 | -------------------------------------------------------------------------------- /client/src/comic/MapRender.tsx: -------------------------------------------------------------------------------- 1 | import React, {useCallback, useLayoutEffect, useRef, useState, useMemo} from 'react' 2 | import throttle from 'lodash/throttle' 3 | 4 | import type {ItemLoc} from '../types' 5 | import lootImageURL from '../lootImageURL' 6 | import useCanvas from '../useCanvas' 7 | 8 | function draw( 9 | canvas: HTMLCanvasElement, 10 | dpr: number, 11 | width: number, 12 | height: number, 13 | x: number, 14 | y: number, 15 | scale: number, 16 | items: Iterable, 17 | getImage: (url: string) => HTMLImageElement, 18 | ) { 19 | const debugEnabled = localStorage.getItem('mapDebug') === 'true' 20 | const ctx = canvas.getContext('2d') 21 | ctx.save() 22 | ctx.scale(dpr, dpr) 23 | ctx.clearRect(0, 0, width, height) 24 | ctx.scale(scale, scale) 25 | ctx.translate(-x, y) 26 | 27 | const top = height / scale 28 | for (const item of items) { 29 | const img = getImage(lootImageURL(item.img)) 30 | if (img) { 31 | // If an image is in "broken" error state it can cause the canvas render to crash. We filter those out in MapLoader, but should also be defensive here. 32 | try { 33 | ctx.drawImage(img, item.minX, top - item.maxY, item.maxX - item.minX, item.maxY - item.minY) 34 | } catch (err) { 35 | console.warn('Error drawing image', item, err) 36 | } 37 | } 38 | if (debugEnabled) { 39 | ctx.strokeStyle = 'red' 40 | ctx.fillText(`${item.minX}, ${item.minY}`, item.minX, height - item.minY) 41 | ctx.strokeRect(item.minX, top - item.maxY, item.maxX - item.minX, item.maxY - item.minY) 42 | } 43 | } 44 | 45 | if (y < 0) { 46 | ctx.globalCompositeOperation = 'destination-over' 47 | ctx.fillStyle = 'white' 48 | ctx.fillRect(x, top, width / scale, -y) 49 | ctx.globalCompositeOperation = 'difference' 50 | ctx.fillStyle = 'white' 51 | ctx.fillRect(x, top, width / scale, -y) 52 | } 53 | 54 | ctx.restore() 55 | } 56 | 57 | const MapRender: React.FC<{ 58 | width: number, 59 | height: number, 60 | x: number, 61 | y: number, 62 | scale: number, 63 | items: Iterable, 64 | style?: React.CSSProperties, 65 | onClick?: (ev: React.MouseEvent) => void, 66 | }> = ({width, height, x, y, scale, items, style, onClick}) => { 67 | const [dpr, canvasWidth, canvasHeight, canvasRef] = useCanvas(width, height) 68 | const [imagesUpdated, setImagesUpdated] = useState({}) 69 | const imgCache = useRef(new Map()) 70 | 71 | const redrawWithNewImages = useMemo(() => throttle(() => { 72 | setImagesUpdated({}) 73 | }, 500), []) 74 | 75 | const getImage = useCallback((url: string) => { 76 | const map = imgCache.current 77 | if (map.has(url)) { 78 | return map.get(url) 79 | } else { 80 | map.set(url, null) 81 | const img = new Image() 82 | img.addEventListener('load', () => { 83 | map.set(url, img) 84 | // Force update. 85 | redrawWithNewImages() 86 | }) 87 | img.src = url 88 | } 89 | }, []) 90 | 91 | useLayoutEffect(() => { 92 | draw(canvasRef.current, dpr, width, height, x, y, scale, items, getImage) 93 | }, [dpr, width, height, x, y, items, imagesUpdated]) 94 | 95 | return ( 96 | 103 | ) 104 | } 105 | 106 | export default MapRender 107 | -------------------------------------------------------------------------------- /client/src/comic/useDragPos.ts: -------------------------------------------------------------------------------- 1 | import {useCallback, useRef, useState} from 'react' 2 | import clamp from 'lodash/clamp' 3 | 4 | import {Loc} from '../types' 5 | 6 | interface DragEvents { 7 | onMouseDown: (ev: any) => void, 8 | } 9 | 10 | interface Pos { 11 | x: number, 12 | y: number, 13 | } 14 | 15 | export interface DragSettings { 16 | pos?: Pos, 17 | bounds?: Loc, 18 | } 19 | 20 | interface DragState extends Pos { 21 | isDragging: boolean, 22 | hasDragged: boolean, 23 | startPos: Pos, 24 | } 25 | 26 | interface DragInternalState { 27 | bounds: null | Loc, 28 | startMousePos: null | Pos, 29 | } 30 | 31 | export default function useDragPos(settings: DragSettings = {}): [DragState, DragEvents, (settings: DragSettings) => void] { 32 | const internalStateRef = useRef({ 33 | bounds: settings.bounds, 34 | startMousePos: null, 35 | }) 36 | 37 | const [dragState, setDragState] = useState({ 38 | isDragging: false, 39 | hasDragged: false, 40 | x: settings.pos?.x ?? 0, 41 | y: settings.pos?.y ?? 0, 42 | startPos: null, 43 | }) 44 | 45 | const handleMove = useCallback((ev) => { 46 | const {clientX, clientY} = ev.type === 'mousemove' ? ev : ev.touches[0] 47 | const {bounds, startMousePos} = internalStateRef.current 48 | setDragState(({x, y, startPos, ...rest}) => { 49 | let newX = startPos.x + (Math.round(clientX) - startMousePos.x) 50 | let newY = startPos.y - (Math.round(clientY) - startMousePos.y) 51 | if (bounds) { 52 | newX = clamp(newX, bounds.minX, bounds.maxX) 53 | newY = clamp(newY, bounds.minY, bounds.maxY) 54 | } 55 | return { 56 | ...rest, 57 | isDragging: true, 58 | hasDragged: true, 59 | x: newX, 60 | y: newY, 61 | startPos, 62 | } 63 | }) 64 | }, []) 65 | 66 | const handleStop = useCallback((ev) => { 67 | if (ev.type === 'mouseup' && ev.button !== 0) { 68 | return 69 | } else if (ev.type === 'touchend' && ev.touches.length > 0) { 70 | return 71 | } 72 | window.removeEventListener('mouseup', handleStop) 73 | window.removeEventListener('mousemove', handleMove) 74 | window.removeEventListener('touchend', handleStop) 75 | window.removeEventListener('touchmove', handleMove) 76 | document.body.style.cursor = null 77 | internalStateRef.current.startMousePos = null 78 | setDragState((prevState) => ({ 79 | ...prevState, 80 | isDragging: false, 81 | startPos: null, 82 | })) 83 | }, []) 84 | 85 | const handleStart = useCallback((ev) => { 86 | if (ev.type === 'mousedown' && ev.button !== 0) { 87 | return 88 | } 89 | window.addEventListener('mouseup', handleStop) 90 | window.addEventListener('mousemove', handleMove) 91 | window.addEventListener('touchend', handleStop) 92 | window.addEventListener('touchmove', handleMove) 93 | document.body.style.cursor = 'grabbing' 94 | const {clientX, clientY} = ev.type === 'mousedown' ? ev : ev.touches[0] 95 | internalStateRef.current.startMousePos = { 96 | x: Math.round(clientX), 97 | y: Math.round(clientY), 98 | } 99 | setDragState((prevState) => ({ 100 | ...prevState, 101 | isDragging: true, 102 | startPos: { 103 | x: prevState.x, 104 | y: prevState.y, 105 | }, 106 | })) 107 | }, []) 108 | 109 | const reset = useCallback((settings: DragSettings) => { 110 | setDragState((prevState) => ({ 111 | ...prevState, 112 | x: settings.pos?.x ?? prevState.x, 113 | y: settings.pos?.y ?? prevState.y, 114 | })) 115 | internalStateRef.current = { 116 | ...internalStateRef.current, 117 | bounds: settings.bounds, 118 | } 119 | }, []) 120 | 121 | // TODO touch 122 | const dragEventHandlers = { 123 | onMouseDown: handleStart, 124 | onTouchStart: handleStart, 125 | } 126 | 127 | return [dragState, dragEventHandlers, reset] 128 | } 129 | -------------------------------------------------------------------------------- /client/src/comic/useMapLoader.ts: -------------------------------------------------------------------------------- 1 | import {useRef, useLayoutEffect, useState} from 'react' 2 | 3 | import type {ZItemMap, ZLoc, ItemLoc} from '../types' 4 | import type {APIClient} from '../APIClient' 5 | import type MapLoader from './MapLoader' 6 | import type {RenderMetrics} from './MapLoader' 7 | 8 | interface MapLoaderMethods { 9 | setView: (x: number, y: number, width: number, height: number, scale: number) => void, 10 | checkCollision: (zloc: ZLoc) => boolean, 11 | getItemsAt: (zloc: ZLoc) => Array, 12 | } 13 | 14 | export default function useMapLoader(mapLoader: MapLoader): [Array, RenderMetrics, MapLoaderMethods] { 15 | const [metrics, setMetrics] = useState(null) 16 | const [items, setItems] = useState([]) 17 | 18 | useLayoutEffect(() => { 19 | mapLoader.events.on('metrics', setMetrics) 20 | mapLoader.events.on('update', setItems) 21 | return () => { 22 | mapLoader.events.off('metrics', setMetrics) 23 | mapLoader.events.off('update', setItems) 24 | } 25 | }, []) 26 | 27 | const methods = { 28 | setView: mapLoader.view, 29 | checkCollision: mapLoader.checkCollision, 30 | getItemsAt: mapLoader.getItemsAt, 31 | } 32 | 33 | return [items, metrics, methods] 34 | } 35 | -------------------------------------------------------------------------------- /client/src/custom.d.ts: -------------------------------------------------------------------------------- 1 | import RBush, {BBox} from 'rbush' 2 | 3 | import type {ArtImage} from './types' 4 | import type {MapleComicGlobal} from './index' 5 | 6 | // Extend rbush types to expose internal bounding box of items 7 | declare module 'rbush' { 8 | export default interface RBush { 9 | data: BBox, 10 | } 11 | } 12 | 13 | declare module "*.png" { 14 | const content: ArtImage 15 | export default content 16 | } 17 | 18 | declare global { 19 | interface Window { MapleComic: MapleComicGlobal; } 20 | } 21 | -------------------------------------------------------------------------------- /client/src/extension/index.ts: -------------------------------------------------------------------------------- 1 | declare const chrome: { 2 | runtime: { 3 | getURL: (path: string) => string 4 | } 5 | } 6 | 7 | __webpack_public_path__ = chrome.runtime.getURL('/') 8 | -------------------------------------------------------------------------------- /client/src/extension/manifest.json: -------------------------------------------------------------------------------- 1 | { 2 | "manifest_version": 2, 3 | "name": "xkcd loot developer", 4 | "version": "0.1", 5 | "description": "Allows testing of xkcd's 2020 april fools project.", 6 | "permissions": [ 7 | "${apiServerURL}*" 8 | ], 9 | "content_scripts": [ 10 | { 11 | "matches": ["*://xkcd.com/*"], 12 | "js": ["extension.js"], 13 | "run_at": "document_start" 14 | } 15 | ] 16 | } 17 | -------------------------------------------------------------------------------- /client/src/index.ejs: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | <%= comic.name %> 6 | 7 | 8 | 18 | 19 | 20 | 21 | 22 | 23 |
24 |
25 | 26 | 27 | <%= tags.bodyTags %> 28 | 29 | 30 | 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /client/src/index.tsx: -------------------------------------------------------------------------------- 1 | import React from 'react' 2 | import ReactDOM from 'react-dom' 3 | 4 | import comicData from '../comic' 5 | import {MapleClient, MockAPIClient} from './APIClient' 6 | import App from './App' 7 | import MapLoader from './comic/MapLoader' 8 | import LootStateController from './loot/LootStateController' 9 | 10 | export class MapleComicGlobal { 11 | comicEl: Element = null 12 | 13 | claimLoot: (path: string) => void 14 | 15 | draw(comicEl: Element) { 16 | comicEl.innerHTML = '' 17 | this.comicEl = comicEl 18 | } 19 | } 20 | 21 | function initAPI() { 22 | if (process.env.USE_MOCK_API) { 23 | return new MockAPIClient() 24 | } else { 25 | return new MapleClient(comicData.apiServerURL) 26 | } 27 | } 28 | 29 | function claimPageview(lootStateController: LootStateController) { 30 | const pathWithStrippedSlashes = location.pathname.replace(/^\/+|\/+$/g, '') 31 | lootStateController.claimLoot(pathWithStrippedSlashes) 32 | } 33 | 34 | function main() { 35 | const api = initAPI() 36 | const mapLoader = new MapLoader(api) 37 | const lootStateController = new LootStateController(api) 38 | 39 | if (process.env.NODE_ENV === 'development') { 40 | // Make it easier to claim loots on the dev console. 41 | window.MapleComic.claimLoot = (path: string) => { 42 | lootStateController.claimLoot(path) 43 | } 44 | } 45 | 46 | const containerEl = document.createElement('div') 47 | document.body.appendChild(containerEl) 48 | 49 | const {comicEl} = window.MapleComic 50 | 51 | const app = ( 52 | 58 | ) 59 | ReactDOM.render(app, containerEl, () => { 60 | claimPageview(lootStateController) 61 | }) 62 | } 63 | 64 | document.addEventListener('DOMContentLoaded', main) 65 | 66 | window.MapleComic = new MapleComicGlobal() 67 | -------------------------------------------------------------------------------- /client/src/loot/LootButton.tsx: -------------------------------------------------------------------------------- 1 | import React, {useCallback, useRef, useState} from 'react' 2 | import styled, {css, keyframes} from 'styled-components' 3 | 4 | import type {StoredInventoryItem} from '../types' 5 | import lootImageURL from '../lootImageURL' 6 | import {preloadImg} from '../preloadImg' 7 | import ParticlePop from './ParticlePop' 8 | 9 | const treasureClosedImg = preloadImg(require('../../art/treasure-closed.png')) 10 | const treasureOpenImg = preloadImg(require('../../art/treasure-open.png')) 11 | 12 | const LootButton: React.FC<{ 13 | className?: string, 14 | firstNewLoot: StoredInventoryItem, 15 | openNewLoot: () => void, 16 | }> = ({className, firstNewLoot, openNewLoot}) => { 17 | const [isOpen, setIsOpen] = useState(false) 18 | const handleOpenClick = useCallback(() => { 19 | setIsOpen(true) 20 | setTimeout(() => { 21 | setIsOpen(false) 22 | openNewLoot() 23 | }, 2000) 24 | }, []) 25 | 26 | return ( 27 | 28 | 29 | 35 | 40 | 41 | 42 | {isOpen && firstNewLoot && } 47 | {isOpen && } 51 | 52 | ) 53 | } 54 | 55 | const PositionContainer = styled.div` 56 | position: relative; 57 | ` 58 | 59 | const PositionedParticlePop = styled(ParticlePop)` 60 | position: absolute; 61 | right: 0; 62 | bottom: -100px; 63 | z-index: -1; 64 | ` 65 | 66 | const shake = keyframes` 67 | 0% { 68 | transform: rotate(-1deg); 69 | } 70 | 71 | 50% { 72 | transform: rotate(1deg); 73 | } 74 | 75 | 100% { 76 | transform: rotate(-1deg); 77 | } 78 | `; 79 | 80 | interface ShakeContainerProps { 81 | canShake: boolean, 82 | } 83 | const ShakeContainer = styled.div` 84 | &:hover { 85 | animation: ${({canShake}) => canShake ? css`${shake} .35s linear infinite` : 'none'}; 86 | } 87 | ` 88 | 89 | interface StyledLootButtonProps { 90 | hasLoot: boolean, 91 | isOpen: boolean, 92 | } 93 | const StyledLootButton = styled.div` 94 | padding: 4px; 95 | border-bottom-width: 4px; 96 | margin-top: ${({isOpen}) => isOpen ? '0' : '27px'}; 97 | margin-right: ${({isOpen}) => isOpen ? '0' : '27px'}; 98 | transition: transform .35s ease; 99 | transform: ${({hasLoot}) => hasLoot ? 'none' : 'scale(0)'}; 100 | cursor: pointer; 101 | 102 | &:focus { 103 | outline: none; 104 | } 105 | 106 | ${({isOpen}) => isOpen ? css` 107 | cursor: default; 108 | ` : css` 109 | &:hover { 110 | transform: scale(1.1); 111 | transition-duration: .15s; 112 | } 113 | 114 | &:active { 115 | transform: scale(1.05); 116 | transition-duration: .15s; 117 | } 118 | `} 119 | 120 | ` 121 | 122 | const slideUp = keyframes` 123 | 0% { 124 | opacity: 0; 125 | transform: translateY(70px) scale(.25); 126 | } 127 | 128 | 100% { 129 | opacity: 1; 130 | transform: translateY(0) scale(1); 131 | } 132 | `; 133 | 134 | const NewLootItem = styled.div` 135 | position: absolute; 136 | right: 50px; 137 | bottom: 110px; 138 | width: 100px; 139 | height: 100px; 140 | padding: 5px; 141 | background: white center center no-repeat; 142 | background-size: contain; 143 | animation: ${slideUp} .75s ease; 144 | border: 2px solid black; 145 | ` 146 | 147 | export default LootButton 148 | -------------------------------------------------------------------------------- /client/src/loot/LootPane.tsx: -------------------------------------------------------------------------------- 1 | import React, {useCallback, useMemo} from 'react' 2 | import styled, {keyframes} from 'styled-components' 3 | 4 | import type {ArtImage, StoredInventoryItem} from '../types' 5 | import comicData from '../../comic' 6 | import lootImageURL from '../lootImageURL' 7 | import LootButton from './LootButton' 8 | import Text, {SimpleText} from '../Text' 9 | 10 | const xImg = require('../../art/x.png') 11 | const upImg = require('../../art/up.png') 12 | 13 | const LootPane: React.FC<{ 14 | isExpanded: boolean, 15 | isEditingMap: boolean, 16 | isColliding: boolean, 17 | selectedItemId: null | string, 18 | loot: Array, 19 | hint: null | string, 20 | firstNewLoot?: StoredInventoryItem, 21 | openNewLoot?: () => void, 22 | onToggleExpanded?: () => void, 23 | onChangeSelected: (id: null | string) => void, 24 | onConfirmPlacement: () => void, 25 | }> = ({isExpanded, isEditingMap, isColliding, selectedItemId, loot, hint, firstNewLoot, openNewLoot, onToggleExpanded, onChangeSelected, onConfirmPlacement}) => { 26 | const handleItemSelect = useCallback((ev) => { 27 | onChangeSelected(ev.target.dataset.id) 28 | }, [onChangeSelected]) 29 | 30 | const handleResetSelected = useCallback(() => { 31 | onChangeSelected(null) 32 | }, [onChangeSelected]) 33 | 34 | let commandContent 35 | if (isEditingMap) { 36 | if (isColliding) { 37 | commandContent = Move your item to an empty space. 38 | } else if (selectedItemId) { 39 | commandContent = <> 40 | Confirm position? 41 | 44 | Place it 45 | 46 | 49 | Cancel 50 | 51 | 52 | } else if (loot.length) { 53 | commandContent = Select an item to place it. 54 | } 55 | } else { 56 | commandContent = Place your items in the Collector's Edition 57 | } 58 | 59 | const lootItemContent = useMemo(() => ( 60 | loot.map(item => 61 | 70 | ) 71 | ), [loot, selectedItemId, handleItemSelect]) 72 | 73 | return ( 74 | 75 | {onToggleExpanded && 78 | Backpack 79 | 84 | } 85 | 86 | {commandContent && {commandContent}} 87 | 88 | {loot.length > 0 && hint && Hint: {hint}} 89 | 90 | 91 | {lootItemContent} 92 | {loot.length === 0 && hint && Hint: {hint}} 93 | 94 | {openNewLoot && } 98 | 99 | ) 100 | } 101 | 102 | const expandDuration = .5 103 | 104 | interface AboveBarProps { 105 | isHidden: boolean, 106 | } 107 | const AboveBar = styled.div` 108 | display: flex; 109 | align-items: flex-end; 110 | flex-wrap: wrap; 111 | position: absolute; 112 | bottom: 157px; 113 | left: 0; 114 | right: 200px; 115 | padding: 0 10px; 116 | opacity: ${({isHidden}) => isHidden ? 0 : 1}; 117 | transition: opacity ${expandDuration}s ease; 118 | 119 | & > * { 120 | margin-bottom: 5px; 121 | } 122 | ` 123 | 124 | const Spacer = styled.div` 125 | flex: 1; 126 | min-width: 50px; 127 | ` 128 | 129 | const Hint = styled(Text)` 130 | flex-shrink: 0; 131 | background: white; 132 | border: 2px solid black; 133 | border-radius: 4px; 134 | padding: 5px 10px; 135 | ` 136 | 137 | const CommandButton = styled.button` 138 | box-sizing: content-box; 139 | background: #ccc; 140 | border: none; 141 | border-radius: 2px; 142 | padding: 0 5px; 143 | font-size: 22px; 144 | ` 145 | 146 | const CommandBar = styled.div` 147 | display: flex; 148 | flex-shrink: 0; 149 | background: white; 150 | border: 2px solid black; 151 | padding: 5px 10px; 152 | font-size: 22px; 153 | 154 | ${CommandButton} { 155 | margin-left: 15px; 156 | } 157 | ` 158 | 159 | const FillHint = styled(Text)` 160 | align-self: center; 161 | text-align: center; 162 | flex: 1; 163 | color: black; 164 | ` 165 | 166 | const Link = styled.a` 167 | color: blue; 168 | font-weight: normal; 169 | text-decoration: underline; 170 | ` 171 | 172 | interface LootItemProps { 173 | isSelected: boolean, 174 | } 175 | const LootItem = styled.div` 176 | width: 100px; 177 | height: 100px; 178 | box-sizing: border-box; 179 | flex-shrink: 0; 180 | background: center center no-repeat; 181 | background-color: ${({isSelected}) => isSelected ? '#ddd' : '#fff'}; 182 | background-size: contain; 183 | border-color: ${({isSelected}) => isSelected ? '#ddd' : '#fff'}; 184 | border-style: solid; 185 | border-width: 10px; 186 | border-radius: 2px; 187 | 188 | &:hover { 189 | background-color: #eee; 190 | border-color: #eee; 191 | } 192 | ` 193 | 194 | const LootTray = styled.div` 195 | display: flex; 196 | height: 140px; 197 | padding: 5px; 198 | background: white; 199 | flex-wrap: wrap; 200 | overflow-y: auto; 201 | ` 202 | 203 | const PositionedLootButton = styled(LootButton)` 204 | position: absolute; 205 | top: -230px; 206 | right: 0; 207 | ` 208 | 209 | const ToggleButton = styled.div` 210 | position: absolute; 211 | display: flex; 212 | align-items: center; 213 | top: -40px; 214 | right: 34px; 215 | height: 30px; 216 | font-size: 22px; 217 | padding: 4px 10px; 218 | background: white; 219 | border-top-left-radius: 4px; 220 | border-top-right-radius: 4px; 221 | border: 2px solid black; 222 | border-bottom-width: 0; 223 | user-select: none; 224 | cursor: pointer; 225 | 226 | & > * { 227 | margin: 0 6px; 228 | } 229 | ` 230 | 231 | interface StyledLootPaneProps { 232 | isExpanded: boolean, 233 | } 234 | const StyledLootPane = styled.div` 235 | position: fixed; 236 | left: 0; 237 | bottom: 0; 238 | width: 100%; 239 | background: white center center; 240 | border-top: 2px solid black; 241 | transform: ${({isExpanded}) => isExpanded ? 'none' : 'translate(0, 100%)'}; 242 | transition: transform ${expandDuration}s ease; 243 | ` 244 | 245 | export default LootPane 246 | -------------------------------------------------------------------------------- /client/src/loot/LootStateController.ts: -------------------------------------------------------------------------------- 1 | import countBy from 'lodash/countBy' 2 | import find from 'lodash/find' 3 | import findIndex from 'lodash/findIndex' 4 | import sample from 'lodash/sample' 5 | import {Emitter} from '@servie/events' 6 | import {v4 as uuidv4} from 'uuid' 7 | 8 | import type {ZLoc, ItemLoc, InventoryItem, StoredInventoryItem, InventoryState, BinData} from '../types' 9 | import type {APIClient} from '../APIClient' 10 | 11 | const SESSION_KEY = 'session' 12 | const INVENTORY_KEY = 'inventory' 13 | const SEEN_KEY = 'seen' 14 | 15 | interface LootEvents { 16 | change: [InventoryState], 17 | } 18 | 19 | export default class LootStateController { 20 | api: APIClient 21 | lastHint: string 22 | events: Emitter 23 | 24 | constructor(api: APIClient) { 25 | this.api = api 26 | this.events = new Emitter() 27 | this.lastHint = null 28 | window.addEventListener('storage', this._handleStorageChange) 29 | } 30 | 31 | get sessionData(): null | string { 32 | return localStorage.getItem(SESSION_KEY) 33 | } 34 | 35 | get seenIds(): Set { 36 | return new Set(JSON.parse(localStorage.getItem(SEEN_KEY) || '[]')) 37 | } 38 | 39 | get inventory(): Array { 40 | return JSON.parse(localStorage.getItem(INVENTORY_KEY) || '[]') 41 | } 42 | 43 | get state(): InventoryState { 44 | const {seenIds, inventory} = this 45 | const firstNewLoot = inventory.find(i => !seenIds.has(i.id)) 46 | const seenInventory = inventory.filter(i => seenIds.has(i.id)) 47 | return { 48 | firstNewLoot, 49 | loot: seenInventory, 50 | hint: this.lastHint, 51 | } 52 | } 53 | 54 | _emitState() { 55 | this.events.emit('change', this.state) 56 | } 57 | 58 | _handleStorageChange = (ev: StorageEvent) => { 59 | if (ev.key === INVENTORY_KEY || ev.key === SEEN_KEY) { 60 | this._emitState() 61 | } 62 | } 63 | 64 | _handleServerData({loot, hints, session}: {loot: Array, hints: Array, session: string}) { 65 | localStorage.setItem(SESSION_KEY, session) 66 | this._storeServerLoot(loot) 67 | this.lastHint = sample(hints) 68 | this._emitState() 69 | } 70 | 71 | _storeServerLoot(serverInventory: Array) { 72 | const newInventory = [...this.inventory] 73 | 74 | const serverCounts = countBy(serverInventory, i => i.img) 75 | const localCounts = countBy(this.inventory, i => i.img) 76 | const imgKeys = new Set([...Object.keys(serverCounts), ...Object.keys(localCounts)]) 77 | for (const img of imgKeys) { 78 | const serverCount = serverCounts[img] || 0 79 | const localCount = localCounts[img] || 0 80 | 81 | if (serverCount > localCount) { 82 | for (let i = 0; i < serverCount - localCount; i++) { 83 | newInventory.unshift({ 84 | id: uuidv4(), 85 | ...find(serverInventory, i => i.img === img), 86 | }) 87 | } 88 | } else if (serverCount < localCount) { 89 | for (let i = 0; i < localCount - serverCount; i++) { 90 | const removeIdx = findIndex(newInventory, i => i.img === img) 91 | newInventory.splice(removeIdx, 1) 92 | } 93 | } 94 | } 95 | 96 | localStorage.setItem(INVENTORY_KEY, JSON.stringify(newInventory)) 97 | } 98 | 99 | async claimLoot(path: string) { 100 | const {sessionData} = this 101 | const {loot, hints, session} = await this.api.claimLoot(sessionData, path) 102 | this._handleServerData({loot, hints, session}) 103 | } 104 | 105 | openNewLoot() { 106 | const seenIds = this.seenIds 107 | const firstNewLoot = this.inventory.find(i => !seenIds.has(i.id)) 108 | if (firstNewLoot) { 109 | const newSeenIds = [firstNewLoot.id, ...seenIds] 110 | localStorage.setItem(SEEN_KEY, JSON.stringify(newSeenIds)) 111 | this._emitState() 112 | } 113 | } 114 | 115 | async placeItem(id: string, itemLoc: ItemLoc): Promise> { 116 | const {inventory, seenIds, sessionData} = this 117 | 118 | const {placed, loot, hints, binDatas, session} = await this.api.placeItem(sessionData, itemLoc) 119 | 120 | if (placed) { 121 | // Remove the specific item from our local stores first. 122 | const newSeenIds = [...seenIds].filter(sid => sid !== id) 123 | const newInventory = inventory.filter(i => i.id !== id) 124 | localStorage.setItem(INVENTORY_KEY, JSON.stringify(newInventory)) 125 | localStorage.setItem(SEEN_KEY, JSON.stringify(newSeenIds)) 126 | } 127 | 128 | // Make sure everything matches up with the server's loot data. 129 | this._handleServerData({loot, hints, session}) 130 | 131 | return placed && binDatas 132 | } 133 | } 134 | -------------------------------------------------------------------------------- /client/src/loot/ParticlePop.tsx: -------------------------------------------------------------------------------- 1 | import React, {useEffect, useRef} from 'react' 2 | import sample from 'lodash/sample' 3 | import random from 'lodash/random' 4 | 5 | import type {PreloadedArtImage} from '../preloadImg' 6 | import {preloadImg} from '../preloadImg' 7 | import useCanvas from '../useCanvas' 8 | 9 | const particleImgs = [ 10 | require('../../art/bubble-1.png'), 11 | require('../../art/bubble-2.png'), 12 | require('../../art/puff-1.png'), 13 | require('../../art/puff-2.png'), 14 | require('../../art/star-1.png'), 15 | require('../../art/star-2.png'), 16 | require('../../art/spiral.png'), 17 | ].map(preloadImg) 18 | 19 | type ParticleState = { 20 | img: PreloadedArtImage, 21 | s: number, 22 | x: number, 23 | y: number, 24 | a: number, 25 | vx: number, 26 | vy: number, 27 | va: number, 28 | drag: number, 29 | time: number, 30 | } 31 | 32 | function* animate( 33 | canvas: HTMLCanvasElement, 34 | dpr: number, 35 | width: number, 36 | height: number, 37 | ): Generator { 38 | const ctx = canvas.getContext('2d') 39 | ctx.scale(dpr, dpr) 40 | 41 | let particles: Array = [] 42 | for (let i = 0; i < random(60, 80); i++) { 43 | particles.push({ 44 | img: sample(particleImgs), 45 | s: random(.4, 1.1), 46 | x: width * .9 + random(-12, 12), 47 | y: height * .75 + random(-8, 8), 48 | a: 0, 49 | vx: -width / 100 + random(0, 10.5), 50 | vy: -height / 60 + random(0, 8.5), 51 | va: random(-.1, .1), 52 | drag: random(-.02, 0), 53 | time: random(110, 125), 54 | }) 55 | } 56 | 57 | while (particles.length) { 58 | ctx.clearRect(0, 0, width, height) 59 | for (const particle of particles) { 60 | particle.time-- 61 | if (particle.time > 115) { 62 | continue 63 | } 64 | particle.vy += width / 5000 65 | particle.vx *= 1 + particle.drag 66 | particle.x += particle.vx 67 | particle.y += particle.vy 68 | particle.a += particle.va 69 | const {el, width: pw, height: ph} = particle.img 70 | ctx.save() 71 | ctx.translate(particle.x, particle.y) 72 | ctx.rotate(particle.a) 73 | ctx.scale(particle.s, particle.s) 74 | ctx.globalAlpha = particle.time > 60 ? 1 : particle.time / 60 75 | 76 | try { 77 | ctx.drawImage(el, -pw / 2, -ph / 2, pw, ph) 78 | } catch (err) { 79 | console.warn('Error drawing particle image', particle, err) 80 | } 81 | 82 | ctx.restore() 83 | } 84 | 85 | particles = particles.filter(p => p.time > 0) 86 | yield 87 | } 88 | } 89 | 90 | const ParticlePop: React.FC<{ 91 | className?: string, 92 | width: number, 93 | height: number, 94 | }> = ({className, width, height}) => { 95 | const [dpr, canvasWidth, canvasHeight, canvasRef] = useCanvas(width, height) 96 | 97 | useEffect(() => { 98 | const animation = animate(canvasRef.current, dpr, width, height) 99 | 100 | function step() { 101 | animation.next() 102 | requestAnimationFrame(step) 103 | } 104 | step() 105 | }, []) 106 | 107 | return ( 108 | 115 | ) 116 | } 117 | 118 | export default ParticlePop 119 | -------------------------------------------------------------------------------- /client/src/loot/useLootState.ts: -------------------------------------------------------------------------------- 1 | import React, {useCallback, useLayoutEffect, useRef, useState} from 'react' 2 | 3 | import type {ItemLoc, StoredInventoryItem, InventoryState, BinData} from '../types' 4 | import type {APIClient} from '../APIClient' 5 | import LootStateController from './LootStateController' 6 | 7 | export default function useLootState(api: APIClient, lootStateController: LootStateController): [InventoryState, () => void, (id: string, itemLoc: ItemLoc) => Promise>] { 8 | const [lootState, setLootState] = useState(lootStateController.state) 9 | 10 | useLayoutEffect(() => { 11 | lootStateController.events.on('change', setLootState) 12 | return () => { 13 | lootStateController.events.off('change', setLootState) 14 | } 15 | }, []) 16 | 17 | const openNewLoot = useCallback(() => lootStateController.openNewLoot(), []) 18 | const placeItem = useCallback((id: string, itemLoc: ItemLoc) => lootStateController.placeItem(id, itemLoc), []) 19 | return [lootState, openNewLoot, placeItem] 20 | } 21 | -------------------------------------------------------------------------------- /client/src/lootImageURL.ts: -------------------------------------------------------------------------------- 1 | import comicData from '../comic' 2 | 3 | export default function lootImageURL(imgName: string) { 4 | return comicData.itemImgBaseURL + imgName 5 | } 6 | -------------------------------------------------------------------------------- /client/src/preloadImg.ts: -------------------------------------------------------------------------------- 1 | import type {ArtImage} from './types' 2 | 3 | export interface PreloadedArtImage extends ArtImage { 4 | el: HTMLImageElement, 5 | } 6 | 7 | export function preloadImg(imgData: ArtImage): PreloadedArtImage { 8 | const el = new Image() 9 | setTimeout(() => { 10 | el.src = imgData.url['2x'] 11 | }, 0) 12 | return {el, ...imgData} 13 | } 14 | -------------------------------------------------------------------------------- /client/src/types.ts: -------------------------------------------------------------------------------- 1 | export interface ArtImage { 2 | width: number, 3 | height: number, 4 | url: { 5 | '2x': string, 6 | }, 7 | } 8 | 9 | export type ServerAABB = { 10 | min: [number, number, number], 11 | max: [number, number, number], 12 | } 13 | 14 | export type ServerItem = { 15 | img: string, 16 | aabb: ServerAABB, 17 | } 18 | 19 | export type ServerItems = Array 20 | 21 | export type ServerBinSpace = { 22 | [key: string]: ServerAABB, 23 | } 24 | 25 | export type ServerBinItemMap = { 26 | [key: string]: ServerItems, 27 | } 28 | 29 | export type ServerClaim = { 30 | value: { 31 | loot: Array, 32 | hints: Array, 33 | }, 34 | session: string, 35 | } 36 | 37 | export type ServerPlace = { 38 | value: { 39 | placed: boolean, 40 | user: { 41 | loot: Array, 42 | hints: Array, 43 | }, 44 | bins: ServerBinItemMap, 45 | }, 46 | session: string, 47 | } 48 | 49 | export type ClaimResult = { 50 | loot: Array, 51 | hints: Array, 52 | session: string, 53 | } 54 | 55 | export type PlaceResult = { 56 | placed: boolean, 57 | loot: Array, 58 | hints: Array, 59 | binDatas: Array, 60 | session: string, 61 | } 62 | 63 | export interface InventoryItem { 64 | img: string, 65 | width: number, 66 | height: number, 67 | z: number, 68 | } 69 | 70 | export interface StoredInventoryItem extends InventoryItem { 71 | id: string, 72 | } 73 | 74 | export type InventoryState = { 75 | firstNewLoot: null | StoredInventoryItem, 76 | loot: Array, 77 | hint: null | string, 78 | } 79 | 80 | export interface Loc { 81 | minX: number, 82 | maxX: number, 83 | minY: number, 84 | maxY: number, 85 | } 86 | 87 | export interface ZLoc extends Loc { 88 | minZ: number 89 | } 90 | 91 | export interface ItemLoc extends ZLoc { 92 | kind: 'item', 93 | img: string, 94 | } 95 | 96 | export type ZItemMap = Map> 97 | 98 | export interface BinLoc extends Loc { 99 | kind: 'bin', 100 | id: string, 101 | } 102 | 103 | export interface BinData { 104 | id: string, 105 | expiresAt: number, 106 | items: Array, 107 | } 108 | 109 | export interface ViewData { 110 | expiresAt: number, 111 | bins: Array, 112 | } 113 | 114 | export interface ItemPlaceState { 115 | isColliding: boolean, 116 | zloc: ZLoc, 117 | } 118 | -------------------------------------------------------------------------------- /client/src/useCanvas.ts: -------------------------------------------------------------------------------- 1 | import React, {useRef} from 'react' 2 | 3 | export default function useCanvas(width: number, height: number): [number, number, number, React.RefObject] { 4 | const dpr = window.devicePixelRatio || 1 5 | const canvasWidth = Math.round(width * dpr) 6 | const canvasHeight = Math.round(height * dpr) 7 | const canvasRef = useRef() 8 | return [dpr, canvasWidth, canvasHeight, canvasRef] 9 | } 10 | -------------------------------------------------------------------------------- /client/src/useStorage.ts: -------------------------------------------------------------------------------- 1 | import {useCallback, useEffect, useState} from 'react' 2 | 3 | function parse(json: string, fallback: any): any { 4 | try { 5 | return JSON.parse(json) 6 | } catch (err) { 7 | return fallback 8 | } 9 | } 10 | 11 | export default function useStorage(key: string, initialValue: T): [T, (value: T) => void] { 12 | const [value, setValue] = useState(parse(localStorage.getItem(key), initialValue) ?? initialValue) 13 | 14 | const handleStorageSet = useCallback((value: T) => { 15 | localStorage.setItem(key, JSON.stringify(value)) 16 | setValue(value) 17 | }, []) 18 | 19 | const handleStorageChange = useCallback((ev: StorageEvent) => { 20 | if (ev.key === key) { 21 | const value = parse(ev.newValue, initialValue) 22 | setValue(value) 23 | } 24 | }, []) 25 | 26 | useEffect(() => { 27 | window.addEventListener('storage', handleStorageChange) 28 | return () => { 29 | window.removeEventListener('storage', handleStorageChange) 30 | } 31 | }, []) 32 | 33 | useEffect(() => { 34 | }, [value]) 35 | 36 | return [value, handleStorageSet] 37 | } 38 | -------------------------------------------------------------------------------- /client/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "sourceMap": true, 4 | "noImplicitAny": true, 5 | "esModuleInterop": true, 6 | "module": "esnext", 7 | "target": "es6", 8 | "jsx": "react", 9 | "allowJs": true, 10 | "moduleResolution": "node", 11 | "resolveJsonModule": true, 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /client/webpack.config.js: -------------------------------------------------------------------------------- 1 | const path = require('path') 2 | const webpack = require('webpack') 3 | const CopyWebpackPlugin = require('copy-webpack-plugin') 4 | const HtmlWebpackPlugin = require('html-webpack-plugin') 5 | const ZipWebpackPlugin = require('zip-webpack-plugin') 6 | 7 | const comicData = require('./comic') 8 | 9 | const tsLoader = { 10 | test: /\.tsx?$/, 11 | use: 'ts-loader', 12 | exclude: /node_modules/, 13 | } 14 | 15 | function comicImageLoader(mode) { 16 | return { 17 | test: /\.png$/, 18 | use: [ 19 | mode === 'development' && 'cache-loader', 20 | { 21 | loader: 'comic-image-loader', 22 | options: { 23 | name: 'static/[contenthash:6].[ext]', 24 | quant: true, 25 | scale: .1, 26 | }, 27 | }, 28 | ].filter(Boolean), 29 | } 30 | } 31 | 32 | const resolve = { 33 | extensions: ['.tsx', '.ts', '.js'], 34 | } 35 | 36 | const resolveLoader = { 37 | modules: [ 38 | 'node_modules', 39 | path.resolve(__dirname, 'loaders'), 40 | ] 41 | } 42 | 43 | function devServer() { 44 | return { 45 | writeToDisk: true, 46 | contentBase: path.resolve(__dirname, 'dist'), 47 | proxy: { 48 | '/api': { 49 | target: process.env.MAPLE_API_SERVER, 50 | pathRewrite: {'^/api' : ''}, 51 | changeOrigin: true, 52 | headers: { 53 | 'Origin': new URL(process.env.MAPLE_API_SERVER).origin, 54 | }, 55 | }, 56 | }, 57 | } 58 | } 59 | 60 | function commonPlugins(mode) { 61 | return [ 62 | new webpack.BannerPlugin('code by chromako.de.'), 63 | new webpack.DefinePlugin({ 64 | 'process.env.MAPLE_API_SERVER': JSON.stringify(mode === 'development' ? '/api/' : process.env.MAPLE_API_SERVER), 65 | 'process.env.MAPLE_ITEM_IMG_URL': JSON.stringify(process.env.MAPLE_ITEM_IMG_URL), 66 | 'process.env.USE_MOCK_API': JSON.stringify(process.env.USE_MOCK_API), 67 | }), 68 | ] 69 | } 70 | 71 | function buildComic(env, argv) { 72 | const publicPath = process.env.MAPLE_ASSET_URL || '/comic/' 73 | return { 74 | name: 'comic', 75 | entry: { 76 | comic: './src/index.tsx', 77 | }, 78 | output: { 79 | path: path.resolve(__dirname, 'dist/comic'), 80 | filename: '[name].js', 81 | publicPath, 82 | }, 83 | module: { 84 | rules: [ 85 | tsLoader, 86 | comicImageLoader(argv.mode), 87 | ], 88 | }, 89 | resolve, 90 | resolveLoader, 91 | plugins: [ 92 | ...commonPlugins(argv.mode), 93 | new HtmlWebpackPlugin({ 94 | inject: false, 95 | minify: false, 96 | template: 'src/index.ejs', 97 | templateParameters: (compilation, assets, assetTags, options) => ({ 98 | tags: assetTags, 99 | comic: comicData, 100 | }), 101 | }), 102 | ], 103 | devServer: argv.mode === 'development' ? devServer() : {}, 104 | } 105 | } 106 | 107 | function buildAdmin(env, argv) { 108 | const publicPath = process.env.MAPLE_ADMIN_ASSET_URL || '/admin/' 109 | return { 110 | name: 'admin', 111 | entry: { 112 | admin: './src/admin/index.tsx', 113 | }, 114 | output: { 115 | path: path.resolve(__dirname, 'dist/admin'), 116 | filename: '[name].js', 117 | publicPath, 118 | }, 119 | module: { 120 | rules: [ 121 | tsLoader, 122 | comicImageLoader(argv.mode), 123 | ], 124 | }, 125 | resolve, 126 | resolveLoader, 127 | plugins: [ 128 | ...commonPlugins(argv.mode), 129 | new HtmlWebpackPlugin({ 130 | inject: false, 131 | minify: false, 132 | template: 'src/admin/index.ejs', 133 | templateParameters: (compilation, assets, assetTags, options) => ({ 134 | tags: assetTags, 135 | comic: comicData, 136 | }), 137 | }), 138 | ], 139 | devServer: argv.mode === 'development' ? devServer(): {}, 140 | } 141 | } 142 | 143 | function buildLootExtension(env, argv) { 144 | const output = { 145 | path: path.resolve(__dirname, 'dist/extension'), 146 | filename: '[name].js', 147 | } 148 | 149 | return { 150 | name: 'extension', 151 | entry: { 152 | extension: ['./src/extension/index.ts', './src/index.tsx'], 153 | }, 154 | output, 155 | module: { 156 | rules: [ 157 | tsLoader, 158 | comicImageLoader(argv.mode), 159 | ], 160 | }, 161 | resolve, 162 | resolveLoader, 163 | plugins: [ 164 | ...commonPlugins(argv.mode), 165 | new CopyWebpackPlugin([ 166 | { 167 | from: 'src/extension/manifest.json', 168 | to: 'manifest.json', 169 | transform: (content) => content.toString().replace('${apiServerURL}', comicData.apiServerURL) 170 | }, 171 | ]), 172 | new ZipWebpackPlugin({ 173 | path: '../', 174 | filename: 'xkcd-loot-extension.zip' 175 | }), 176 | ], 177 | } 178 | } 179 | 180 | module.exports = [buildComic, buildAdmin, buildLootExtension] 181 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? import {}, ghc_version ? "ghc8101" }: 2 | 3 | with pkgs; 4 | 5 | let 6 | baseDeps = [ 7 | haskell.compiler.${ghc_version} 8 | cabal-install 9 | cacert 10 | curl 11 | gitMinimal 12 | zlib 13 | redis 14 | ]; 15 | in 16 | 17 | rec { 18 | inherit ghc_version; 19 | 20 | # This one is only useful after running `cabal install --installdir=$PWD/bin` so the binaries exist 21 | runtimeImage = dockerTools.buildLayeredImage { 22 | name = "maple"; 23 | tag = "latest"; 24 | contents = [ 25 | bash 26 | coreutils # gitlab executor needs this :-| 27 | zlib 28 | gmp 29 | libffi 30 | redis # for tests 31 | ]; 32 | config.Env = [ 33 | "LD_LIBRARY_PATH=/lib" 34 | ]; 35 | config.Entrypoint = ["/bin/sh"]; 36 | config.WorkingDir = "/srv/maple"; 37 | extraCommands = '' 38 | mkdir -p srv/maple 39 | cp -a ${./loot} srv/maple/loot 40 | cp -a ${./test_loot.csv} srv/maple/test_loot.csv 41 | cp -a ${./bin}/* srv/maple/ 42 | ''; 43 | }; 44 | 45 | shell = pkgs.mkShell { 46 | buildInputs = baseDeps ++ [ 47 | ghcid 48 | ]; 49 | LIBRARY_PATH = "${pkgs.zlib}/lib"; 50 | }; 51 | 52 | client = stdenv.mkDerivation rec { 53 | name = "maple-client"; 54 | srcs = ./client; 55 | buildInputs = [ 56 | nodePackages.npm 57 | nodejs 58 | ]; 59 | 60 | ## Override this to control which components get built: 61 | build_components = ["comic" "admin" "extension"]; 62 | 63 | ## Override these to pass vars to the npm build: 64 | # MAPLE_ASSET_URL = "/....."; 65 | # MAPLE_ADMIN_ASSET_URL = "/...."; 66 | # MAPLE_API_SERVER = "/...."; 67 | # MAPLE_ITEM_IMG_URL = "/...."; 68 | ## (see client/comic.js for a list of variables) 69 | 70 | buildPhase = '' 71 | ${clientShell.shellHook} 72 | ln -sf $NODE_PATH node_modules 73 | for c in $build_components; do 74 | npm run "build:$c" 75 | done 76 | ''; 77 | installPhase = '' 78 | cp -a dist $out 79 | ''; 80 | }; 81 | 82 | clientShell = (callPackage ./client {}).shell; 83 | 84 | clientImage = 85 | dockerTools.buildLayeredImage { 86 | name = "maple-client"; 87 | tag = "latest"; 88 | contents = [ 89 | bash 90 | coreutils 91 | nodePackages.npm 92 | nodejs 93 | (pkgs.writeScriptBin "entrypoint.sh" '' 94 | #!/bin/bash 95 | ${clientShell.shellHook} 96 | exec "$@" 97 | '') 98 | ]; 99 | config.Args = ["bash"]; 100 | config.Entrypoint = ["/bin/entrypoint.sh"]; 101 | config.WorkingDir = "/srv/maple/client"; 102 | extraCommands = '' 103 | mkdir -p srv/maple 104 | cp -a ${./client} srv/maple/client 105 | ${clientShell.shellHook} 106 | chmod +w srv/maple/client 107 | cd srv/maple/client 108 | ln -sf $NODE_PATH node_modules 109 | ${nodePackages.npm}/bin/npm run build 110 | ''; 111 | }; 112 | } 113 | -------------------------------------------------------------------------------- /doc-gen/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# OPTIONS_GHC -fno-warn-orphans #-} -- TODO remove this 7 | module Main where 8 | 9 | import Data.Map (Map) 10 | import qualified Data.Map as Map 11 | import qualified Data.Foldable as Foldable 12 | import Data.Proxy 13 | import Linear 14 | import Data.Text (Text) 15 | import qualified Data.Time as Time 16 | import Network.HTTP.Date 17 | 18 | import Servant.API 19 | import Servant.Docs 20 | import Servant.Docs.Internal 21 | import Web.Cookie 22 | 23 | import Maple.AABB 24 | import Maple.Loot 25 | import Maple.Web.Admin 26 | import Maple.Web.API 27 | import Maple.Web.Local 28 | import Maple.Web.Session 29 | 30 | main :: IO () 31 | main = writeFile "docs.md" markdownMapleDocs 32 | 33 | mapleDocsAPI :: Proxy (MapleAPI Int Int V3 Int Int (ImgLoot V3 Int)) 34 | mapleDocsAPI = mapleAPI 35 | 36 | mapleDocs :: API 37 | mapleDocs = docsWith (DocOptions 5) [] mempty mapleDocsAPI 38 | 39 | markdownMapleDocs :: String 40 | markdownMapleDocs = markdown mapleDocs 41 | 42 | instance ToAuthInfo (BasicAuth "admin" MapleAdmin) where 43 | toAuthInfo _ = 44 | DocAuthentication "This route requires a user login" "Username and password" 45 | 46 | {- Warning - orphan instances -} 47 | 48 | instance ToSample (Map Int [ImgLoot V3 Int]) where 49 | toSamples _ = 50 | samples [Map.fromList [ (1,[ImgLoot (bound (V3 0 0 1) (V3 20 20 1)) "https://example.com/image.png"])]] 51 | 52 | instance ToSample (Sessioned Int (ImgLoot V3 Int) (UserWithBins Int (ImgLoot V3 Int))) where 53 | toSamples _ = samples [Sessioned "{user session}" $ UserWithBins (Map.fromList [(1,[ImgLoot (bound (V3 0 0 1) (V3 20 20 1)) "https://example.com/image.png"])]) True u] 54 | where u = UserInfo [ImgLoot (bound (V3 0 0 1) (V3 20 20 1)) "https://example.com/image.png"] ["A hint to help you find an image"] 55 | 56 | instance ToSample Text where 57 | toSamples _ = samples ["..."] 58 | 59 | instance HasDocs api => HasDocs (MapleLocal s :> api) where 60 | docsFor _ = docsFor (Proxy :: Proxy api) 61 | 62 | instance ToSample (Sessioned Int (ImgLoot V3 Int) (ImgLoot V3 Int)) where 63 | toSamples _ = 64 | samples [Sessioned "{user session}" $ ImgLoot (bound (V3 0 0 1) (V3 20 20 1)) "https://example.com/image.png"] 65 | 66 | instance ToSample (Sessioned Int (ImgLoot V3 Int) (UserInfo (ImgLoot V3 Int))) where 67 | toSamples _ = 68 | samples [Sessioned "{user session}" $ UserInfo [ImgLoot (bound (V3 0 0 1) (V3 20 20 1)) "https://example.com/image.png"] ["A hint to help you find an image"]] 69 | 70 | instance ToSample (Sessioned Int (ImgLoot V3 Int) ()) where 71 | toSamples _ = 72 | samples [Sessioned "{user session}" ()] 73 | 74 | instance ToSample (Sessioned Int (ImgLoot V3 Int) Int) where 75 | toSamples _ = 76 | samples [Sessioned "{user session}" 10] 77 | 78 | instance ToSample HTTPDate where 79 | toSamples _ = 80 | samples [utcToHTTPDate $ Time.UTCTime (Time.ModifiedJulianDay 20090) $ Time.secondsToDiffTime 0] 81 | 82 | instance ToSample CacheControlHeader where 83 | toSamples _ = 84 | samples [CacheControlHeader "public, max-age=20"] 85 | 86 | instance ToSample MapleCacheControl where 87 | toSamples _ = 88 | samples [MapleCacheControl 5, MapleCacheControl 60] 89 | 90 | instance ToSample (BoundingBox V3 Int) where 91 | toSamples _ = 92 | samples [bound (V3 0 0 0) (V3 20 20 1)] 93 | 94 | instance ToSample (UserInfo (ImgLoot V3 Int)) where 95 | toSamples _ = 96 | samples [UserInfo [ImgLoot (bound (V3 0 0 1) (V3 20 20 1)) "https://example.com/image.png"] ["A hint to help you find an image"]] 97 | 98 | 99 | instance ToSample (UserInfo (ImgLoot V2 Int)) where 100 | toSamples _ = 101 | samples [UserInfo [ImgLoot (bound (V2 0 0) (V2 20 20)) "https://example.com/image.png"] ["A hint to help you find an image"]] 102 | 103 | instance ToSample SetCookie where 104 | toSamples _ = 105 | samples [defaultSetCookie { setCookieName = "maple", setCookieValue = "..."}] 106 | 107 | instance ToSample (V2 Int) where 108 | toSamples _ = 109 | samples [V2 0 0, V2 5 6, V2 12 12] 110 | 111 | instance ToSample (V3 Int) where 112 | toSamples _ = 113 | samples [V3 0 0 0, V3 5 0 6, V3 12 12 1 ] 114 | 115 | 116 | instance ToSample (BoundingBox V2 Int) where 117 | toSamples _ = 118 | samples $ [bound (V2 0 0) (V2 10 10)] 119 | 120 | instance ToSample (Map Int (BoundingBox V2 Int)) where 121 | toSamples _ = 122 | singleSample $ Map.fromList $ Foldable.toList $ (,) <$> toSample Proxy <*> toSample Proxy 123 | 124 | instance ToSample Int where 125 | toSamples _ = singleSample 5 126 | 127 | instance ToSample (ImgLoot V2 Int) where 128 | toSamples _ = singleSample $ ImgLoot (bound (V2 0 0) (V2 10 10)) "test.png" 129 | 130 | instance ToSample (ImgLoot V3 Int) where 131 | toSamples _ = singleSample $ ImgLoot (bound (V3 0 0 0) (V3 10 10 1)) "test.png" 132 | 133 | instance ToSample p => ToParam (QueryParam' '[Required] "maxPoint" (V2 p)) where 134 | toParam _ = 135 | DocQueryParam "maxPoint" 136 | ["5,10", "0,0"] 137 | "Required maximum point" 138 | Normal 139 | 140 | 141 | instance ToSample p => ToParam (QueryParam' '[Required] "minPoint" (V2 p)) where 142 | toParam _ = 143 | DocQueryParam "minPoint" 144 | ["0,5", "12,15"] 145 | "Required minimum point" 146 | Normal 147 | 148 | instance ToParam (QueryParam' '[Required] "minPoint" (V3 Int)) where 149 | toParam _ = 150 | DocQueryParam "minPoint" 151 | ["0,5,1", "12,15,1"] 152 | "Required minimum point" 153 | Normal 154 | 155 | instance ToParam (QueryParam' '[Required] "maxPoint" (V3 Int)) where 156 | toParam _ = 157 | DocQueryParam "maxPoint" 158 | ["0,0,1", "8,8,1"] 159 | "Required maximum point" 160 | Normal 161 | 162 | instance ToSample b => ToCapture (Capture "id" b) where 163 | toCapture _ = 164 | DocCapture "id" "id for a bin" 165 | -------------------------------------------------------------------------------- /loot/1/A.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xkcd/maple/a6f85fc4e2c1de2446477071bb30a4660805d696/loot/1/A.png -------------------------------------------------------------------------------- /loot/1/B.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xkcd/maple/a6f85fc4e2c1de2446477071bb30a4660805d696/loot/1/B.png -------------------------------------------------------------------------------- /loot/1/C.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xkcd/maple/a6f85fc4e2c1de2446477071bb30a4660805d696/loot/1/C.png -------------------------------------------------------------------------------- /loot/1/D.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xkcd/maple/a6f85fc4e2c1de2446477071bb30a4660805d696/loot/1/D.png -------------------------------------------------------------------------------- /loot/1/E.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xkcd/maple/a6f85fc4e2c1de2446477071bb30a4660805d696/loot/1/E.png -------------------------------------------------------------------------------- /loot/1/F.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xkcd/maple/a6f85fc4e2c1de2446477071bb30a4660805d696/loot/1/F.png -------------------------------------------------------------------------------- /loot/2/box.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xkcd/maple/a6f85fc4e2c1de2446477071bb30a4660805d696/loot/2/box.png -------------------------------------------------------------------------------- /maple.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: maple 4 | version: 0 5 | synopsis: The story goes, the ways of the future were shown in the Maple. 6 | -- description: 7 | homepage: https://oss.xkcd.com/ 8 | bug-reports: https://code.xkrd.net/xkcd/maple/issues 9 | license: BSD-3-Clause 10 | license-file: LICENSE 11 | author: davean 12 | maintainer: oss@xkcd.com 13 | copyright: xkcd 2020 14 | category: Web 15 | extra-source-files: CHANGELOG.md 16 | 17 | common deps 18 | default-language: Haskell2010 19 | ghc-options: -O2 20 | build-depends: 21 | aeson 22 | , attoparsec 23 | , base >=4.12.0.0 && < 4.15 24 | , base64 25 | , bcrypt 26 | , directory 27 | , bytes 28 | , bytestring 29 | , cassava 30 | , cereal 31 | , clientsession 32 | , containers 33 | , cookie 34 | , crypto-api 35 | , delay 36 | , exceptions 37 | , filepath 38 | , hashable 39 | , hedis 40 | , http-date 41 | , http-types 42 | , ip 43 | , JuicyPixels 44 | , monad-loops 45 | , mtl 46 | , network 47 | , lens 48 | , linear 49 | , mime-types 50 | , random 51 | , ref-fd 52 | , safe 53 | , servant 54 | , servant-server 55 | , skein 56 | , stm 57 | , tai 58 | , tagged 59 | , text 60 | , time 61 | , uuid 62 | , vector 63 | , wai 64 | , wai-cors 65 | , wai-app-static 66 | , wide-word 67 | 68 | library 69 | import: deps 70 | hs-source-dirs: src 71 | exposed-modules: 72 | Maple.AABB 73 | Maple.Config 74 | Maple.Loot 75 | Maple.Map 76 | Maple.Session 77 | Maple.Staticize 78 | Maple.Storage.Redis 79 | Maple.Storage.Ref 80 | Maple.TextHintParser 81 | Maple.Web 82 | Maple.Web.Admin 83 | Maple.Web.API 84 | Maple.Web.Local 85 | Maple.Web.Session 86 | Maple.Web.Server 87 | 88 | executable maple-example 89 | import: deps 90 | main-is: Main.hs 91 | build-depends: 92 | maple 93 | , warp 94 | 95 | executable maple-doc-gen 96 | import: deps 97 | hs-source-dirs: doc-gen 98 | main-is: Main.hs 99 | build-depends: 100 | maple 101 | , servant-docs 102 | 103 | test-suite maple-test 104 | import: deps 105 | type: exitcode-stdio-1.0 106 | hs-source-dirs: test 107 | main-is: MapleTest.hs 108 | other-modules: 109 | AABBTest 110 | ParserTests 111 | build-depends: 112 | binary 113 | , maple 114 | , QuickCheck 115 | , process 116 | , tasty 117 | , tasty-hunit 118 | , tasty-test-reporter 119 | , tasty-test-vector 120 | , tasty-quickcheck 121 | , wai 122 | , wai-extra 123 | , with-utf8 124 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | let default_ghc_version = (import ./default.nix {}).ghc_version; in 2 | 3 | { ghc_version ? default_ghc_version }: 4 | 5 | (import ./default.nix { inherit ghc_version; }).shell 6 | -------------------------------------------------------------------------------- /snippets: -------------------------------------------------------------------------------- 1 | import qualified Data.Aeson as JS 2 | import qualified Data.ByteString.Lazy as BL 3 | 4 | ngm = updateMap (runIdentity $ singletonIGridMap2 (pure (0::Word64)) (AABB (V3 (0::Int) 0 0) (pure 0)) (AABB (V2 0 0) (V2 500 500))) (\gid sm -> do { extendedPosY <- foldlM (\m _ -> igridmap2ExtendY gid m) sm [(1::Int)..9]; extendedNegY <- foldlM (\m _ -> igridmap2ExtendYNeg gid m) extendedPosY [(1::Int)..10]; extendedPosX <- foldlM (\m _ -> igridmap2ExtendX gid m) extendedNegY [(1::Int)..19]; foldlM (\m _ -> igridmap2ExtendXNeg gid m) extendedPosX [(1::Int)..20] }) 5 | 6 | OR 7 | 8 | ogm <- loadGridMap 9 | ngm = updateMap ogm (\gid sm -> igridmap2ExtendX gid sm >>= igridmap2ExtendXNeg gid >>= igridmap2ExtendY gid >>= igridmap2ExtendYNeg gid) 10 | 11 | ngm^.binMap.igmBBs.to (bounding . concatMap (corners . fst) . concatMap toList . toList) 12 | 13 | BL.writeFile "gridmap.json" $ JS.encode ngm 14 | -------------------------------------------------------------------------------- /src/Maple/AABB.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | module Maple.AABB where 7 | 8 | import Control.Lens hiding ((.=)) 9 | import Data.Aeson 10 | import Linear 11 | import Linear.Affine 12 | 13 | slice2d :: (R2 v) => Lens' (v p) (V2 p) 14 | slice2d = lens (\vn -> V2 (vn^._x) (vn^._y)) (\s b -> s & _x .~ (b^._x) & _y .~ (b ^. _y)) 15 | 16 | -- | An Axis Aligned Bounding Box 17 | data BoundingBox v p = AABB { _minCorner, _maxCorner :: v p } deriving (Show, Eq, Ord) 18 | 19 | makeClassy ''BoundingBox 20 | 21 | box2d :: R2 v => BoundingBox v p -> BoundingBox V2 p 22 | box2d bb = AABB (bb^.minCorner._xy) (bb^.maxCorner._xy) 23 | 24 | from2X2D :: (R2 v, HasBoundingBox i v p, Affine v, Integral p) => i -> i 25 | from2X2D bb = 26 | bb & boundingBox.maxCorner._xy .~ nMax 27 | where 28 | minC = bb^.boundingBox.minCorner._xy 29 | maxC = bb^.boundingBox.maxCorner._xy 30 | diag = maxC .-. minC 31 | nMax = minC .+^ (fmap (`div` 2) diag) 32 | 33 | instance (Additive v, Ord p) => Semigroup (BoundingBox v p) where 34 | (AABB aminC amaxC) <> (AABB bminC bmaxC) = AABB (liftU2 min aminC bminC) (liftU2 max amaxC bmaxC) 35 | 36 | instance (Applicative v, Additive v, Ord p, Num p) => Monoid (BoundingBox v p) where 37 | mempty = AABB (pure 0) (pure 0) 38 | 39 | instance (Additive v) => Affine (BoundingBox v) where 40 | type Diff (BoundingBox v) = v 41 | 42 | bba .-. bbb = bbb^.minCorner ^-^ bba^.minCorner 43 | 44 | (AABB minC maxC) .+^ v = AABB (minC ^+^ v) (maxC ^+^ v) 45 | 46 | instance ToJSON (v p) => ToJSON (BoundingBox v p) where 47 | toJSON (AABB minC maxC) = 48 | object [ 49 | "min" .= minC 50 | , "max" .= maxC 51 | ] 52 | 53 | instance FromJSON (v p) => FromJSON (BoundingBox v p) where 54 | parseJSON = 55 | withObject "BoundingBox" $ \o -> 56 | AABB <$> o .: "min" <*> o .: "max" 57 | 58 | 59 | corners :: (Additive v, Traversable v) => BoundingBox v p -> [v p] 60 | corners (AABB minC maxC) = sequenceA $ liftI2 (\a b -> [a, b]) minC maxC 61 | 62 | -- | Constructs an AABB from any two corners.a 63 | bound :: (Additive v, Ord p) => v p -> v p -> BoundingBox v p 64 | bound c0 c1 = AABB (liftU2 min c0 c1) (liftU2 max c0 c1) 65 | 66 | bounding :: (Foldable t, Applicative v, Additive v, Ord p, Num p) => t (v p) -> BoundingBox v p 67 | bounding = foldr (\pnt (AABB minC maxC) -> AABB (liftU2 min minC pnt) (liftU2 max maxC pnt)) mempty 68 | 69 | liftI3 :: Additive f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d 70 | liftI3 f a b c = liftI2 (\(a', b') c' -> f a' b' c') (liftI2 (,) a b) c 71 | 72 | touches :: (Additive v, Traversable v, Ord p, Eq (v p)) => BoundingBox v p -> v p -> Bool 73 | touches bb@(AABB minC maxC) pnt = 74 | -- Its between the inclusive min edges and exclusive max edges. 75 | and (liftI3 (\l h p -> l <= p && p < h) minC maxC pnt) 76 | -- The min is the inclusive corner. Every corner is some AABB's min. 77 | && (pnt==minC || not (pnt `elem` (corners bb))) 78 | 79 | liftI4 :: Additive f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e 80 | liftI4 f a b c d = liftI2 (\(a', b') (c', d') -> f a' b' c' d') (liftI2 (,) a b) (liftI2 (,) c d) 81 | 82 | -- | Check if two bounding boxes overlap in any way 83 | overlaps :: (Additive v, Traversable v, Ord p, Eq (v p)) => BoundingBox v p -> BoundingBox v p -> Bool 84 | overlaps (AABB aminC amaxC) (AABB bminC bmaxC) = 85 | and $ liftI4 overlap aminC amaxC bminC bmaxC 86 | where 87 | overlap aminP amaxP bminP bmaxP = 88 | containsPoint aminP amaxP bminP 89 | || containsPoint bminP bmaxP aminP 90 | containsPoint x1 x2 y = 91 | ((x1 <= y) && (y < x2)) || (x1 == y) 92 | 93 | overlaps' :: (Additive v, Traversable v, Ord p, Eq (v p), HasBoundingBox b v p) => b -> b -> Bool 94 | overlaps' bba bbb = overlaps (bba^.boundingBox) (bbb^.boundingBox) 95 | 96 | -- | Takes on BB, the first one, and expands it to be large enough to cover any area that could 97 | -- include the second bounding when said is directly adjacent to the first. 98 | expandBy :: (Additive v, Num p) => BoundingBox v p -> BoundingBox v p -> BoundingBox v p 99 | expandBy (AABB cminC cmaxC) (AABB nminC nmaxC) = 100 | let d = nmaxC ^-^ nminC 101 | in AABB (cminC ^-^ d) (cmaxC ^+^ d) 102 | -------------------------------------------------------------------------------- /src/Maple/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE UndecidableInstances #-} 9 | module Maple.Config where 10 | 11 | import Control.Lens 12 | import Data.ByteString (ByteString) 13 | import Data.Kind 14 | import Maple.Loot 15 | import Web.ClientSession 16 | import Maple.Map 17 | import Maple.Session 18 | import Maple.Web.Admin 19 | import Maple.Web.API 20 | import Maple.Web.Local 21 | 22 | -- | The configuration that defines the Maple system. 23 | -- g is the map type. 24 | -- is (HasBinMap) 25 | -- l is the local 26 | -- is (Hashable) 27 | -- s is the list of keys we keep to enable us to tell if a loot is unlocked. 28 | -- is (To/FromJSON) 29 | -- i is the loot type. 30 | -- is (To/FromJSON) 31 | -- v is the vector and dimensionality. 32 | -- is (R1, R2, Affine) 33 | -- p is the storage in the dimension. 34 | -- is (Num) 35 | -- b is the bin type. 36 | -- is (Eq) 37 | -- e is extra storage, so it can be used as a reader without translation. 38 | data MapleConfig g l s i (v::Type->Type) p b e 39 | = (HasBinMap g g v p b) => MC 40 | { _mcCSKey :: Key 41 | , _mcGrigMap :: g 42 | , _mcLootBoxes :: LootBoxes s i 43 | , _mcMkLocal :: MakeMapleLocal l 44 | , _mcCheckAdmin :: MapleAdminCheck 45 | , _mcBinListCachePolicy :: MapleCacheControl 46 | , _mcBinContentsCachePolicy :: MapleCacheControl 47 | , _mcAdminLoot :: [i] 48 | , _mcPoolSize :: LocalPoolSize 49 | , _mcImageFolders :: [String] 50 | , _mcPaused :: Bool 51 | , _mcAllowedOrigins :: [ByteString] 52 | , _mcExtra :: e 53 | } 54 | 55 | makeClassy ''MapleConfig 56 | 57 | instance Functor (MapleConfig g l s i v p b) where 58 | fmap f d = d { _mcExtra = f (_mcExtra d) } 59 | 60 | instance HasBinMap g g v p b => HasBinMap (MapleConfig g l s i v p b e) g v p b where 61 | binMap = mcGrigMap 62 | 63 | instance HasClientKey (MapleConfig g l s i v p b e) where 64 | clientKey = mcCSKey 65 | 66 | instance HasLocalPoolSize (MapleConfig g l s i v p b e) where 67 | localPoolSize = mcPoolSize 68 | -------------------------------------------------------------------------------- /src/Maple/Loot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE TemplateHaskell #-} 9 | {-# LANGUAGE TupleSections #-} 10 | module Maple.Loot where 11 | 12 | import Codec.Picture 13 | import Control.Applicative 14 | import Control.Exception (PatternMatchFail(..)) 15 | import Control.Lens 16 | import Control.Monad.Catch 17 | import Control.Monad.Reader 18 | import Crypto.Classes 19 | import Crypto.Skein 20 | import qualified Data.Aeson as JS 21 | import Data.ByteString (ByteString) 22 | import qualified Data.ByteString.Base64.URL as B64U 23 | import qualified Data.ByteString.Lazy as BL 24 | import qualified Data.Csv as CSV 25 | import Data.Foldable 26 | import Data.List (sort) 27 | import Data.Map (Map) 28 | import qualified Data.Map as Map 29 | import Data.Maybe 30 | import qualified Data.Serialize as C 31 | import qualified Data.Set as Set 32 | import Data.Text (Text) 33 | import qualified Data.Text as T 34 | import qualified Data.Text.Encoding as TE 35 | import Data.UUID (UUID) 36 | --import qualified Data.UUID.V5 as V5 37 | import Data.Word 38 | import Linear 39 | import Linear.Affine 40 | import Maple.AABB 41 | import Maple.Map 42 | import Maple.Session 43 | import System.FilePath.Posix 44 | import System.Random 45 | 46 | class HasUUID h where 47 | hasUUID :: Getter h UUID 48 | 49 | type Hint = Text 50 | 51 | type Tumbler s i = forall l . (MonadReader [s] l, Alternative l) => l i 52 | 53 | data LootBox s i 54 | = LootBox 55 | { _lbHint :: Hint 56 | , _lbDifficulty :: Difficulty 57 | , _ldTumbler :: ReaderT [s] Maybe i 58 | } 59 | 60 | makeLenses ''LootBox 61 | 62 | -- A collection of potental loot boxes 63 | -- Difficulty allows us to give a good sampling, this might be color? 64 | -- Hint is what we show the person, if we choose to name the loot riddle. 65 | -- s -> Maybe i is a function that takes our state and tells us what loot we got or that we haven't gotten it yet. 66 | type LootBoxes s i = Map HintId (LootBox s i) 67 | 68 | hintId :: LootBox s i -> HintId 69 | hintId (LootBox {_lbHint=h}) = B64U.encodeBase64 $ C.encode (hash' (TE.encodeUtf8 h)::Skein_256_128) 70 | 71 | dropLoot :: forall s i . LootBoxes s i -> SessionData s i -> [(HintId, i)] 72 | dropLoot lm s = 73 | mapMaybe checkTumbler (s^.sdCurrentHints) 74 | where 75 | checkTumbler :: HintId -> Maybe (HintId, i) 76 | checkTumbler hid = do 77 | lb <- Map.lookup hid lm 78 | fmap (hid,) $ (lb^.ldTumbler) `runReaderT` (s^.sdKeyHistory) 79 | 80 | newtype LocalPoolSize = LPS Word deriving (Read, Show, Eq, Ord, C.Serialize, Enum, Bounded, Num, Real, Integral) via Word 81 | 82 | makeClassy ''LocalPoolSize 83 | 84 | localPool :: (BinReader c g l v p b m, MonadReader c m, HasLocalPoolSize c, C.Serialize l) => LootBoxes s i -> l -> m [HintId] 85 | localPool lm lcl = do 86 | cnt <- view localPoolSize 87 | let lclStr = C.encode lcl 88 | ld <- readLocalDifficulty lcl 89 | pure $ take (fromIntegral cnt) $ map snd $ sort $ map (\k -> (hash (BL.fromChunks [lclStr, TE.encodeUtf8 k])::Skein_256_128, k)) $ 90 | Map.keys $ Map.filter (\h -> (h^.lbDifficulty) >= ld) lm 91 | 92 | sessionHints :: (BinReader c g l v p b m, MonadIO m, MonadReader c m, HasLocalPoolSize c, C.Serialize l) 93 | => LootBoxes s i -> l -> SessionData s i -> m [HintId] 94 | sessionHints lm lcl sess = do 95 | case length $ sess^.sdCurrentHints of 96 | l | l >= 5 -> pure [] 97 | l -> do 98 | let inSess = Set.fromList $ (sess^.sdCurrentHints) ++ (sess^.sdRecentHints) 99 | lp <- localPool lm lcl 100 | liftIO $ (take (5-l) . map snd . sort) <$> mapM (\v -> (randomIO::IO Word64) >>= \r -> pure (r, v)) 101 | (filter (not . (`Set.member` inSess)) $ lp) 102 | 103 | currentHintsOnly :: LootBoxes s i -> SessionData s i -> SessionData s i 104 | currentHintsOnly lm sess = 105 | sess & sdCurrentHints .~ (sess^.sdCurrentHints.to (filter (`Map.member` lm))) 106 | 107 | data ImgLoot v p = ImgLoot {_ilAABB :: (BoundingBox v p), _ilImg :: Text} deriving (Eq, Ord, Show) 108 | 109 | class HasLootName a where 110 | lootName :: a -> Text 111 | 112 | instance HasLootName (ImgLoot v p) where 113 | lootName = _ilImg 114 | 115 | -- | Checks if two ImgLoots are the same dimensions and have the same text 116 | isTranslatedLoot :: (HasPos i v p, HasLootName i, HasBoundingBox i v p, Eq (v p)) => i -> i -> Bool 117 | isTranslatedLoot i1 i2 = 118 | (lootName i1) == (lootName i2) && 119 | (i1 ^. boundingBox) == ((i2 & pos .~ (i1 ^. pos)) ^. boundingBox) 120 | 121 | data NoSuchLoot = NoSuchLoot deriving (Show) 122 | 123 | instance Exception NoSuchLoot 124 | 125 | extract :: (HasPos i v p, HasLootName i, HasBoundingBox i v p, Eq (v p)) => i -> [i] -> Maybe (i, [i]) 126 | extract t l' = go [] l' 127 | where 128 | go _ [] = Nothing 129 | go p (h:r) | isTranslatedLoot h t = Just (h, (reverse p)++r) 130 | go p (h:r) = go (h:p) r 131 | 132 | -- | Removes loot from the session and updates the generation in storage. 133 | removeLoot :: (HasPos i v p, HasLootName i, HasBoundingBox i v p, MonadThrow m, BinStorage c g l v p b m) => SessionData s i -> i -> m (SessionData s i) 134 | removeLoot sd i = do 135 | case extract i (sd^.sdCurrentLoot) of 136 | Nothing -> throwM NoSuchLoot 137 | Just (_, rl) -> pure (sd { _sdCurrentLoot = rl }) 138 | 139 | {- 140 | instance (JS.ToJSON (v p)) => HasUUID (ImgLoot v p) where 141 | hasUUID = 142 | to (\(ImgLoot aabb img) -> 143 | V5.generateNamed (read "91ff06d6-b0fd-41d7-b343-e8d59641acb4") $ 144 | BL.unpack $ JS.encode (aabb, img)) 145 | -} 146 | 147 | instance (JS.ToJSON (v p)) => JS.ToJSON (ImgLoot v p) where 148 | toJSON (ImgLoot b img) = 149 | JS.object [ 150 | "aabb" JS..= b 151 | , "img" JS..= img 152 | ] 153 | 154 | instance (JS.FromJSON (v p)) => JS.FromJSON (ImgLoot v p) where 155 | parseJSON = 156 | JS.withObject "ImgLoot" $ \o -> 157 | ImgLoot <$> o JS..: "aabb" <*> o JS..: "img" 158 | 159 | makeLenses ''ImgLoot 160 | 161 | instance HasBoundingBox (ImgLoot v p) v p where 162 | boundingBox = ilAABB 163 | 164 | instance (Affine v, Num p) => HasPos (ImgLoot v p) v p 165 | 166 | -- | Given a function that can create the correct BoundingBox from the file's name and a 2D image size. 167 | -- produce an image loot. 168 | readImgLoot :: (MonadThrow m, MonadIO m) => (FilePath -> V2 Int -> BoundingBox v p) -> FilePath -> m (ImgLoot v p) 169 | readImgLoot dimify fn = do 170 | ei' <- liftIO $ readImage fn 171 | case ei' of 172 | Left e -> throwM $ PatternMatchFail e 173 | Right i' -> do 174 | let i = convertRGBA8 i' 175 | pure $ ImgLoot (dimify fn (V2 (imageWidth i) (imageHeight i))) (T.pack $ fn) 176 | 177 | data LootCSV 178 | = LootCSV { _lcsvDifficulty :: Difficulty, _lcsvHint :: Hint, _lcsvKey :: Text, _lcsvPath :: FilePath } 179 | deriving (Read, Show, Eq, Ord) 180 | 181 | csvDifficulty, csvHint, csvKey, csvImage :: ByteString 182 | csvDifficulty = TE.encodeUtf8 $ T.pack "difficulty" 183 | csvHint = TE.encodeUtf8 $ T.pack "hint" 184 | csvKey = TE.encodeUtf8 $ T.pack "key" 185 | csvImage = TE.encodeUtf8 $ T.pack "image" 186 | 187 | instance CSV.FromNamedRecord LootCSV where 188 | parseNamedRecord m = LootCSV <$> m CSV..: csvDifficulty <*> m CSV..: csvHint <*> m CSV..: csvKey <*> m CSV..: csvImage 189 | 190 | instance CSV.ToNamedRecord LootCSV where 191 | toNamedRecord (LootCSV difficulty hint key img) = 192 | CSV.namedRecord 193 | [ csvDifficulty CSV..= difficulty 194 | , csvHint CSV..= hint 195 | , csvKey CSV..= key 196 | , csvImage CSV..= img 197 | ] 198 | 199 | instance CSV.DefaultOrdered LootCSV where 200 | headerOrder _ = CSV.header [csvDifficulty, csvHint, csvKey, csvImage] 201 | 202 | -- | Assume the depth is in the second component and that the target dimensionality is 3D, 203 | -- produce the bounding box. 204 | filePath3D :: FilePath -> V2 Int -> BoundingBox V3 Int 205 | filePath3D fn dm = 206 | let z = read $ init $ splitPath fn!!1 207 | in bound (V3 0 0 z) (V3 (dm^._x.to fromIntegral) (dm^._y.to fromIntegral) z) 208 | 209 | atExactly :: i -> Text -> Tumbler Text i 210 | atExactly i k = do 211 | sl <- ask 212 | case listToMaybe sl of 213 | Nothing -> empty 214 | Just s -> 215 | case T.uncons k of 216 | Just ('@', knotch) | knotch == s -> pure i 217 | _ -> empty 218 | 219 | -- | Reads a CSV, converting it into loot. 220 | loadLoot :: (Traversable v, Applicative v, Additive v, Ord p, Num p, MonadIO m) 221 | => (FilePath -> V2 Int -> BoundingBox v p) 222 | -- ^ The function to convert the filenames and image size into their bounding boxes. 223 | -> (forall l . (MonadReader [s] l, Alternative l) => [ImgLoot v p -> Text -> l i]) 224 | -- ^ Convert the key field to an actual key. 225 | -> [FilePath] -- ^ The directories its safe to load images from. 226 | -> FilePath -- ^ The CSV to load. 227 | -> m (BoundingBox v p, LootBoxes s i, [ImgLoot v p]) 228 | loadLoot dimify keyHoles safeDirs csvFile = liftIO $ do 229 | csvData <- BL.readFile csvFile 230 | case CSV.decodeByName csvData of 231 | Left e -> fail e 232 | Right (_, v) -> do 233 | loadedLoot <- forM (toList v) $ \(LootCSV difficulty hint key imgFl) -> do 234 | let nimgFl = normalise imgFl 235 | when ((not $ isRelative nimgFl) || (not $ (head $ splitDirectories nimgFl) `elem` safeDirs)) $ 236 | fail $ "bad image file location! "<>nimgFl 237 | imgLoot <- readImgLoot dimify nimgFl 238 | pure $ (imgLoot, (imgLoot^.boundingBox.to corners 239 | ,LootBox hint difficulty $ foldr (<|>) empty $ map (\keyHole -> keyHole imgLoot key) keyHoles)) 240 | let mbl = Map.fromListWith buildTumber . map (\ll->(hintId $ snd ll,ll)) $ snd <$> loadedLoot 241 | pure $ (bounding $ foldr (\(cs, _) acs -> cs<>acs) [] mbl, fmap snd mbl, fst <$> loadedLoot) 242 | where 243 | buildTumber :: ([v p], LootBox s i) -> ([v p], LootBox s i) -> ([v p], LootBox s i) 244 | buildTumber (bb0, lb0) (bb1, lb1) = (bb0<>bb1 ,lb0 { _ldTumbler = (_ldTumbler lb0) <|> (_ldTumbler lb1) }) 245 | 246 | data GroupCSV 247 | = GroupCSV { _gcsvGroup :: Text, _gcsvDepth :: Int, _gcsvImage :: FilePath } 248 | deriving (Read, Show, Eq, Ord) 249 | 250 | csvGroup, csvDepth :: ByteString 251 | csvGroup = TE.encodeUtf8 $ T.pack "group" 252 | csvDepth = TE.encodeUtf8 $ T.pack "depth" 253 | 254 | instance CSV.FromNamedRecord GroupCSV where 255 | parseNamedRecord m = GroupCSV <$> m CSV..: csvGroup <*> m CSV..: csvDepth <*> m CSV..: csvImage 256 | 257 | instance CSV.ToNamedRecord GroupCSV where 258 | toNamedRecord (GroupCSV grp dpth img) = 259 | CSV.namedRecord 260 | [ csvGroup CSV..= grp 261 | , csvDepth CSV..= dpth 262 | , csvImage CSV..= img 263 | ] 264 | 265 | instance CSV.DefaultOrdered GroupCSV where 266 | headerOrder _ = CSV.header [csvGroup, csvDepth, csvImage] 267 | 268 | maxBB :: (Foldable t, Traversable v, Applicative v, Additive v, Ord p, Num p) => t (ImgLoot v p) -> BoundingBox v p 269 | maxBB = bounding . concatMap (\l -> l^.boundingBox.to corners) 270 | 271 | loadGroups :: MonadIO m 272 | => [FilePath] -- ^ The directories its safe to load images from. 273 | -> FilePath -- ^ The CSV to load. 274 | -> m (Map Text [ImgLoot V3 Int]) 275 | loadGroups safeDirs csvFile = liftIO $ do 276 | csvData <- BL.readFile csvFile 277 | case CSV.decodeByName csvData of 278 | Left e -> fail e 279 | Right (_, v) -> do 280 | fmap (Map.fromListWith (++) . map (fmap pure)) . 281 | forM (toList v) $ \(GroupCSV grp dpth fp) -> do 282 | let nimgFl = normalise fp 283 | when ((not $ isRelative nimgFl) || (not $ (head $ splitDirectories nimgFl) `elem` safeDirs)) $ 284 | fail $ "bad image file location! "<>nimgFl 285 | (grp,) <$> readImgLoot (\_ (V2 x y) -> AABB (V3 0 0 dpth) (V3 x y dpth)) nimgFl 286 | 287 | -- | Reads group encoded CSV, converting it into loot. 288 | loadGrouped :: (MonadFail m, MonadIO m) 289 | => ([i] -> Text -> Either String ([s] -> Maybe i)) 290 | -- ^ Convert the key field to an actual key. 291 | -> (Map Text [i]) -- ^ The loot groups to use. 292 | -> FilePath -- ^ The CSV to load. 293 | -> m (LootBoxes s i) 294 | loadGrouped keyHoles grpMap csvFile = liftIO $ do 295 | csvData <- BL.readFile csvFile 296 | case CSV.decodeByName csvData of 297 | Left e -> fail e 298 | Right (_, v) -> do 299 | loadedLoot <- forM (toList v) $ \(LootCSV difficulty hint key imgGrp) -> do 300 | case Map.lookup (T.pack imgGrp) grpMap of 301 | Nothing -> fail $ "Could not find group "<>imgGrp 302 | Just imgsInGrp -> 303 | case keyHoles imgsInGrp key of 304 | Left e -> fail $ mconcat 305 | [ "Got ", e, "when trying to parse: ", T.unpack key] 306 | Right tblr -> pure $ LootBox hint difficulty (lift . tblr =<< ask) 307 | let mbl = Map.fromListWith (\lb0 lb1 -> lb0 { _ldTumbler = (_ldTumbler lb0) <|> (_ldTumbler lb1) }) . 308 | map (\ll->(hintId ll,ll)) $ loadedLoot 309 | pure $ mbl 310 | -------------------------------------------------------------------------------- /src/Maple/Map.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DefaultSignatures #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE FunctionalDependencies #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE ScopedTypeVariables #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE TemplateHaskell #-} 11 | {-# LANGUAGE TupleSections #-} 12 | {-# LANGUAGE TypeFamilies #-} 13 | {-# LANGUAGE UndecidableInstances #-} 14 | module Maple.Map where 15 | 16 | import Control.Lens 17 | import Control.Monad.Except 18 | import Control.Monad.Reader 19 | import Control.Monad.State 20 | import qualified Data.Aeson as JS 21 | import Data.Foldable 22 | import Data.Kind 23 | import Data.List 24 | import Data.Proxy 25 | import Data.Time 26 | import Data.UUID (UUID) 27 | import qualified Data.Vector as V 28 | import Linear 29 | import Linear.Affine 30 | import Maple.AABB 31 | import Maple.Session 32 | 33 | class HasPos i v p | i -> v, i -> p where 34 | pos :: Lens' i (Point v p) 35 | default pos :: (Num p, Affine v, HasBoundingBox i v p) => Lens' i (Point v p) 36 | pos = lens (\s -> s^.boundingBox.minCorner.from _Point) 37 | (\s b -> 38 | let off = s^.boundingBox.maxCorner .-. s^.boundingBox.minCorner 39 | in (s & boundingBox.minCorner .~ (b^.lensP)) & boundingBox.maxCorner .~ ((b^.lensP) .+^ off)) 40 | 41 | instance (Affine v, Num p) => HasPos (BoundingBox v p) v p 42 | 43 | pos2d :: forall i v p . (R2 v, HasPos i v p) => Proxy v -> Lens' i (Point V2 p) 44 | pos2d _ = 45 | lens (\vn -> P (V2 (vn^.(pos::Lens' i (Point v p))._x) (vn^.(pos::Lens' i (Point v p))._y))) 46 | (\s b -> s & (pos::Lens' i (Point v p))._x .~ (b^._x) & (pos::Lens' i (Point v p))._y .~ (b ^. _y)) 47 | 48 | class (R2 v, Ord b) => HasBinMap c g (v::Type->Type) p b | c -> g, c -> v, c -> p, c -> b where 49 | 50 | binMap :: Getter c g 51 | 52 | -- | Useful if we need to reproject everything into a new universe. 53 | allBins :: Getter c [b] 54 | default allBins :: HasBinMap g g v p b => Getter c [b] 55 | allBins = binMap.allBins 56 | 57 | -- | What is the largest BB allowed in the Grid that we have to check we could overlap. 58 | largestBB :: Getter c (BoundingBox v p) 59 | default largestBB :: HasBinMap g g v p b => Getter c (BoundingBox v p) 60 | largestBB = binMap.largestBB 61 | 62 | -- | The bin this point belongs in. 63 | homeBin :: HasPos i v p => c -> i -> Maybe b 64 | default homeBin :: (HasBinMap g g v p b, HasPos i v p) => c -> i -> Maybe b 65 | homeBin g i = g^.binMap.to (`homeBin` i) 66 | 67 | -- | The list of bins that could possibly have something that overlaps this. 68 | overlapableBins :: (HasBoundingBox i v p) => c -> i -> [(BoundingBox V2 p, b)] 69 | default overlapableBins :: (R2 v, HasBoundingBox i v p, HasBinMap g g v p b) 70 | => c -> i -> [(BoundingBox V2 p, b)] 71 | overlapableBins g b = g^.binMap.to (`overlapableBins` b) 72 | 73 | data IGridMap2 v p b 74 | = IGMap 75 | { _igmMaxBB :: BoundingBox v p 76 | -- | Sorted by the min corner in X and then Y. 77 | , _igmBBs :: V.Vector (V.Vector (BoundingBox V2 p, b)) 78 | } 79 | deriving (Eq, Ord, Show) 80 | 81 | makeLenses ''IGridMap2 82 | 83 | instance (JS.ToJSON p, JS.ToJSON (V2 p), JS.ToJSON (v p), JS.ToJSON b) => JS.ToJSON (IGridMap2 v p b) where 84 | toJSON (IGMap maxBB vBBs) = JS.object [ "maxBB" JS..= maxBB, "tiles" JS..= (map V.toList $ V.toList vBBs)] 85 | 86 | instance (JS.ToJSON p, JS.FromJSON (V2 p), JS.FromJSON (v p), JS.FromJSON b) => JS.FromJSON (IGridMap2 v p b) where 87 | parseJSON = JS.withObject "IGridMap2" $ \v -> IGMap 88 | <$> v JS..: "maxBB" 89 | <*> (V.fromList <$> (v JS..: "tiles" >>= mapM (fmap V.fromList . JS.parseJSON))) 90 | 91 | -- | Creates a IGridMap with a single tile in it. 92 | singletonIGridMap2 :: Monad m => m b -> BoundingBox v p -> BoundingBox V2 p -> m (IGridMap2 v p b) 93 | singletonIGridMap2 gID maxBB baseBB = (IGMap maxBB) <$> ((V.singleton . V.singleton . (baseBB,)) <$> gID) 94 | 95 | -- | Adds another row of the tile in the x direction 96 | igridmap2ExtendX :: (Monad m, HasPos (BoundingBox V2 p) V2 p, Num p) => m b -> IGridMap2 v p b -> m (IGridMap2 v p b) 97 | igridmap2ExtendX gID (IGMap maxBB v) = do 98 | fy <- V.lastM v 99 | b <- V.headM fy 100 | let xstride = b^._1.maxCorner._x - b^._1.minCorner._x 101 | ny <- V.forM fy $ \(lbb, _) -> (lbb & pos._x +~ xstride,) <$> gID 102 | pure $ IGMap maxBB (v `V.snoc` ny) 103 | 104 | -- | Adds another row of the tile in the negative x direction 105 | igridmap2ExtendXNeg :: (Monad m, HasPos (BoundingBox V2 p) V2 p, Num p) => m b -> IGridMap2 v p b -> m (IGridMap2 v p b) 106 | igridmap2ExtendXNeg gID (IGMap maxBB v) = do 107 | hy <- V.headM v 108 | b <- V.headM hy 109 | let xstride = b^._1.maxCorner._x - b^._1.minCorner._x 110 | ny <- V.forM hy $ \(lbb, _) -> (lbb & pos._x -~ xstride,) <$> gID 111 | pure $ IGMap maxBB (ny `V.cons` v) 112 | 113 | -- | Adds another row of the tile in the y direction 114 | igridmap2ExtendY :: (Monad m, HasPos (BoundingBox V2 p) V2 p, Num p) => m b -> IGridMap2 v p b -> m (IGridMap2 v p b) 115 | igridmap2ExtendY gID (IGMap maxBB v) = do 116 | b <- V.headM v >>= V.headM 117 | let ystride = b^._1.maxCorner._y - b^._1.minCorner._y 118 | nv <- V.forM v $ \yv -> do 119 | (ly, _) <- V.lastM yv 120 | ny <- (ly & pos._y +~ ystride,) <$> gID 121 | pure $ yv `V.snoc` ny 122 | pure $ IGMap maxBB nv 123 | 124 | -- | Adds another row of the tile in the y direction 125 | igridmap2ExtendYNeg :: (Monad m, HasPos (BoundingBox V2 p) V2 p, Num p) => m b -> IGridMap2 v p b -> m (IGridMap2 v p b) 126 | igridmap2ExtendYNeg gID (IGMap maxBB v) = do 127 | b <- V.headM v >>= V.headM 128 | let ystride = b^._1.maxCorner._y - b^._1.minCorner._y 129 | nv <- V.forM v $ \yv -> do 130 | (ly, _) <- V.headM yv 131 | ny <- (ly & pos._y -~ ystride,) <$> gID 132 | pure $ ny `V.cons` yv 133 | pure $ IGMap maxBB nv 134 | 135 | -- | Given the largest BoundingBox that can be placed in the map, 136 | -- a function to define bins for generated bounding boxes, 137 | -- an origin point, a stride vector, and how many bins in both 138 | -- x and y to generate to build a IGridMap2. 139 | buildMap :: (Monad m, R2 v, Integral p) => (BoundingBox V2 p -> m (BoundingBox V2 p, b)) -> BoundingBox v p -> Point V2 p -> V2 p -> p -> p -> m (IGridMap2 v p b) 140 | buildMap g l orig step xc yc = do 141 | let b = AABB (orig^.lensP) ((orig^.lensP) .+^ step) 142 | (fmap $ IGMap l) $ do 143 | V.generateM (fromIntegral xc) $ \xm' -> do 144 | V.generateM (fromIntegral yc) $ \ym' -> do 145 | let j = V2 ((step^._x) * fromIntegral xm') ((step^._y) * fromIntegral ym') 146 | g $ b & minCorner._xy .~ ((b ^.minCorner._xy) .+^ j) 147 | & maxCorner._xy .~ ((b ^.maxCorner._xy) .+^ j) 148 | 149 | binsUnique :: (HasBinMap c (IGridMap2 v p b) v p b, Additive v, Ord p, Eq p) => c -> Bool 150 | binsUnique c = 151 | let binSet = c^.binMap.igmBBs.to (concatMap toList . toList) 152 | bids = map snd binSet 153 | in (nub bids == bids) && and [bid0 == bid1 || not (b0 `overlaps'` b1) | (b0, bid0) <- binSet, (b1, bid1) <- binSet] 154 | 155 | updateMap :: (Num b, Ord b, Ord p, Integral p, Eq (v p), Traversable v, Additive v, R2 v) => IGridMap2 v p b -> (forall m . Monad m => m b -> IGridMap2 v p b -> m (IGridMap2 v p b)) -> (IGridMap2 v p b) 156 | updateMap ogm act = 157 | if binsUnique ngm 158 | then ngm 159 | else error "BAD UPDATE OF MAP" 160 | where 161 | high = ogm^.binMap.igmBBs.to (maximum . map snd . concatMap toList . toList) 162 | ngm = fst $ (`runState` (high+1)) $ act (state (\c -> (c, c+1))) ogm 163 | 164 | instance forall v p b. (R2 v, Additive v, Traversable v, Ord b, Ord p, Integral p, Eq (v p)) => HasBinMap (IGridMap2 v p b) (IGridMap2 v p b) v p b where 165 | 166 | binMap = id 167 | 168 | largestBB = igmMaxBB 169 | 170 | allBins = binMap.igmBBs. to (map snd . mconcat . fmap toList . toList) 171 | 172 | homeBin (IGMap {_igmBBs=ab}) i = do 173 | xv <- findX2 (i^.pos2d (Proxy::Proxy v)) ab 174 | b <- V.headM xv 175 | let stride = b^._1.maxCorner._y - b^._1.minCorner._y 176 | fmap snd $ xv V.!? (fromIntegral $ (i^.(pos::HasPos i v p => Lens' i (Point v p))._Point._y - b^._1.minCorner._y) `div` stride) 177 | 178 | overlapableBins (IGMap {_igmMaxBB=lbb, _igmBBs=ab}) bb = 179 | let q = (bb^.boundingBox.to box2d) `expandBy` (lbb^.to box2d) 180 | in filter (overlaps q . fst) $ mconcat $ fmap toList $ toList $ ab 181 | 182 | -- | Finds the vector the BoundingBox for that X will be found in for 2 dimensions of bounding boxes. 183 | findX2 :: (Integral p) => Point V2 p -> V.Vector (V.Vector (BoundingBox V2 p, b)) -> Maybe (V.Vector (BoundingBox V2 p, b)) 184 | findX2 pnt v = do 185 | i <- V.headM v >>= V.headM 186 | let stride = i^._1.maxCorner._x - i^._1.minCorner._x 187 | v V.!? (fromIntegral $ (pnt^._x - i^._1.minCorner._x) `div` stride) 188 | 189 | data DBMeta l i 190 | = DBMeta 191 | { _dbmLocal :: l 192 | , _dbmTime :: UTCTime 193 | , _dbmItem :: i 194 | } 195 | deriving (Read, Show, Eq, Ord, Functor) 196 | 197 | makeLenses ''DBMeta 198 | 199 | instance HasPos i v p => HasPos (DBMeta l i) v p where 200 | pos = dbmItem.pos 201 | 202 | instance HasBoundingBox i v p => HasBoundingBox (DBMeta l i) v p where 203 | boundingBox = dbmItem.boundingBox 204 | 205 | instance (JS.ToJSON l, JS.ToJSON i) => JS.ToJSON (DBMeta l i) where 206 | toJSON (DBMeta l t i) = JS.object ["l" JS..= l, "t" JS..= t, "i" JS..= i] 207 | 208 | instance (JS.FromJSON l, JS.FromJSON i) => JS.FromJSON (DBMeta l i) where 209 | parseJSON = JS.withObject "dbmeta" $ \v -> DBMeta 210 | <$> v JS..: "l" 211 | <*> v JS..: "t" 212 | <*> v JS..: "i" 213 | 214 | class (MonadReader c m, HasBinMap c g v p b, HasBinMap g g v p b, HasPos (I m) v p, Ord p, Eq (v p), Traversable v, Additive v) => BinReader c g l v p b m | m -> c, m -> l where 215 | -- | The type of the items stored. 216 | type I m :: Type 217 | 218 | -- | Gets the bin contense 219 | tip :: b -> m [DBMeta l (I m)] 220 | 221 | -- | Reads the state of the session, starting at generation 0 if not yet set. 222 | readSession :: UUID -> m SessionGeneration 223 | 224 | -- | Gets the current difficulty for a locality, or 0 if not set. 225 | readLocalDifficulty :: l -> m Difficulty 226 | 227 | instance (BinReader c g l v p b m) => BinReader c g l v p b (ExceptT e m) where 228 | type I (ExceptT e m) = I m 229 | tip = lift . tip 230 | readSession = lift . readSession 231 | readLocalDifficulty = lift . readLocalDifficulty 232 | 233 | doesNotOverlap :: (BinReader c g l v p b tx, R2 v, HasBoundingBox (I tx) v p 234 | ,HasBoundingBox i v p, Additive v, Traversable v, Ord p, Eq (v p)) 235 | => i -> tx Bool 236 | doesNotOverlap i = do 237 | bs <- view (to (`overlapableBins` i)) 238 | fmap (not . or) . forM (snd <$> bs) $ \b -> (any (\c -> overlaps' (i^.boundingBox) (c^.boundingBox))) <$> tip b 239 | 240 | class (BinReader c g l v p b m) => BinStorage c g l v p b m where 241 | -- | takes a function that tells us if we should commit 242 | binTX :: (forall tx . (BinReader c g l v p b tx, I m ~ I tx) => DBMeta l (I tx) -> tx Bool) 243 | -> DBMeta l (I m) -> m Bool 244 | -- | Given a function that says if it should be in the set, makes the bin contain only the ones that should. 245 | binFilter :: b -> (DBMeta l (I m) -> Bool) -> m () 246 | -- | Stores session state, throws is session generation provided does not match. 247 | setSession :: UUID -> Maybe SessionGeneration -> SessionGeneration -> m () 248 | -- | Verifies DB connetion. Throws an exception if it fails 249 | checkDB :: m () 250 | -- | Increase locality difficulty by value. 251 | incLocalDifficulty :: l -> Difficulty -> m () 252 | -- | Returns Just the time they can next place and updates the last palce time, 253 | -- or Nothing if they can't play yet. 254 | tryPlace :: l -> NominalDiffTime -> m (Maybe UTCTime) 255 | 256 | instance (BinStorage c g l v p b m) => BinStorage c g l v p b (ExceptT e m) where 257 | binTX f i = lift $ binTX f i 258 | binFilter b f = lift $ binFilter b f 259 | setSession u mo n = lift $ setSession u mo n 260 | checkDB = lift checkDB 261 | incLocalDifficulty l d = lift $ incLocalDifficulty l d 262 | tryPlace l nd = lift $ tryPlace l nd 263 | 264 | incSessionGen :: BinStorage c g l v p b m => SessionData s i -> m (SessionData s i) 265 | incSessionGen sd = do 266 | let ng = 1 + sd^.sdGeneration 267 | setSession (sd^.sdUUID) (Just $ sd^.sdGeneration) ng 268 | pure (sd { _sdGeneration = ng }) 269 | -------------------------------------------------------------------------------- /src/Maple/Session.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | module Maple.Session where 5 | 6 | import Control.Lens 7 | import Control.Monad.Catch 8 | import Control.Monad.Reader 9 | import qualified Data.Aeson as JS 10 | import Data.ByteString (ByteString) 11 | import qualified Data.ByteString.Base64.URL as B64U 12 | import qualified Data.ByteString.Lazy as BL 13 | import qualified Data.Serialize as C 14 | import Data.Text (Text) 15 | import Data.UUID (UUID) 16 | import qualified Data.UUID.V1 as V1 17 | import Data.Word 18 | import qualified Web.ClientSession as CS 19 | 20 | type Difficulty = Word16 21 | 22 | type SessionGeneration = Word64 23 | 24 | data SessionState 25 | = SessGeneration SessionGeneration 26 | | SessFraud 27 | deriving (Read, Show, Eq, Ord) 28 | 29 | instance C.Serialize SessionState where 30 | put SessFraud = C.put (-1::Integer) 31 | put (SessGeneration g) = C.put (fromIntegral g::Integer) 32 | 33 | get = do 34 | (i::Integer) <- C.get 35 | if i < 0 36 | then pure $ SessFraud 37 | else pure $ SessGeneration (fromIntegral i) 38 | 39 | getGen :: SessionState -> Maybe SessionGeneration 40 | getGen (SessGeneration g) = Just g 41 | getGen SessFraud = Nothing 42 | 43 | data SessionFraud = SessionFraud deriving (Show) 44 | 45 | instance Exception SessionFraud 46 | 47 | getGenM :: MonadThrow m => SessionState -> m SessionGeneration 48 | getGenM SessFraud = throwM SessionFraud 49 | getGenM (SessGeneration g) = pure g 50 | 51 | instance Semigroup SessionState where 52 | SessFraud <> _ = SessFraud 53 | _ <> SessFraud = SessFraud 54 | (SessGeneration g0) <> (SessGeneration g1) = SessGeneration $ max g0 g1 55 | 56 | instance Monoid SessionState where 57 | mempty = SessGeneration 0 58 | 59 | -- | Hash of the hint so we can go in both directions and not take too much space on the client. 60 | -- but it is still stable to updates. 61 | type HintId = Text 62 | 63 | -- | This is the data we use for the client state. 64 | -- It MUST BE HMACes on the client. 65 | -- The generation is our protection against fuckery, 66 | -- effectively checkpointing us to move forward when 67 | -- loot is actually placed. 68 | data SessionData s i 69 | = SessionData 70 | { _sdUUID :: UUID 71 | , _sdGeneration :: SessionGeneration 72 | , _sdKeyHistory :: [s] 73 | , _sdCurrentLoot :: [i] 74 | , _sdCurrentHints :: [HintId] 75 | , _sdRecentHints :: [HintId] 76 | } 77 | deriving (Show, Eq, Ord) 78 | 79 | makeLenses ''SessionData 80 | 81 | emptySessionData :: MonadIO m => m (SessionData s i) 82 | emptySessionData = liftIO $ do 83 | mu <- V1.nextUUID 84 | case mu of 85 | Nothing -> fail "Can't generate a V1 UUID?!" 86 | Just u -> pure $ SessionData u 0 [] [] [] [] 87 | 88 | addKey :: SessionData s i -> s -> SessionData s i 89 | addKey sd s = sd { _sdKeyHistory = take 50 $ s : (_sdKeyHistory sd) } 90 | 91 | addLoot :: SessionData s i -> i -> SessionData s i 92 | addLoot sd i = sd { _sdCurrentLoot = take 50 $ i : (_sdCurrentLoot sd) } 93 | 94 | instance (JS.ToJSON s, JS.ToJSON i) => JS.ToJSON (SessionData s i) where 95 | toJSON (SessionData u g h l c r) = 96 | JS.object 97 | [ "u" JS..= u 98 | , "g" JS..= g 99 | , "h" JS..= h 100 | , "l" JS..= l 101 | , "c" JS..= c --(map (encodeBase64 . T.pack . show) c) 102 | , "r" JS..= r 103 | ] 104 | 105 | instance (JS.FromJSON s, JS.FromJSON i) => JS.FromJSON (SessionData s i) where 106 | parseJSON = JS.withObject "session" $ \v -> SessionData 107 | <$> v JS..: "u" 108 | <*> v JS..: "g" 109 | <*> v JS..: "h" 110 | <*> v JS..: "l" 111 | <*> v JS..: "c" 112 | <*> v JS..: "r" 113 | 114 | class HasClientKey c where 115 | clientKey :: Lens' c CS.Key 116 | 117 | instance HasClientKey CS.Key where 118 | clientKey = id 119 | 120 | encodeSession :: (JS.ToJSON s, JS.ToJSON i, MonadReader c m, HasClientKey c, MonadIO m) => SessionData s i -> m ByteString 121 | encodeSession s = do 122 | k <- view clientKey 123 | liftIO $ CS.encryptIO k (B64U.encodeBase64' $ BL.toStrict $ JS.encode s) 124 | 125 | data SessionUnreadable = SessionUnreadable deriving (Show) 126 | 127 | instance Exception SessionUnreadable 128 | 129 | decodeSession :: (JS.FromJSON s, JS.FromJSON i, MonadReader c m, MonadThrow m, HasClientKey c) => ByteString -> m (SessionData s i) 130 | decodeSession b = do 131 | k <- view clientKey 132 | case (JS.decode' . BL.fromStrict) =<< (either (const Nothing) Just . B64U.decodeBase64) =<< CS.decrypt k b of 133 | Nothing -> throwM SessionUnreadable 134 | Just s -> pure s 135 | -------------------------------------------------------------------------------- /src/Maple/Staticize.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | module Maple.Staticize where 5 | 6 | import Control.Lens 7 | import Control.Monad.IO.Class 8 | import qualified Data.Aeson as JS 9 | import qualified Data.ByteString.Lazy as BL 10 | import Data.Foldable 11 | import Data.Map (Map) 12 | import qualified Data.Map as Map 13 | import qualified Data.Text as T 14 | import Data.Tuple 15 | import Linear 16 | import Maple.AABB 17 | import Maple.Config 18 | import Maple.Map 19 | import System.Directory 20 | import System.FilePath 21 | 22 | staticize :: forall c l s i v p b e m 23 | . (JS.ToJSON p, JS.ToJSONKey b, JS.ToJSON (I m), BinReader c (IGridMap2 v p b) l v p b m, MonadIO m) 24 | => (HasMapleConfig c (IGridMap2 v p b) l s i v p b e) 25 | => FilePath -> m () 26 | staticize t = do 27 | liftIO $ createDirectoryIfMissing True t 28 | (sv::Map b (BoundingBox V2 p)) <- view (binMap.igmBBs.to (Map.fromList . map (swap) . concatMap toList . toList)) 29 | liftIO $ BL.writeFile (t"view") $ JS.encode sv 30 | let JS.ToJSONKeyText bidf' _ = JS.toJSONKey @b 31 | let dibf = T.unpack . bidf' 32 | liftIO $ createDirectoryIfMissing False (t"bin") 33 | forM_ (Map.keys sv) $ \b -> do 34 | bc <- map _dbmItem <$> tip b 35 | liftIO $ BL.writeFile (t"bin"(dibf b)) $ JS.encode bc 36 | sfs <- view mcImageFolders 37 | liftIO $ createDirectoryIfMissing False (t"static") 38 | forM_ sfs $ \f -> do 39 | liftIO $ putStrLn $ "Make sure to copy "<>f<>" into "<>(t"static/") 40 | -------------------------------------------------------------------------------- /src/Maple/Storage/Redis.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | {-# LANGUAGE LambdaCase #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE ScopedTypeVariables #-} 10 | {-# LANGUAGE TemplateHaskell #-} 11 | {-# LANGUAGE TupleSections #-} 12 | {-# LANGUAGE TypeFamilies #-} 13 | module Maple.Storage.Redis where 14 | 15 | import Control.Lens 16 | import Control.Monad.Catch 17 | import Control.Monad.Error.Class 18 | import Control.Monad.Fail 19 | import Control.Monad.IO.Class 20 | import Control.Monad.Reader 21 | import Control.Time 22 | import qualified Data.Aeson as JS 23 | import qualified Data.Bytes.Get as S 24 | import qualified Data.Bytes.Put as S 25 | import qualified Data.Bytes.Serial as S 26 | import qualified Data.ByteString as BS 27 | import qualified Data.ByteString.Lazy as BL 28 | import Data.Either 29 | import Data.Kind 30 | import Data.Maybe 31 | import qualified Data.Serialize as C 32 | import qualified Data.Text as T 33 | import qualified Data.Text.Encoding as TE 34 | import Data.Time 35 | import Data.UUID (UUID) 36 | import qualified Data.UUID as UUID 37 | import qualified Data.UUID.V1 as V1 38 | import Data.Word 39 | import qualified Database.Redis as Redis 40 | import Linear 41 | import Maple.Config 42 | import Maple.Map 43 | import Maple.Session 44 | import Safe 45 | import System.Random 46 | 47 | data RedisEnv 48 | = RedisBinEnv 49 | { _rePool :: Redis.Connection 50 | } 51 | 52 | makeClassy ''RedisEnv 53 | 54 | instance HasRedisEnv (MapleConfig g l s i v p b RedisEnv) where 55 | redisEnv = mcExtra 56 | 57 | newtype RedisStoreT f g l s i (v::Type->Type) p b m a = RS { unRedisStore :: ReaderT (f RedisEnv) m a } 58 | deriving (Functor, Applicative, Monad, MonadReader (f RedisEnv), MonadError e, MonadThrow, MonadCatch, MonadMask, MonadIO, MonadFail) 59 | deriving (MonadTrans) via ReaderT (f RedisEnv) 60 | 61 | runRedisStore' :: (HasMapleConfig (f RedisEnv) g l s i v p b RedisEnv, HasRedisEnv (f RedisEnv), HasBinMap (f RedisEnv) g v p b, MonadIO m) => (f RedisEnv) -> RedisStoreT f g l s i v p b m a -> m a 62 | runRedisStore' ref (RS m) = runReaderT m ref 63 | 64 | startRedisStore :: (Functor f, HasRedisEnv (f RedisEnv), HasBinMap (f e) g v p b, HasBinMap (f RedisEnv) g v p b, MonadIO m) => Redis.ConnectInfo -> f e -> m (f RedisEnv) 65 | startRedisStore cinf c = do 66 | rp <- liftIO $Redis.checkedConnect cinf 67 | pure $ fmap (const $ RedisBinEnv rp) c 68 | 69 | runRedisStore :: (Functor f, HasRedisEnv (f RedisEnv), HasBinMap (f e) g v p b, HasBinMap (f RedisEnv) g v p b, MonadIO m) => Redis.ConnectInfo -> f e -> RedisStoreT f g l s i v p b m a -> m a 70 | runRedisStore cinf c (RS m) = do 71 | env <- startRedisStore cinf c 72 | m `runReaderT` env 73 | 74 | sessKey :: UUID -> BS.ByteString 75 | sessKey u = mconcat [TE.encodeUtf8 $ T.pack "sess_", UUID.toASCIIBytes u] 76 | 77 | collapseEithers :: Either e0 (Either e1 a) -> Maybe a 78 | collapseEithers (Right (Right a)) = Just a 79 | collapseEithers _ = Nothing 80 | 81 | either2maybe :: Either e a -> Maybe a 82 | either2maybe (Left _) = Nothing 83 | either2maybe (Right a) = Just a 84 | 85 | readSess :: (Redis.RedisCtx m f, Functor f) => UUID -> m (f (Maybe SessionState)) 86 | readSess u = (fmap $ join . fmap (either2maybe . C.decode)) <$> Redis.get (sessKey u) 87 | 88 | localDiffKey :: Show l => l -> BS.ByteString 89 | localDiffKey l = mconcat [TE.encodeUtf8 $ T.pack "locdif_", TE.encodeUtf8 $ T.pack $ show l] 90 | 91 | localLastKey :: Show l => l -> BS.ByteString 92 | localLastKey l = mconcat [TE.encodeUtf8 $ T.pack "loclast_", TE.encodeUtf8 $ T.pack $ show l] 93 | 94 | readLocalDiff :: (Show l, Redis.RedisCtx m (Either Redis.Reply)) => l -> m Difficulty 95 | readLocalDiff l = (fromRight 0 . fmap (fromMaybe 0 . join . fmap (readMay . T.unpack . TE.decodeUtf8))) <$> Redis.get (localDiffKey l) 96 | 97 | binKey :: Word64 -> BS.ByteString 98 | binKey b = mconcat [TE.encodeUtf8 $ T.pack "bin_", TE.encodeUtf8 $ T.pack $ show b] 99 | 100 | readBin :: forall i . (JS.FromJSON i) => Word64 -> Redis.Redis (Either SomeException [(UUID, i)]) 101 | readBin b = do 102 | (bimap (const $ toException RedisError) (mapMaybe parseBin)) <$> Redis.hgetall (binKey b) 103 | where 104 | parseBin :: (BS.ByteString, BS.ByteString) -> Maybe (UUID, i) 105 | parseBin (bsu, bsi) = do 106 | u <- UUID.fromASCIIBytes bsu 107 | i <- JS.decodeStrict' bsi 108 | pure (u, i) 109 | 110 | newtype SetWatch f g l s i (v::Type->Type) p b a 111 | = SWT { unSWT :: ReaderT (f RedisEnv) Redis.Redis a } 112 | deriving (Functor, Applicative, Monad, MonadReader (f RedisEnv), MonadFail) 113 | 114 | instance (HasPos i v p, HasRedisEnv (f RedisEnv), HasBinMap (f RedisEnv) g v p Word64, HasBinMap g g v p Word64, Ord p, Eq (v p), Traversable v, Additive v, JS.FromJSON i, Show l, JS.FromJSON l) => BinReader (f RedisEnv) g l v p Word64 (SetWatch f g l s i v p Word64) where 115 | type I (SetWatch f g l s i v p Word64) = i 116 | 117 | tip b = do 118 | void $ SWT $ lift $ Redis.watch [binKey b] 119 | r <- SWT $ lift $ readBin b 120 | case r of 121 | Left _ -> pure [] 122 | Right t -> pure $ map snd t 123 | 124 | -- | Not correct, but we shouldn't be using this. 125 | readSession _ = pure $ 0 126 | 127 | readLocalDifficulty _ = pure $ 0 128 | 129 | instance (HasPos i v p, HasRedisEnv (f RedisEnv), HasBinMap (f RedisEnv) g v p Word64, HasBinMap g g v p Word64, Ord p, Eq (v p), Traversable v, Additive v, MonadThrow m, MonadIO m, JS.FromJSON i, Show l, JS.FromJSON l) => BinReader (f RedisEnv) g l v p Word64 (RedisStoreT f g l s i v p Word64 m) where 130 | type I (RedisStoreT f g l s i v p Word64 m) = i 131 | 132 | tip b = do 133 | p <- view rePool 134 | r <- liftIO $ Redis.runRedis p $ readBin b 135 | case r of 136 | Left e -> throwM e 137 | Right t -> pure $ map snd t 138 | 139 | readSession u = do 140 | p <- view rePool 141 | mss <- liftIO $ Redis.runRedis p $ readSess u 142 | case mss of 143 | Left _ -> throwM RedisError 144 | Right Nothing -> throwM SessionFraud 145 | Right (Just SessFraud) -> throwM SessionFraud 146 | Right (Just (SessGeneration g)) -> pure g 147 | 148 | readLocalDifficulty l = do 149 | p <- view rePool 150 | liftIO $ Redis.runRedis p $ readLocalDiff l 151 | 152 | data RedisError = RedisError deriving (Show) 153 | 154 | instance Exception RedisError 155 | 156 | instance Functor Redis.TxResult where 157 | fmap f (Redis.TxSuccess a) = Redis.TxSuccess (f a) 158 | fmap _ Redis.TxAborted = Redis.TxAborted 159 | fmap _ (Redis.TxError e) = Redis.TxError e 160 | 161 | instance (HasPos i v p, HasRedisEnv (f RedisEnv), HasBinMap (f RedisEnv) g v p Word64, HasBinMap g g v p Word64, Ord p, Eq (v p), Traversable v, Additive v, MonadThrow m, MonadFail m, MonadIO m, JS.FromJSON i, JS.ToJSON i, Show l, JS.FromJSON l, JS.ToJSON l) => BinStorage (f RedisEnv) g l v p Word64 (RedisStoreT f g l s i v p Word64 m) where 162 | checkDB = do 163 | p <- view rePool 164 | ep <- liftIO $ Redis.runRedis p $ Redis.ping 165 | case ep of 166 | Left _ -> throwM RedisError 167 | Right Redis.Ok -> pure () 168 | Right Redis.Pong -> pure () 169 | Right (Redis.Status _) -> throwM RedisError 170 | 171 | binFilter b f = do 172 | p <- view rePool 173 | ebm <- liftIO $ Redis.runRedis p $ readBin b 174 | case ebm of 175 | Left _ -> throwM RedisError 176 | Right bm -> do 177 | void $ liftIO $ Redis.runRedis p $ Redis.hdel (binKey b) $ (`mapMaybe` bm) $ \(u, i) -> do 178 | if f i 179 | then Nothing 180 | else Just $ UUID.toASCIIBytes u 181 | 182 | binTX chk i = do 183 | env <- view id 184 | mb <- view $ (binMap.to (`homeBin` i)) 185 | p <- view rePool 186 | Just u <- liftIO $ V1.nextUUID 187 | case mb of 188 | Nothing -> pure False 189 | Just b -> runTx 0 190 | where 191 | runTx tries = do 192 | txr <- liftIO $ Redis.runRedis p $ do 193 | cont <- (unSWT $ (chk i::SetWatch f g l s i v p Word64 Bool)) `runReaderT` env 194 | case cont of 195 | False -> pure Nothing 196 | True -> fmap Just $ Redis.multiExec $ Redis.hset (binKey b) (UUID.toASCIIBytes u) (BL.toStrict $ JS.encode i) 197 | case txr of 198 | Nothing -> pure False 199 | Just (Redis.TxSuccess _) -> pure True 200 | Just Redis.TxAborted | tries <= 5 -> do 201 | liftIO $ randomRIO (0, ((1.4::Double)^(tries::Word))/10) >>= delay 202 | runTx (tries+1) 203 | Just Redis.TxAborted -> pure False 204 | Just (Redis.TxError _) -> throwM RedisError 205 | 206 | setSession u mo n = do 207 | p <- view rePool 208 | let sk = sessKey u 209 | mf <- liftIO $ Redis.runRedis p $ do 210 | emo <- Redis.getset sk (C.encode $ SessGeneration n) 211 | case fmap (fmap C.decode) $ emo of 212 | Left _ -> pure $ Nothing 213 | -- It didn't exist, so we have to trust it 214 | Right Nothing -> pure $ Just False 215 | -- We couldn't decode so we screwed up, trust it. 216 | Right (Just (Left _)) -> pure $ Just False 217 | -- Everything was right 218 | Right (Just (Right (SessGeneration g))) | (Just g) == mo -> pure $ Just False 219 | -- They're from the future, so we lost a write? 220 | Right (Just (Right (SessGeneration g))) | (Just g) < mo -> pure $ Just False 221 | -- g must be larger, or we had no expectation, but it was in the DB, so thats bad. 222 | Right (Just (Right (SessGeneration _))) -> do 223 | void $ Redis.set sk (C.encode SessFraud) 224 | pure $ Just True 225 | -- Fraud stays fraud. 226 | Right (Just (Right SessFraud)) -> do 227 | void $ Redis.set sk (C.encode SessFraud) 228 | pure $ Just True 229 | case mf of 230 | Nothing -> throwM RedisError 231 | Just True -> throwM SessionFraud 232 | Just False -> pure () 233 | 234 | incLocalDifficulty l d = do 235 | p <- view rePool 236 | void . liftIO $ Redis.runRedis p $ Redis.incrby (localDiffKey l) (fromIntegral d) 237 | 238 | tryPlace l nd = do 239 | now <- liftIO $ getCurrentTime 240 | p <- view rePool 241 | transact p (localLastKey l) now (0::Word64) 242 | where 243 | transact _ _ _ cnt | cnt >= 10 = throwM RedisError 244 | transact p lk now cnt = do 245 | es <- liftIO $ Redis.runRedis p $ do 246 | void $ Redis.watch [lk] 247 | molt <- (join . collapseEithers . fmap (sequenceA . fmap (S.runGetS S.deserialize))) <$> Redis.get lk 248 | fmap (const molt) <$> Redis.multiExec (Redis.set lk (S.runPutS $ S.serialize now)) 249 | case es of 250 | Redis.TxSuccess molt -> 251 | pure $ case molt of 252 | Nothing -> Nothing 253 | Just lt | (nd `addUTCTime` lt) < now -> Nothing 254 | Just _ -> Just $ nd `addUTCTime` now 255 | Redis.TxAborted -> transact p lk now (cnt+1) 256 | Redis.TxError _ -> throwM RedisError 257 | -------------------------------------------------------------------------------- /src/Maple/Storage/Ref.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | {-# LANGUAGE LambdaCase #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE TemplateHaskell #-} 10 | {-# LANGUAGE TupleSections #-} 11 | {-# LANGUAGE TypeFamilies #-} 12 | module Maple.Storage.Ref where 13 | 14 | import Control.Lens 15 | import Control.Monad.Catch 16 | import Control.Monad.Error.Class 17 | import Control.Monad.Fail 18 | import Control.Monad.Loops 19 | import Control.Monad.IO.Class 20 | import Control.Monad.Reader 21 | import Control.Monad.Ref 22 | import Data.Kind 23 | import Data.Map (Map) 24 | import qualified Data.Map as Map 25 | import Data.Time 26 | import Data.UUID 27 | import Linear 28 | import Maple.Config 29 | import Maple.Map 30 | import Maple.Session 31 | 32 | data RefBinEnv r l b i 33 | = RefBinEnv 34 | { _rbeLock :: r Bool 35 | , _rbeBins :: Map b (r [DBMeta l i]) 36 | , _rbeSess :: r (Map UUID SessionState) 37 | , _rbeLocDif :: r (Map l Difficulty) 38 | , _rbeLocLast :: r (Map l UTCTime) 39 | } 40 | 41 | makeClassy ''RefBinEnv 42 | 43 | instance HasRefBinEnv (MapleConfig g l s i v p b (RefBinEnv r l b i)) r l b i where 44 | refBinEnv = mcExtra 45 | 46 | newtype RefBinStoreT r f g l s i (v::Type->Type) p b m a = RBS { unRefBinStore :: ReaderT (f (RefBinEnv r l b i)) m a } 47 | deriving (Functor, Applicative, Monad, MonadReader (f (RefBinEnv r l b i)), MonadError e, MonadThrow, MonadCatch, MonadMask, MonadIO, MonadFail) 48 | deriving (MonadTrans) via ReaderT (f (RefBinEnv r l b i)) 49 | 50 | runRefBinStore' :: (HasRefBinEnv (f (RefBinEnv r l b i)) r l b i, HasBinMap (f (RefBinEnv r l b i)) g v p b, MonadRef r m) => (f (RefBinEnv r l b i)) -> RefBinStoreT r f g l s i v p b m a -> m a 51 | runRefBinStore' ref (RBS m) = runReaderT m ref 52 | 53 | startBinStore :: (Functor f, HasRefBinEnv (f (RefBinEnv r l b i)) r l b i, HasBinMap (f e) g v p b, HasBinMap (f (RefBinEnv r l b i)) g v p b, Ord l, MonadRef r m) => f e -> m (f (RefBinEnv r l b i)) 54 | startBinStore c = do 55 | l <- newRef True 56 | br <- forM (c^.allBins) $ \i -> (i,) <$> newRef [] 57 | s <- newRef mempty 58 | d <- newRef mempty 59 | t <- newRef mempty 60 | pure $ fmap (const $ RefBinEnv l (Map.fromList br) s d t) c 61 | 62 | runRefBinStore :: (Functor f, HasRefBinEnv (f (RefBinEnv r l b i)) r l b i, HasBinMap (f e) g v p b, HasBinMap (f (RefBinEnv r l b i)) g v p b, Ord l, MonadRef r m) => f e -> RefBinStoreT r f g l s i v p b m a -> m a 63 | runRefBinStore c (RBS m) = do 64 | env <- startBinStore c 65 | m `runReaderT` env 66 | 67 | instance (HasPos i v p, HasRefBinEnv (f (RefBinEnv r l b i)) r l b i, HasBinMap (f (RefBinEnv r l b i)) g v p b, HasBinMap g g v p b, Ord p, Eq (v p), Traversable v, Additive v, Ord l, MonadAtomicRef r m, MonadThrow m) => BinReader (f (RefBinEnv r l b i)) g l v p b (RefBinStoreT r f g l s i v p b m) where 68 | type I (RefBinStoreT r f g l s i v p b m) = i 69 | 70 | tip b = do 71 | view (rbeBins.at b) >>= maybe (pure []) (lift . readRef) 72 | 73 | readSession u = view rbeSess >>= (fmap (Map.lookup u) . lift . readRef) >>= maybe (throwM SessionFraud) getGenM 74 | 75 | readLocalDifficulty l = view rbeLocDif >>= (fmap (Map.findWithDefault 0 l) . lift . readRef) 76 | 77 | instance (HasPos i v p, HasRefBinEnv (f (RefBinEnv r l b i)) r l b i, HasBinMap (f (RefBinEnv r l b i)) g v p b, HasBinMap g g v p b, Ord p, Eq (v p), Traversable v, Additive v, Ord l, MonadMask m, MonadAtomicRef r m, MonadThrow m, MonadIO m) => BinStorage (f (RefBinEnv r l b i)) g l v p b (RefBinStoreT r f g l s i v p b m) where 78 | checkDB = pure () -- always up 79 | 80 | binFilter b f = 81 | view (rbeBins.at b) >>= maybe (pure ()) (\r -> lift $ atomicModifyRef' r ((,()) . filter f)) 82 | 83 | binTX chk i = do 84 | mb <- view $ (binMap.to (`homeBin` i)) 85 | l <- view rbeLock 86 | case mb of 87 | Nothing -> pure False 88 | Just b -> do 89 | mbr <- view (rbeBins.at b) 90 | case mbr of 91 | Nothing -> pure False 92 | Just br -> do 93 | bracket_ (pure () `untilM_` (lift $ atomicModifyRef' l (\case { True -> (False, True); False -> (False, False)}))) 94 | (lift $ writeRef l True) $ do 95 | g <- chk i 96 | case g of 97 | False -> pure False 98 | True -> lift $ atomicModifyRef' br (\bc -> (i:bc, True)) 99 | 100 | setSession u mo n = do 101 | sm <- view rbeSess 102 | f <- lift $ atomicModifyRef' sm (\os -> 103 | let mov = Map.lookup u os 104 | in case mov of 105 | -- If we don't have the data, we're forced into blind acceptance. 106 | Nothing -> (Map.insert u (SessGeneration n) os , False) 107 | -- Everything matches. 108 | Just (SessGeneration g) | (Just g) == mo -> (Map.insert u (SessGeneration n) os , False) 109 | -- If they're from the future, we missed a write. 110 | Just (SessGeneration g) | (Just g) < mo -> (Map.insert u (SessGeneration n) os , False) 111 | -- By process of elimination, their session is older and is thus a replay. 112 | Just (SessGeneration _) -> (Map.insert u SessFraud os , True) 113 | -- Fraud stays fraud 114 | Just SessFraud -> (os, True) 115 | ) 116 | case f of 117 | True -> throwM SessionFraud 118 | False -> pure () 119 | 120 | incLocalDifficulty l d = do 121 | view rbeLocDif >>= lift . (`atomicModifyRef'` (\lm -> (Map.insertWith (+) l d lm, ()))) 122 | 123 | tryPlace l nd = do 124 | now <- liftIO $ getCurrentTime 125 | r <- view rbeLocLast 126 | lift . atomicModifyRef' r $ \lm -> 127 | case Map.lookup l lm of 128 | Nothing -> (Map.insert l now lm, Nothing) 129 | Just lt | (nd `addUTCTime` lt) < now -> (Map.insert l now lm, Nothing) 130 | Just _ -> (Map.insert l now lm, Just $ nd `addUTCTime` now) 131 | -------------------------------------------------------------------------------- /src/Maple/TextHintParser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | module Maple.TextHintParser where 4 | 5 | import Control.Monad 6 | import Data.Attoparsec.Text (Parser) 7 | import qualified Data.Attoparsec.Text as P 8 | import Data.Hashable 9 | import Data.List 10 | import Data.Map (Map) 11 | import qualified Data.Map as Map 12 | import Data.Maybe 13 | import Data.Text (Text) 14 | import qualified Data.Text as T 15 | import System.Random 16 | 17 | -- | text symbols: Matches a piece of text containing something in the set of [a-zA-Z0-9/_] (non-empty) 18 | textSymbol :: Parser Text 19 | textSymbol = P.takeWhile1 (P.inClass "a-zA-Z0-9/_") P. "text symbol" 20 | 21 | textHintLang :: r -> Text -> Either String ([Text] -> Maybe r) 22 | textHintLang r = P.parseOnly (textHintParser textSymbol r) 23 | 24 | parseTextTumbler :: forall r . [r] -> Text -> Either String ([Text] -> Maybe r) 25 | parseTextTumbler rs t = 26 | fmap randomizer $ textHintLang () t 27 | where 28 | randomizer :: ([Text] -> Maybe ()) -> [Text] -> Maybe r 29 | randomizer decider s = 30 | fmap (const $ rs!!(fst $ randomR (0, length rs-1) (mkStdGen (hash s)))) $ decider s 31 | 32 | -- | Pattern matching 33 | -- @_ : matches some symbol _ 34 | -- $A_ : matches any complete symbol that no other variable in scope currently matches as the variable A. 35 | -- Can be constrained to be in the, optional, _ pattern (Either @ or {}) 36 | -- Legal variable names are in [a-zA-z0-9_]. 37 | -- {a,b} : matches a symbol in the set of a and b. 38 | -- [a,b] : matche she pattern a and matches the pattern b. 39 | -- ... : Skips 0 or more list entries. 40 | -- 41 | -- lexically scoped variables. 42 | textHintParser :: Eq s => Parser s -> r -> Parser ([s] -> Maybe r) 43 | textHintParser ps r = (\f -> f (\_ _ -> Just r) mempty) <$> (parseListBody ps <* P.endOfInput) 44 | 45 | data VarValue s 46 | = VarSym s 47 | deriving (Eq, Ord, Read, Show) 48 | 49 | type ParserCont s r = (Map Text (VarValue s) -> [s] -> Maybe r) -> Map Text (VarValue s) -> [s] -> Maybe r 50 | 51 | parseListBody :: Eq s => Parser s -> Parser (ParserCont s r) 52 | parseListBody ps = do 53 | conts <- (parseListEntry ps) `P.sepBy1'` (P.char ',') 54 | pure $ \cont vmap slist -> (foldr (\upper lower -> upper lower) cont conts) vmap slist 55 | 56 | parseListEntry :: Eq s => Parser s -> Parser (ParserCont s r) 57 | parseListEntry ps = do 58 | P.choice 59 | [ anyTextSymbol ps 60 | , inSymbolSet ps 61 | , varMatcher ps 62 | , elipseMatcher 63 | ] P. "List entry" 64 | 65 | -- | A type that represents setting the value of a variable and returning the unused portion of the list 66 | -- if we managed to match. 67 | type VarAssigner s = [s] -> Maybe (VarValue s, [s]) 68 | 69 | -- | Given a Var, checks if it matches and if it does, returns Just the unused tail. 70 | checkVar :: Eq s => VarValue s -> [s] -> Maybe [s] 71 | checkVar (VarSym _) [] = Nothing 72 | checkVar (VarSym v) (h:t) = if v == h then Just t else Nothing 73 | 74 | parseVarAssigner :: Eq s => Parser s -> Parser (VarAssigner s) 75 | parseVarAssigner ps = P.choice 76 | [ parseVarSet 77 | , parseNoVarRestriction 78 | ] P. "Var assigner" 79 | where 80 | parseVarSet = do 81 | sset <- (P.char '{') *> ps `P.sepBy1'` (P.char '|') <* (P.char '}') 82 | pure $ \case 83 | (h:t) | h `elem` sset -> Just (VarSym h, t) 84 | _ -> Nothing 85 | parseNoVarRestriction = do 86 | me <- P.peekChar 87 | case me of 88 | -- End of string, so no specifier 89 | Nothing -> pure $ \case 90 | [] -> Nothing 91 | (h:t) -> Just (VarSym h, t) 92 | -- No specifier 93 | Just ',' -> pure $ \case 94 | [] -> Nothing 95 | (h:t) -> Just (VarSym h, t) 96 | Just _ -> mzero P. "Not a valid variable assigner" 97 | 98 | varMatcher :: Eq s => Parser s -> Parser (ParserCont s r) 99 | varMatcher ps = do 100 | v <- P.char '$' *> P.takeWhile1 (P.inClass "a-zA-Z0-9_") 101 | vassigner <- parseVarAssigner ps 102 | pure $ \cont vmap slist -> 103 | case Map.lookup v vmap of 104 | -- New variable case 105 | Nothing -> 106 | case vassigner slist of 107 | Nothing -> mzero 108 | Just (assignment, t) -> 109 | if assignment `elem` (Map.elems vmap) 110 | then mzero 111 | else cont (Map.insert v assignment vmap) t 112 | -- We know it doesn't match another variable because we already assigned it 113 | Just assigned -> 114 | case checkVar assigned slist of 115 | Nothing -> mzero 116 | Just pf -> cont vmap pf 117 | 118 | anyTextSymbol :: Eq s => Parser s -> Parser (ParserCont s r) 119 | anyTextSymbol ps = do 120 | s <- P.char '@' *> ps 121 | pure $ \cont vmap slist -> 122 | case slist of 123 | (h:t) | h == s -> cont vmap t 124 | _ -> mzero 125 | 126 | inSymbolSet :: Eq s => Parser s -> Parser (ParserCont s r) 127 | inSymbolSet ps = do 128 | sset <- (P.char '{') *> ps `P.sepBy1'` (P.char '|') <* (P.char '}') 129 | pure $ \cont vmap slist -> 130 | case slist of 131 | (h:t) | h `elem` sset -> cont vmap t 132 | _ -> mzero 133 | 134 | elipseMatcher :: Parser (ParserCont s r) 135 | elipseMatcher = do 136 | void $ P.string $ T.pack "..." 137 | pure $ \cont vmap slist -> 138 | listToMaybe $ 139 | mapMaybe (cont vmap) $ 140 | tails slist 141 | -------------------------------------------------------------------------------- /src/Maple/Web.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | module Maple.Web where 6 | 7 | import Control.Lens 8 | import Control.Monad.Catch (MonadThrow) 9 | import Control.Monad.Except 10 | import Data.Aeson (ToJSON, FromJSON, ToJSONKey) 11 | import Data.Serialize 12 | 13 | import Maple.AABB 14 | import Maple.Config 15 | import Maple.Loot 16 | import Maple.Map 17 | import Maple.Session 18 | import Maple.Web.Server 19 | 20 | import Servant.API 21 | import Servant.Server 22 | 23 | import qualified Network.Wai.Middleware.Cors as Cors 24 | import Network.HTTP.Types.Method 25 | import Network.Wai 26 | 27 | serveMapleAPI :: forall m c g l s i v p b e 28 | . (Applicative v, Num p, FromJSON (v p), Read p, FromJSON p, ToJSON p, FromJSON s, ToJSON i, FromJSON i, ToJSONKey b, FromHttpApiData b, FromHttpApiData (v p), i ~ (I m)) 29 | => (Show (v p), Show i, HasLootName i, Eq i, ToJSON s, HasBoundingBox i v p, BinStorage c g l v p b m, HasClientKey c, Serialize l, MonadThrow m, MonadIO m, HasLocalPoolSize c, HasMapleConfig c g l s i v p b e) 30 | => c -- ^ Config to run the server with 31 | -> (forall x. m x -> IO x) -- ^ Function run the internal m in 32 | -> Application 33 | serveMapleAPI config runM = 34 | Cors.cors getCorsPolicy $ mapleApp config $ hoistMapleAPIServer (runExceptTHandler runM) $ mapleAPIServer config 35 | where 36 | getCorsPolicy request = 37 | if requestMethod request == methodGet 38 | then Just Cors.simpleCorsResourcePolicy 39 | else Just corsPolicy -- Only allow select origins 40 | corsPolicy = 41 | Cors.simpleCorsResourcePolicy { 42 | Cors.corsOrigins = Just (config ^. mcAllowedOrigins, True) 43 | } 44 | -- | Run a servant hanlder in ExceptT ServerError m a 45 | -- in order to run things underneath. Handler doesn't allow for this 46 | runExceptTHandler :: forall m a. (forall x. m x -> IO x) 47 | -> ExceptT ServerError m a 48 | -> Handler a 49 | runExceptTHandler run ref = Handler $ mapExceptT run ref 50 | -------------------------------------------------------------------------------- /src/Maple/Web/API.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} -- TODO remove this 5 | module Maple.Web.API where 6 | 7 | import Data.Aeson (FromJSON (..), ToJSON (..)) 8 | import qualified Data.Aeson as Aeson 9 | import Data.Bifunctor 10 | import qualified Data.Foldable as Foldable 11 | import Data.Map (Map) 12 | import Data.Proxy 13 | import qualified Data.Text as Text 14 | import qualified Data.Text.Encoding as Text 15 | import Linear 16 | import Network.HTTP.Date 17 | import Text.Read 18 | 19 | import Servant.API 20 | 21 | import Maple.AABB 22 | import Maple.Web.Admin 23 | import Maple.Web.Local 24 | import Maple.Web.Session 25 | 26 | instance Read p => FromHttpApiData (V2 p) where 27 | parseQueryParam txt = 28 | -- TODO Clean up this "parser" 29 | case Text.splitOn "," txt of 30 | [x,y] -> first Text.pack $ V2 <$> readEitherText x <*> readEitherText y 31 | _ -> Left $ "Unable to parse V2 point from: " <> txt 32 | where 33 | readEitherText = readEither . Text.unpack 34 | 35 | instance Read p => FromHttpApiData (V3 p) where 36 | parseQueryParam txt = 37 | -- TODO Clean up this "parser" 38 | case Text.splitOn "," txt of 39 | [x,y,z] -> first Text.pack $ V3 <$> readEitherText x <*> readEitherText y <*> readEitherText z 40 | _ -> Left $ "Unable to parse V3 point from: " <> txt 41 | where 42 | readEitherText = readEither . Text.unpack 43 | 44 | -- TODO remove this. it's bad 45 | instance (ToJSON p) => ToJSON (V3 p) where 46 | toJSON p = toJSON $ Foldable.toList p 47 | instance (ToJSON p) => ToJSON (V2 p) where 48 | toJSON p = toJSON $ Foldable.toList p 49 | 50 | instance (FromJSON p) => FromJSON (V3 p) where 51 | parseJSON o = do 52 | xs <- parseJSON o 53 | case xs of 54 | [x,y,z] -> pure $ V3 x y z 55 | _ -> fail "Unable to parse V3 from list" 56 | 57 | instance (FromJSON p) => FromJSON (V2 p) where 58 | parseJSON o = do 59 | xs <- parseJSON o 60 | case xs of 61 | [x,y] -> pure $ V2 x y 62 | _ -> fail "Unable to parse V2 from list" 63 | 64 | data UserInfo i = UserInfo { 65 | userLoot :: [i] 66 | , userHints :: [Text.Text] 67 | } deriving (Eq, Ord, Show) 68 | 69 | instance ToJSON i => ToJSON (UserInfo i) where 70 | toJSON (UserInfo loot hints) = 71 | Aeson.object [ 72 | "loot" Aeson..= loot 73 | , "hints" Aeson..= hints 74 | ] 75 | 76 | instance FromJSON i => FromJSON (UserInfo i) where 77 | parseJSON = 78 | Aeson.withObject "UserInfo" $ \o -> 79 | UserInfo 80 | <$> o Aeson..: "loot" 81 | <*> o Aeson..: "hints" 82 | 83 | 84 | data UserWithBins b i = UserWithBins { 85 | binImages :: Map b [i] 86 | , lootPlaced :: Bool 87 | , userData :: UserInfo i 88 | } deriving (Eq, Ord, Show) 89 | 90 | instance (Aeson.ToJSONKey b, ToJSON i) => ToJSON (UserWithBins b i) where 91 | toJSON (UserWithBins b p u) = 92 | Aeson.object [ 93 | "bins" Aeson..= b 94 | , "placed" Aeson..= p 95 | , "user" Aeson..= u 96 | ] 97 | 98 | instance (Aeson.FromJSONKey b, FromJSON i, Ord b) => FromJSON (UserWithBins b i) where 99 | parseJSON = 100 | Aeson.withObject "UserWithBins" $ \o -> 101 | UserWithBins 102 | <$> o Aeson..: "bins" 103 | <*> o Aeson..: "placed" 104 | <*> o Aeson..: "user" 105 | 106 | instance ToHttpApiData HTTPDate where 107 | toUrlPiece = Text.decodeUtf8 . formatHTTPDate 108 | 109 | data MapleCacheControl = MapleCacheControl { 110 | mapleCacheControlMaxSeconds :: Word 111 | } 112 | 113 | newtype CacheControlHeader = CacheControlHeader { 114 | unCacheControlHeader :: Text.Text 115 | } 116 | 117 | instance ToHttpApiData CacheControlHeader where 118 | toUrlPiece = unCacheControlHeader 119 | 120 | type (MapleAPI s l v p b i) = 121 | "view" :> QueryParam' '[Required] "minPoint" (V2 p) :> QueryParam' '[Required] "maxPoint" (V2 p) :> Get '[JSON] (Headers '[Header "Surrogate-Control" Text.Text, Header "Cache-Control" CacheControlHeader] (Map b (BoundingBox V2 p))) -- 122 | -- View 123 | -- TODO 124 | -- give chromakode better JSON (get rid of the tuples) 125 | -- fix BoundingBox query parameter encoding 126 | :<|> "bin" :> Capture "id" b :> Get '[JSON] (Headers '[Header "Cache-Control" CacheControlHeader, Header "Expires" HTTPDate] [i]) -- 5 seconds 127 | :<|> "season" :> "pass" :> Post '[JSON] (Sessioned s i (UserInfo i)) 128 | :<|> MapleLocal l :> "user" :> ReqBody '[JSON] (Sessioned s i ()) :> Post '[JSON] (Sessioned s i (UserInfo i)) 129 | :<|> MapleLocal l :> "claim" :> ReqBody '[JSON] (Sessioned s i s) :> Post '[JSON] (Sessioned s i (UserInfo i)) 130 | :<|> MapleLocal l :> "place" :> ReqBody '[JSON] (Sessioned s i i) :> Post '[JSON] (Headers '[Header "Cache-Control" CacheControlHeader] (Sessioned s i (UserWithBins b i))) 131 | :<|> "healthz" :> GetNoContent 132 | :<|> "static" :> Raw 133 | :<|> BasicAuth "admin" MapleAdmin :> "mod" :> "clear" :> ReqBody '[JSON] (BoundingBox v p) :> Post '[JSON] (Map b [i]) 134 | :<|> BasicAuth "admin" MapleAdmin :> "mod" :> "remove" :> ReqBody '[JSON] i :> Post '[JSON] (Map b [i]) 135 | :<|> BasicAuth "admin" MapleAdmin :> "mod" :> "loot" :> "all" :> Get '[JSON] [i] 136 | :<|> MapleLocal l :> BasicAuth "admin" MapleAdmin :> "mod" :> "loot" :> "place" :> ReqBody '[JSON] i :> Post '[JSON] (Map b [i]) 137 | 138 | mapleAPI :: Proxy (MapleAPI c l v p b i) 139 | mapleAPI = Proxy 140 | -------------------------------------------------------------------------------- /src/Maple/Web/Admin.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Maple.Web.Admin where 3 | 4 | import Crypto.BCrypt 5 | import qualified Data.Map as Map 6 | import qualified Data.Text as Text 7 | import qualified Data.Text.Encoding as Text 8 | import qualified Data.Text.IO as Text 9 | import Data.Text (Text) 10 | import Servant.API 11 | import Servant.Server 12 | 13 | newtype MapleAdminCheck = MapleAdminCheck { 14 | runMapleAdminCheck :: (Text, Text) -> Maybe MapleAdmin 15 | } 16 | 17 | data MapleAdmin = MapleAdmin { 18 | mapleAdminUsername :: Text 19 | } deriving (Eq, Ord, Show) 20 | 21 | mapleAdminCheck :: MapleAdminCheck -> BasicAuthCheck MapleAdmin 22 | mapleAdminCheck adminCheck = 23 | BasicAuthCheck $ \(BasicAuthData user' pass') -> 24 | let requestUser = Text.decodeUtf8 user' 25 | rawPassword = Text.decodeUtf8 pass' 26 | in case runMapleAdminCheck adminCheck (requestUser, rawPassword) of 27 | Nothing -> pure NoSuchUser 28 | Just user -> pure $ Authorized user 29 | 30 | nullAdminCheck :: MapleAdminCheck 31 | nullAdminCheck = MapleAdminCheck $ \(user, _pass) -> Just $ MapleAdmin user 32 | 33 | authCheckFromFile :: String -> IO MapleAdminCheck 34 | authCheckFromFile fp = do 35 | users <- (Map.fromList . parseFile) <$> Text.readFile fp 36 | pure $ MapleAdminCheck $ \(user, pass) -> do 37 | hashedPassword <- Map.lookup user users 38 | if validatePassword hashedPassword (Text.encodeUtf8 pass) 39 | then Just $ MapleAdmin user 40 | else Nothing 41 | where 42 | parseFile = fmap (toTuple . Text.splitOn ":") . Text.lines 43 | toTuple [user,passHash] = (user, Text.encodeUtf8 passHash) 44 | toTuple _ = error "Unable to parse auth file" 45 | -------------------------------------------------------------------------------- /src/Maple/Web/Local.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | {-# LANGUAGE TypeOperators #-} 8 | module Maple.Web.Local where 9 | 10 | import Control.Monad.Reader 11 | import Crypto.Classes 12 | import Crypto.Skein 13 | import Data.Bifunctor 14 | import qualified Data.ByteString.Lazy as BSL 15 | import qualified Data.Serialize as C 16 | import Data.Text (Text) 17 | import qualified Data.Text.Encoding as Text 18 | import qualified Data.Text.Encoding as TE 19 | import Data.WideWord.Word128 (word128Hi64) 20 | import Data.Word 21 | import qualified Net.IP as IP 22 | import Net.IPv4 (getIPv4) 23 | import Net.IPv6 (getIPv6) 24 | import Network.Socket 25 | import Network.Wai 26 | import Servant 27 | import Servant.Server.Internal.Delayed 28 | import Servant.Server.Internal.DelayedIO 29 | 30 | data MapleLocal l 31 | 32 | -- | Function to make a localg 33 | -- This is passed into the servant context 34 | -- TODO better name? 35 | newtype MakeMapleLocal l = MakeMapleLocal { 36 | makeMapleLocal :: (Request -> Either Text l) 37 | } 38 | 39 | instance HasLink api => HasLink (MapleLocal l :> api) where 40 | type MkLink (MapleLocal l :> api) a = MkLink api a 41 | toLink toA _ = toLink toA (Proxy :: Proxy api) 42 | 43 | xffIPLocal :: MakeMapleLocal Word64 44 | xffIPLocal = MakeMapleLocal getLocal 45 | where 46 | getLocal :: Request -> Either Text Word64 47 | getLocal r = 48 | case join $ fmap (IP.decode . TE.decodeLatin1) $ lookup "X-Forward-For" $ requestHeaders r of 49 | Nothing -> case remoteHost r of 50 | (SockAddrInet _ addr) -> 51 | first (const "could not decode locality") $ 52 | C.decode $ C.encode (hash' (C.encode addr)::Skein_256_128) 53 | (SockAddrInet6 _ _ (addr0, addr1, _, _) _) -> 54 | first (const "could not decode locality") $ 55 | C.decode $ C.encode (hash' (C.encode (addr0, addr1))::Skein_256_128) 56 | (SockAddrUnix _) -> Left "Unable to get ipv4 address from unix socket" 57 | Just xff -> first (const "could not decode locality") $ 58 | C.decode $ C.encode (hash' (IP.case_ (C.encode . getIPv4) 59 | (C.encode . word128Hi64 . getIPv6) xff)::Skein_256_128) 60 | 61 | ipv4Local :: MakeMapleLocal Word32 62 | ipv4Local = MakeMapleLocal (getIPV4 . remoteHost) 63 | where 64 | getIPV4 :: SockAddr -> Either Text Word32 65 | getIPV4 (SockAddrInet _ addr) = Right addr 66 | getIPV4 (SockAddrInet6 _ _ _ _) = Left "Unable to get ipv4 address from ipv6 host" 67 | getIPV4 (SockAddrUnix _) = Left "Unable to get ipv4 address from unix socket" 68 | 69 | instance (HasServer api ctx, HasContextEntry ctx (MakeMapleLocal l)) => HasServer (MapleLocal l :> api) ctx where 70 | type ServerT (MapleLocal l :> api) m = l -> ServerT api m 71 | route _ context subserver = 72 | route (Proxy :: Proxy api) context $ 73 | addAuthCheck subserver userSession 74 | where 75 | getLocal :: MakeMapleLocal l 76 | getLocal = getContextEntry context 77 | -- Here we get the users session id using `auth` 78 | -- If you want to ban users from connecting or anything like that 79 | -- you can `delayedFailFatal` or similar from 80 | -- `Servant.Server.Internal.DelayedIO` 81 | -- If there needs to be multiple auth checks 82 | -- we can also use a named context entry 83 | userSession :: DelayedIO l 84 | userSession = do 85 | res <- makeMapleLocal getLocal <$> ask 86 | case res of 87 | -- This should probably thorw something in the accept? 88 | Left err -> delayedFailFatal $ err401 { errBody = BSL.fromStrict $ Text.encodeUtf8 err } 89 | Right l -> pure l 90 | 91 | hoistServerWithContext _ pc nt s = 92 | hoistServerWithContext (Proxy :: Proxy api) pc nt . s 93 | -------------------------------------------------------------------------------- /src/Maple/Web/Server.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | {-# LANGUAGE TypeOperators #-} 8 | module Maple.Web.Server where 9 | 10 | import Control.Lens (Lens', to, view, (%~), (&), (^.), (.~)) 11 | import Control.Monad 12 | import Control.Monad.Catch 13 | import Control.Monad.Error.Class 14 | import Control.Monad.IO.Class 15 | import Data.Aeson 16 | import Data.Bifunctor 17 | import Data.Foldable 18 | import Data.Map (Map) 19 | import qualified Data.Map as Map 20 | import Data.Maybe 21 | import Data.Proxy 22 | import Data.Serialize 23 | import qualified Data.Set as Set 24 | import qualified Data.Text as Text 25 | import qualified Data.Text.Encoding as Text 26 | import qualified Data.Text.Lazy as LText 27 | import qualified Data.Text.Lazy.Builder as LText 28 | import qualified Data.Text.Lazy.Builder.Int as LText 29 | import qualified Data.Time as Time 30 | import Data.Tuple 31 | import Linear 32 | import Network.HTTP.Date 33 | import Network.Mime 34 | import Servant.API 35 | import Servant.Server 36 | import Servant.Server.StaticFiles 37 | import System.IO 38 | import System.Random 39 | import WaiAppStatic.Storage.Filesystem 40 | import WaiAppStatic.Types 41 | import qualified Web.ClientSession as CS 42 | 43 | import Maple.AABB 44 | import Maple.Config 45 | import Maple.Loot 46 | import Maple.Map 47 | import Maple.Session 48 | import Maple.Web.Admin 49 | import Maple.Web.API 50 | import Maple.Web.Local 51 | import Maple.Web.Session 52 | 53 | 54 | mapleApp :: forall config g l s i v p b e 55 | . (FromJSON (v p), FromJSON (V2 p), Read p, ToJSON p, FromJSON s, ToJSON i, FromJSON i, ToJSONKey b, FromHttpApiData b, FromHttpApiData (v p)) 56 | => HasMapleConfig config g l s i v p b e 57 | => config 58 | -> Server (MapleAPI s l v p b i) 59 | -> Application 60 | mapleApp config = 61 | serveWithContext mapleAPI context 62 | where 63 | context :: Context '[BasicAuthCheck MapleAdmin, CS.Key, MakeMapleLocal l] 64 | context = (mapleAdminCheck $ config ^. mcCheckAdmin) :. (config ^. mcCSKey) :. (config ^. mcMkLocal) :. EmptyContext 65 | 66 | -- | Hoist a maple API server into a different monad 67 | -- useful for n ~ Handler 68 | hoistMapleAPIServer :: forall s l i v p b m n 69 | . (Num p, Applicative v, FromJSON (v p), ToJSON p, FromJSON (V2 p), Read p, ToJSON i, FromJSON i, FromJSON s, ToJSONKey b, FromHttpApiData b, FromHttpApiData (v p)) 70 | => (forall x. m x -> n x) 71 | -> ServerT (MapleAPI s l v p b i) m 72 | -> ServerT (MapleAPI s l v p b i) n 73 | hoistMapleAPIServer = hoistServerWithContext mapleAPI mapleContext 74 | where 75 | mapleContext :: Proxy '[BasicAuthCheck MapleAdmin, CS.Key, MakeMapleLocal l] 76 | mapleContext = Proxy 77 | 78 | -- | Maple API server 79 | -- TODO add a new session request 80 | mapleAPIServer :: (Show (v p), Show i, HasLocalPoolSize c, Serialize l, MonadError ServerError m, MonadThrow m, MonadIO m, HasMapleConfig c g l s i v p b e, i ~ I m) 81 | => (HasLootName i, Num p, Applicative v, FromJSON s, FromJSON i, FromJSON (v p), ToJSON s, HasClientKey c, Eq (v p), Eq i, ToJSON i, HasBoundingBox i v p, BinStorage c g l v p b m) 82 | => c -> ServerT (MapleAPI s l v p b i) m 83 | mapleAPIServer c = 84 | viewportBinsH 85 | :<|> binContentsH 86 | :<|> newSeasonPassH 87 | :<|> userInfoH 88 | :<|> claimLootH 89 | :<|> placeLootH 90 | :<|> healthH 91 | :<|> staticH (c ^. mcImageFolders) 92 | :<|> moderationClearH 93 | :<|> moderationRemoveH 94 | :<|> moderationListLootH (c ^. mcAdminLoot) 95 | :<|> moderationPlaceLootH 96 | 97 | newSeasonPassH :: (MonadThrow m, MonadIO m, HasClientKey c, ToJSON s, ToJSON i, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 98 | => m (Sessioned s i (UserInfo i)) 99 | newSeasonPassH = guardOnPaused $ do 100 | newSession <- emptySessionData 101 | makeUserInfo newSession 102 | 103 | -- | Get the bounding boxes and bins for a given viewport 104 | -- TODO should this check viewport bounding box size? 105 | -- TODO Maybe change the order in overlapableBins? 106 | viewportBinsH :: (Num p, Applicative v, MonadIO m, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 107 | => V2 p -> V2 p -> m (Headers '[Header "Surrogate-Control" Text.Text, Header "Cache-Control" CacheControlHeader] (Map b (BoundingBox V2 p))) 108 | viewportBinsH minPoint maxPoint = do 109 | withSurrogateHeader $ withCacheHeaders mcBinListCachePolicy $ do 110 | bs <- view (to (`overlapableBins` viewport)) 111 | pure $ Map.fromList $ fmap swap bs 112 | where viewport = bound ((pure 0) & _xy .~ minPoint) ((pure 0) & _xy .~ maxPoint) 113 | 114 | binContentsH :: (MonadIO m, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 115 | => b -> m (Headers '[Header "Cache-Control" CacheControlHeader, Header "Expires" HTTPDate] [I m]) 116 | binContentsH bin = 117 | withCacheHeaders mcBinContentsCachePolicy $ withExpiresHeaders mcBinContentsCachePolicy $ map _dbmItem <$> tip bin 118 | 119 | userInfoH :: (MonadThrow m, FromJSON i, FromJSON s, i ~ I m, BinStorage c g l v p b m, HasLocalPoolSize c) 120 | => (Serialize l, HasMapleConfig c g l s i v p b e, MonadIO m, HasClientKey c, ToJSON s, ToJSON i) 121 | => l -> Sessioned s i () -> m (Sessioned s i (UserInfo i)) 122 | userInfoH local sessioned = guardOnPaused $ do 123 | lootBoxes <- view mcLootBoxes 124 | (sessionInfo, _) <- first (currentHintsOnly lootBoxes) <$> getSessionData local sessioned 125 | newHints <- sessionHints lootBoxes local sessionInfo 126 | newSessionInfo <- if null newHints then pure sessionInfo else incSessionGen (sessionInfo & sdCurrentHints %~ mappend newHints) 127 | makeUserInfo newSessionInfo 128 | 129 | claimLootH :: (HasLocalPoolSize c, Serialize l, MonadThrow m, FromJSON i, FromJSON s, MonadIO m, HasClientKey c, ToJSON s, ToJSON i, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 130 | => l -> Sessioned s i s -> m (Sessioned s i (UserInfo i)) 131 | claimLootH local sessioned = guardOnPaused $ do 132 | (currentSession, key) <- getSessionData local sessioned 133 | lootBoxes <- view mcLootBoxes 134 | let newSession = addKey currentSession key 135 | case dropLoot lootBoxes newSession of 136 | [] -> do 137 | -- Don't need to increment the session here 138 | -- a replay attack doesn't help them here 139 | makeUserInfo newSession 140 | lootResult -> do 141 | let completedHints = fmap fst lootResult 142 | newLoot = fmap snd lootResult 143 | addLootToSession s = foldr' (flip addLoot) s newLoot 144 | removeHintsFromSession s = s & sdCurrentHints %~ (filter (not . (`elem` completedHints))) 145 | & sdRecentHints %~ (Set.toList . Set.fromList . (completedHints++)) 146 | ld <- readLocalDifficulty local 147 | incBy <- fmap (sum . (0:)) . liftIO . 148 | forM (mapMaybe (fmap _lbDifficulty . (`Map.lookup` lootBoxes)) $ completedHints) $ \hd -> do 149 | incEng <- randomRIO (0, ld + hd) 150 | pure $ if incEng < hd then 1 else 0 151 | when (incBy > 0) $ incLocalDifficulty local incBy 152 | lootSession <- incSessionGen $ removeHintsFromSession $ addLootToSession newSession 153 | makeUserInfo lootSession 154 | 155 | -- | Sign and encode the session 156 | -- returning the set cookie header for the session 157 | -- and the UserInfo for the session 158 | makeUserInfo :: (MonadIO m, HasClientKey c, ToJSON s, ToJSON i, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 159 | => SessionData s i -> m (Sessioned s i (UserInfo i)) 160 | makeUserInfo session = do 161 | lootBoxes <- view mcLootBoxes 162 | newSession <- Text.decodeUtf8 <$> encodeSession session 163 | pure $ Sessioned newSession $ UserInfo { 164 | userLoot = session ^. sdCurrentLoot 165 | -- Done this way to keep the order of hints 166 | , userHints = fmap (view lbHint) . catMaybes $ (flip Map.lookup lootBoxes) <$> (session ^. sdCurrentHints) 167 | } 168 | 169 | -- TODO give back new session 170 | placeLootH :: (HasMapleConfig c g l s i v p b e, MonadThrow m, MonadError ServerError m, HasClientKey c, BinStorage c g l v p b m, HasBoundingBox i v p) 171 | => (HasLootName i, Num p, HasLocalPoolSize c, Serialize l, ToJSON s, i ~ I m, ToJSON i, FromJSON i, FromJSON s, Eq i, MonadThrow m, MonadIO m) 172 | => l -> Sessioned s i i -> m (Headers '[Header "Cache-Control" CacheControlHeader] (Sessioned s i (UserWithBins b i))) 173 | placeLootH local sessioned = withCacheHeaders mcBinContentsCachePolicy $ guardOnPaused $ do 174 | (session, loot) <- getSessionData local sessioned 175 | removedLootSession <- removeLoot session loot 176 | currentTime <- liftIO Time.getCurrentTime 177 | added <- binTX doesNotOverlap (DBMeta local currentTime loot) 178 | newSession <- incSessionGen $ if added then removedLootSession else session 179 | u <- makeUserInfo newSession 180 | let viewport = loot ^. boundingBox 181 | bs <- fmap snd <$> view (to (`overlapableBins` viewport)) 182 | items <- mapM (\b -> (\is -> (b, fmap _dbmItem is)) <$> tip b) bs 183 | pure $ UserWithBins (Map.fromList items) added <$> u 184 | 185 | healthH :: (Monad m, MonadThrow m, BinStorage c g l v p b m) => m NoContent 186 | healthH = do 187 | checkDB 188 | pure NoContent 189 | 190 | staticH :: [String] -> ServerT Raw m 191 | staticH folders = serveDirectoryWith $ serveDirectoriesStatic folders 192 | 193 | serveDirectoriesStatic :: [String] -> StaticSettings 194 | serveDirectoriesStatic folders = 195 | StaticSettings { 196 | ssLookupFile = lookupFile 197 | , ssGetMimeType = return . defaultMimeLookup . fromPiece . fileName 198 | , ssIndices = [] 199 | , ssListing = Nothing 200 | , ssMaxAge = MaxAgeSeconds 60 -- TODO make this a configuration option 201 | , ssMkRedirect = ssMkRedirect (defaultWebAppSettings "") -- This doesn't actually use the folder "" but it isn't exported anywhere else 202 | , ssRedirectToIndex = False 203 | , ssUseHash = True 204 | , ssAddTrailingSlash = False 205 | , ss404Handler = Nothing 206 | } 207 | where 208 | lookupFile pieces = 209 | case pieces of 210 | (p:rest) -> 211 | let p' = Text.unpack $ fromPiece p 212 | in if p' `elem` folders 213 | then do ssLookupFile (defaultWebAppSettings p') rest 214 | else pure LRNotFound 215 | _ -> pure LRNotFound 216 | 217 | -- | Remove all items that overlap with a bin 218 | moderationClearH :: (MonadIO m, Show (v p), HasMapleConfig c g l s i v p b e, i ~ I m, BinStorage c g l v p b m, HasBoundingBox i v p) 219 | => MapleAdmin -> BoundingBox v p -> m (Map b [i]) 220 | moderationClearH admin viewport = do 221 | logAdminAction admin $ "clear " <> show viewport 222 | bins <- fmap snd <$> view (to (`overlapableBins` viewport)) 223 | mapM_ (flip binFilter (not . overlaps viewport . view boundingBox)) bins 224 | items <- mapM (\b -> (\is -> (b, fmap _dbmItem is)) <$> tip b) bins 225 | pure $ Map.fromList items 226 | 227 | moderationRemoveH :: (MonadIO m, Show i, Eq i, HasBoundingBox i v p, HasMapleConfig c g l s i v p b e, i ~ I m, BinStorage c g l v p b m) 228 | => MapleAdmin -> i -> m (Map b [i]) 229 | moderationRemoveH admin i = do 230 | logAdminAction admin $ "remove " <> show i 231 | let imageBB = i ^. boundingBox 232 | bins <- fmap snd <$> view (to (`overlapableBins` imageBB)) 233 | mapM_ (flip binFilter (not . ((==) i) . _dbmItem)) bins 234 | items <- mapM (\b -> (\is -> (b, fmap _dbmItem is)) <$> tip b) bins 235 | pure $ Map.fromList items 236 | 237 | moderationListLootH :: (HasBoundingBox i v p, HasMapleConfig c g l s i v p b e, i ~ I m, BinStorage c g l v p b m) 238 | => [i] -> MapleAdmin -> m [i] 239 | moderationListLootH allLoot _ = pure allLoot 240 | 241 | moderationPlaceLootH :: (MonadError ServerError m, HasClientKey c, BinStorage c g l v p b m, HasBoundingBox i v p, i ~ I m) 242 | => (Show i, ToJSON i, Eq i, MonadThrow m, MonadIO m) 243 | => l -> MapleAdmin -> i -> m (Map b [i]) 244 | moderationPlaceLootH local admin loot = do 245 | logAdminAction admin $ "place " <> show loot 246 | currentTime <- liftIO Time.getCurrentTime 247 | _ <- binTX (const $ pure True) (DBMeta local currentTime loot) 248 | let viewport = loot ^. boundingBox 249 | bs <- fmap snd <$> view (to (`overlapableBins` viewport)) 250 | items <- mapM (\b -> (\is -> (b, fmap _dbmItem is)) <$> tip b) bs 251 | pure $ Map.fromList items 252 | 253 | withCacheHeaders :: (MonadIO m, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 254 | => AddHeader h CacheControlHeader orig res 255 | => Lens' (MapleConfig g l s i v p b e) MapleCacheControl 256 | -> m orig 257 | -> m res 258 | withCacheHeaders l act = do 259 | res <- act 260 | cacheControl <- view (mapleConfig . l) 261 | let 262 | secondsToExpire = mapleCacheControlMaxSeconds cacheControl 263 | cacheHeader = CacheControlHeader $ LText.toStrict $ LText.toLazyText $ "public, max-age=" <> LText.decimal secondsToExpire 264 | pure $ addHeader cacheHeader res 265 | 266 | withExpiresHeaders :: (MonadIO m, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 267 | => (AddHeader h HTTPDate orig res) 268 | => Lens' (MapleConfig g l s i v p b e) MapleCacheControl 269 | -> m orig 270 | -> m res 271 | withExpiresHeaders l act = do 272 | res <- act 273 | cacheControl <- view (mapleConfig . l) 274 | currentTime <- liftIO $ Time.getCurrentTime 275 | let 276 | secondsToExpire = mapleCacheControlMaxSeconds cacheControl 277 | timeToExpire = Time.addUTCTime (Time.secondsToNominalDiffTime (fromIntegral secondsToExpire)) currentTime 278 | expiresDate = utcToHTTPDate timeToExpire 279 | pure $ addHeader expiresDate res 280 | 281 | withSurrogateHeader :: (Monad m, AddHeader h Text.Text orig b) => m orig -> m b 282 | withSurrogateHeader act = do 283 | res <- act 284 | pure $ addHeader (Text.pack "max-age=3600") res 285 | 286 | data MaplePausedException = MaplePausedException deriving (Show) 287 | 288 | instance Exception MaplePausedException 289 | 290 | guardOnPaused :: (MonadThrow m, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) => m a -> m a 291 | guardOnPaused act = do 292 | paused <- view $ mapleConfig . mcPaused 293 | when paused $ throwM MaplePausedException 294 | act 295 | 296 | -- Verify the data in a session, throwing an error if validation fails 297 | getSessionData :: (HasLocalPoolSize c, Serialize l, MonadIO m, FromJSON s, FromJSON i, MonadThrow m, HasClientKey c, HasMapleConfig c g l s i v p b e, BinStorage c g l v p b m) 298 | => l -> Sessioned s i a -> m (SessionData s i, a) 299 | getSessionData local unverifified = do 300 | session <- if Text.null sessionText 301 | then do 302 | lootBoxes <- view mcLootBoxes 303 | sessionInfo <- emptySessionData 304 | newHints <- sessionHints lootBoxes local sessionInfo 305 | pure $ sessionInfo & sdCurrentHints %~ mappend newHints 306 | else decodeSession $ Text.encodeUtf8 sessionText 307 | pure (session, sessionValue unverifified) 308 | where 309 | sessionText = sessionData unverifified 310 | 311 | logAdminAction :: MonadIO m => MapleAdmin -> String -> m () 312 | logAdminAction admin str = 313 | liftIO $ hPutStrLn stderr $ (Text.unpack $ mapleAdminUsername admin) <> ": " <> str 314 | -------------------------------------------------------------------------------- /src/Maple/Web/Session.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Maple.Web.Session where 3 | 4 | import Control.Monad.Catch 5 | import Control.Monad.Reader 6 | import Data.Aeson (FromJSON, ToJSON) 7 | import qualified Data.Aeson as Aeson 8 | import Data.Text (Text) 9 | import qualified Data.Text.Encoding as Text 10 | 11 | import Maple.Session 12 | 13 | data Sessioned s i a = Sessioned { 14 | sessionData :: Text 15 | , sessionValue :: a 16 | } deriving (Eq, Ord, Show) 17 | 18 | instance Functor (Sessioned s i) where 19 | fmap f (Sessioned d v) = Sessioned d (f v) 20 | 21 | instance ToJSON a => ToJSON (Sessioned s i a) where 22 | toJSON (Sessioned d v) = 23 | Aeson.object [ 24 | "session" Aeson..= d 25 | , "value" Aeson..= v 26 | ] 27 | 28 | instance FromJSON a => FromJSON (Sessioned s i a) where 29 | parseJSON = 30 | Aeson.withObject "Sessioned" $ \o -> 31 | Sessioned <$> (o Aeson..: "session") <*> (o Aeson..: "value") 32 | 33 | makeSessioned :: (MonadIO m, ToJSON s, ToJSON i, MonadReader c m, MonadThrow m, HasClientKey c) 34 | => SessionData s i -> a -> m (Sessioned s i a) 35 | makeSessioned session value = do 36 | encodedSession <- encodeSession session 37 | pure $ Sessioned (Text.decodeUtf8 encodedSession) value 38 | -------------------------------------------------------------------------------- /test/AABBTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# OPTIONS_GHC -fno-warn-orphans #-} 4 | module AABBTest where 5 | 6 | import Control.Monad.State 7 | import Data.Foldable 8 | import Linear 9 | import Test.QuickCheck 10 | 11 | import Test.Tasty 12 | import Test.Tasty.HUnit 13 | import Test.Tasty.QuickCheck 14 | 15 | import Maple.AABB 16 | 17 | instance (Foldable v, Applicative v, Additive v, Ord p, Arbitrary (v p), Eq (v p)) => Arbitrary (BoundingBox v p) where 18 | arbitrary = do 19 | (p1 :: v p) <- arbitrary 20 | let 21 | validP2 :: v p -> Bool 22 | validP2 = all (not . (`elem` toList p1)) 23 | (p2 :: v p) <- arbitrary `suchThat` validP2 24 | pure $ bound p1 p2 25 | 26 | instance Arbitrary a => Arbitrary (V3 a) where 27 | arbitrary = V3 <$> arbitrary <*> arbitrary <*> arbitrary 28 | 29 | instance Arbitrary a => Arbitrary (V2 a) where 30 | arbitrary = V2 <$> arbitrary <*> arbitrary 31 | 32 | -- Close to the definition in HSpec 33 | infix 1 `shouldSatisfy` 34 | shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion 35 | shouldSatisfy x f = 36 | assertBool ("predicate failed on: " <> show x) (f x) 37 | 38 | aabbTests :: TestTree 39 | aabbTests = 40 | testGroup "AABB" [ 41 | overlapping2dBoxes 42 | , testCase "Trivial points in a box" $ do 43 | let 44 | box :: BoundingBox V2 Int 45 | box = bound (V2 0 0) (V2 2 2) 46 | pointsIn = [(V2 0 0), (V2 1 1), (V2 1 0), (V2 0 1)] 47 | forM_ pointsIn $ \p -> 48 | (box, p) `shouldSatisfy` (uncurry touches) 49 | , testCase "Trivial 2d 2x2 box around the origin contains the origin" $ do 50 | let 51 | box :: BoundingBox V2 Int 52 | box = bound (V2 1 1) (V2 (-1) (-1)) 53 | box `shouldSatisfy` (`touches` (V2 0 0)) 54 | , testProperty "Min corner is contained in a box" $ \box -> 55 | touches (box :: BoundingBox V2 Int) $ _minCorner box 56 | , testProperty "Max corner is not contained in a box" $ \box -> 57 | not $ touches (box :: BoundingBox V2 Int) $ _maxCorner box 58 | , testProperty "Overlaps is symmetric" $ \(b1 :: BoundingBox V3 Int) b2 -> 59 | overlaps b1 b2 ==> overlaps b2 b1 60 | , testCase "3D overlapping volumes" $ do 61 | let 62 | c1, c2, c3 :: BoundingBox V3 Int 63 | c1 = bound (V3 0 0 0) (V3 5 5 5) 64 | c2 = bound (V3 0 0 0) (V3 10 10 10) 65 | c3 = bound (V3 (-1) (-1) (-1)) (V3 1 1 1) 66 | (c1,c2) `shouldSatisfy` uncurry overlaps 67 | (c1,c3) `shouldSatisfy` uncurry overlaps 68 | , testCase "3D non-overlapping volumes" $ do 69 | let 70 | c1, c2, c3 :: BoundingBox V3 Int 71 | c1 = bound (V3 0 0 0) (V3 5 5 5) 72 | c2 = bound (V3 5 5 5) (V3 6 6 6) 73 | c3 = bound (V3 (-1) (-1) (-1)) (V3 0 0 0) 74 | (c1,c2) `shouldSatisfy` not . uncurry overlaps 75 | (c1,c3) `shouldSatisfy` not . uncurry overlaps 76 | ] 77 | 78 | -- | Just some simple 2d cases 79 | overlapping2dBoxes :: TestTree 80 | overlapping2dBoxes = 81 | testGroup "Overlapping 2d boxes" [notTouching2d, noCornersIntersecting, adjacent2d, bottomLeftIn2d 82 | , bottomRightIn2d, topLeftIn2d, topRightIn2d] 83 | 84 | -- | 4x4 2D Bounding box centered around the origin 85 | bba :: BoundingBox V2 Int 86 | bba = bound (V2 (-2) (-2)) (V2 2 2) 87 | 88 | {-| 89 | bba 90 | +---+ 91 | +-------+ 92 | | | | | bbb 93 | +-------+ 94 | +---+ 95 | -} 96 | noCornersIntersecting :: TestTree 97 | noCornersIntersecting = 98 | testCase "Two boxes overlap with no corners" $ 99 | assertBool "overlaps bba bbb" $ overlaps bba bbb 100 | where 101 | bbb = bound (V2 (-4) (-1)) (V2 4 1) 102 | 103 | 104 | {-| 105 | bba bbb 106 | +---+ +---+ 107 | | | | | 108 | | | | | 109 | | | | | 110 | +---+ +---+ 111 | -} 112 | notTouching2d :: TestTree 113 | notTouching2d = 114 | testCase "Two separate boxes don't overlap" $ 115 | assertBool "" $ not $ overlaps bba bbb 116 | where 117 | bbb = bound (V2 6 0) (V2 10 4) 118 | 119 | {-| 120 | bba bbb 121 | +---+---+ 122 | | | | 123 | | | | 124 | | | | 125 | +---+---+ 126 | -} 127 | adjacent2d :: TestTree 128 | adjacent2d = do 129 | testCase "Adjacent boxes don't overlap" $ 130 | (bba, bbb) `shouldSatisfy` not . (uncurry overlaps) 131 | where 132 | bbb = bound (V2 2 (-2)) (V2 6 2) 133 | 134 | {-| 135 | bbb 136 | +-------+ 137 | | bba | 138 | | +---+ | 139 | | | | | 140 | | | | | 141 | | | | | 142 | | +---+ | 143 | +-------+ 144 | -} 145 | fullContained2d :: TestTree 146 | fullContained2d = 147 | testCase "bba is fully c" $ 148 | assertBool "overlaps bba bbb" $ overlaps bba bbb 149 | where 150 | bbb = bound (V2 6 0) (V2 10 4) 151 | {-| 152 | bbb 153 | +---+ 154 | | | 155 | | +---+ 156 | | | | | 157 | +---+ |bba 158 | | | 159 | +---+ 160 | -} 161 | bottomRightIn2d :: TestTree 162 | bottomRightIn2d = 163 | testCase "Bottom right corner of bbb is in bba" $ 164 | assertBool "overlaps bba bbb" $ overlaps bba bbb 165 | where 166 | bbb = bound (V2 (-4) (0)) (V2 0 4) 167 | 168 | {-| 169 | +---+ 170 | | | 171 | +---+ |bbb 172 | | | | | 173 | bba | +---+ 174 | | | 175 | +---+ 176 | -} 177 | bottomLeftIn2d :: TestTree 178 | bottomLeftIn2d = 179 | testCase "Bottom left corner of bbb is in bba" $ 180 | assertBool "overlaps bba bbb" $ overlaps bba bbb 181 | where 182 | bbb = bound (V2 (0) (0)) (V2 4 4) 183 | 184 | {-| 185 | +---+ 186 | | | 187 | bba | +---+ 188 | | | | | 189 | +---+ | bbb 190 | | | 191 | +---+ 192 | -} 193 | topLeftIn2d :: TestTree 194 | topLeftIn2d = 195 | testCase "Top left corner of bbb is in bba" $ 196 | assertBool "overlaps bba bbb" $ overlaps bba bbb 197 | where 198 | bbb = bound (V2 (0) (-4)) (V2 4 0) 199 | 200 | {-| 201 | +---+ 202 | | | 203 | +---+ |bba 204 | | | | | 205 | | +---+ 206 | | | 207 | +---+ 208 | bbb 209 | -} 210 | topRightIn2d :: TestTree 211 | topRightIn2d = 212 | testCase "Top right corner of bbb is in bba" $ 213 | assertBool "overlaps bba bbb" $ overlaps bba bbb 214 | where 215 | bbb = bound (V2 (-4) (-4)) (V2 0 0) 216 | -------------------------------------------------------------------------------- /test/ParserTests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | module ParserTests where 4 | 5 | import qualified Data.Attoparsec.Text as P 6 | import Data.Text (Text) 7 | import Maple.TextHintParser 8 | import Test.Tasty 9 | import Test.Tasty.HUnit 10 | import Test.Tasty.TestVector 11 | 12 | checkHintLang :: Text -> [Text] -> Maybe () -> Bool 13 | checkHintLang hint s r = 14 | either (error . ("did not parse hint format: " <>)) (\p -> p s == r) $ textHintLang () hint 15 | 16 | -- | Just some simple 2d cases 17 | testHintParser :: TestTree 18 | testHintParser = testGroup "Hint Parser" 19 | [ testCase "Single value matcher" $ do 20 | let ap = fmap (\f -> f (\_ _ -> Just ()) mempty ["aba"]) $ 21 | P.parseOnly (anyTextSymbol textSymbol) $ "@aba" 22 | ap @?= (Right (Just ())) 23 | , testVectors "Single value matches" (checkHintLang "@aba") 24 | [ (["aba"], Just ()) 25 | , (["aba","bab"], Just ()) 26 | , (["bab"], Nothing) 27 | , ([], Nothing) 28 | , (["bab","aba"], Nothing) 29 | ] 30 | , testVectors "List value matches" (checkHintLang "@aba,@bab") $ 31 | [ (["aba"], Nothing) 32 | , (["bab"], Nothing) 33 | , (["aba","bab"], Just ()) 34 | , (["aba","bab","cab"], Just ()) 35 | , (["cab","aba","bab"], Nothing) 36 | , (["cab","aba","bab","cab"], Nothing) 37 | , (["bab","aba"], Nothing) 38 | ] 39 | , testVectors "Set value matches" (checkHintLang "{aba|bab}") $ 40 | [ (["aba"], Just ()) 41 | , (["bab"], Just ()) 42 | , (["aba","cab"], Just ()) 43 | , (["bab","cab"], Just ()) 44 | , (["cab"], Nothing) 45 | , (["cab","aba"], Nothing) 46 | , (["cab","bab"], Nothing) 47 | ] 48 | , testVectors "List set matches at start" (checkHintLang "{aba|bab},@bab") $ 49 | [ (["aba"], Nothing) 50 | , (["bab"], Nothing) 51 | , (["aba","bab"], Just ()) 52 | , (["bab","bab"], Just ()) 53 | , (["aba","cab"], Nothing) 54 | , (["cab","bab"], Nothing) 55 | , (["cab","aba"], Nothing) 56 | , (["cab","aba","bab","cab"], Nothing) 57 | , (["aba","bab","cab"], Just ()) 58 | , (["bab","bab","cab"], Just ()) 59 | ] 60 | , testVectors "List set matches later" (checkHintLang "@cab,{aba|bab}") $ 61 | [ (["aba"], Nothing) 62 | , (["bab"], Nothing) 63 | , (["cab"], Nothing) 64 | , (["cab","aba"], Just ()) 65 | , (["cab","bab"], Just ()) 66 | , (["aba","cab"], Nothing) 67 | , (["bab","cab"], Nothing) 68 | , (["cab","aba","bab"], Just ()) 69 | , (["cab","bab","aba"], Just ()) 70 | ] 71 | , testVectors "Variable matches anything" (checkHintLang "$A") $ 72 | [ (["aba"], Just ()) 73 | , (["bab"], Just ()) 74 | , (["cab"], Just ()) 75 | , ([], Nothing) 76 | , (["aba","bab","cab"], Just ()) 77 | ] 78 | , testVectors "Variable checks equality" (checkHintLang "$A,$A") $ 79 | [ (["aba","aba"], Just ()) 80 | , (["aba","bab"], Nothing) 81 | , (["aba"], Nothing) 82 | , ([], Nothing) 83 | , (["aba","aba","bab"], Just ()) 84 | ] 85 | , testVectors "Two variables" (checkHintLang "$A,$B") $ 86 | [ (["aba"], Nothing) 87 | , (["aba","aba"], Nothing) 88 | , (["aba","bab"], Just ()) 89 | , (["aba","aba","bab"], Nothing) 90 | , (["aba","bab","bab"], Just ()) 91 | ] 92 | , testVectors "Variable of set matches" (checkHintLang "$A{aba|bab}") $ 93 | [ (["aba"], Just ()) 94 | , (["bab"], Just ()) 95 | , (["cab"], Nothing) 96 | , ([], Nothing) 97 | , (["aba","bab","cab"], Just ()) 98 | , (["bab","aba","cab"], Just ()) 99 | , (["cab","aba"], Nothing) 100 | ] 101 | , testVectors "Variable of set checks equality" (checkHintLang "$A{aba|bab},$A") $ 102 | [ (["aba","aba"], Just ()) 103 | , (["aba","bab"], Nothing) 104 | , (["aba"], Nothing) 105 | , ([], Nothing) 106 | , (["aba","aba","bab"], Just ()) 107 | ] 108 | , testVectors "Two variable sets" (checkHintLang "$A{aba|bab},$B{aba|bab}") $ 109 | [ (["aba"], Nothing) 110 | , (["aba","aba"], Nothing) 111 | , (["aba","bab"], Just ()) 112 | , (["aba","aba","bab"], Nothing) 113 | , (["aba","bab","bab"], Just ()) 114 | ] 115 | , testVectors "Variable of set with open variable" (checkHintLang "$A{aba|bab},$B") $ 116 | [ (["aba"], Nothing) 117 | , (["aba","aba"], Nothing) 118 | , (["aba","bab"], Just ()) 119 | , (["aba","aba","bab"], Nothing) 120 | , (["aba","bab","bab"], Just ()) 121 | , (["bab"], Nothing) 122 | , (["bab","bab"], Nothing) 123 | , (["bab","aba"], Just ()) 124 | , (["bab","bab","aba"], Nothing) 125 | , (["bab","aba","aba"], Just ()) 126 | ] 127 | , testVectors "Variable of set matches" (checkHintLang "$A{aba|bab}") $ 128 | [ (["aba"], Just ()) 129 | , (["bab"], Just ()) 130 | , (["cab"], Nothing) 131 | , ([], Nothing) 132 | , (["aba","bab","cab"], Just ()) 133 | , (["bab","aba","cab"], Just ()) 134 | , (["cab","aba"], Nothing) 135 | ] 136 | , testVectors "List of set matches" (checkHintLang "{aba|bab},{aba|bab}") $ 137 | [ (["aba"], Nothing) 138 | , (["bab"], Nothing) 139 | , (["cab","aba","bab"], Nothing) 140 | , (["aba","aba"], Just ()) 141 | , (["aba","bab"], Just ()) 142 | , (["bab","bab"], Just ()) 143 | , (["bab","aba"], Just ()) 144 | , (["aba","aba","bab"], Just ()) 145 | , (["aba","bab","bab"], Just ()) 146 | , (["aba","cab","aba"], Nothing) 147 | ] 148 | , testGroup "elipses" $ 149 | [ testVectors "after var, at end" (checkHintLang "@aba,...") $ 150 | [ (["aba"], Just ()) 151 | , (["aba","bab"], Just ()) 152 | , (["aba","bab","cab"], Just ()) 153 | , ([], Nothing) 154 | , (["bab"], Nothing) 155 | , (["bab","aba"], Nothing) 156 | ] 157 | , testVectors "before var, at start" (checkHintLang "...,@aba") $ 158 | [ (["aba"], Just ()) 159 | , (["aba","bab"], Just ()) 160 | , (["aba","bab","cab"], Just ()) 161 | , ([], Nothing) 162 | , (["bab"], Nothing) 163 | , (["bab","aba"], Just ()) 164 | , (["bab","cab","aba"], Just ()) 165 | , (["bab","aba","cab"], Just ()) 166 | ] 167 | , testVectors "var between sets" (checkHintLang "{aba|cab},...,@bab,...,{aba|cab}") $ 168 | [ (["aba"], Nothing) 169 | , (["bab"], Nothing) 170 | , (["bab","aba"], Nothing) 171 | , (["aba","bab"], Nothing) 172 | , (["aba","bab","cab"], Just ()) 173 | , (["cab","bab","aba"], Just ()) 174 | , ([], Nothing) 175 | , (["aba","d","bab","cab"], Just ()) 176 | , (["aba","bab","d","cab"], Just ()) 177 | , (["aba","d","bab","d","cab"], Just ()) 178 | ] 179 | ] 180 | , testVectors "Number set value matches" (checkHintLang "{123|586}") $ 181 | [ (["123"], Just ()) 182 | , (["586"], Just ()) 183 | , (["123","411"], Just ()) 184 | , (["586","411"], Just ()) 185 | , (["411"], Nothing) 186 | , (["411","123"], Nothing) 187 | , (["411","586"], Nothing) 188 | ] 189 | ] 190 | -------------------------------------------------------------------------------- /test_grouped.csv: -------------------------------------------------------------------------------- 1 | difficulty,hint,key,image 2 | 0,A,@A,A 3 | 0,A,@a,A 4 | 1,Give me a vowel?,{A|E|a|e},Vowels 5 | -------------------------------------------------------------------------------- /test_groups.csv: -------------------------------------------------------------------------------- 1 | group,depth,image 2 | A,1,loot/1/A.png 3 | A,2,loot/1/A.png 4 | Vowels,1,loot/1/A.png 5 | Vowels,1,loot/1/E.png 6 | -------------------------------------------------------------------------------- /test_loot.csv: -------------------------------------------------------------------------------- 1 | difficulty,hint,key,image 2 | 0,The start of the alphabet,@a,loot/1/A.png 3 | 0,Comes after A,@b,loot/1/B.png 4 | 0,Comes after B,@c,loot/1/C.png 5 | 0,Comes before E,@d,loot/1/D.png 6 | 0,The second vowel,@e,loot/1/E.png 7 | 5,"With this, you can describe what ail causes",@f,loot/1/F.png 8 | 3,Start a box,@[,loot/2/box.png 9 | -------------------------------------------------------------------------------- /test_loot_combine.csv: -------------------------------------------------------------------------------- 1 | difficulty,hint,key,image 2 | 0,The start of the alphabet,@a,loot/1/A.png 3 | 1,The start of the alphabet,@A,loot/1/A.png 4 | --------------------------------------------------------------------------------