├── agents ├── vote │ ├── README.md │ ├── documentation.lisp │ ├── package.lisp │ ├── maiden-vote.asd │ └── vote.lisp ├── lastfm │ ├── documentation.lisp │ ├── package.lisp │ └── maiden-lastfm.asd ├── lookup │ ├── documentation.lisp │ ├── package.lisp │ ├── maiden-lookup.asd │ ├── interface.lisp │ └── lookup.lisp ├── dictionary │ ├── documentation.lisp │ ├── package.lisp │ └── maiden-dictionary.asd ├── core-manager │ ├── README.md │ ├── package.lisp │ ├── maiden-core-manager.asd │ └── documentation.lisp ├── quicklisp │ ├── README.md │ ├── package.lisp │ ├── maiden-quicklisp.asd │ └── documentation.lisp ├── accounts │ ├── README.md │ ├── maiden-accounts.asd │ ├── package.lisp │ └── conditions.lisp ├── urlinfo │ ├── README.md │ ├── package.lisp │ ├── maiden-urlinfo.asd │ └── documentation.lisp ├── location │ ├── package.lisp │ ├── README.md │ ├── maiden-location.asd │ ├── documentation.lisp │ └── location.lisp ├── medals │ ├── package.lisp │ ├── README.md │ ├── maiden-medals.asd │ ├── documentation.lisp │ └── medals.lisp ├── help │ ├── package.lisp │ ├── README.md │ ├── maiden-help.asd │ └── documentation.lisp ├── activatable │ ├── package.lisp │ ├── maiden-activatable.asd │ ├── README.md │ ├── documentation.lisp │ └── activatable.lisp ├── emoticon │ ├── package.lisp │ ├── README.md │ ├── maiden-emoticon.asd │ ├── documentation.lisp │ └── emoticon.lisp ├── time │ ├── README.md │ ├── package.lisp │ ├── maiden-time.asd │ └── documentation.lisp ├── talk │ ├── README.md │ ├── package.lisp │ ├── maiden-talk.asd │ ├── documentation.lisp │ ├── codes.lisp │ └── talk.lisp ├── weather │ ├── README.md │ ├── package.lisp │ ├── maiden-weather.asd │ └── documentation.lisp ├── counter │ ├── package.lisp │ ├── README.md │ ├── maiden-counter.asd │ ├── documentation.lisp │ └── counter.lisp ├── crimes │ ├── toolkit.lisp │ ├── maiden-crimes.asd │ ├── package.lisp │ ├── cardcast.lisp │ └── README.md ├── throttle │ ├── README.md │ ├── package.lisp │ └── maiden-throttle.asd ├── silly │ ├── package.lisp │ ├── README.md │ ├── maiden-silly.asd │ ├── songs.txt │ ├── fortunes.txt │ └── documentation.lisp ├── notify │ ├── package.lisp │ ├── maiden-notify.asd │ ├── README.md │ ├── notes.lisp │ ├── interface.lisp │ └── documentation.lisp ├── blocker │ ├── package.lisp │ ├── maiden-blocker.asd │ └── README.md ├── relay │ ├── maiden-channel-relay.asd │ ├── documentation.lisp │ └── relay.lisp ├── chatlog │ ├── package.lisp │ └── maiden-chatlog.asd ├── permissions │ ├── package.lisp │ ├── maiden-permissions.asd │ └── README.md ├── trivia │ ├── maiden-trivia.asd │ ├── package.lisp │ ├── README.md │ ├── game.lisp │ └── trivia.lisp ├── markov │ ├── package.lisp │ ├── README.md │ ├── maiden-markov.asd │ └── interface.lisp └── commands │ ├── maiden-commands.asd │ ├── staple.lisp │ ├── package.lisp │ ├── extraction.lisp │ ├── README.md │ └── dispatch.lisp ├── .gitattributes ├── .gitignore ├── client.lisp ├── clients ├── logger │ ├── documentation.lisp │ ├── package.lisp │ ├── client.lisp │ └── maiden-logger.asd ├── twitter │ ├── documentation.lisp │ ├── package.lisp │ └── maiden-twitter.asd ├── irc │ ├── conditions.lisp │ ├── maiden-irc.asd │ └── README.md ├── lichat │ ├── maiden-lichat.asd │ ├── README.md │ └── package.lisp └── relay │ ├── maiden-relay.asd │ ├── package.lisp │ ├── conditions.lisp │ ├── events.lisp │ ├── containers.lisp │ └── virtual-client.lisp ├── examples └── circ │ ├── package.lisp │ ├── maiden-circ.asd │ └── README.md ├── modules ├── serialize │ ├── package.lisp │ ├── README.md │ ├── maiden-serialize.asd │ ├── documentation.lisp │ └── serialize.lisp ├── api-access │ ├── package.lisp │ ├── README.md │ ├── maiden-api-access.asd │ ├── documentation.lisp │ └── toolkit.lisp ├── networking │ ├── events.lisp │ ├── maiden-networking.asd │ ├── package.lisp │ └── conditions.lisp ├── storage │ ├── package.lisp │ ├── maiden-storage.asd │ ├── README.md │ └── documentation.lisp └── client-entities │ ├── README.md │ ├── maiden-client-entities.asd │ ├── events.lisp │ ├── package.lisp │ └── entities.lisp ├── README.md ├── LICENSE ├── agent.lisp ├── maiden.asd ├── conditions.lisp ├── event.lisp ├── standard-events.lisp ├── entity.lisp ├── package.lisp └── maiden-logo.svg /agents/vote/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | 2 | doc/ linguist-vendored 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | config/ 2 | backup/ 3 | modules/trainer/ 4 | lib/ -------------------------------------------------------------------------------- /agents/lastfm/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.lastfm) 2 | -------------------------------------------------------------------------------- /agents/lookup/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.lookup) 2 | -------------------------------------------------------------------------------- /client.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden) 2 | 3 | (define-consumer client () ()) 4 | -------------------------------------------------------------------------------- /clients/logger/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.logger) 2 | 3 | -------------------------------------------------------------------------------- /clients/twitter/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.twitter) 2 | -------------------------------------------------------------------------------- /agents/dictionary/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.dictionary) 2 | -------------------------------------------------------------------------------- /agents/vote/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.vote) 2 | 3 | (docs:define-docs 4 | ) 5 | -------------------------------------------------------------------------------- /agents/core-manager/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent offers some commands to help manage the various consumers on a core. It will also allow you to stop the core altogether, or to reload the configuration. 3 | -------------------------------------------------------------------------------- /examples/circ/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:circ 3 | (:nicknames #:org.shirakumo.maiden.circ) 4 | (:use #:cl #:maiden) 5 | (:shadow #:server)) 6 | (in-package #:org.shirakumo.maiden.circ) 7 | -------------------------------------------------------------------------------- /clients/logger/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-logger 3 | (:nicknames #:org.shirakumo.maiden.clients.logger) 4 | (:use #:cl #:maiden #:maiden-client-entitiesk) 5 | ;; 6 | (:export 7 | #:log-event 8 | #:logger)) 9 | -------------------------------------------------------------------------------- /agents/lastfm/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:maiden-lastfm 3 | (:nicknames #:org.shirakumo.maiden.agents.lastfm) 4 | (:use #:cl #:maiden #:maiden-client-entities #:maiden-commands #:maiden-api-access) 5 | ;; interface.lisp 6 | (:export 7 | #:lastfm)) 8 | -------------------------------------------------------------------------------- /agents/lookup/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (defpackage #:maiden-lookup 3 | (:nicknames #:org.shirakumo.maiden.agents.lookup) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities #:maiden-api-access) 5 | ;; interface.lisp 6 | (:export 7 | #:lookup)) 8 | -------------------------------------------------------------------------------- /agents/vote/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-vote 3 | (:nicknames #:org.shirakumo.maiden.agents.vote) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities) 5 | ;; vote.lisp 6 | (:export 7 | #:vote 8 | #:start-vote 9 | #:end-vote)) 10 | -------------------------------------------------------------------------------- /modules/serialize/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-serialize 3 | (:nicknames #:org.shirakumo.maiden.modules.serialize) 4 | (:use #:cl #:maiden) 5 | (:export 6 | #:serialize 7 | #:deserialize)) 8 | 9 | (use-package '#:maiden-serialize '#:maiden-user) 10 | -------------------------------------------------------------------------------- /agents/quicklisp/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent allows you to manage the software sources of the different packages in the system. It uses both Quicklisp and Git to provide this. The available commands and functions should be rather self-explanatory once you take a look at them. Thus, see the symbol index. 3 | -------------------------------------------------------------------------------- /agents/accounts/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides accounts for Maiden. Accounts are things by which users can be linked across different networks and different identities. Users can also store information and preferences in an account, which can then be reused by other parts of the system to provide better user interaction. 3 | -------------------------------------------------------------------------------- /agents/urlinfo/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides URL inspection facilities. It automatically fetches the HTTP headers of an URL and provides useful information about its contents. It can do so automatically for whenever a user posts an URL in a message. In order to activate this, see [maiden-activatable](../activatable/). 3 | -------------------------------------------------------------------------------- /agents/urlinfo/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-urlinfo 3 | (:nicknames #:org.shirakumo.maiden.agents.urlinfo) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities #:maiden-activatable) 5 | ;; urlinfo.lisp 6 | (:export 7 | #:fetch 8 | #:urlinfo 9 | #:test)) 10 | -------------------------------------------------------------------------------- /clients/irc/conditions.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.irc) 2 | 3 | (define-condition message-too-long-warning (message-condition client-condition warning) 4 | () 5 | (:report (lambda (c s) 6 | (declare (ignore c)) 7 | (format s "Message exceeds length limit of ~a." *send-length-limit*)))) 8 | -------------------------------------------------------------------------------- /clients/logger/client.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.logger) 2 | 3 | (define-event log-event (client-event deeds:message-event) 4 | ()) 5 | 6 | (define-consumer logger (client) 7 | ()) 8 | 9 | (define-handler (logger events log-event) (logger ev message) 10 | :match-consumer 'client 11 | (v:info :logger "~a" message)) 12 | -------------------------------------------------------------------------------- /agents/location/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-location 3 | (:nicknames #:org.shirakumo.maiden.agents.location) 4 | (:use #:cl #:maiden #:maiden-api-access #:maiden-commands #:maiden-client-entities) 5 | ;; location.lisp 6 | (:export 7 | #:geo-information 8 | #:coordinates 9 | #:address 10 | #:location)) 11 | -------------------------------------------------------------------------------- /agents/medals/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-medals 3 | (:nicknames #:org.shirakumo.maiden.agents.medals) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 5 | ;; medals.lisp 6 | (:export 7 | #:medals 8 | #:add-medals 9 | #:remove-medals 10 | #:medals 11 | #:show 12 | #:award 13 | #:take)) 14 | -------------------------------------------------------------------------------- /modules/api-access/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-api-access 3 | (:nicknames #:org.shirakumo.maiden.modules.api-access) 4 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 5 | (:use #:cl #:maiden) 6 | (:export 7 | #:request 8 | #:parse-to 9 | #:request-as 10 | #:json-v)) 11 | 12 | (use-package '#:maiden-api-access '#:maiden-user) 13 | -------------------------------------------------------------------------------- /agents/quicklisp/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-quicklisp 3 | (:nicknames #:org.shirakumo.maiden.agents.quicklisp) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities) 5 | (:export 6 | #:quicklisp 7 | #:update 8 | #:upgrade 9 | #:version 10 | #:quickload 11 | #:uninstall 12 | #:install-dist 13 | #:uninstall-dist)) 14 | -------------------------------------------------------------------------------- /agents/help/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-help 3 | (:nicknames #:org.shirakumo.maiden.agents.help) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities) 5 | ;; help.lisp 6 | (:export 7 | #:help 8 | #:about 9 | #:about-self 10 | #:about-uptime 11 | #:about-command 12 | #:list-consumers 13 | #:about-consumer 14 | #:about-term)) 15 | -------------------------------------------------------------------------------- /agents/dictionary/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-dictionary 3 | (:nicknames #:org.shirakumo.maiden.agents.dictionary) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities) 5 | ;; dictionary.lisp 6 | (:export 7 | #:dictionary 8 | #:synonyms 9 | #:antonyms 10 | #:definitions 11 | #:pronunciations 12 | #:etymologies 13 | #:description)) 14 | -------------------------------------------------------------------------------- /agents/activatable/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-activatable 3 | (:nicknames #:org.shirakumo.maiden.agents.activatable) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 5 | ;; activatable.lisp 6 | (:export 7 | #:activate 8 | #:deactivate 9 | #:active-p 10 | #:list-active 11 | #:activatable-handler 12 | #:activatable)) 13 | -------------------------------------------------------------------------------- /modules/networking/events.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.networking) 2 | 3 | (define-event connection-event (client-event) 4 | ()) 5 | 6 | (define-event connection-initiated (connection-event) 7 | ()) 8 | 9 | (define-event connection-closed (connection-event) 10 | ()) 11 | 12 | (define-event outgoing-event (client-event) 13 | ()) 14 | 15 | (define-event incoming-event (client-event) 16 | ()) 17 | -------------------------------------------------------------------------------- /agents/emoticon/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-emoticon 3 | (:nicknames #:org.shirakumo.maiden.agents.emoticon) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 5 | ;; emoticon.lisp 6 | (:shadow #:remove #:list) 7 | (:export 8 | #:emoticon 9 | #:remove-emoticon 10 | #:list-emoticons 11 | #:add 12 | #:change 13 | #:remove 14 | #:list)) 15 | -------------------------------------------------------------------------------- /agents/time/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides various functions to look up and compare times at different places, and even for users of the system. The provided functions and commands should be fairly self-explanatory, so see the symbol index. 3 | 4 | You should set the `:api-key` configuration value of the consumer to the [Google Maps Timezone API](https://developers.google.com/maps/documentation/timezone/start) key that you obtained. 5 | -------------------------------------------------------------------------------- /agents/medals/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent offers a silly "medals" system, wherein users can be awarded fictitious medals for certain things. 3 | 4 | ## How To 5 | If you have the permission to do so, you can award other users medals, or take them away again. 6 | 7 | ::award SomeDude "the medal medal" 8 | 9 | Users can view their own, or someone else's medals. 10 | 11 | ::show medals of SomeDude 12 | 13 | And that's it. 14 | -------------------------------------------------------------------------------- /agents/talk/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides a Text To Speech functionality and allows you to play back random text on your computer. It also provides some commands for people to do that. Naturally, the TTS won't happen on their end, but nevertheless this can be useful for situations like a stream, where the other users will see and hear your screen. The available functions and commands should be self-explanatory, so see the symbol index. 3 | -------------------------------------------------------------------------------- /agents/emoticon/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides "emoticons" for text chats. Emotes are basically special sequences that are recognised by the bot and upon which the bot replies with a specific string. Very simple stuff. 3 | 4 | ## How To 5 | Add an emote 6 | 7 | ::add emoticon foo bar 8 | 9 | And invoke it. 10 | 11 | And so, :foo: became something else. 12 | 13 | That should prompt the bot to reply with "bar". That's it. 14 | -------------------------------------------------------------------------------- /agents/weather/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides weather and forecast information using the [OpenWeatherMap](https://openweathermap.org) API. It also uses the [maiden-location](../location/) system for location resolution. It thus provides users the ability to request both current weather and forecast information for their location. 3 | 4 | Simply see the symbol index for the available commands and functions. They should be self-explanatory. 5 | -------------------------------------------------------------------------------- /agents/core-manager/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-core-manager 3 | (:nicknames #:org.shirakumo.maiden.agents.core-manager) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities) 5 | ;; core-manager.lisp 6 | (:export 7 | #:core-manager 8 | #:start-consumer 9 | #:stop-consuemr 10 | #:remove-consumer 11 | #:add-consumer 12 | #:list-consumers 13 | #:stop-core 14 | #:reload)) 15 | -------------------------------------------------------------------------------- /agents/counter/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-counter 3 | (:nicknames #:org.shirakumo.maiden.agents.counter) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities #:maiden-activatable) 5 | ;; counter.lisp 6 | (:shadow #:remove #:list) 7 | (:export 8 | #:counter 9 | #:remove-counter 10 | #:set-counter 11 | #:list-counters 12 | #:add 13 | #:change 14 | #:remove 15 | #:list)) 16 | -------------------------------------------------------------------------------- /agents/location/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This provides an agent and some functions to perform geolocation. It allows retrieving the address of an ambiguous location, as well as getting the exact geological latitude and longitude coordinates of a place. This is done through the Google Maps geocoding API. 3 | 4 | You should set the `:api-key` configuration value of the consumer to the [Google Maps Geocoding API](https://developers.google.com/maps/documentation/geocoding/start) key that you obtained. 5 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # This repository has [moved](https://shirakumo.org/projects/maiden)! 2 | Due to Microsoft's continued enshittification of the platform this repository has been moved to [Codeberg](https://shirakumo.org/projects/maiden) in August of 2025. It will not receive further updates or patches. **Issues and pull requests will not be looked at here either**, please submit your patches and issue tickets on Codeberg, or send them directly via good old email patches to [shirakumo@tymoon.eu](mailto:shirakumo@tymoon.eu). 3 | 4 | Thanks. -------------------------------------------------------------------------------- /agents/talk/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-talk 3 | (:nicknames #:org.shirakumo.maiden.agents.talk) 4 | (:use #:cl #:maiden #:maiden-commands) 5 | (:local-nicknames 6 | (#:mixed #:org.shirakumo.fraf.mixed) 7 | (#:harmony #:org.shirakumo.fraf.harmony.user) 8 | (#:v #:org.shirakumo.verbose)) 9 | ;; talk.lisp 10 | (:export 11 | #:talk 12 | #:speech-file 13 | #:stop-playing 14 | #:play 15 | #:talk 16 | #:talk-en 17 | #:talk-lang 18 | #:shut-up)) 19 | -------------------------------------------------------------------------------- /agents/time/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-time 3 | (:nicknames #:org.shirakumo.maiden.agents.time) 4 | (:use #:cl #:maiden #:maiden-api-access #:maiden-commands #:maiden-client-entities) 5 | ;; time.lisp 6 | (:shadow #:time) 7 | (:export 8 | #:timezone-data 9 | #:timezone 10 | #:local-time 11 | #:user-time 12 | #:time 13 | #:timezone-location 14 | #:time-dwim 15 | #:time-location 16 | #:time-user 17 | #:time-between 18 | #:time-between-users)) 19 | -------------------------------------------------------------------------------- /agents/crimes/toolkit.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.crimes) 2 | 3 | (defmacro rotatef-list (place) 4 | (let ((val (gensym "VALUE"))) 5 | `(let ((,val ,place)) 6 | (when ,val 7 | (setf (cdr (last ,val)) (list (car ,val))) 8 | (setf ,place (cdr ,val)))))) 9 | 10 | (defmacro push-to-end (item place) 11 | (let ((value (gensym "VALUE"))) 12 | `(let ((,value ,place)) 13 | (if ,value 14 | (setf (cdr (last ,value)) (list ,item)) 15 | (setf ,place (list ,item)))))) 16 | -------------------------------------------------------------------------------- /agents/throttle/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides throttling on the users. This prevents them from overloading or spamming the services provided through commands and minimises the risk of exposing the bot to lots of users. The behaviour of the throttling can be customised rather precisely. 3 | 4 | As soon as the throttling agent is put on a core, it will automatically record the usage stats of each user and throttle their commands at appropriate times. The few commands seen in the symbol index allow the management of the throttling configuration. 5 | -------------------------------------------------------------------------------- /agents/silly/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-silly 3 | (:nicknames #:org.shirakumo.maiden.agents.silly) 4 | (:use #:cl #:maiden #:maiden-activatable #:maiden-commands #:maiden-api-access #:maiden-client-entities) 5 | ;; silly.lisp 6 | (:export 7 | #:silly 8 | #:silly-function 9 | #:remove-silly-function 10 | #:define-silly 11 | #:define-simple-silly 12 | #:eight 13 | #:jerkcity 14 | #:roll 15 | #:hello 16 | #:present 17 | #:you-are 18 | #:make 19 | #:fortune 20 | #:tell)) 21 | -------------------------------------------------------------------------------- /agents/silly/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides all sorts of silly distractions and commands. The functionality provided by this is purely meant for entertainment value and doesn't really hold any value beyond that. 3 | 4 | Primarily, it offers some automatic replies to certain kinds of messages that users might type. In order to get these replies, you must activate the silly module in the given channel. See [maiden-activatable](../activatable/). 5 | 6 | The fortune command may be of particular interest. View the `fortunes.txt` for all possible fortune messages. 7 | -------------------------------------------------------------------------------- /agents/weather/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-weather 3 | (:nicknames #:org.shirakumo.maiden.agents.weather) 4 | (:use #:cl #:maiden #:maiden-api-access #:maiden-storage #:maiden-client-entities #:maiden-commands) 5 | ;; weather.lisp 6 | (:export 7 | #:weather-data 8 | #:location-coordinates 9 | #:location-weather-data 10 | #:format-weather-data 11 | #:format-daily-forecast 12 | #:weather 13 | #:weather-dwim 14 | #:weather-location 15 | #:forecast-location 16 | #:weather-user 17 | #:forecast-user)) 18 | -------------------------------------------------------------------------------- /clients/twitter/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-twitter 3 | (:nicknames #:org.shirakumo.maiden.clients.twitter) 4 | (:use #:cl #:maiden #:maiden-client-entities) 5 | (:shadow #:user #:channel) 6 | (:export 7 | #:twitter-client 8 | #:api-key 9 | #:api-secret 10 | #:access-token 11 | #:access-secret 12 | #:login 13 | #:send-event 14 | #:send 15 | #:user 16 | #:channel 17 | #:update-channel 18 | #:update-status 19 | #:reply-to 20 | #:status 21 | #:object 22 | #:direct-message 23 | #:object)) 24 | -------------------------------------------------------------------------------- /agents/throttle/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-throttle 3 | (:nicknames #:org.shirakumo.maiden.agents.throttle) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 5 | ;; throttle.lisp 6 | (:export 7 | #:throttle 8 | #:attempts 9 | #:time-frame 10 | #:cooldown-function 11 | #:cooldown-step 12 | #:cooldown-max 13 | #:records 14 | #:record 15 | #:attempts 16 | #:timestamp 17 | #:timeout 18 | #:clear-tax 19 | #:tax 20 | #:view-config 21 | #:set-config 22 | #:clear-tax)) 23 | -------------------------------------------------------------------------------- /agents/notify/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-notify 3 | (:nicknames #:org.shirakumo.maiden.agents.notify) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 5 | ;; interface.lisp 6 | (:export 7 | #:notify 8 | #:forget-notes 9 | #:send-join-note 10 | #:send-note) 11 | ;; notes.lisp 12 | (:export 13 | #:note 14 | #:id 15 | #:from 16 | #:to 17 | #:message 18 | #:date 19 | #:trigger 20 | #:make-note 21 | #:register-note 22 | #:remove-note 23 | #:clear-notes 24 | #:user-notes)) 25 | -------------------------------------------------------------------------------- /agents/help/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This is an agent that provides a generic help and introspection facility, with the hopes that it will make it easier to discover the available commands and features that the system offers. 3 | 4 | ## How To 5 | The `help` command should do pretty much everything. The following terms are handled specially: 6 | 7 | * `uptime` 8 | * `about` 9 | 10 | Otherwise the term is first attempted to be interpreted as a command name, otherwise as the name of a consumer, and finally as a command search term. 11 | 12 | ::help about 13 | ::help list 14 | ::help about command 15 | -------------------------------------------------------------------------------- /examples/circ/maiden-circ.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-circ 2 | :version "1.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "A simple IRC client example using Maiden3" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "circ")) 13 | :depends-on (:maiden-relay 14 | :maiden-irc)) 15 | -------------------------------------------------------------------------------- /agents/blocker/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-blocker 3 | (:nicknames #:org.shirakumo.maiden.agents.blocker) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 5 | ;; blocker.lisp 6 | (:export 7 | #:clause 8 | #:remove-clause 9 | #:define-clause 10 | #:match-rule 11 | #:ensure-rule 12 | #:rule 13 | #:add-rule 14 | #:remove-rule 15 | #:blocked-p 16 | #:blocker 17 | #:block-channel 18 | #:block-user 19 | #:block-regex 20 | #:block-prefix 21 | #:update-rule 22 | #:remove-rule 23 | #:view-rule 24 | #:view-rules)) 25 | -------------------------------------------------------------------------------- /modules/serialize/README.md: -------------------------------------------------------------------------------- 1 | ## About Maiden-Serialize 2 | This module is useful to serialise data, especially events. The bulk of the work is handled by cl-store. Additionally, the data is compressed using gzip. 3 | 4 | ## How To 5 | Just call `serialize` on an object and a target stream, or `deserialize` on a source stream and an alist of discoveries. Currently only two discoveries are supported, for `'consumer`s and `'core`s. Each discovery entry is a cons of the type of discovery and a function that takes a single argument, the id. If no matching discovery is provided, the id is used instead of the full object. 6 | 7 | For everything else, see cl-store. 8 | -------------------------------------------------------------------------------- /clients/twitter/maiden-twitter.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-twitter 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Twitter client for Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "client") 13 | (:file "documentation")) 14 | :depends-on (:maiden-client-entities 15 | :chirp)) 16 | -------------------------------------------------------------------------------- /modules/api-access/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This is a very, very small system to help you with the common task of accessing an HTTP API. 3 | 4 | ## How To 5 | There's only two functions you'll really need directly from this, `request-as` and `json-v`. 6 | 7 | ``` 8 | (maiden-api-access:request-as 9 | :json "https://maps.googleapis.com/maps/api/geocode/json" 10 | :get `(("sensor" "false") ("address" "Hong Kong")) 11 | (values (list (json-v * "geometry" "location" "lat") 12 | (json-v * "geometry" "location" "lng")) 13 | (json-v * "address_components" 0 "long_name")) 14 | ``` 15 | 16 | And that's already pretty much all she wrote. 17 | -------------------------------------------------------------------------------- /clients/logger/maiden-logger.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-logger 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Primitive logging example client" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "client") 13 | (:file "documentation")) 14 | :depends-on (:maiden 15 | :maiden-client-entities)) 16 | -------------------------------------------------------------------------------- /modules/storage/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-storage 3 | (:nicknames #:org.shirakumo.maiden.modules.storage) 4 | (:use #:cl #:maiden) 5 | (:export 6 | #:config-pathname 7 | #:storage 8 | #:with-storage 9 | #:reload 10 | #:offload 11 | #:restore 12 | #:define-stored-accessor)) 13 | 14 | ;; re-export 15 | (let ((symbs '(ubiquitous:*storage* 16 | ubiquitous:value 17 | ubiquitous:remvalue 18 | ubiquitous:defaulted-value))) 19 | (import symbs '#:maiden-storage) 20 | (export symbs '#:maiden-storage)) 21 | 22 | (use-package '#:maiden-storage '#:maiden-user) 23 | -------------------------------------------------------------------------------- /agents/help/maiden-help.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-help 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Help system for the commands." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "help") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-client-entities 16 | :documentation-utils)) 17 | -------------------------------------------------------------------------------- /agents/vote/maiden-vote.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-vote 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Access information about URLs in Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "vote") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-client-entities 16 | :cl-ppcre)) 17 | -------------------------------------------------------------------------------- /modules/serialize/maiden-serialize.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-serialize 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Serialisation support for Maiden events." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "serialize") 13 | (:file "documentation")) 14 | :depends-on (:maiden 15 | :cl-store 16 | :gzip-stream)) 17 | -------------------------------------------------------------------------------- /agents/counter/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides simple, silly counter functionality. It detects messages by a regex and then increases a counter and replies with a message. 3 | 4 | ## How To 5 | There's several commands to manage the counters. 6 | 7 | ``` 8 | ::add counter foo \\bfoo|bar|baz|ban\\b "~a examples have been posted." 9 | ``` 10 | 11 | When a message is encountered that contains `foo`, `bar`, `baz`, or `ban`, the counter is increased and a response is given as specified above. Simple stuff. See the symbol index for the other commands. 12 | 13 | The command handler is an activatable handler, so it must be activated explicitly first. See [maiden-activatable](../activatable/). 14 | -------------------------------------------------------------------------------- /modules/storage/maiden-storage.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-storage 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Storage support for Maiden modules." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "storage") 13 | (:file "documentation")) 14 | :depends-on (:maiden 15 | :pathname-utils 16 | :ubiquitous-concurrent)) 17 | -------------------------------------------------------------------------------- /agents/relay/maiden-channel-relay.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-channel-relay 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Module to allow relaying messages from one channel to another." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "relay") 12 | (:file "documentation")) 13 | :depends-on (:maiden-commands 14 | :maiden-storage 15 | :maiden-client-entities)) 16 | -------------------------------------------------------------------------------- /agents/chatlog/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-chatlog 3 | (:nicknames #:org.shirakumo.maiden.agents.chatlog) 4 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 5 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 6 | ;; chatlog.lisp 7 | (:export 8 | #:chatlog 9 | #:activate 10 | #:activate-on 11 | #:deactivate 12 | #:deactivate-on 13 | #:initialize) 14 | ;; database.lisp 15 | (:export 16 | #:connection 17 | #:with-db 18 | #:prepared-statement 19 | #:initialize-database 20 | #:add-channel 21 | #:del-channel 22 | #:record-message 23 | #:process-back-queue 24 | #:maybe-record-message)) 25 | -------------------------------------------------------------------------------- /modules/api-access/maiden-api-access.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-api-access 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Serialisation support for Maiden events." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "toolkit") 13 | (:file "documentation")) 14 | :depends-on (:maiden 15 | :drakma 16 | :jsown 17 | :plump)) 18 | -------------------------------------------------------------------------------- /agents/core-manager/maiden-core-manager.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-core-manager 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Manage the core through an agent." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "core-manager") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-client-entities 16 | :maiden-storage)) 17 | -------------------------------------------------------------------------------- /modules/client-entities/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This is a Maiden subsystem to provide commonly used objects and methods that deal with entities usually found on clients that interact with remote systems-- particularly chat systems. If you are implementing a client, you will want to subclass the various classes provided by this system and flesh them out with the required functionality. If you are implementing an agent that should stay agnostic to the client it interacts with, you should handle the events and objects presented by this system. 3 | 4 | ## How To 5 | There's no particular "how to" for this. Read through the symbol index to see what's contained in here. What you should use and how should be fairly self-explanatory after that. 6 | -------------------------------------------------------------------------------- /agents/quicklisp/maiden-quicklisp.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-quicklisp 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Manage Quicklisp through Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "quicklisp") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-client-entities 16 | :quicklisp 17 | :legit)) 18 | -------------------------------------------------------------------------------- /clients/lichat/maiden-lichat.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-lichat 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Lichat client for Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "events") 13 | (:file "client") 14 | (:file "documentation")) 15 | :depends-on (:maiden-networking 16 | :maiden-client-entities 17 | :lichat-protocol)) 18 | -------------------------------------------------------------------------------- /agents/activatable/maiden-activatable.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-activatable 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Provide a handler type that can be activated on a per-channel basis." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "activatable") 13 | (:file "documentation")) 14 | :depends-on (:maiden 15 | :maiden-storage 16 | :maiden-commands)) 17 | -------------------------------------------------------------------------------- /agents/dictionary/maiden-dictionary.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-dictionary 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Performs dictionary lookups" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "dictionary") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-storage 16 | :maiden-client-entities 17 | :oxenfurt)) 18 | -------------------------------------------------------------------------------- /agents/throttle/maiden-throttle.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-throttle 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Module to allow throttling the number of commands a user can submit." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "throttle") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-storage 16 | :maiden-client-entities)) 17 | -------------------------------------------------------------------------------- /agents/time/maiden-time.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-time 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Retrieve global time information in Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "time") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-location 16 | :maiden-api-access 17 | :maiden-client-entities)) 18 | -------------------------------------------------------------------------------- /agents/location/maiden-location.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-location 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Handle location data with Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "location") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-storage 16 | :maiden-api-access 17 | :maiden-client-entities)) 18 | -------------------------------------------------------------------------------- /agents/relay/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.channel-relay) 2 | 3 | (docs:define-docs 4 | (type relay 5 | "Allows relaying messages from a remote channel.") 6 | (function mappings 7 | "Returns the hash table from source channels to target relay mappings.") 8 | (type mapping 9 | "Information about a relay mapping to another channel.") 10 | (function prefix-id 11 | "Whether to prefix the channel ID in the relay message.") 12 | (function prefix-user 13 | "Whether to prefix the username in the relay message.") 14 | (command activate 15 | "Start relaying messages from another channel visited by the bot.") 16 | (command deactivate 17 | "Stop relaying messages from a remote channel.")) 18 | -------------------------------------------------------------------------------- /agents/permissions/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-permissions 3 | (:nicknames #:org.shirakumo.maiden.agents.permissions) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-storage #:maiden-client-entities) 5 | ;; permissions.lisp 6 | (:export 7 | #:generate-token 8 | #:permission-denied 9 | #:user 10 | #:perm 11 | #:normalize-permission 12 | #:perm-match-p 13 | #:user-perm 14 | #:administrator-p 15 | #:add-administrator 16 | #:remove-administrator 17 | #:add-default-permission 18 | #:remove-default-permission 19 | #:allowed-p 20 | #:grant 21 | #:deny 22 | #:check-allowed 23 | #:with-permission 24 | #:permissions 25 | #:check-access 26 | #:administrate-self)) 27 | -------------------------------------------------------------------------------- /agents/blocker/maiden-blocker.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-blocker 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Module to allow blocking channels or users from issuing commands." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "blocker") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-storage 16 | :maiden-client-entities 17 | :cl-ppcre)) 18 | -------------------------------------------------------------------------------- /modules/client-entities/maiden-client-entities.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-client-entities 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Support for the concepts of users and channels." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "entities") 13 | (:file "clients") 14 | (:file "events") 15 | (:file "documentation")) 16 | :depends-on (:maiden 17 | :documentation-utils)) 18 | -------------------------------------------------------------------------------- /agents/lastfm/maiden-lastfm.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-lastfm 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "A last.fm interface for Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "interface") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-api-access 16 | :maiden-client-entities 17 | :maiden-storage 18 | :bordeaux-threads)) 19 | -------------------------------------------------------------------------------- /agents/notify/maiden-notify.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-notify 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "An offline notes system for Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "notes") 13 | (:file "interface") 14 | (:file "documentation")) 15 | :depends-on (:maiden-commands 16 | :maiden-storage 17 | :maiden-accounts 18 | :maiden-client-entities)) 19 | -------------------------------------------------------------------------------- /agents/medals/maiden-medals.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-medals 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Allows you to award \"medals\" to users in Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "medals") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-storage 16 | :maiden-accounts 17 | :maiden-client-entities 18 | :cl-ppcre)) 19 | -------------------------------------------------------------------------------- /agents/counter/maiden-counter.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-counter 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Module to add counters to user messages in Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "counter") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-storage 16 | :maiden-client-entities 17 | :maiden-activatable 18 | :cl-ppcre)) 19 | -------------------------------------------------------------------------------- /agents/permissions/maiden-permissions.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-permissions 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Permission management for maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "permissions") 13 | (:file "documentation")) 14 | :depends-on (:maiden-storage 15 | :maiden-commands 16 | :maiden-client-entities 17 | :documentation-utils 18 | :cl-ppcre)) 19 | -------------------------------------------------------------------------------- /modules/networking/maiden-networking.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-networking 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Mixin components to help with common networking tasks in Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "conditions") 13 | (:file "events") 14 | (:file "clients") 15 | (:file "documentation")) 16 | :depends-on (:maiden 17 | :cl+ssl 18 | :usocket)) 19 | -------------------------------------------------------------------------------- /agents/emoticon/maiden-emoticon.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-emoticon 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Module to add \"emoticons\" to user messages in Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "emoticon") 13 | (:file "documentation")) 14 | :depends-on (:maiden-activatable 15 | :maiden-commands 16 | :maiden-storage 17 | :maiden-client-entities 18 | :cl-ppcre)) 19 | -------------------------------------------------------------------------------- /agents/trivia/maiden-trivia.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-trivia 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Simple trivia game for Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "trivia") 13 | (:file "game") 14 | (:file "interface") 15 | (:file "documentation")) 16 | :depends-on (:maiden-commands 17 | :maiden-client-entities 18 | :maiden-storage 19 | :alexandria)) 20 | -------------------------------------------------------------------------------- /agents/urlinfo/maiden-urlinfo.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-urlinfo 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Access information about URLs in Maiden." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "urlinfo") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-activatable 16 | :maiden-client-entities 17 | :drakma 18 | :cl-ppcre 19 | :plump)) 20 | -------------------------------------------------------------------------------- /agents/markov/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-markov 3 | (:nicknames #:org.shirakumo.maiden.agents.markov) 4 | (:use #:cl #:maiden #:maiden-activatable #:maiden-commands #:maiden-storage #:maiden-client-entities) 5 | ;; generator.lisp 6 | (:export 7 | #:generator 8 | #:word 9 | #:word-index 10 | #:chain 11 | #:ensure-chain 12 | #:add-chain 13 | #:next-word-index 14 | #:random-token 15 | #:make-sentence 16 | #:find-sentence 17 | #:learn-sentence 18 | #:learn 19 | #:learn-from-file) 20 | ;; storage.lisp 21 | (:export 22 | #:read-generator 23 | #:write-generator) 24 | ;; interface.lisp 25 | (:export 26 | #:markov 27 | #:ramble 28 | #:ramble-about 29 | #:ramble-chance 30 | #:set-ramble-chance 31 | #:stats)) 32 | -------------------------------------------------------------------------------- /agents/talk/maiden-talk.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-talk 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Performs text-to-speech" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "codes") 13 | (:file "talk") 14 | (:file "documentation")) 15 | :defsystem-depends-on (:trivial-features) 16 | :depends-on (:maiden-commands 17 | :array-utils 18 | :drakma 19 | :cl-mixed-mpg123 20 | :harmony)) 21 | -------------------------------------------------------------------------------- /agents/accounts/maiden-accounts.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-accounts 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Account management agent for Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "conditions") 13 | (:file "account") 14 | (:file "fields") 15 | (:file "interface") 16 | (:file "documentation")) 17 | :depends-on (:maiden-storage 18 | :maiden-commands 19 | :maiden-client-entities)) 20 | -------------------------------------------------------------------------------- /agents/notify/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides notification messages, allowing users to write eachother reminders in case one should be temporarily unresponsive or offline. Notes will be persisted, and delivered to the target user as soon as it appears that they are responsive again. 3 | 4 | ## How To 5 | You can create a note to be delivered when the user next speaks, or when they next join a visible channel. 6 | 7 | ::notify SomeDude Hey man, where have you been? 8 | ::notify on join SomeDude Whoa, hello! Long time no see. 9 | 10 | The message will be delivered as soon as appropriate. If you already saw the message and don't want to be notified of them again, you can throw them away. 11 | 12 | ::forget notes 13 | 14 | And that's it. Naturally this interface is also available directly from the REPL. 15 | -------------------------------------------------------------------------------- /agents/weather/maiden-weather.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-weather 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Simple weather data access through forecast.io" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "weather") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-storage 16 | :maiden-location 17 | :maiden-api-access 18 | :maiden-client-entities 19 | :local-time)) 20 | -------------------------------------------------------------------------------- /agents/commands/maiden-commands.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-commands 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Command parsing and issuing module for Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "parsing") 13 | (:file "extraction") 14 | (:file "invocation") 15 | (:file "dispatch") 16 | (:file "documentation")) 17 | :depends-on (:lambda-fiddle 18 | :maiden 19 | :maiden-client-entities)) 20 | -------------------------------------------------------------------------------- /agents/chatlog/maiden-chatlog.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-chatlog 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "A chat logger to a Postgres database." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "database") 13 | (:file "chatlog") 14 | (:file "documentation")) 15 | :depends-on (:maiden-commands 16 | :maiden-storage 17 | :maiden-client-entities 18 | :postmodern 19 | :babel 20 | :bordeaux-threads)) 21 | -------------------------------------------------------------------------------- /clients/relay/maiden-relay.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-relay 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Relay client for Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "conditions") 13 | (:file "containers") 14 | (:file "events") 15 | (:file "virtual-client") 16 | (:file "relay") 17 | (:file "client") 18 | (:file "documentation")) 19 | :depends-on (:maiden-serialize 20 | :maiden-networking)) 21 | -------------------------------------------------------------------------------- /agents/silly/maiden-silly.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-silly 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Makes the bot have silly responses for various messages." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "silly") 13 | (:file "documentation")) 14 | :depends-on (:maiden-commands 15 | :maiden-activatable 16 | :maiden-api-access 17 | :maiden-client-entities 18 | :lquery 19 | :cl-ppcre 20 | :alexandria)) 21 | -------------------------------------------------------------------------------- /agents/markov/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This provides a fast and compact Markov chains implementation. Markov chains are stored efficiently in memory and on disk, allowing for huge dictionaries without loss of resources or performance. 3 | 4 | It also implements its own binary format in order to save the dictionary fast and compact. 5 | 6 | ## How To 7 | Create a `generator` instance, and train it with `learn` or `learn-from-file` 8 | 9 | (defvar *g* (make-instance 'generator)) 10 | (learn "Hey this is a sentence you can learn." *g*) 11 | (learn-from-file "~/king-james.txt" *g*) 12 | (learn-from-file "~/sicp.txt" *g*) 13 | (make-sentence *g*) 14 | (find-sentence *g* "lambda") 15 | 16 | You can also make it learn from a chat channel by activating the module on that channel. See [maiden-activatable](../activatable/) and the commands in the symbol index. 17 | -------------------------------------------------------------------------------- /agents/blocker/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides a facility to allow blocking and excluding channels, clients, users, or other parts from event or command processing. This is useful in case of spammers, or if some functionality does not provide an explicit kill switch, but must be turned off for a specific environment. 3 | 4 | ## How To 5 | Blocking happens over rules, which are a composition of clauses. The syntax is as most easily explained through some examples: 6 | 7 | ``` 8 | (channel "foo") 9 | (or (user "dios") (user "gott")) 10 | (and (prefix "::") (user "no-commands-user")) 11 | ``` 12 | 13 | Logical combinations can be made via `and`, `or`, and `not`. Tests can be made with `channel`, `client`, `user`, `regex`, and `prefix`. You can also define additional clauses for these rules using `define-clause`. 14 | 15 | Rules can also be defined and managed over the interface. 16 | -------------------------------------------------------------------------------- /clients/irc/maiden-irc.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-irc 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "IRC client for Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "events") 13 | (:file "commands") 14 | (:file "client") 15 | (:file "users") 16 | (:file "documentation")) 17 | :depends-on (:maiden-networking 18 | :maiden-client-entities 19 | :babel 20 | :cl-ppcre 21 | :form-fiddle 22 | :lambda-fiddle 23 | :cl-base64)) 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Yukari Hafner 2 | 3 | This software is provided 'as-is', without any express or implied 4 | warranty. In no event will the authors be held liable for any damages 5 | arising from the use of this software. 6 | 7 | Permission is granted to anyone to use this software for any purpose, 8 | including commercial applications, and to alter it and redistribute it 9 | freely, subject to the following restrictions: 10 | 11 | 1. The origin of this software must not be misrepresented; you must not 12 | claim that you wrote the original software. If you use this software 13 | in a product, an acknowledgment in the product documentation would be 14 | appreciated but is not required. 15 | 2. Altered source versions must be plainly marked as such, and must not be 16 | misrepresented as being the original software. 17 | 3. This notice may not be removed or altered from any source distribution. 18 | -------------------------------------------------------------------------------- /agents/activatable/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides handlers that can be de/activated on a per-client/channel basis. This means that handlers, which provide passive reactions not based on commands can be managed with this. 3 | 4 | ## How To 5 | In order to define a handler that can be de/activated, you must set `activatable-handler` as its superclass and pass the body option `:module`. An example, for a fictitious `beer` agent it might look as follows: 6 | 7 | ``` 8 | (define-handler (beer give-beer message-event) (c ev message) 9 | :class activatable-handler 10 | :module #.*package* 11 | (when (search "I'm thirsty" message) 12 | (reply ev "Have a beer! c(%)"))) 13 | ``` 14 | 15 | We're passing the file's package at read-time here, which is a bit more comfortable than passing the name of the package explicitly. Henceforth the handler can be de/activated using the appropriate functions or commands and the package name. 16 | -------------------------------------------------------------------------------- /agents/crimes/maiden-crimes.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-crimes 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Play Cards Against Humanity." 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "toolkit") 13 | (:file "cards") 14 | (:file "cardcast") 15 | (:file "game") 16 | (:file "interface") 17 | (:file "documentation")) 18 | :depends-on (:maiden-commands 19 | :maiden-client-entities 20 | :maiden-api-access 21 | :maiden-storage 22 | :alexandria 23 | :cl-ppcre)) 24 | -------------------------------------------------------------------------------- /agents/markov/maiden-markov.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-markov 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Markov chains for Maiden" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "generator") 13 | (:file "storage") 14 | (:file "interface") 15 | (:file "documentation")) 16 | :depends-on (:maiden-commands 17 | :maiden-activatable 18 | :maiden-client-entities 19 | :maiden-storage 20 | :alexandria 21 | :cl-ppcre 22 | :fast-io 23 | :babel 24 | :parse-number)) 25 | -------------------------------------------------------------------------------- /agents/lookup/maiden-lookup.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem maiden-lookup 2 | :version "0.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "An agent providing spec lookup functionality" 7 | :homepage "https://shinmera.com/docs/maiden/" 8 | :bug-tracker "https://shinmera.com/project/maiden/issues" 9 | :source-control (:git "https://shinmera.com/project/maiden.git") 10 | :serial T 11 | :components ((:file "package") 12 | (:file "lookup") 13 | (:file "parsers") 14 | (:file "archives") 15 | (:file "clhs") 16 | (:file "mop") 17 | (:file "shirakumo") 18 | (:file "interface") 19 | (:file "documentation")) 20 | :depends-on (:maiden-commands 21 | :maiden-api-access 22 | :maiden-client-entities 23 | :cl-ppcre 24 | :lquery 25 | :drakma)) 26 | -------------------------------------------------------------------------------- /agents/trivia/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-trivia 3 | (:nicknames #:org.shirakumo.maiden.agents.trivia) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities) 5 | ;; game.lisp 6 | (:export 7 | #:game 8 | #:channel 9 | #:questions 10 | #:question-time 11 | #:question-limit 12 | #:scores 13 | #:start 14 | #:end 15 | #:answer 16 | #:skip 17 | #:winner 18 | #:hint 19 | #:make-game) 20 | ;; interface.lisp 21 | (:export 22 | #:trivia 23 | #:start-game 24 | #:hint 25 | #:skip 26 | #:end-game 27 | #:add-question 28 | #:update-question 29 | #:remove-question 30 | #:add-categories 31 | #:remove-categories) 32 | ;; trivia.lisp 33 | (:export 34 | #:question 35 | #:text 36 | #:answers 37 | #:hint 38 | #:id 39 | #:check 40 | #:question 41 | #:category 42 | #:add-category 43 | #:remove-category 44 | #:categories 45 | #:add-question 46 | #:update-question 47 | #:remove-question 48 | #:load-questions 49 | #:save-questions)) 50 | -------------------------------------------------------------------------------- /agents/accounts/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-accounts 3 | (:nicknames #:org.shirakumo.maiden.agents.accounts) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities) 5 | (:shadow #:identity) 6 | ;; account.lisp 7 | (:export 8 | #:account 9 | #:identities 10 | #:password 11 | #:identity 12 | #:add-identity 13 | #:remove-identity 14 | #:identity-p 15 | #:account 16 | #:delete-account) 17 | ;; conditions.lisp 18 | (:export 19 | #:account-condition 20 | #:field-access-defnied 21 | #:no-account-for-identity 22 | #:account-not-found 23 | #:account-already-exists) 24 | ;; fields.lisp 25 | (:export 26 | #:field-info 27 | #:name 28 | #:access 29 | #:field-info 30 | #:remove-field-info 31 | #:define-fields 32 | #:access-p 33 | #:field) 34 | ;; interface.lisp 35 | (:export 36 | #:accounts 37 | #:login 38 | #:logout 39 | #:create 40 | #:destroy 41 | #:update-password 42 | #:associate 43 | #:deassociate 44 | #:field 45 | #:set-field 46 | #:test-authentication)) 47 | -------------------------------------------------------------------------------- /modules/client-entities/events.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.client-entities) 2 | 3 | (define-event user-event (client-event) 4 | ((user :initarg :user :initform (error "USER required.") :reader user))) 5 | 6 | (define-event user-removed (user-event) 7 | ()) 8 | 9 | (define-event user-added (user-event) 10 | ()) 11 | 12 | (define-event user-name-changed (user-event) 13 | ((old-name :initarg :old-name :initform (error "OLD-NAME required.") :reader old-name))) 14 | 15 | (define-event message-event (user-event) 16 | ((message :initarg :message :initform (error "MESSAGE required.") :accessor message :mutable T))) 17 | 18 | (defgeneric reply (event format-string &rest format-args)) 19 | 20 | (define-event channel-event (client-event) 21 | ((channel :initarg :channel :initform (error "CHANNEL required.") :reader channel))) 22 | 23 | (define-event user-entered (user-event channel-event) 24 | ()) 25 | 26 | (define-event user-left (user-event channel-event) 27 | ()) 28 | 29 | (defmethod reply ((event channel-event) fmst &rest args) 30 | (apply #'reply (channel event) fmst args)) 31 | -------------------------------------------------------------------------------- /agent.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden) 2 | 3 | (define-consumer agent () ()) 4 | 5 | (defmethod initialize-instance :after ((agent agent) &key) 6 | (unless (name agent) 7 | (setf (name agent) (class-name (class-of agent))))) 8 | 9 | (defmethod print-object ((agent agent) stream) 10 | (print-unreadable-object (agent stream :type T) 11 | (format stream "~@[~a ~]~a" 12 | (when (string/= (name agent) (class-name (class-of agent))) (name agent)) 13 | (id agent)))) 14 | 15 | (defmethod matches ((a agent) (b agent)) 16 | (eql (class-of a) (class-of b))) 17 | 18 | (defmethod matches ((a agent) (b symbol)) 19 | (or (call-next-method) 20 | (and (find-class b NIL) 21 | (typep a b)))) 22 | 23 | (defmethod matches ((a symbol) (b agent)) 24 | (matches b a)) 25 | 26 | (defmethod add-consumer :before ((agent agent) (core core)) 27 | (let ((existing (find (name agent) (consumers core) :test #'matches :key #'name))) 28 | (when (and existing (not (eql existing agent))) 29 | (error 'agent-already-exists-error :core core :agent agent :existing-agent existing)))) 30 | -------------------------------------------------------------------------------- /clients/lichat/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This is a client that enables using Maiden as a client for Lichat networks. 3 | 4 | ## How To 5 | In order to use this client, simply create an instance of `lichat-client`, add it to a core, and start it. You can use `add-to-core` to do so quickly. Upon construction, you will probably be interested in the following initargs: 6 | 7 | * `:username` The name to use on the server. The client's name defaults to the hostname. If you need to retrieve it from the core easily, or want to maintain multiple connections to the same host, you should also provide `:name`. 8 | * `:password` The password for use upon connection. Defaults to NIL. If your user has an account, you will need to set this to be able to connect. 9 | * `:host` The hostname of the server to connect to. 10 | * `:port` The port of the server to connect to. Defaults to 1111. 11 | 12 | All the Lichat replies and commands are present as events, and functions for the latter, in the `org.shirakumo.maiden.clients.lichat.rpl` and `org.shirakumo.maiden.clients.lichat.cmd` packages, which are nicknamed to `lichat-rpl` and `lichat-cmd` respectively. 13 | -------------------------------------------------------------------------------- /agents/core-manager/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.core-manager) 2 | 3 | (docs:define-docs 4 | (type core-manager 5 | "This agent handles the management of consumers on the bot's core. Specifically it allows adding, removing, starting, and stopping consumers.") 6 | 7 | (command start-consumer 8 | "Start an existing consumer of the given name on the current core.") 9 | 10 | (command stop-consumer 11 | "Stop an existing consumer of the given name on the current core.") 12 | 13 | (command remove-consumer 14 | "Completely remove an existing consumer of the given name from the current core.") 15 | 16 | (command add-consumer 17 | "Create and add a new consumer to the current core.") 18 | 19 | (command list-consumers 20 | "Show a list of all consumers on the current core by their names or IDs.") 21 | 22 | (command stop-core 23 | "Stop the current core completely. Note that this will effectively shut down the bot, but not the lisp instance.") 24 | 25 | (command reload 26 | "Reload the bot configuration files lazily by clearing out the internal configuration cache.")) 27 | -------------------------------------------------------------------------------- /modules/serialize/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.serialize) 2 | 3 | ;; serialize.lisp 4 | (docs:define-docs 5 | (variable *finders* 6 | "Association list tying a \"type\" to a function that can resolve an instance of that \"type\" from an ID. 7 | 8 | See FIND-INSTANCE") 9 | 10 | (variable *event-code* 11 | "The CL-STORE code assigned to events.") 12 | 13 | (variable *core-code* 14 | "The CL-STORE code assigned to cores.") 15 | 16 | (variable *consumer-code* 17 | "The CL-STORE code assigned to consumers.") 18 | 19 | (variable *footer-buffer* 20 | "The buffer to store the gzip footer in.") 21 | 22 | (function find-instance 23 | "Attempts to resolve the ID of the given \"type\" to an instance using the finders. 24 | 25 | See *FINDERS*") 26 | 27 | (function serialize 28 | "Serialize the given object to the given target stream. 29 | 30 | The data is serialized, GZIP compressed, and then put to the stream.") 31 | 32 | (function deserialize 33 | "Deserialize an object from the given stream. 34 | 35 | FINDERS must be a suitable alist that can find COREs and CONSUMERs by their ID. 36 | 37 | See FIND-INSTANCE")) 38 | -------------------------------------------------------------------------------- /agents/medals/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.medals) 2 | 3 | (docs:define-docs 4 | (function maybe-account 5 | "Attempts to find an account of the given name. 6 | 7 | See MAIDEN-ACCOUNTS:ACCOUNT") 8 | 9 | (function user-name 10 | "Attempts to find the user-name of the thing. 11 | 12 | Accepts USER, STRING, SYMBOL.") 13 | 14 | (function medals 15 | "Accessor to the medals carried by the user of the given name. 16 | 17 | If the user has an account, the account's 18 | name is used for the storage instead. 19 | 20 | See MAYBE-ACCOUNT") 21 | 22 | (function add-medals 23 | "Adds the given medals to the user of the given name. 24 | 25 | See MEDALS") 26 | 27 | (function remove-medals 28 | "Remove the given medals from the user of the given name. 29 | 30 | See MEDALS") 31 | 32 | (type medals 33 | "This implements a simple 'medal' system, where users can be awarded random medals.") 34 | 35 | (command show 36 | "Displays the awarded medals for a user or yourself.") 37 | 38 | (command award 39 | "Award medals to a user. The medals can be literally anything.") 40 | 41 | (command take 42 | "Take away medals from a user.")) 43 | -------------------------------------------------------------------------------- /agents/commands/staple.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | 3 | (defclass symb-command (staple:symb-function) 4 | ()) 5 | 6 | (defmethod staple:symb-name ((symb symb-command)) 7 | (maiden-commands:prefix 8 | (maiden-commands:command-invoker (slot-value symb 'symbol)))) 9 | 10 | (defmethod staple:symb-function ((symb symb-command)) 11 | (maiden-commands::invoker 12 | (maiden-commands:command-invoker (slot-value symb 'symbol)))) 13 | 14 | (defmethod staple:symb-documentation ((symb symb-command)) 15 | (documentation (slot-value symb 'symbol) 'maiden-commands:command)) 16 | 17 | (defmethod staple:symb-arguments ((symb symb-command)) 18 | (maiden-commands::lambda-list 19 | (maiden-commands:command-invoker (slot-value symb 'symbol)))) 20 | 21 | (defmethod staple:symb-type-order ((symb (eql 'symb-command))) 22 | (1+ (staple:symb-type-order 'symb-function))) 23 | 24 | (defun command-invoker-p (symbol) 25 | ) 26 | 27 | (staple:define-converter symb-command (symbol package) 28 | (when (and (eql :external (nth-value 1 (find-symbol (string symbol) package))) 29 | (maiden-commands:command-invoker symbol)) 30 | (list (make-instance 'symb-command :symbol symbol :package package)))) 31 | -------------------------------------------------------------------------------- /modules/client-entities/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-client-entities 3 | (:nicknames #:org.shirakumo.maiden.modules.client-entities) 4 | (:use #:cl #:maiden) 5 | ;; clients.lisp 6 | (:export 7 | #:user-client 8 | #:username 9 | #:find-user 10 | #:authenticate 11 | #:channel-client 12 | #:find-channel 13 | #:user-container 14 | #:user-map 15 | #:remove-channel 16 | #:channel-container 17 | #:channel-map 18 | #:remove-user 19 | #:simple-user-channel-client 20 | #:simple-user 21 | #:simple-channel) 22 | ;; entities.lisp 23 | (:export 24 | #:client-entity 25 | #:client 26 | #:user 27 | #:username 28 | #:authenticated 29 | #:ensure-user 30 | #:authenticated-p 31 | #:channels 32 | #:channel 33 | #:ensure-channel 34 | #:users) 35 | ;; events.lisp 36 | (:export 37 | #:user-event 38 | #:user 39 | #:user-removed 40 | #:user-added 41 | #:user-name-changed 42 | #:message-event 43 | #:message 44 | #:reply 45 | #:channel-event 46 | #:channel 47 | #:old-topic 48 | #:user-entered 49 | #:user-left)) 50 | 51 | (use-package '#:maiden-client-entities '#:maiden-user) 52 | -------------------------------------------------------------------------------- /agents/lookup/interface.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.lookup) 2 | 3 | (define-consumer lookup (agent) 4 | ()) 5 | 6 | (define-command (lookup look-up) (c ev archive &string term) 7 | :command "look up" 8 | (let* ((matches (look-up archive term)) 9 | (exact (or (find term matches :key #'first :test #'string-equal) 10 | (unless (cdr matches) (first matches))))) 11 | (if exact 12 | (destructuring-bind (match url &optional title) exact 13 | (declare (ignore match)) 14 | (reply ev "~@[~@(~a~) ~]~a" title url)) 15 | (reply ev "Found: ~{~a~^, ~}" (mapcar #'first matches))))) 16 | 17 | (define-command (lookup archive-list) (c ev) 18 | :command "list archives" 19 | (reply ev "Known archives: ~{~(~a~)~^, ~}" (sort (list-archives) #'string<))) 20 | 21 | (defmacro define-shorthand-command (name &key (archive (string name)) (command (string name))) 22 | `(define-command (lookup ,name) (c ev &string term) 23 | :command ,command 24 | (issue (make-instance 'look-up :term term :archive ,(string archive) :dispatch-event ev) 25 | (core ev)))) 26 | 27 | (define-shorthand-command clhs) 28 | (define-shorthand-command mop) 29 | -------------------------------------------------------------------------------- /maiden.asd: -------------------------------------------------------------------------------- 1 | (pushnew :deeds-no-startup *features*) 2 | 3 | (asdf:defsystem maiden 4 | :version "3.1.0" 5 | :license "zlib" 6 | :author "Yukari Hafner " 7 | :maintainer "Yukari Hafner " 8 | :description "A modern and extensible chat bot framework." 9 | :homepage "https://shinmera.com/docs/maiden/" 10 | :bug-tracker "https://shinmera.com/project/maiden/issues" 11 | :source-control (:git "https://shinmera.com/project/maiden.git") 12 | :serial T 13 | :components ((:file "package") 14 | (:file "toolkit") 15 | (:file "conditions") 16 | (:file "event") 17 | (:file "standard-events") 18 | (:file "entity") 19 | (:file "consumer") 20 | (:file "core") 21 | (:file "agent") 22 | (:file "client") 23 | (:file "documentation")) 24 | :depends-on (:deeds 25 | :verbose 26 | :trivial-garbage 27 | :bordeaux-threads 28 | :closer-mop 29 | :uuid 30 | :form-fiddle 31 | :lambda-fiddle 32 | :documentation-utils 33 | :trivial-indent)) 34 | -------------------------------------------------------------------------------- /modules/api-access/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.api-access) 2 | 3 | (docs:define-docs 4 | (function construct-url 5 | "Construct an URL with GET parameters properly encoded into it. 6 | 7 | See DRAKMA:URL-ENCODE") 8 | 9 | (function request 10 | "Perform an HTTP request. 11 | 12 | The URL is preserved as-is, and no encoding is performed on it. 13 | You will have to make sure each URL character is already encoded 14 | as necessary. GET and POST parameters are however encoded as 15 | expected for a request. 16 | 17 | See REQUEST-AS") 18 | 19 | (function parse-to 20 | "Attempt to parse the input string to a certain type of data. 21 | 22 | TYPE can be one of 23 | - :STRING Just return the input again. 24 | - :JSON Parse the input into a JSON object. 25 | - :HTML :XML Parse the input into a DOM. 26 | - :SEXP Parse the input as a SEXP. 27 | 28 | See JSOWN:PARSE 29 | See PLUMP:PARSE 30 | See CL:READ-FROM-STRING") 31 | 32 | (function request-as 33 | "Perform an HTTP request and parse the data into the requested format. 34 | 35 | See REQUEST 36 | See PARSE-TO") 37 | 38 | (function json-v 39 | "Easily access a value in a JSON object as parsed by JSOWN. 40 | 41 | See PARSE-TO")) 42 | -------------------------------------------------------------------------------- /agents/location/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.location) 2 | 3 | (docs:define-docs 4 | (variable *geocode-api* 5 | "Address of the google maps geocode API.") 6 | 7 | (function geo-information 8 | "Retrieve geolocation information about the given location. 9 | 10 | Errors are signalled in the following cases: 11 | - No results could be found for the location 12 | - You exceeded the maximum number of queries allowed 13 | - Some other failure on behalf of the Google API. 14 | 15 | See *GEOCODE-API*") 16 | 17 | (function coordinates 18 | "Return the coordinates of a location. 19 | 20 | Returns two values: 21 | - A list of the latitude and longitude of the location 22 | - The long name of the resolved address of the location 23 | 24 | See GEO-INFORMATION") 25 | 26 | (function address 27 | "Attempt to find the closes address for the location. 28 | 29 | See GEO-INFORMATION") 30 | 31 | (type location 32 | "This agent helps with location information such as geocoding using the Google Maps API.") 33 | 34 | (command query-address 35 | "Try to discover the actual address of an approximate location.") 36 | 37 | (command query-coordinates 38 | "Attempt to find the latitude and longitude coordinates of the location.")) 39 | -------------------------------------------------------------------------------- /agents/trivia/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent provides a simple trivia game for players in a chat channel. It also allows players to create, edit, and manage the existing questions in the system. Unfortunately, due to it being seemingly impossible to find a machine-readable, high-quality, free set of trivia questions on the internet, no standard set of questions is included in this library. 3 | 4 | ## How To 5 | Start a new trivia game by selecting a set of categories for the questions to use. 6 | 7 | ::start trivia game science technology 8 | 9 | It should not show a first question. If someone in the channel answers the question correctly, they will be awarded points, and the next question is shown. If they are quick enough, they get a time bonus. If nobody manages to answer the question correctly, you can request a hint. 10 | 11 | ::hint answer 12 | 13 | Not all questions include a hint however, and not all hints may be sufficiently indicative of the correct answer. You can also skip the question entirely. 14 | 15 | ::skip question 16 | 17 | Finally, the game ends when all questions have been answered, or when it is ended explicitly. 18 | 19 | :end trivia game 20 | 21 | At the end the winner is announced. 22 | 23 | See the rest of the commands on how to manage the questions. 24 | -------------------------------------------------------------------------------- /agents/silly/songs.txt: -------------------------------------------------------------------------------- 1 | Here's to you Nicola and Bart, rest forever here in our hearts 2 | I give my life, not for honor, but for you, snake eater 3 | Where did you come from, where did you go? Where did you come from, Cotton-Eye Joe? 4 | And you may find yourself living in a shotgun shack, and you may find yourself in another part of the world 5 | And you may ask yourself, "Am I right, am I wrong?", and you may say to yourself, "My God, what have I done?" 6 | Same as it ever was, same as it ever was 7 | I'm nuclear, I'm wild, I'm breaking up inside 8 | You're face to face with the man who sold the world 9 | Just wanna play video games, everything else is really lame 10 | All this pain reminds me of what I am, I'll live, I'll become all I need to be 11 | Woa hoooooooooooooo 12 | Shevalin, nie miosa 13 | This is my escape, I'm running through this world, and I'm not looking back 14 | I'm a god, how can you kill a god? What a grand and intoxicating innocence 15 | And they run when the sun comes up, with their lives on the line, aliiiiiiiiiiiiiiive 16 | When the sun sets, we will not forget the, red sun over paradise 17 | You're the best around, nothing's gonna ever keep you down 18 | Country roads, take me home 19 | Game over yeaaaah 20 | Go go go go go galo sengen! 21 | How could this happen to me? 22 | Pam pa ram, pampam pa raaam, pampa raaam 23 | -------------------------------------------------------------------------------- /agents/help/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.help) 2 | 3 | (docs:define-docs 4 | (type help 5 | "This agent provides generic help commands that should provide information for the user and help in discovering the system interactively.") 6 | 7 | (function find-consumer 8 | "Attempt to find a consumer on the core that matches the name somehow.") 9 | 10 | (command about 11 | "This is the generic interface for the help system. Depending on what it finds for the term, it dispatches to other help commands.") 12 | 13 | (command about-self 14 | "This displays a blurb that describes some information about the bot and its current status.") 15 | 16 | (command about-uptime 17 | "This displays information about the running time of the bot.") 18 | 19 | (command about-command 20 | "This displays available information about a command that the bot supports.") 21 | 22 | (command list-consumers 23 | "List all the consumers (systems) that are running on the bot.") 24 | 25 | (command about-consumer 26 | "This displays documentation information about a consumer (system) that's running on the bot.") 27 | 28 | (command about-term 29 | "This searches for a command that approximately matches the given term. It displays a list of up to ten matches, in decreasing order of similarity.")) 30 | -------------------------------------------------------------------------------- /agents/commands/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-commands 3 | (:nicknames #:org.shirakumo.maiden.agents.commands) 4 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 5 | (:use #:cl #:maiden #:maiden-client-entities) 6 | ;; dispatch.lisp 7 | (:export 8 | #:commands) 9 | ;; extraction.lisp 10 | (:export 11 | #:command-extractor 12 | #:remove-command-extractor 13 | #:define-command-extractor 14 | #:extract-command 15 | #:command-p 16 | #:prefix) 17 | ;; invocation.lisp 18 | (:export 19 | #:framework-message 20 | #:issue-message 21 | #:command-event 22 | #:public 23 | #:dispatch-event 24 | #:relay 25 | #:command-invoker 26 | #:name 27 | #:docstring 28 | #:invoker 29 | #:lambda-list 30 | #:remove-command-invoker 31 | #:list-command-invokers 32 | #:find-command-invoker 33 | #:define-command-invoker 34 | #:command 35 | #:define-simple-command-invoker 36 | #:define-command 37 | #:remove-command 38 | #:consumer-commands 39 | #:find-matching-command) 40 | ;; parsing.lisp 41 | (:export 42 | #:&string 43 | #:command-condition 44 | #:lexing-error 45 | #:expected-key-error 46 | #:destructuring-error 47 | #:not-enough-arguments-error 48 | #:too-many-arguments-error 49 | #:with-command-destructuring-bind)) 50 | -------------------------------------------------------------------------------- /agents/accounts/conditions.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.accounts) 2 | 3 | (define-condition account-condition (condition) ()) 4 | 5 | (define-condition field-access-denied (account-condition error) 6 | ((user :initarg :user) 7 | (field :initarg :field) 8 | (account :initarg :account)) 9 | (:report (lambda (c s) (format s "~a is not permitted to access the field ~a on ~a." 10 | (name (slot-value c 'user)) 11 | (slot-value c 'field) 12 | (name (slot-value c 'account)))))) 13 | 14 | (define-condition no-account-for-identity (account-condition error) 15 | ((identity :initarg :identity)) 16 | (:report (lambda (c s) (format s "The identity ~s does not have any account associated with it." 17 | (slot-value c 'identity))))) 18 | 19 | (define-condition account-not-found (account-condition error) 20 | ((name :initarg :name)) 21 | (:report (lambda (c s) (format s "No account with name ~s found." 22 | (slot-value c 'name))))) 23 | 24 | (define-condition account-already-exists (account-condition error) 25 | ((name :initarg :name)) 26 | (:report (lambda (c s) (format s "An account with the name ~s already exists." 27 | (slot-value c 'name))))) 28 | -------------------------------------------------------------------------------- /modules/storage/README.md: -------------------------------------------------------------------------------- 1 | ## About Maiden-Storage 2 | This offers convenient persistent and thread-safe storage for Maiden components. 3 | 4 | ## How To 5 | For the most part you will want to refer to [Ubiquitous](http://shinmera.github.io/ubiquitous/) for docs, since that is the underlying system used for persistence and storage management. 6 | 7 | Time for a simple example. 8 | 9 | (maiden:define-consumer tester () ()) 10 | 11 | The `with-storage` macro takes care of establishing the proper context where the storage is accessible through `value`. 12 | 13 | (maiden:define-instruction (tester write-storage) (c ev field value) 14 | (maiden-storage:with-storage (c) 15 | (setf (maiden-storage:value field) value))) 16 | 17 | (maiden:define-query (tester read-storage) (c ev field) 18 | (maiden-storage:with-storage (c) 19 | (maiden-storage:value field))) 20 | 21 | Let's construct a test case. 22 | 23 | (defvar *core* (maiden:make-simple-core 'tester)) 24 | 25 | (write-storage *core* :test "Hey!") 26 | (read-storage *core* :test) 27 | 28 | As apparent, the access works as intended. Just to make sure things are also persisted to disk, let's check that out. 29 | 30 | (alexandria:read-file-into-string (ubiquitous:designator-pathname 'tester :lisp)) 31 | 32 | And sure enough the file is filled with the info we stored. 33 | -------------------------------------------------------------------------------- /clients/irc/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This is a client that enables using Maiden as a client for IRC networks. It does its best to provide all possible IRC commands and replies, but may still be missing a few exotic ones. With a bit of work, it could also be used as the basis for an IRC server. 3 | 4 | ## How To 5 | In order to use this client, simply create an instance of `irc-client`, add it to a core, and start it. You can use `add-to-core` to do so quickly. Upon construction, you will probably be interested in the following initargs: 6 | 7 | * `:nickname` The nickname to use on the server. The client's name defaults to the hostname. If you need to retrieve it from the core easily, or want to maintain multiple connections to the same host, you should also provide `:name`. 8 | * `:username` The IRC username. Defaults to `(machine-instance)`. 9 | * `:realname` The IRC realname. Defaults to `(machine-instance)`. 10 | * `:password` The password for use upon connection. Defaults to NIL. Most networks don't use this feature anyway. 11 | * `:host` The hostname of the server to connect to. 12 | * `:port` The port of the server to connect to. Defaults to 6667. 13 | * `:services-password` The password to use to identify with the NickServ on the servers. 14 | 15 | All the IRC replies and commands are present as events, and functions for the latter, in the `org.shirakumo.maiden.clients.irc.events` package, which is nicknamed to `irc`. 16 | -------------------------------------------------------------------------------- /agents/emoticon/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.emoticon) 2 | 3 | (docs:define-docs 4 | (function emoticon 5 | "Accessor to the emoticon of the given name. 6 | 7 | The value should be the response string for the emote. 8 | 9 | See REMOVE-EMOTICON 10 | See LIST-EMOTICONS") 11 | 12 | (function remove-emoticon 13 | "Remove the emoticon of the given name from the system. 14 | 15 | See EMOTICON 16 | See LIST-EMOTICONS") 17 | 18 | (function list-emoticons 19 | "Return a fresh list of all emoticons that are saved on the system. 20 | 21 | See EMOTICON 22 | See REMOVE-EMOTICON") 23 | 24 | (function maximum 25 | "Accessor to the maximum number of emoticons that are expanded in a single message. 26 | 27 | Defaults to 5. 28 | 29 | See EMOTICON") 30 | 31 | (type emoticon 32 | "This agent provides 'emoticons' as seen on forums. Emoticons are tokens like :this: that the bot replies to with a saved response. This can also serve as a convenient shortcut mechanism.") 33 | 34 | (command add 35 | "Add a new emoticon mapping. If you want your name or emoticon text to contain spaces or such, supply it as a string encased in double-quotes.") 36 | 37 | (command change 38 | "Change the reply for an emoticon mapping.") 39 | 40 | (command remove 41 | "Remove an existing emoticon mapping.") 42 | 43 | (command list 44 | "List the names of all available emoticon mappings.")) 45 | -------------------------------------------------------------------------------- /agents/commands/extraction.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.commands) 2 | 3 | (defvar *extractors* ()) 4 | 5 | (defun command-extractor (name) 6 | (cdr (assoc name *extractors*))) 7 | 8 | (defun (setf command-extractor) (function name) 9 | (update-list (cons name function) *extractors* :key #'car)) 10 | 11 | (defun remove-command-extractor (name) 12 | (setf *extractors* (remove name *extractors* :key #'car))) 13 | 14 | (defmacro define-command-extractor (name (event) &body body) 15 | `(progn (setf (command-extractor ',name) 16 | (lambda (,event) 17 | ,@body)) 18 | ',name)) 19 | 20 | (defmethod extract-command ((event message-event)) 21 | (loop for extractor in *extractors* 22 | thereis (funcall (cdr extractor) event))) 23 | 24 | (defmethod command-p ((event message-event)) 25 | (not (null (extract-command event)))) 26 | 27 | (define-command-extractor prefix (event) 28 | (when (starts-with "::" (message event)) 29 | (subseq (message event) 2))) 30 | 31 | (define-command-extractor username (event) 32 | (let* ((msg (string-left-trim "@" (message event))) 33 | (username (username (client event))) 34 | (length (length username))) 35 | (when (and (< (1+ length) (length msg)) 36 | (string-equal msg username :end1 length) 37 | (find (aref msg length) ":,：、")) 38 | (string-left-trim " 　" (subseq msg (1+ length)))))) 39 | -------------------------------------------------------------------------------- /agents/permissions/README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | This agent implements a permissions system, allowing you to specify more finely-grained who gets to do what. 3 | 4 | ## How To 5 | After adding the agent to the core, you'll first want to call `generate-token`, which will return you a new administrator authentication token. You should then use this token in the network/client you want to become administrator on like so: 6 | 7 | ::upgrade to administrator dadwa213185233231... 8 | 9 | Note that you will have to repeat this step for every client, unless you also have an [account](../accounts/) set up that does the tracking for you. From there on out you can check access to commands and grant people rights, or deny them explicitly. 10 | 11 | Permissions are modelled as lists of tokens, which form trees. Each token defines a "subtree" that is either granted or denied. In order to specify a denying permission, simply prefix the first token with a bang. Users are also denoted by such permission lists, where the list starts with the user's name, followed by the client's name, followed by its class description. Thus you can increasingly finely grant a specific user, or all users with that name permissions. 12 | 13 | Beware of simply blanket-granting just a username permissions, though. Some clients cannot always guarantee the authenticity of a username, and it isn't guaranteed that the same username denotes the same individual over different networks anyway. 14 | 15 | See the symbol index for the possible commands available to manage permissions. 16 | -------------------------------------------------------------------------------- /modules/client-entities/entities.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.client-entities) 2 | 3 | (defclass client-entity (named-entity) 4 | ((client :initarg :client :accessor client)) 5 | (:default-initargs 6 | :client (error "CLIENT required."))) 7 | 8 | (defmethod matches ((a client-entity) (b client-entity)) 9 | (and (call-next-method) 10 | (eql (client a) (client b)))) 11 | 12 | (defclass user (client-entity data-entity) 13 | ((authenticated :initarg :authenticated))) 14 | 15 | (defmethod username ((user user)) 16 | (name user)) 17 | 18 | (defmethod (setf username) (name (user user)) 19 | (setf (name user) name)) 20 | 21 | (defmethod ensure-user ((user user) client) 22 | user) 23 | 24 | (defmethod authenticated-p ((user user)) 25 | (if (slot-boundp user 'authenticated) 26 | (slot-value user 'authenticated) 27 | (setf (slot-value user 'authenticated) 28 | (authenticate user (client user))))) 29 | 30 | (defmethod authenticate :around ((user user) client) 31 | (let ((value (call-next-method))) 32 | (setf (slot-value user 'authenticated) value))) 33 | 34 | ;; Shitty default implementation 35 | (defmethod channels ((user user)) 36 | (when (typep (client user) 'channel-client) 37 | (loop for channel in (channels (client user)) 38 | when (find user (users channel)) collect channel))) 39 | 40 | (defclass channel (client-entity) 41 | ()) 42 | 43 | (defmethod ensure-channel ((channel channel) client) 44 | channel) 45 | 46 | (defmethod users ((channel channel)) 47 | ()) 48 | -------------------------------------------------------------------------------- /agents/counter/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.counter) 2 | 3 | (docs:define-docs 4 | (function counter 5 | "Direct accessor to the counter storage. 6 | 7 | A counter is a plist of the following keys: 8 | - :NAME The name of the counter 9 | - :MATCH The regex that matches an applicable message. 10 | - :RESPONSE The response string to use when a message matches. Should be a format string that contains a single placeholder that is filled with the current counter value. 11 | - :COUNT The actual counter value of how many times the counter was invoked. 12 | 13 | See REMOVE-COUNTER 14 | See LIST-COUNTERS 15 | See SET-COUNTER") 16 | 17 | (function remove-counter 18 | "Remove a counter from the storage. 19 | 20 | See COUNTER 21 | See LIST-COUNTERS") 22 | 23 | (function list-counters 24 | "Return a list of all the counters in the storage. 25 | 26 | See COUNTER 27 | See REMOVE-COUNTER") 28 | 29 | (function set-counter 30 | "More conveniently update or create a counter in the storage. 31 | 32 | See COUNTER") 33 | 34 | (type counter 35 | "This agent provides a simple regex based matcher that increases a counter every time it sees a matching message.") 36 | 37 | (command add 38 | "Add a new counter. MATCH should be a regular expression. RESPONSE, if specified, is the message displayed when the counter matches.") 39 | 40 | (command change 41 | "Update an existing counter definition.") 42 | 43 | (command remove 44 | "Remove an existing counter definition.") 45 | 46 | (command list 47 | "List the names of all existing counter definitions.")) 48 | -------------------------------------------------------------------------------- /agents/commands/README.md: -------------------------------------------------------------------------------- 1 | ## Maiden-Commands 2 | This agent is responsible for catching `message-event`s and turning them into `command-event`s if apropriate. It also gives you the `define-command` macro to define user-invokable commands with. 3 | 4 | ## How To 5 | In order to define a command, use `define-command`, which will generate a matching event, function, and handler for you, similar to `define-instruction`. It will also create the appropriate translation for you through `define-command-invoker`. 6 | 7 | First, let's create a consumer and add a command to it. 8 | 9 | (maiden:define-consumer tester () ()) 10 | 11 | (maiden-commands:define-command (tester greet) (instance event name &optional greeting) 12 | (maiden:reply event "~a, ~a" (or greeting "Hello") name)) 13 | 14 | Now we have to create a test environment for us to work with. 15 | 16 | (defvar *core* (maiden:make-simple-core 'maiden-commands:commands 'tester)) 17 | 18 | We can now call the command as a function. 19 | 20 | (greet *core* "someone") 21 | 22 | Or through a message that is recognised as a command. 23 | 24 | (maiden-commands:issue-message *core* "::greet you") 25 | 26 | In order for the latter to work, the `commands` agent must be present on the core. 27 | 28 | You can manipulate what is recognised as a command message through the extractors. Calling `remove-command-extractor` on `prefix` will stop the double-colons from being recognised as a command prefix. You can add arbitrary functions that do what you want through `define-command-extractor`. The function should return the substring of the event's message that contains the actual command, or `NIL` if it is not a command message. 29 | -------------------------------------------------------------------------------- /agents/commands/dispatch.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.commands) 2 | 3 | (define-consumer commands (agent) 4 | ()) 5 | 6 | (define-handler (commands processor (and message-event passive-event)) (c ev message) 7 | (unless (matches (username (client ev)) (user ev)) 8 | (let ((command (extract-command ev))) 9 | (when command 10 | (multiple-value-bind (match alternatives) (find-matching-command command) 11 | (cond ((not (null match)) 12 | (handler-case 13 | (handler-bind ((error #'maybe-invoke-debugger)) 14 | (funcall (invoker match) ev (if (= (length command) (length (prefix match))) 15 | "" (subseq command (1+ (length (prefix match))))))) 16 | (command-condition (err) 17 | (reply ev "Invalid command: ~a" err)) 18 | (error (err) 19 | (reply ev "Unexpected error: ~a" err)))) 20 | ((null alternatives) 21 | (reply ev "I don't know what you mean.")) 22 | (T 23 | (setf alternatives (sort alternatives #'compare-alternatives)) 24 | (reply ev "Unknown command. Possible matches: ~10{~a~^, ~}" 25 | (mapcar #'prefix (mapcar #'cdr alternatives)))))))))) 26 | 27 | (defun compare-alternatives (a b) 28 | (let ((a-distance (car a)) 29 | (a-length (length (prefix (cdr a)))) 30 | (b-distance (car b)) 31 | (b-length (length (prefix (cdr b))))) 32 | (or (< a-distance b-distance) 33 | (and (= a-distance b-distance) 34 | (< b-length a-length))))) 35 | -------------------------------------------------------------------------------- /clients/relay/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-relay 3 | (:nicknames #:org.shirakumo.maiden.clients.relay) 4 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 5 | (:use #:cl #:maiden #:maiden-serialize #:maiden-networking) 6 | ;; client.lisp 7 | (:export 8 | #:relay-client 9 | #:remote 10 | #:process) 11 | ;; conditions.lisp 12 | (:export 13 | #:relay-condition 14 | #:carrier-condition 15 | #:message 16 | #:target-condition 17 | #:target 18 | #:no-relay-target-specified 19 | #:relay-route-not-found 20 | #:relay-link-not-found 21 | #:client-version-mismatch 22 | #:remote-version) 23 | ;; containers.lisp 24 | (:export 25 | #:subscription-update 26 | #:target 27 | #:subscriber 28 | #:subscription 29 | #:event-type 30 | #:filter 31 | #:unsubscription 32 | #:network-update 33 | #:new 34 | #:bad 35 | #:make-network-update 36 | #:transport 37 | #:make-transport) 38 | ;; events.lisp 39 | (:export 40 | #:relay-instruction-event 41 | #:data-response-event 42 | #:source 43 | #:response-event 44 | #:response 45 | #:slot-event 46 | #:slot 47 | #:object 48 | #:slot-value-event 49 | #:slot-setf-event 50 | #:slot-makunbound-event 51 | #:slot-boundp-event 52 | #:generic-call-event 53 | #:form) 54 | ;; relay.lisp 55 | (:export 56 | #:relay 57 | #:subscriptions 58 | #:my-subscriptions 59 | #:routable-p 60 | #:update 61 | #:relay 62 | #:connect 63 | #:subscribe 64 | #:unsubscribe) 65 | ;; virtual-client.lisp 66 | (:export 67 | #:virtual-client 68 | #:links 69 | #:make-virtual-client 70 | #:define-virtual-client-method)) 71 | -------------------------------------------------------------------------------- /conditions.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden) 2 | 3 | (define-condition maiden-condition (condition) 4 | ()) 5 | 6 | (define-condition core-condition (maiden-condition) 7 | ((core :initarg :core :reader core)) 8 | (:default-initargs :core (error "CORE required."))) 9 | 10 | (define-condition consumer-name-duplicated-warning (core-condition warning) 11 | ((existing-consumer :initarg :existing-consumer :reader existing-consumer) 12 | (new-consumer :initarg :new-consumer :reader new-consumer)) 13 | (:default-initargs 14 | :existing-consumer (error "EXISTING-CONSUMER required.") 15 | :new-consumer (error "NEW-CONSUMER required.")) 16 | (:report (lambda (c s) (format s "A consumer with the name ~s (~a) ~ 17 | already exists when adding ~a to ~a." 18 | (name (existing-consumer c)) (existing-consumer c) 19 | (new-consumer c) (core c))))) 20 | 21 | (define-condition agent-condition (maiden-condition) 22 | ((agent :initarg :agent :reader agent)) 23 | (:default-initargs :agent (error "AGENT required."))) 24 | 25 | (define-condition agent-already-exists-error (core-condition agent-condition) 26 | ((existing-agent :initarg :existing-agent :reader existing-agent)) 27 | (:default-initargs :existing-agent (error "EXISTING-AGENT required.")) 28 | (:report (lambda (c s) (format s "An agent of the same class ~s (~a) already exists." 29 | (class-name (class-of (agent c))) (existing-agent c))))) 30 | 31 | (define-condition client-condition (maiden-condition) 32 | ((client :initarg :client :reader client)) 33 | (:default-initargs :client (error "CLIENT required."))) 34 | -------------------------------------------------------------------------------- /agents/time/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.time) 2 | 3 | (docs:define-docs 4 | (variable *timezone-api* 5 | "The address for the Google maps timezone resolution API.") 6 | 7 | (function timezone-data 8 | "Returns the JSON object returned by the API for the given location. 9 | 10 | See *TIMEZONE-API*") 11 | 12 | (function timezone 13 | "Returns information about the timezone active at the location. 14 | 15 | Returns two values-- the name of the zone and its ID. 16 | 17 | See TIMEZONE") 18 | 19 | (function time 20 | "Returns the current, local time in universal-time at the given location. 21 | 22 | See TIMEZONE-DATA") 23 | 24 | (function user-location 25 | "Attempt to find a suitable location for the user's timezone. 26 | 27 | Looks at the user's :TIMEZONE and :LOCATION data-values. 28 | 29 | See MAIDEN:DATA-VALUE") 30 | 31 | (type time 32 | "This agent provides all sorts of time, date, and timezone utilities.") 33 | 34 | (command timezone-location 35 | "Shows the time zone of a location.") 36 | 37 | (command time-dwim 38 | "With no argument, the time for the requester is shown, if their location is known. Otherwise, the time for the given user or location is shown, if possible.") 39 | 40 | (command time-location 41 | "Show the time for a location.") 42 | 43 | (command time-user 44 | "Show the time for a user. Note that this only works if the location of the user is known.") 45 | 46 | (command time-between 47 | "Show the time difference between two locations.") 48 | 49 | (command time-between-users 50 | "Show the time difference between two users. Note that this only works if the location of the user is known.")) 51 | -------------------------------------------------------------------------------- /agents/notify/notes.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.notify) 2 | 3 | (defclass note () 4 | ((id :initarg :id :accessor id) 5 | (from :initarg :from :accessor from) 6 | (to :initarg :to :accessor to) 7 | (message :initarg :message :accessor message) 8 | (date :initarg :date :accessor date) 9 | (trigger :initarg :trigger :accessor trigger)) 10 | (:default-initargs 11 | :id (next-note-id) 12 | :from "Anonymous" 13 | :to (error "TO required.") 14 | :message (error "MESSAGE required.") 15 | :date (get-universal-time) 16 | :trigger :message)) 17 | 18 | (defmethod initialize-instance :after ((note note) &key) 19 | (register-note note)) 20 | 21 | (defun make-note (from to message &key (date (get-universal-time)) (trigger :message)) 22 | (make-instance 'note :from from :to to :message message :date date :trigger trigger)) 23 | 24 | (defun next-note-id () 25 | (with-storage ('global) 26 | (setf (value :next-id) (1+ (or (value :next-id) 0))))) 27 | 28 | (defun normalize-user-name (user) 29 | (string-downcase 30 | (etypecase user 31 | (user (name user)) 32 | (symbol (string user)) 33 | (string user)))) 34 | 35 | (defun register-note (note) 36 | (with-storage ('notes) 37 | (pushnew note (value (normalize-user-name (to note))) :key #'id))) 38 | 39 | (defun remove-note (note) 40 | (let ((to (normalize-user-name (to note)))) 41 | (with-storage ('notes) 42 | (setf (value to) (remove (id note) (value to) :key #'id))))) 43 | 44 | (defun clear-notes (user) 45 | (with-storage ('notes) 46 | (setf (value (normalize-user-name user)) ()))) 47 | 48 | (defun user-notes (user) 49 | (copy-list 50 | (ignore-errors 51 | (with-storage ('notes) 52 | (value (normalize-user-name user)))))) 53 | -------------------------------------------------------------------------------- /agents/silly/fortunes.txt: -------------------------------------------------------------------------------- 1 | great danger ahead. 2 | great fortune ahead. 3 | good news ahead. 4 | your life will change in a new direction soon. 5 | one of your relatives will die within the next ten years. 6 | you will be surprised. 7 | you will be bored. 8 | there is someone behind you. 9 | someone is watching you. 10 | something is watching you. 11 | wonder mood. 12 | F K... in the coffee! 13 | the coffee never fails. 14 | look in the coffee. 15 | the coffee will tell you more. 16 | spiders. 17 | birds. 18 | penguins. 19 | today you will realise that your existence is meaningless and that the universe does not care about what you do. 20 | nothing. 21 | something. 22 | everything. 23 | you will finally remember that thing you forgot. 24 | you will sneeze. 25 | you will die. 26 | you wil-- wait, SHIT! I dropped my crystal ball! 27 | clouds will look more intimidating than usual. 28 | the weather might change. 29 | something that I refuse to tell you. 30 | you will not believe this fortune. 31 | someone will insult your dumb ass. 32 | the public transport will be late today. 33 | black. 34 | white. 35 | red. 36 | green. 37 | blue. 38 | it will happen tomorrow. 39 | you might go too far in a few places. 40 | it's gonna be great. 41 | it's like poetry... so that they rhyme. 42 | your life will be so dense-- every day will have so much going on in it. 43 | if you can get it working you might be able to diminish the effects of it. 44 | you will stare into the void. 45 | the void will stare into you. 46 | make up your own fortune. 47 | all knowledge is ultimately based on that which we cannot prove. Will you fight? Or will you perish like a dog? 48 | Metal Gear?! 49 | a woman in the cell? 50 | nice shoes. 51 | curses. 52 | charms. 53 | blessings. 54 | unknown. 55 | forlorn. 56 | silence. 57 | alarm bells. 58 | -------------------------------------------------------------------------------- /modules/networking/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-networking 3 | (:nicknames #:org.shirakumo.maiden.modules.networking) 4 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 5 | (:use #:cl #:maiden) 6 | ;; conditions.lisp 7 | (:export 8 | #:client-connection-failed-error 9 | #:client-still-connected-error 10 | #:client-reconnection-exceeded-error 11 | #:client-connection-closed-uncleanly-warning 12 | #:closing-error 13 | #:client-timeout-error 14 | #:timeout 15 | #:data-condition 16 | #:data 17 | #:data-parse-error 18 | #:unknown-data-warning 19 | #:data-too-long-warning) 20 | ;; clients.lisp 21 | (:export 22 | #:client-connected-p 23 | #:close-connection 24 | #:initiate-connection 25 | #:handle-connection 26 | #:handle-connection-error 27 | #:handle-connection-idle 28 | #:process 29 | #:send 30 | #:receive 31 | #:accept 32 | #:make-tcp-server-client 33 | #:remote-client 34 | #:ip-client 35 | #:host 36 | #:port 37 | #:socket-client 38 | #:socket 39 | #:read-thread 40 | #:recv-lock 41 | #:send-lock 42 | #:reconnecting-client 43 | #:failures 44 | #:max-failures 45 | #:backoff 46 | #:interval 47 | #:max-reconnect-delay 48 | #:timeout-client 49 | #:timeout 50 | #:last-received-time 51 | #:text-client 52 | #:encoding 53 | #:buffer 54 | #:tcp-client 55 | #:element-type 56 | #:idle-interval 57 | #:ssl 58 | #:socket-stream 59 | #:text-tcp-client 60 | #:tcp-server 61 | #:clients 62 | #:tcp-server-client 63 | #:server 64 | #:socket) 65 | ;; events.lisp 66 | (:export 67 | #:connection-event 68 | #:connection-initiated 69 | #:connection-closed 70 | #:outgoing-event 71 | #:incoming-event)) 72 | 73 | (use-package '#:maiden-networking '#:maiden-user) 74 | -------------------------------------------------------------------------------- /clients/relay/conditions.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.relay) 2 | 3 | (define-condition relay-condition (client-condition) ()) 4 | 5 | (define-condition carrier-condition (relay-condition) 6 | ((message :initarg :message :reader message)) 7 | (:default-initargs :message (error "MESSAGE required."))) 8 | 9 | (define-condition target-condition (relay-condition) 10 | ((target :initarg :target :reader target)) 11 | (:default-initargs :target (error "TARGET required."))) 12 | 13 | (define-condition no-relay-target-specified (carrier-condition error) 14 | () 15 | (:report (lambda (c s) (format s "Cannot relay ~s to nothing over ~a. 16 | Somewhere a target was not properly specified." 17 | (message c) (client c))))) 18 | 19 | (define-condition relay-route-not-found (carrier-condition target-condition error) 20 | () 21 | (:report (lambda (c s) (format s "No route found to ~a over ~a for ~s. 22 | Either the network is temporarily unstable or the target is unreachable." 23 | (target c) (client c) (message c))))) 24 | 25 | (define-condition relay-link-not-found (carrier-condition target-condition error) 26 | () 27 | (:report (lambda (c s) (format s "No link found to ~a over ~a for ~s. 28 | 29 | This means that the network is either temporarily unstable or permanently corrupted. 30 | A complete restarting of the local relay and re-establishment of the connections 31 | should fix this problem." 32 | (target c) (client c) (message c))))) 33 | 34 | (define-condition client-version-mismatch (relay-condition warning) 35 | ((remote-version :initarg :remote-version :reader remote-version)) 36 | (:report (lambda (c s) (format s "The version of the framework at the remote relay ~a (~a) does not match ours (~a)." 37 | (remote (client c)) (remote-version c) (asdf:component-version (asdf:find-system :maiden)))))) 38 | -------------------------------------------------------------------------------- /examples/circ/README.md: -------------------------------------------------------------------------------- 1 | ## Primitive Maiden Based IRC Client 2 | This is a very small and primitive IRC client application to be used in the SLIME REPL. It serves mostly as a starting point for those who want to write a real client using Maiden3 as the back-end. 3 | 4 | ## How To: 5 | Currently neither Maiden3 nor the latest version of Deeds are on Quicklisp, so you'll have to clone them into your `local-projects` or wherever. 6 | For Maiden, clone the `v3` branch of `https://shinmera.com/project/maiden` and for Deeds the `master` branch of `https://shinmera.com/project/deeds`. 7 | 8 | Once you got that, make sure to `(ql:register-local-projects)`, then simply `(ql:quickload :maiden-circ)`, and finally `(in-package #:circ)`. 9 | 10 | Next you have to start up everything, which can be done by the `init` function. Using it without any arguments will setup a simple local IRC client. However, if you pass it `:relay T` it will also set it up to be able to relay events and such to another, remote client that will share the IRC connections rather than establish them by itself. If you pass it `:remote T` it will connect to a relay and use that for everything. Instead of `T` for both you can pass a list with the hostname and port to use. 11 | 12 | Once the init is done, you can `connect` to an IRC server like so: `(connect *core* 'freenode "irc.freenode.net" "CircTest")`. The `*core*` argument is necessary due to the way Maiden automatically creates commands, which has to support the scenario of multiple cores in the same image. 13 | 14 | After that, you can use the `j`, `r`, `p`, `w`, and `lw` functions to go about as usual in a client: 15 | 16 | ``` 17 | (j "#lisp") 18 | (r "Good morning, #lisp.") 19 | (j "#clasp") 20 | (lw) 21 | (w "#lisp") 22 | (r "Oh boy.") 23 | (p "#lisp" "#clasp") 24 | ``` 25 | 26 | Disconnecting will merely require `(disconnect *core* 'freenode)`. Note that you can also have multiple connections at the same time, just call `connect` again as desired. 27 | -------------------------------------------------------------------------------- /agents/weather/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.weather) 2 | 3 | (docs:define-docs 4 | (variable *weather-api* 5 | "Address to the DarkSky weather API endpoint.") 6 | 7 | (function weather-data 8 | "Returns the JSON object data from the weather API. 9 | 10 | Units are in SI, and data is only returned for the 11 | given time-frame, which can be one of the following: 12 | :CURRENTLY :MINUTELY :HOURLY :DAILY :FLAGS :ALERTS 13 | 14 | See the DarkSky API documentation for more information. 15 | See MAIDEN-API-ACCESS:REQUEST-AS") 16 | 17 | (function location-weather-data 18 | "Returns the JSON object data from the weather API for the given location. 19 | 20 | Returns the resolved location as its second value. 21 | 22 | See WEATHER-DATA 23 | See MAIDEN-LOCATION:COORDINATES") 24 | 25 | (function format-weather-data 26 | "Format the given JSON object representing current weather data in a human-readable way.") 27 | 28 | (function day-of-week 29 | "Returns a string for the day of the week of the given unix-time.") 30 | 31 | (function format-daily-forecast 32 | "Format the given JSON object representing a daily forecast in a human-readable way.") 33 | 34 | (type weather 35 | "This agent provides utilities to retrieve weather information about a location.") 36 | 37 | (command weather-dwim 38 | "Retrieve weather information about yourself, a user, or a location.") 39 | 40 | (command weather-location 41 | "Retrieve weather information about a specific location.") 42 | 43 | (command forecast-location 44 | "Retrieve a weather forecast for the next week for a specified location.") 45 | 46 | (command weather-user 47 | "Retrieve weather information for a user. Note that this only works if the location of the user is known.") 48 | 49 | (command forecast-user 50 | "Retrieve a weather forecast for the next week for a user. Note that this only works if the location of the user is known.")) 51 | -------------------------------------------------------------------------------- /event.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden) 2 | 3 | (defclass event-class (deeds:event-class) 4 | ((effective-advice :initform () :accessor advice) 5 | (direct-advice :initarg :advice :accessor direct-advice)) 6 | (:default-initargs 7 | :direct-advice ())) 8 | 9 | (defmethod c2mop:finalize-inheritance :after ((class event-class)) 10 | (let ((advice ())) 11 | ;; Calculate inherited advice 12 | (dolist (super (c2mop:class-direct-superclasses class)) 13 | (when (typep super 'event-class) 14 | (unless (c2mop:class-finalized-p super) 15 | (c2mop:finalize-inheritance super)) 16 | (setf advice (union advice (advice super))))) 17 | ;; Remove blocked advice 18 | (when (slot-boundp class 'direct-advice) 19 | (dolist (direct-advice (direct-advice class)) 20 | (cond ((and (listp direct-advice) (eql (first direct-advice) 'not)) 21 | (setf advice (remove (second direct-advice) advice))) 22 | ((listp direct-advice) 23 | (setf advice (union advice direct-advice :test #'equalp))) 24 | (T 25 | (pushnew direct-advice advice :test #'equalp))))) 26 | ;; Set effective advice. 27 | (setf (advice class) advice))) 28 | 29 | (defclass event (deeds:event) 30 | () 31 | (:metaclass event-class)) 32 | 33 | (defmethod advice ((event event)) 34 | (advice (class-of event))) 35 | 36 | (defmethod core ((event event)) 37 | (event-loop event)) 38 | 39 | (defmacro define-event (name direct-superclasses direct-slots &rest options) 40 | (when (loop for super in direct-superclasses 41 | never (c2mop:subclassp (find-class super) (find-class 'event))) 42 | (push 'event direct-superclasses)) 43 | (pushnew `(:metaclass event-class) options 44 | :test #'(lambda (a b) (eql (car a) (car b)))) 45 | `(eval-when (:compile-toplevel :load-toplevel :execute) 46 | (defclass ,name ,direct-superclasses 47 | ,direct-slots 48 | ,@options))) 49 | -------------------------------------------------------------------------------- /modules/serialize/serialize.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.serialize) 2 | 3 | (defvar *finders* ()) 4 | (defvar *event-code* (cl-store:register-code 100 'event)) 5 | (defvar *core-code* (cl-store:register-code 101 'core)) 6 | (defvar *consumer-code* (cl-store:register-code 102 'consumer)) 7 | (defvar *footer-buffer* (make-array 8 :initial-element 0 :element-type '(unsigned-byte 8))) 8 | 9 | (defun find-instance (id type) 10 | (let ((finder (cdr (assoc type *finders*)))) 11 | (when finder (funcall finder id)))) 12 | 13 | (cl-store:defstore-cl-store (object event stream) 14 | (cl-store:output-type-code *event-code* stream) 15 | (cl-store::store-type-object object stream)) 16 | 17 | (cl-store:defrestore-cl-store (event stream) 18 | (deeds:with-immutable-slots-unlocked () 19 | (cl-store::restore-type-object stream))) 20 | 21 | (cl-store:defstore-cl-store (object core stream) 22 | (cl-store:output-type-code *core-code* stream) 23 | (cl-store::store-type-object (id object) stream)) 24 | 25 | (cl-store:defrestore-cl-store (core stream) 26 | (let ((id (cl-store::restore-type-object stream))) 27 | (or (find-instance id 'core) id))) 28 | 29 | (cl-store:defstore-cl-store (object consumer stream) 30 | (cl-store:output-type-code *consumer-code* stream) 31 | (cl-store::store-type-object (id object) stream)) 32 | 33 | (cl-store:defrestore-cl-store (consumer stream) 34 | (let ((id (cl-store::restore-type-object stream))) 35 | (or (find-instance id 'consumer) id))) 36 | 37 | (defgeneric serialize (object target) 38 | (:method (object (target stream)) 39 | (let ((target (gzip-stream:make-gzip-output-stream target))) 40 | (cl-store:store object target) 41 | (finish-output target)))) 42 | 43 | (defgeneric deserialize (source finders) 44 | (:method ((source stream) finders) 45 | (let ((*finders* finders)) 46 | (prog1 (cl-store:restore (gzip-stream:make-gzip-input-stream source)) 47 | (read-sequence *footer-buffer* source))))) 48 | -------------------------------------------------------------------------------- /agents/notify/interface.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.notify) 2 | 3 | (define-consumer notify (agent) 4 | ()) 5 | 6 | (defun handle-note-notification (ev user trigger) 7 | (dolist (note (sort (user-notes user) #'< :key #'date)) 8 | (when (eql (trigger note) trigger) 9 | (remove-note note) 10 | (reply ev "~a: ~a said ~a: ~a" 11 | (name user) (from note) (format-time (date note)) (message note))))) 12 | 13 | (defun handle-note-creation (ev target message trigger) 14 | (cond ((string= "" target) 15 | (reply ev "I'll have to know someone to tell the message to.")) 16 | ((string-equal (name (user ev)) target) 17 | (reply ev "Are you feeling lonely?")) 18 | (T 19 | (make-note (name (user ev)) 20 | (normalize-user-name target) 21 | message 22 | :trigger trigger) 23 | (reply ev "~a: Got it. I'll let ~a know as soon as possible." 24 | (name (user ev)) target)))) 25 | 26 | (define-handler (notify new-message message-event) (c ev user) 27 | (unless (maiden-commands:command-p ev) 28 | (handle-note-notification ev user :message))) 29 | 30 | (define-handler (notify user-enter user-entered) (c ev user) 31 | (handle-note-notification ev user :join)) 32 | 33 | (define-command (notify forget-notes) (c ev &optional target) 34 | :command "forget notes" 35 | :before '(new-message) 36 | (if target 37 | (dolist (note (user-notes target)) 38 | (when (string-equal (name (user ev)) (from note)) 39 | (remove-note note))) 40 | (clear-notes (user ev))) 41 | (reply ev "Ok, I forgot all about the notes.")) 42 | 43 | (define-command (notify send-join-note) (c ev target &string message) 44 | :command "notify on join" 45 | (handle-note-creation ev target message :join)) 46 | 47 | (define-command (notify send-note) (c ev target &string message) 48 | :command "notify" 49 | (handle-note-creation ev target message :message)) 50 | -------------------------------------------------------------------------------- /agents/crimes/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-crimes 3 | (:nicknames #:org.shirakumo.maiden.agents.crimes) 4 | (:use #:cl #:maiden #:maiden-commands #:maiden-client-entities #:maiden-api-access) 5 | ;; cardcast.lisp 6 | (:export 7 | #:*cardcast/decks* 8 | #:*cardcast/deck* 9 | #:*cardcast/deck/cards* 10 | #:cardcast/decks 11 | #:cardcast/deck 12 | #:cardcast/deck/cards 13 | #:load-cardcast-deck 14 | #:find-cardcast-decks) 15 | ;; cards.lisp 16 | (:export 17 | #:*decks* 18 | #:deck 19 | #:remove-deck 20 | #:deck 21 | #:name 22 | #:title 23 | #:calls 24 | #:responses 25 | #:list-calls 26 | #:list-responses 27 | #:save-deck 28 | #:load-deck 29 | #:remove-card 30 | #:card 31 | #:text 32 | #:call 33 | #:add-call 34 | #:response 35 | #:add-response 36 | #:result 37 | #:call 38 | #:responses 39 | #:required-responses 40 | #:remaining-responses 41 | #:complete-p 42 | #:text) 43 | ;; game.lisp 44 | (:export 45 | #:player 46 | #:user 47 | #:game 48 | #:hand 49 | #:score 50 | #:result 51 | #:complete-p 52 | #:remaining-responses 53 | #:draw-cards 54 | #:next-round 55 | #:game 56 | #:channel 57 | #:calls 58 | #:responses 59 | #:players 60 | #:scrambled 61 | #:hand-size 62 | #:win-score 63 | #:in-session 64 | #:add-deck 65 | #:officer 66 | #:start 67 | #:end 68 | #:join 69 | #:leave 70 | #:submit 71 | #:winner 72 | #:finish-round 73 | #:next-round) 74 | ;; interface.lisp 75 | (:export 76 | #:crimes 77 | #:games 78 | #:user-game 79 | #:open-game 80 | #:add-deck 81 | #:start-game 82 | #:end-game 83 | #:join-game 84 | #:leave-game 85 | #:submit-card 86 | #:select-winner 87 | #:create-deck 88 | #:remove-deck 89 | #:list-decks 90 | #:search-deck 91 | #:download-deck 92 | #:add-call 93 | #:add-response 94 | #:remove-card) 95 | ;; toolkit.lisp 96 | (:export)) 97 | -------------------------------------------------------------------------------- /standard-events.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden) 2 | 3 | (defgeneric respond (event &key &allow-other-keys)) 4 | 5 | (defmethod respond ((event event) &rest args &key (class (class-of event)) &allow-other-keys) 6 | (issue (apply #'make-instance class args) 7 | (event-loop event))) 8 | 9 | (define-event passive-event () 10 | ()) 11 | 12 | (define-event active-event () 13 | ()) 14 | 15 | (define-event client-event () 16 | ((client :initarg :client :reader client)) 17 | (:default-initargs 18 | :client (error "CLIENT required."))) 19 | 20 | (defmethod respond ((event client-event) &rest args &key (class (class-of event)) &allow-other-keys) 21 | (remf args :class) 22 | (issue (apply #'make-instance class :client (client event) args) 23 | (event-loop event))) 24 | 25 | (define-event instruction-event (active-event) 26 | ()) 27 | 28 | (define-event query-event (identified-event instruction-event) 29 | ()) 30 | 31 | (defmethod respond ((event query-event) &key payload) 32 | (issue (make-instance 'response-event :identifier (identifier event) 33 | :payload payload) 34 | (event-loop event))) 35 | 36 | (define-event response-event (identified-event payload-event passive-event) 37 | () 38 | (:default-initargs :identifier (error "IDENTIFIER required."))) 39 | 40 | (define-event core-event () 41 | ()) 42 | 43 | (define-event consumer-added (core-event passive-event) 44 | ((consumer :initarg :consumer)) 45 | (:default-initargs 46 | :consumer (error "CONSUMER required."))) 47 | 48 | (defmethod print-object ((event consumer-added) stream) 49 | (print-unreadable-object (event stream :type T :identity T) 50 | (format stream "~a" (slot-value event 'consumer)))) 51 | 52 | (define-event consumer-removed (core-event passive-event) 53 | ((consumer :initarg :consumer)) 54 | (:default-initargs 55 | :consumer (error "CONSUMER required."))) 56 | 57 | (defmethod print-object ((event consumer-removed) stream) 58 | (print-unreadable-object (event stream :type T :identity T) 59 | (format stream "~a" (slot-value event 'consumer)))) 60 | -------------------------------------------------------------------------------- /agents/location/location.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.location) 2 | 3 | (defparameter *geocode-api* "https://maps.googleapis.com/maps/api/geocode/json") 4 | 5 | ;; (maiden-accounts:define-fields 6 | ;; (location () "A physical location where the user currently resides.")) 7 | 8 | (defun geo-information (location &optional key) 9 | (let* ((key (or key (maiden-storage:with-storage ('location) (maiden-storage:value :api-key)))) 10 | (data (request-as :json *geocode-api* :get `(("sensor" "false") ("address" ,location) ("key" ,(or key ""))))) 11 | (status (json-v data "status"))) 12 | (cond ((string-equal status "ok") 13 | (json-v data "results" 0)) 14 | ((string-equal status "zero_results") 15 | (error "No location called ~s could be found." location)) 16 | ((string-equal status "over_query_limit") 17 | (error "Exceeded allowed amount of queries against the Google Maps API.")) 18 | ((null key) 19 | (error "You have not set the Google Maps API key yet.")) 20 | (T 21 | (error "Google Maps failed to perform your request for an unknown reason."))))) 22 | 23 | (defun coordinates (location &optional key) 24 | (let ((data (geo-information location key))) 25 | (values (list (json-v data "geometry" "location" "lat") 26 | (json-v data "geometry" "location" "lng")) 27 | (json-v data "address_components" 0 "long_name")))) 28 | 29 | (defun address (location &optional key) 30 | (let ((data (geo-information location key))) 31 | (json-v data "formatted_address"))) 32 | 33 | (define-consumer location (agent) 34 | ()) 35 | 36 | (define-command (location query-address) (c ev &string location) 37 | :command "address of" 38 | (reply ev "I think the address for ~s is ~a." location (address location))) 39 | 40 | (define-command (location query-coordinates) (c ev &string location) 41 | :command "coordinates of" 42 | (multiple-value-bind (coordinates location) (coordinates location) 43 | (reply ev "~s is located at ~flat ~flng." 44 | location (first coordinates) (second coordinates)))) 45 | -------------------------------------------------------------------------------- /clients/relay/events.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.relay) 2 | 3 | (define-event relay-instruction-event (instruction-event) 4 | ()) 5 | 6 | (define-event data-response-event (deeds:identified-event relay-instruction-event) 7 | ((source :initarg :source :reader source)) 8 | (:default-initargs 9 | :source (error "SOURCE required.") 10 | :identifier (uuid:make-v4-uuid))) 11 | 12 | (defmethod execute-instruction :around ((event data-response-event) &key relay) 13 | (relay (make-transport 14 | (make-instance 'response-event 15 | :payload (call-next-method) 16 | :identifier (deeds:identifier event)) 17 | (source event)) 18 | (source event) 19 | relay)) 20 | 21 | (define-event slot-event (data-response-event) 22 | ((slot :initarg :slot :reader slot) 23 | (object :initarg :object :reader object)) 24 | (:default-initargs 25 | :slot (error "SLOT required.") 26 | :object (error "OBJECT required."))) 27 | 28 | (define-event slot-value-event (slot-event) 29 | ()) 30 | 31 | (defmethod execute-instruction ((event slot-value-event) &key) 32 | (slot-value (object event) (slot event))) 33 | 34 | (define-event slot-setf-event (slot-event) 35 | ((value :initarg :value :reader value)) 36 | (:default-initargs 37 | :value NIL)) 38 | 39 | (defmethod execute-instruction ((event slot-setf-event) &key) 40 | (setf (slot-value (object event) (slot event)) (value event))) 41 | 42 | (define-event slot-makunbound-event (slot-event) 43 | ()) 44 | 45 | (defmethod execute-instruction ((event slot-makunbound-event) &key) 46 | (slot-makunbound (object event) (slot event))) 47 | 48 | (define-event slot-boundp-event (slot-event) 49 | ()) 50 | 51 | (defmethod execute-instruction ((event slot-boundp-event) &key) 52 | (slot-boundp (object event) (slot event))) 53 | 54 | (define-event generic-call-event (data-response-event) 55 | ((form :initarg :form :reader form)) 56 | (:default-initargs 57 | :form (error "FORM required."))) 58 | 59 | (defmethod execute-instruction ((event generic-call-event) &key) 60 | (apply #'funcall (form event))) 61 | -------------------------------------------------------------------------------- /agents/quicklisp/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.quicklisp) 2 | 3 | (docs:define-docs 4 | (function dists-and-versions 5 | "Return a list of lists of dist names and their current versions.") 6 | 7 | (function dist-for-system 8 | "Return the first dist that contains the system specified.") 9 | 10 | (function check-dists-available 11 | "Check whether all of the dists in the list are ones Quicklisp knows about. 12 | 13 | If one is not, an error is signalled.") 14 | 15 | (function check-systems-available 16 | "Check whether all of the systems in the list are ones Quicklisp knows about. 17 | 18 | If one is not, an error is signalled.") 19 | 20 | (function check-systems-upgradable 21 | "Check whether all of the systems are upgradable. 22 | 23 | System that are not managed by Git or Quicklisp 24 | generate an error.") 25 | 26 | (function update 27 | "Update the Quicklisp dists definitions to the latest versions. 28 | 29 | This will not update any actual systems until they are next loaded.") 30 | 31 | (function upgrade 32 | "Upgrade the given systems to the latest versions. 33 | 34 | This will handle systems that are managed by Git 35 | or by Quicklisp.") 36 | 37 | (type quicklisp 38 | "This agent provides access to the Quicklisp package manager.") 39 | 40 | (command version 41 | "This displays version information about a particular system, or maiden itself.") 42 | 43 | (command update 44 | "This updates all the specified systems to the latest Quicklisp versions. This does not actually reload the code, however. See 'upgrade'.") 45 | 46 | (command upgrade 47 | "This upgrades all the specified systems to the latest Quicklisp versions. This causes the code to be reloaded as well.") 48 | 49 | (command quickload 50 | "Quickload a specific system.") 51 | 52 | (command uninstall 53 | "Uninstall a system from the disk. This will not remove the code from the lisp image if the system has already been loaded.") 54 | 55 | (command install-dist 56 | "Add a new dist to the quicklisp distribution.") 57 | 58 | (command uninstall-dist 59 | "Remove a dist from the quicklisp distribution.")) 60 | -------------------------------------------------------------------------------- /agents/urlinfo/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.urlinfo) 2 | 3 | (docs:define-docs 4 | (function fetch 5 | "Fetches the given HTTP URL. 6 | 7 | Returns three values: 8 | - The URL that was fetched in the end (due to redirects) 9 | - The content-type of the resource the URL points to 10 | - The stream to read the content body from 11 | 12 | See DRAKMA:HTTP-REQUEST") 13 | 14 | (function process-until 15 | "Call FUNCTION on each character read from STREAM until STRING is found. 16 | 17 | The function is only called up until, but not including the 18 | string that defines the end.") 19 | 20 | (function maybe-title 21 | "Extract a title for the document of the given type from the stream. 22 | 23 | This is only done if the type is known and if the document 24 | stream does indeed contain a title. Thus it does not always 25 | return a title even if a document potentially defines it in 26 | some manner.") 27 | 28 | (function nicer-title 29 | "Reformat the title in a way that is perceived to be nicer. 30 | 31 | Gets rid of superfluous spaces and newlines, and reformats 32 | the title as should it be an empty string.") 33 | 34 | (function short-url 35 | "Return a shorter version of the URL that is capped to a maximum of URL-CUTOFF.") 36 | 37 | (function nicer-content-type 38 | "Return a more human-readable version of the given content-type string.") 39 | 40 | (function urlinfo 41 | "Return a formatted string that presents some information about the given URL. 42 | 43 | In particular, it will include a short form of the actual URL 44 | as resolved by the request. It will also include the content- 45 | type of the data at the end, and the title of the document, if 46 | such a title is available.") 47 | 48 | (function find-urls-in-string 49 | "Extract all the URLs in the string and return them in a list.") 50 | 51 | (type urlinfo 52 | "This agent provides an automatic URL inspection. When an URL is encountered, it is looked up, and information about it is displayed in the channel. This can be useful to preview what a link is about.") 53 | 54 | (command test 55 | "Retrieve the information about an URL.")) 56 | -------------------------------------------------------------------------------- /agents/emoticon/emoticon.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.emoticon) 2 | 3 | (defun emoticon (name) 4 | (with-storage ('emoticons) 5 | (value (string-downcase name)))) 6 | 7 | (defun (setf emoticon) (value name) 8 | (with-storage ('emoticons) 9 | (setf (value (string-downcase name)) value))) 10 | 11 | (defun remove-emoticon (name) 12 | (with-storage ('emoticons) 13 | (remvalue (string-downcase name)))) 14 | 15 | (defun list-emoticons () 16 | (with-storage ('emoticons) 17 | (sort (loop for k being the hash-keys of (value) 18 | collect k) #'string<))) 19 | 20 | (define-consumer emoticon (agent) 21 | ((maximum :initarg :maximum :initform 5 :accessor maximum))) 22 | 23 | (define-command (emoticon add) (c ev name &string emoticon) 24 | :command "add emoticon" 25 | (when (emoticon name) 26 | (error "An emoticon named :~a: already exists. Use 'change emoticon' or remove it first." name)) 27 | (when (string= "" name) 28 | (error "The name can't be empty.")) 29 | (setf (emoticon name) emoticon) 30 | (reply ev "Emoticon :~a: added." name)) 31 | 32 | (define-command (emoticon change) (c ev name &string emoticon) 33 | :command "change emoticon" 34 | (setf (emoticon name) emoticon) 35 | (reply ev "Emoticon :~a: changed." name)) 36 | 37 | (define-command (emoticon remove) (c ev name) 38 | :command "remove emoticon" 39 | (remove-emoticon name) 40 | (reply ev "Emoticon :~a: removed." name)) 41 | 42 | (define-command (emoticon list) (c ev) 43 | :command "list emoticons" 44 | (let ((emoticons (list-emoticons))) 45 | (if emoticons 46 | (reply ev "~{:~a:~^ ~}" (list-emoticons)) 47 | (reply ev "No emoticons have been defined yet.")))) 48 | 49 | (define-handler (emoticon respond (and passive-event message-event)) (c ev message) 50 | :class maiden-activatable:activatable-handler 51 | :module #.*package* 52 | (unless (matches (username (client ev)) (user ev)) 53 | (let ((counter 0)) 54 | (cl-ppcre:do-register-groups (name) (":(.*?):" message) 55 | (let ((emoticon (emoticon name))) 56 | (when emoticon 57 | (when (= (incf counter) (maximum c)) 58 | (return)) 59 | (reply ev "~a" emoticon))))))) 60 | -------------------------------------------------------------------------------- /modules/networking/conditions.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.networking) 2 | 3 | (define-condition client-connection-failed-error (client-condition error) 4 | () 5 | (:report (lambda (c s) (format s "Client ~a failed to connect." 6 | (client c))))) 7 | 8 | (define-condition client-still-connected-error (client-condition error) 9 | () 10 | (:report (lambda (c s) (format s "The client ~a is still connected!" 11 | (client c))))) 12 | 13 | (define-condition client-reconnection-exceeded-error (client-condition error) 14 | () 15 | (:report (lambda (c s) (format s "Client ~a exceeded its reconnection attempts." 16 | (client c))))) 17 | 18 | (define-condition client-connection-closed-uncleanly-warning (client-condition warning) 19 | ((closing-error :initarg :closing-error :reader closing-error)) 20 | (:report (lambda (c s) (format s "Error ~s encountered while closing connection of ~a." 21 | (closing-error c) (client c))))) 22 | 23 | (define-condition client-timeout-error (client-condition error) 24 | ((timeout :initarg :timeout :reader timeout)) 25 | (:default-initargs :timeout NIL) 26 | (:report (lambda (c s) (format s "Client ~a timed out~@[ after ~d seconds~]." 27 | (client c) (timeout c))))) 28 | 29 | (define-condition data-condition (condition) 30 | ((data :initarg :data :reader data)) 31 | (:default-initargs :data (error "DATA required."))) 32 | 33 | (define-condition data-parse-error (data-condition client-condition error) 34 | () 35 | (:report (lambda (c s) (format s "Failed to parse ~s from ~a." 36 | (data c) (client c))))) 37 | 38 | (define-condition unknown-data-warning (data-condition client-condition warning) 39 | () 40 | (:report (lambda (c s) (format s "Don't know what to do for ~s from ~a." 41 | (data c) (client c))))) 42 | 43 | (define-condition data-too-long-warning (data-condition client-condition warning) 44 | () 45 | (:report (lambda (c s) (format s "The data ~s might be truncated or dropped as it is too long for ~a." 46 | (data c) (client c))))) 47 | -------------------------------------------------------------------------------- /agents/trivia/game.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.trivia) 2 | 3 | (defclass game () 4 | ((channel :initarg :channel :accessor channel) 5 | (questions :initarg :questions :accessor questions) 6 | (question-time :initarg :question-time :accessor question-time) 7 | (question-limit :initarg :question-limit :accessor question-limit) 8 | (scores :initarg :scores :accessor scores)) 9 | (:default-initargs 10 | :channel (error "CHANNEL required.") 11 | :questions (error "QUESTIONS required.") 12 | :question-time (get-universal-time) 13 | :question-limit 30 14 | :scores ())) 15 | 16 | (defmethod start ((game game)) 17 | (setf (questions game) (alexandria:shuffle (questions game))) 18 | (setf (question-time game) (get-universal-time)) 19 | (setf (scores game) ()) 20 | game) 21 | 22 | (defmethod end ((game game)) 23 | (setf (questions game) ()) 24 | game) 25 | 26 | (defmethod answer (user answer (game game)) 27 | (when (and (questions game) 28 | (check answer (first (questions game)))) 29 | (let* ((diff (- (get-universal-time) (question-time game))) 30 | (score (+ 1 (max 0 (- (question-limit game) diff)))) 31 | (cons (assoc user (scores game) :test #'matches))) 32 | (if cons 33 | (incf (cdr cons) score) 34 | (push (cons user score) (scores game))) 35 | (skip game)))) 36 | 37 | (defmethod skip ((game game)) 38 | (setf (question-time game) (get-universal-time)) 39 | (pop (questions game)) 40 | game) 41 | 42 | (defmethod winner ((game game)) 43 | (unless (questions game) 44 | (setf (scores game) (sort (scores game) #'> :key #'cdr)) 45 | (let ((winner (first (scores game)))) 46 | (values (car winner) (cdr winner))))) 47 | 48 | (defmethod hint ((game game)) 49 | (when (questions game) 50 | (let ((hint (hint (first (questions game))))) 51 | ;; Make extra points void if hint used. 52 | (when hint (setf (question-time game) 0)) 53 | hint))) 54 | 55 | (defun make-game (channel categories &key (limit 30)) 56 | (make-instance 'game :channel channel 57 | :questions (loop for category in categories 58 | append (category category)) 59 | :question-limit limit)) 60 | -------------------------------------------------------------------------------- /agents/crimes/cardcast.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.crimes) 2 | 3 | (defvar *cardcast/decks* "https://api.cardcastgame.com/v1/decks") 4 | (defvar *cardcast/deck* "https://api.cardcastgame.com/v1/decks/~a") 5 | (defvar *cardcast/deck/cards* "https://api.cardcastgame.com/v1/decks/~a/cards") 6 | 7 | (defun cardcast/decks (&key (offset 0) (limit 20) search author category) 8 | (request-as :json *cardcast/decks* :get `((offset ,offset) 9 | (limit ,limit) 10 | ,@(append 11 | (when search `((search ,search))) 12 | (when author `((author ,author))) 13 | (when category `((category ,category))))))) 14 | 15 | (defun cardcast/deck (deck-id) 16 | (request-as :json (format NIL *cardcast/deck* deck-id))) 17 | 18 | (defun cardcast/deck/cards (deck-id) 19 | (request-as :json (format NIL *cardcast/deck/cards* deck-id))) 20 | 21 | (defun cardcast->card (type data) 22 | (make-instance type :id (json-v data "id") 23 | :text (case type 24 | (response (first (json-v data "text"))) 25 | (T (json-v data "text"))))) 26 | 27 | (defun cardcast-list->map (type data) 28 | (let ((table (make-hash-table :test 'equal))) 29 | (dolist (card data table) 30 | (let ((card (cardcast->card type card))) 31 | (setf (gethash (id card) table) card))))) 32 | 33 | (defun load-cardcast-deck (deck-id) 34 | (let ((deckinfo (cardcast/deck deck-id))) 35 | (when (string-equal "not_found" (json-v deckinfo "id")) 36 | (error "No deck with ID ~a found." deck-id)) 37 | (let ((cards (cardcast/deck/cards deck-id))) 38 | (make-instance 'deck :name deck-id 39 | :title (json-v deckinfo "name") 40 | :calls (cardcast-list->map 'call (json-v cards "calls")) 41 | :responses (cardcast-list->map 'response (json-v cards "responses")))))) 42 | 43 | (defun find-cardcast-decks (query) 44 | (let ((data (cardcast/decks :search query))) 45 | (loop for dat in (json-v data "results" "data") 46 | collect (list (json-v dat "name") (json-v dat "code"))))) 47 | -------------------------------------------------------------------------------- /agents/counter/counter.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.counter) 2 | 3 | (defun counter (name) 4 | (with-storage ('counters) 5 | (value (string-downcase name)))) 6 | 7 | (defun (setf counter) (value name) 8 | (with-storage ('counters) 9 | (setf (value (string-downcase name)) value))) 10 | 11 | (defun remove-counter (name) 12 | (with-storage ('counters) 13 | (remvalue (string-downcase name)))) 14 | 15 | (defun list-counters () 16 | (with-storage ('counters) 17 | (loop for v being the hash-values of (value) collect v))) 18 | 19 | (defun set-counter (name match &key response count) 20 | (setf (counter name) `(:name ,name 21 | :match ,match 22 | :response ,(or response (format NIL "~a counter: ~~a" name)) 23 | :count ,(or count 0)))) 24 | 25 | (define-consumer counter (agent) 26 | ()) 27 | 28 | (define-command (counter add) (c ev name match &optional response) 29 | :command "add counter" 30 | (when (counter name) 31 | (error "An counter named ~a already exists. Use 'change counter' or remove it first." name)) 32 | (set-counter name match :response response) 33 | (reply ev "Counter ~a added." name)) 34 | 35 | (define-command (counter change) (c ev name &key match response) 36 | :command "change counter" 37 | (let ((counter (counter name))) 38 | (unless counter (error "A counter named ~a does not exist." name)) 39 | (when match (setf (getf counter :match) match)) 40 | (when response (setf (getf counter :response) response)) 41 | (setf (counter name) counter)) 42 | (reply ev "Counter ~a changed." name)) 43 | 44 | (define-command (counter remove) (c ev name) 45 | :command "remove counter" 46 | (remove-counter name) 47 | (reply ev "Counter ~a removed." name)) 48 | 49 | (define-command (counter list) (c ev) 50 | :command "list counters" 51 | (reply ev "~{~a~^, ~}" (loop for c in (list-counters) collect (getf c :name)))) 52 | 53 | (define-handler (counter respond (and message-event passive-event)) (c ev message) 54 | :class activatable-handler 55 | :module #.*package* 56 | (unless (matches (username (client ev)) (user ev)) 57 | (dolist (c (list-counters)) 58 | (when (cl-ppcre:scan (getf c :match) (string-downcase message)) 59 | (reply ev (getf c :response) (incf (getf c :count))))))) 60 | -------------------------------------------------------------------------------- /agents/medals/medals.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.medals) 2 | 3 | (defun maybe-account (name) 4 | (typecase name 5 | (user (or (maiden-accounts:account (maiden-accounts:identity name) :error NIL) 6 | (maiden-accounts:account name :error NIL))) 7 | (T (maiden-accounts:account name :error NIL)))) 8 | 9 | (defun user-name (name) 10 | (typecase name 11 | (user (name name)) 12 | (T (string-downcase name)))) 13 | 14 | (defun medals (name) 15 | (let ((account (maybe-account name))) 16 | (union (when account 17 | (data-value 'medals account)) 18 | (with-storage ('medals) 19 | (value (user-name name))) 20 | :test #'string-equal))) 21 | 22 | (defun (setf medals) (value name) 23 | (let ((account (maybe-account name))) 24 | (cond (account 25 | (setf (data-value 'medals account) value) 26 | ;; Clear previous storage if any. 27 | (with-storage ('medals) (setf (value (user-name name)) ()))) 28 | (T 29 | (with-storage ('medals) 30 | (setf (value (user-name name)) value)))))) 31 | 32 | (defun add-medals (name &rest medals) 33 | (setf (medals name) (union (medals name) medals :test #'string-equal))) 34 | 35 | (defun remove-medals (name &rest medals) 36 | (setf (medals name) (set-difference (medals name) medals :test #'string-equal))) 37 | 38 | (define-consumer medals (agent) 39 | ()) 40 | 41 | (define-command (medals show) (c ev &optional user) 42 | :command "show medals of" 43 | (let* ((user (or user (name (user ev)))) 44 | (medals (medals user))) 45 | (if medals 46 | (reply ev "~a has been awarded the ~{~a~^, ~} medal~p." user medals (length medals)) 47 | (reply ev "~a has not been awarded for anything yet!" user)))) 48 | 49 | (define-command (medals award) (c ev user &rest medals) 50 | :command "award" 51 | :advice (not public) 52 | (apply #'add-medals user medals) 53 | (reply ev "Congratulations, ~a! You have been awarded the ~{~a~^, ~} medal~p." 54 | user medals (length medals))) 55 | 56 | (define-command (medals take) (c ev user &rest medals) 57 | :command "take medals from" 58 | :advice (not public) 59 | (apply #'remove-medals user medals) 60 | (reply ev "Medal~p ~{~a~^, ~} have been taken from ~a." 61 | (length medals) medals user)) 62 | -------------------------------------------------------------------------------- /agents/activatable/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.activatable) 2 | 3 | (docs:define-docs 4 | (function short-package-name 5 | "Returns the shortest of all the package's nicknames.") 6 | 7 | (function trim-package-prefix 8 | "Removes maiden package prefixes.") 9 | 10 | (function normalize-module-name 11 | "Attempts to normalise the module name. 12 | 13 | This: 14 | 1. Takes the symbol-name for symbols, the short-package- 15 | name for packages, or a straight-up string. 16 | 2. Downcases it. 17 | 3. Trims the package prefix. 18 | 19 | See SHORT-PACKAGE-NAME 20 | See TRIM-PACKAGE-PREFIX") 21 | 22 | (function normalize-ident 23 | "Normalise the thing into an ident. 24 | 25 | THING can be one of 26 | - CHANNEL-EVENT -- Calls itself again using a cons of 27 | client name and channel name. 28 | - CLIENT-EVENT -- Calls itself again using a cons of 29 | client name and NIL. 30 | - CONS -- Returns a fresh cons where both parts 31 | are a downcased string or NIL. Either 32 | can be an entity, a string-designator 33 | or NIL.") 34 | 35 | (function activate 36 | "Activate the modules on the given client ident. 37 | 38 | See NORMALIZE-IDENT 39 | See NORMALIZE-MODULE-NAME") 40 | 41 | (function deactivate 42 | "Deactivate the modules on the given client ident. 43 | 44 | See NORMALIZE-IDENT 45 | See NORMALIZE-MODULE-NAME") 46 | 47 | (function active-p 48 | "Returns whether the given module is active on the given ident. 49 | 50 | See NORMALIZE-IDENT 51 | See NORMALIZE-MODULE-NAME") 52 | 53 | (function list-active 54 | "Lists all active modules for the given ident. 55 | 56 | See NORMALIZE-IDENT") 57 | 58 | (type activatable-handler 59 | "Mixin class for a handler that can be de/activated on a client/channel basis. 60 | 61 | You must pass the name of the module the handler should 62 | belong to as an initarg. 63 | 64 | See MODULE 65 | See ACTIVATE 66 | See DEACTIVATE 67 | See ACTIVE-P") 68 | 69 | (type activatable 70 | "This agent manages the activation of other agents that might want to be blocked on certain channels to avoid unwanted responses.") 71 | 72 | (command activate 73 | "Activate modules on the current channel. By default modules are deactivated.") 74 | 75 | (command deactivate 76 | "Deactivate modules on the current channel.")) 77 | -------------------------------------------------------------------------------- /clients/lichat/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | 3 | (defpackage #:lichat-cmd 4 | (:nicknames #:org.shirakumo.maiden.clients.lichat.cmd) 5 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 6 | (:use) 7 | (:export 8 | #:update 9 | #:ping 10 | #:pong 11 | #:connect 12 | #:disconnect 13 | #:register 14 | #:join 15 | #:leave 16 | #:create 17 | #:kick 18 | #:pull 19 | #:permissions 20 | #:message 21 | #:users 22 | #:channels 23 | #:user-info 24 | #:failure 25 | #:malformed-update 26 | #:connection-unstable 27 | #:too-many-connections 28 | #:update-failure 29 | #:update-id 30 | #:invalid-update 31 | #:username-mismatch 32 | #:incompatible-version 33 | #:invalid-password 34 | #:no-such-profile 35 | #:username-taken 36 | #:no-such-channel 37 | #:already-in-channel 38 | #:not-in-channel 39 | #:channelname-taken 40 | #:bad-name 41 | #:insufficient-permissions 42 | #:invalid-permissions 43 | #:no-such-user 44 | #:too-many-updates)) 45 | 46 | (defpackage #:lichat-rpl 47 | (:nicknames #:org.shirakumo.maiden.clients.lichat.rpl) 48 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 49 | (:use) 50 | (:export 51 | #:update 52 | #:ping 53 | #:pong 54 | #:connect 55 | #:disconnect 56 | #:register 57 | #:join 58 | #:leave 59 | #:create 60 | #:kick 61 | #:pull 62 | #:permissions 63 | #:message 64 | #:users 65 | #:channels 66 | #:user-info 67 | #:failure 68 | #:malformed-update 69 | #:connection-unstable 70 | #:too-many-connections 71 | #:update-failure 72 | #:update-id 73 | #:invalid-update 74 | #:username-mismatch 75 | #:incompatible-version 76 | #:invalid-password 77 | #:no-such-profile 78 | #:username-taken 79 | #:no-such-channel 80 | #:already-in-channel 81 | #:not-in-channel 82 | #:channelname-taken 83 | #:bad-name 84 | #:insufficient-permissions 85 | #:invalid-permissions 86 | #:no-such-user 87 | #:too-many-updates)) 88 | 89 | (defpackage #:maiden-lichat 90 | (:nicknames #:org.shirakumo.maiden.clients.lichat) 91 | (:use #:cl #:maiden #:maiden-networking #:maiden-client-entities) 92 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 93 | (:export 94 | #:lichat-user 95 | #:lichat-channel 96 | #:lichat-client 97 | #:username 98 | #:password 99 | #:bridge)) 100 | -------------------------------------------------------------------------------- /modules/api-access/toolkit.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.api-access) 2 | 3 | (defun construct-url (url get) 4 | (flet ((p (val) 5 | (typecase val 6 | (symbol (string-downcase val)) 7 | (T (princ-to-string val))))) 8 | (format NIL "~a?~{~2{~a=~a~}~^&~}" 9 | url (loop for (key val) in get 10 | collect (list (drakma:url-encode (p key) :utf8) 11 | (drakma:url-encode (p val) :utf8)))))) 12 | 13 | (defun request (url &key get post (method :get) (external-format :utf8) other-args) 14 | (let ((drakma:*text-content-types* (list* '("application" . "xml") 15 | '("application" . "xhtml+xml") 16 | '("application" . "json") 17 | '("application" . "x-sexp") 18 | '("application" . "x-lisp") 19 | drakma:*text-content-types*)) 20 | (url (construct-url url get))) 21 | (v:debug :maiden-api-access "Requesting ~s by ~a~@[ with params ~s~]" 22 | url method post) 23 | (apply #'drakma:http-request 24 | url 25 | :parameters (loop for (key val) in post collect (cons key val)) 26 | :method method 27 | :external-format-in external-format 28 | :external-format-out external-format 29 | :decode-content T 30 | :preserve-uri T 31 | other-args))) 32 | 33 | (defun parse-to (type input) 34 | (ecase type 35 | (:string input) 36 | (:json (jsown:parse input)) 37 | ((:html :xml) (plump:parse input)) 38 | (:sexp (read-from-string input)))) 39 | 40 | (defun request-as (type url &rest args &key get post external-format other-args) 41 | (declare (ignore get post external-format other-args)) 42 | (let ((values (multiple-value-list (apply #'request url args)))) 43 | (values-list (list* (parse-to type (first values)) (rest values))))) 44 | 45 | (defun json-v (json &rest path) 46 | (if path 47 | (cond ((and (consp json) (eql (car json) :obj)) 48 | (apply #'json-v (cdr (assoc (first path) (cdr json) :test #'string=)) (rest path))) 49 | ((consp json) 50 | (apply #'json-v (nth (first path) json) (rest path))) 51 | (T 52 | (error "Don't know how to traverse ~s by ~a" json path))) 53 | json)) 54 | -------------------------------------------------------------------------------- /entity.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden) 2 | 3 | (defgeneric matches (a b)) 4 | 5 | (defmethod matches (a b) 6 | (equal a b)) 7 | 8 | (defmethod matches ((a uuid:uuid) (b uuid:uuid)) 9 | (uuid:uuid= a b)) 10 | 11 | (defmethod matches (a (uuid uuid:uuid)) 12 | (matches uuid a)) 13 | 14 | (defmethod matches ((a uuid:uuid) (b vector)) 15 | (matches (uuid:uuid-to-byte-array a) b)) 16 | 17 | (defmethod matches ((a uuid:uuid) (b string)) 18 | (matches (princ-to-string a) b)) 19 | 20 | (defmethod matches ((a list) (b list)) 21 | (loop for (ael . arest) in a 22 | for (bel . brest) in b 23 | always (and (xnor arest brest) 24 | (matches a b)))) 25 | 26 | (defmethod matches ((a string) (b string)) 27 | (string= a b)) 28 | 29 | (defmethod matches ((a vector) (b vector)) 30 | (and (= (length a) (length b)) 31 | (loop for ael across a 32 | for bel across b 33 | always (matches ael bel)))) 34 | 35 | (defclass entity () 36 | ((id :initarg :id :accessor id)) 37 | (:default-initargs 38 | :id (princ-to-string (uuid:make-v4-uuid)))) 39 | 40 | (defmethod print-object ((entity entity) stream) 41 | (print-unreadable-object (entity stream :type T) 42 | (format stream "~a" (id entity)))) 43 | 44 | (defmethod matches ((a entity) (b entity)) 45 | (or (eq a b) 46 | (matches (id a) (id b)))) 47 | 48 | (defmethod matches ((entity entity) b) 49 | (matches (id entity) b)) 50 | 51 | (defmethod matches (a (entity entity)) 52 | (matches entity a)) 53 | 54 | (defclass named-entity (entity) 55 | ((name :initarg :name :accessor name)) 56 | (:default-initargs 57 | :name NIL)) 58 | 59 | (defmethod print-object ((named-entity named-entity) stream) 60 | (print-unreadable-object (named-entity stream :type T) 61 | (format stream "~@[~a ~]~a" (name named-entity) (id named-entity)))) 62 | 63 | (defmethod matches ((entity named-entity) b) 64 | (or (call-next-method) 65 | (and (name entity) 66 | (matches (name entity) b)))) 67 | 68 | (defgeneric find-entity (id place)) 69 | 70 | (defmethod find-entity (id (entity named-entity)) 71 | (when (matches id entity) 72 | entity)) 73 | 74 | (defmethod find-entity (id (list list)) 75 | (loop for item in list thereis (find-entity id item))) 76 | 77 | (defclass data-entity (entity) 78 | ((data :initform (make-hash-table :test 'equal) :accessor data))) 79 | 80 | (defmethod data-value (field (entity data-entity)) 81 | (gethash field (data entity))) 82 | 83 | (defmethod (setf data-value) (value field (entity data-entity)) 84 | (setf (gethash field (data entity)) value)) 85 | -------------------------------------------------------------------------------- /clients/relay/containers.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.relay) 2 | 3 | (defclass subscription-update (entity) 4 | ((target :initarg :target :accessor target) 5 | (subscriber :initarg :subscriber :accessor subscriber)) 6 | (:default-initargs 7 | :target T 8 | :subscriber (error "SUBSCRIBER required."))) 9 | 10 | (defclass subscription (subscription-update) 11 | ((event-type :initarg :event-type :accessor event-type) 12 | (filter :initarg :filter :accessor filter)) 13 | (:default-initargs 14 | :event-type (error "EVENT-TYPE required.") 15 | :filter T)) 16 | 17 | (defclass unsubscription (subscription-update) 18 | ()) 19 | 20 | (defclass network-update () 21 | ((new :initarg :new :accessor new) 22 | (bad :initarg :bad :accessor bad)) 23 | (:default-initargs 24 | :new () :bad ())) 25 | 26 | (defmethod print-object ((update network-update) stream) 27 | (print-unreadable-object (update stream :type T) 28 | (format stream "~s ~s ~s ~s" :new (new update) :bad (bad update)))) 29 | 30 | (defgeneric make-network-update (new bad)) 31 | 32 | (defmethod make-network-update ((new list) (bad list)) 33 | (make-instance 'network-update :new new :bad bad)) 34 | 35 | (defmethod make-network-update ((new network-update) (special null)) 36 | (make-instance 'network-update 37 | :new (loop for (hops destination name) in (new new) 38 | collect (list (1+ hops) destination name)) 39 | :bad (bad new))) 40 | 41 | (defmethod make-network-update ((new consumer) bad) 42 | (make-network-update `((0 ,(id new) ,(name new))) bad)) 43 | 44 | (defmethod make-network-update (new (bad consumer)) 45 | (make-network-update new `(,(id bad)))) 46 | 47 | (defmethod make-network-update ((new core) bad) 48 | (make-network-update (loop for c in (consumers new) 49 | unless (typep c 'agent) 50 | collect `(0 ,(id c) ,(name c))) bad)) 51 | 52 | (defmethod make-network-update (new (bad core)) 53 | (make-network-update new (loop for c in (consumers bad) 54 | unless (typep c 'agent) 55 | collect (id c)))) 56 | 57 | (defclass transport () 58 | ((event :initarg :event :accessor event) 59 | (target :initarg :target :accessor target))) 60 | 61 | (defmethod print-object ((transport transport) stream) 62 | (print-unreadable-object (transport stream :type T) 63 | (format stream "~s ~s ~s" :to (target transport) (event transport)))) 64 | 65 | (defgeneric make-transport (event target)) 66 | 67 | (defmethod make-transport ((event event) target) 68 | (make-instance 'transport :event event :target target)) 69 | -------------------------------------------------------------------------------- /agents/talk/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.talk) 2 | 3 | ;; codes.lisp 4 | (docs:define-docs 5 | (variable *language-code-map* 6 | "This is an alist of language names to language codes. 7 | 8 | See LANGUAGE-CODE") 9 | 10 | (function language-code 11 | "Returns the appropriate language code for the language, if such a code is known. Otherwise returns the language string itself again.")) 12 | 13 | ;; talk.lisp 14 | (docs:define-docs 15 | (type talk 16 | "This agent provides text-to-speech reading.") 17 | 18 | (function device 19 | "Accessor to the name of the device to use for the output. 20 | 21 | See TALK") 22 | 23 | (function output 24 | "Accessor to the cl-out123:output instance used to play back the voice. 25 | 26 | See TALK") 27 | 28 | (function get-speech-stream 29 | "Attempts to translate the text into the language using Google Translate TTS. 30 | 31 | If successful, returns a stream to the MP3 file returned by the API. 32 | If unsuccessful, an error is signalled. Note that only some languages 33 | are supported, and that only text up to 200 characters is allowed. 34 | 35 | See LANGUAGE-CODE") 36 | 37 | (function call-with-speech-file 38 | "Calls the function with a path to a temporary file containing the TTS mp3 file for the text and language. 39 | 40 | See GET-SPEECH-STREAM 41 | See UIOP:WITH-TEMPORARY-FILE") 42 | 43 | (function with-speech-file 44 | "Wrap the body in an env where PATH is a pathname to an MP3 file. 45 | 46 | See CALL-WITH-SPEECH-FILE") 47 | 48 | (function with-output 49 | "Wrap the body in an environment where OUT is a cl-out123:output that is ready for playback. 50 | 51 | See CL-OUT123:CONNECT 52 | See CL-OUT123:START") 53 | 54 | (function play-file 55 | "Play back the given MP3 file on the given output. 56 | 57 | If output is not given, a new one is constructed. 58 | 59 | See CL-MPG123:CONNECT 60 | See CL-OUT123:PLAY 61 | See WITH-OUTPUT") 62 | 63 | (function split-word-boundary 64 | "Attempt to split the text into a shorter version that does not exceed MAX characters. 65 | 66 | This tries to respect sentence and word boundaries in order to make 67 | the splitting as unawkward as possible.") 68 | 69 | (function talk 70 | "Speak the given text back. 71 | 72 | If the text is too long for the TTS API it is split up into multiple 73 | requests. Thus there might be an occasional gap where a new request 74 | and playback is started in the middle of the text. 75 | 76 | See SPLIT-WORD-BOUNDARY 77 | See PLAY-FILE") 78 | 79 | (command talk-en 80 | "Speak the given text in English. Note that this will be played back on the bot owner's machine.") 81 | 82 | (command talk-lang 83 | "Speak the given text in the requested language, if possible. Note that this will be played back on the bot owner's machine.")) 84 | -------------------------------------------------------------------------------- /agents/lookup/lookup.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.lookup) 2 | 3 | (defvar *lookup-functions* (make-hash-table :test 'equalp)) 4 | 5 | (defun lookup-function (archive) 6 | (or (gethash (string archive) *lookup-functions*) 7 | (error "Unknown archive ~s." archive))) 8 | 9 | (defun (setf lookup-function) (function archive) 10 | (setf (gethash (string archive) *lookup-functions*) function)) 11 | 12 | (defun remove-lookup-function (archive) 13 | (remhash (string archive) *lookup-functions*)) 14 | 15 | (defun list-archives () 16 | (loop for archive being the hash-keys of *lookup-functions* 17 | collect archive)) 18 | 19 | (defmacro define-lookup-function (archive args &body body) 20 | `(setf (lookup-function ',archive) 21 | (lambda ,args ,@body))) 22 | 23 | (defun look-up (archive term) 24 | (funcall (lookup-function archive) term)) 25 | 26 | (defmacro define-webpage-lookup (archive args &body body) 27 | `(define-lookup-function ,archive ,args 28 | (multiple-value-bind (root code headers url) 29 | (request-as :html (progn ,@body)) 30 | (declare (ignore headers)) 31 | (when (/= code 200) 32 | (error "~s not found in ~a." ,(first args) ',archive)) 33 | (list (list ,(first args) 34 | (puri:render-uri url NIL) 35 | (lquery:$1 root "title" (text))))))) 36 | 37 | (defun longest (things) 38 | (let ((longest (first things))) 39 | (dolist (thing (rest things) longest) 40 | (when (< (length longest) (length thing)) 41 | (setf longest thing))))) 42 | 43 | (defun table-find (term table) 44 | (let ((term (cl-ppcre:split " +" term))) 45 | (loop for (matches . data) in table 46 | ;; Attempt to do exact match first. 47 | do (dolist (match matches) 48 | (when (loop for part in term 49 | always (string-equal part match)) 50 | (return-from table-find 51 | (list (list* match data))))) 52 | ;; Otherwise collect if fuzzy matching. 53 | when (loop for match in matches 54 | thereis (loop for part in term 55 | always (search part match :test #'char-equal))) 56 | collect (list* (longest matches) data)))) 57 | 58 | (defmacro define-table-lookup (archive &body entries) 59 | (let ((term (gensym "TERM")) 60 | (entries (loop for entry in entries 61 | collect (destructuring-bind (matches url &optional title) entry 62 | (list (enlist matches) 63 | url 64 | (or title (format NIL "~{~@(~a~)~^ ~}" (enlist matches)))))))) 65 | `(define-lookup-function ,archive (,term) 66 | (or (table-find ,term ',entries) 67 | (error "~s not found in ~a." ,term ',archive))))) 68 | -------------------------------------------------------------------------------- /modules/storage/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.modules.storage) 2 | 3 | ;; storage.lisp 4 | (docs:define-docs 5 | (variable *storages* 6 | "This is a hash table to store caches of the storages.") 7 | 8 | (function package-short-name 9 | "Returns the shortest nickname for the given package.") 10 | 11 | (function left-trim-string 12 | "If the STRING starts with TRIM, then trim it off.") 13 | 14 | (function split 15 | "Split the string by CHAR. Only stores nonempty substrings.") 16 | 17 | (function normalize-fqdn 18 | "Attempts to normalize the FQDN given. 19 | 20 | 1. Everything is downcased 21 | 2. Dots are replaced by slashes 22 | 3. If the result starts with org/shirakumo/, it is trimmed. 23 | 4. If the result starts with maiden, it is trimmed. 24 | 5. If the result starts with -/, it is trimmed.") 25 | 26 | (function package-path 27 | "Discover a path for where to put the storage file for the given package.") 28 | 29 | (function find-config-directory 30 | "Attempt to find a suitable configuration directory. 31 | 32 | If there is a directory named \"config\" within MAIDEN:*ROOT*, 33 | then that is used. Otherwise, a subdirectory named \"maiden\" 34 | in the (UBIQUITOUS:CONFIG-DIRECTORY) is returned.") 35 | 36 | (functon config-pathname 37 | "Returns a suitable pathname to the configuration file for the given object.") 38 | 39 | (function storage 40 | "Accesses the storage object for the given thing. If the storage has not yet been loaded, NIL is returned. 41 | 42 | See *STORAGES*") 43 | 44 | (function ensure-storage 45 | "Returns the proper storage object for the given thing. If the storage has not yet been loaded, it is restored from disk if possible. 46 | 47 | The storage object is not always loaded from disk, and is 48 | instead cached in memory. 49 | 50 | See STORAGE 51 | See RESTORE") 52 | 53 | (function with-storage 54 | "Ensure the storage is available within the body. 55 | 56 | The designator determines for \"what\" the configuration is. 57 | If ALWAYS-LOAD is non-NIL, then the storage is first loaded 58 | from disk every time. 59 | 60 | See CONFIG-PATHNAME 61 | See ENSURE-STORAGE 62 | See UBIQUITOUS:WITH-LOCAL-STORAGE") 63 | 64 | (function reload 65 | "Causes the configuration to be reloaded. 66 | 67 | If DESIGNATOR is NIL, then the configuration is reloaded 68 | for everything. 69 | 70 | The configuration is not immediately reloaded. The reloading 71 | is deferred until the storage in question is actually needed. 72 | 73 | See STORAGE 74 | See *STORAGES*") 75 | 76 | (function offload 77 | "Saves the storage for the given designator to disk. 78 | 79 | The storage is always serialised under the MAIDEN-USER 80 | package. 81 | 82 | See UBIQUITOUS:OFFLOAD 83 | See CONFIG-PATHNAME 84 | See STORAGE") 85 | 86 | (function restore 87 | "Restores the storage for the given designator from disk. 88 | 89 | See UBIQUITOUS:RESTORE 90 | See CONFIG-PATHNAME") 91 | 92 | (function define-stored-accessor 93 | "Define an accessor that defers to the storage instead of the object's slot. 94 | 95 | See WITH-STORAGE")) 96 | -------------------------------------------------------------------------------- /agents/crimes/README.md: -------------------------------------------------------------------------------- 1 | ## About Maiden-Crimes 2 | This is a clone of the popular Cardcast / Cards Against Humanity / Xyzzy type of game. It supports custom deck creation as well as downloading decks directly from . The game works through text only and should thus be compatible with any kind of client that has support for the [maiden-client-entities](../../modules/client-entities/) protocol. 3 | 4 | ## How To 5 | First, open up a game lobby 6 | 7 | ::open crimes 8 | 9 | Following this, users can enter the game. Users can still enter the game while it is running too, though. 10 | 11 | ::join crimes 12 | 13 | Next you should add card decks to the game. You can either create your own decks locally and add those, or search for ones and download them through [Cardcast](https://www.cardcastgame.com/). You only need to download them once, but you do need to add the decks to each new game you start. Here's all of the codes for the official CAH packs for your convenience: 14 | 15 | ::download crime deck CAHBS CAH 16 | ::download crime deck CAHE1 CAHE1 17 | ::download crime deck CAHE2 CAHE2 18 | ::download crime deck CAHE3 CAHE3 19 | ::download crime deck CAHE4 CAHE4 20 | ::download crime deck EU6CJ CAHE5 21 | ::download crime deck PEU3Q CAHE6 22 | ::download crime deck XMAS1 CAHH2 23 | ::download crime deck K4QVW CAHH3 24 | ::download crime deck CDJDV CAHH4 25 | ::download crime deck BBBOX CAHBB 26 | ::download crime deck NXEP0 CAH90 27 | ::download crime deck PNNE9 CAHSCI 28 | ::download crime deck KW8B6 CAHNS2 29 | ::download crime deck DP2VU CAHNS3 30 | ::download crime deck PAXP3 CAHPAX 31 | 32 | To create a game with them, simply use the add command. You can also add by CardCast ID directly. 33 | 34 | ::add crimes deck CAH 35 | ::add crimes deck CAHBB 36 | 37 | Once you have all the cards as you like them and all the players who want to play have joined, you can start the game proper. 38 | 39 | ::start crimes 40 | 41 | From there on out, every round an officer will be selected, while everyone else is a potential criminal. The criminals will get a private message that lists all the possible cards in their hand that they can use to answer the call card. To enter responses, each player can use 42 | 43 | ::commit crime 2 3 4 44 | 45 | Where `2 3 4` are the numbers of the cards the player would like to select. You can also submit multiple times, if you prefer doing that. Each time you submit, it will show you a preview of what your submission will look like. Once all players have submitted enough responses to fill the call, the responses are sorted randomly and presented to all players in the main channel. The officer then gets to convict a criminal. 46 | 47 | ::convict criminal 3 48 | 49 | The criminal's name is then revealed, his score is increased, and a new round with a new officer is started. This continues until either the game is ended explicitly, all players have left the game, or a player reaches the necessary score. 50 | 51 | See the other commands in the symbol index to see how you can create and manage decks using commands. 52 | -------------------------------------------------------------------------------- /agents/vote/vote.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.vote) 2 | 3 | (define-consumer vote (agent) 4 | ((votes :initform (make-hash-table :test 'eq) :accessor votes))) 5 | 6 | (defun integer->letter (int) 7 | (code-char (+ int (1- (char-code #\a))))) 8 | 9 | (defun letter->integer (char) 10 | (- (char-code (char-downcase char)) (1- (char-code #\a)))) 11 | 12 | (defun end-vote (c ev) 13 | (let ((options (gethash (channel ev) (votes c)))) 14 | (when options 15 | (remhash (channel ev) (votes c)) 16 | (let* ((options (sort (rest options) #'> :key #'length)) 17 | (winning (first options))) 18 | (reply ev "Voting is now closed. The winning option, with ~d out of ~d votes, is:" 19 | (length (rest winning)) 20 | (loop for option in options 21 | summing (length (rest option)))) 22 | (reply ev " ~a" (first winning)))))) 23 | 24 | (define-command (vote start-vote) (c ev &rest options) 25 | :command "vote between" 26 | (when (gethash (channel ev) (votes c)) 27 | (error "There's already a vote going on in this channel")) 28 | (when (= 0 (length options)) 29 | (error "You'll have to provide at least one option, come on.")) 30 | (when (< 26 (length options)) 31 | (error "More than 26 options for a vote is not possible. If this was not your intention, please make sure to enclose each option in double-quotes like so:~% ::vote between \"egg\" \"chicken\"")) 32 | (setf (gethash (channel ev) (votes c)) 33 | (list* (user ev) 34 | (mapcar #'list options))) 35 | (reply ev "Please vote using the letters corresponding to the option you like.") 36 | (loop for i from 1 37 | for option in options 38 | do (reply ev "~c. ~a" (integer->letter i) option))) 39 | 40 | (define-handler (vote vote-counter (and message-event channel-event passive-event)) (c ev message) 41 | (unless (matches (username (client ev)) (user ev)) 42 | (cl-ppcre:register-groups-bind (option) ("\\s*(\\w)[.)!]\\s*" message) 43 | (let ((options (rest (gethash (channel ev) (votes c))))) 44 | (when (and options (< 0 (letter->integer (elt option 0)))) 45 | (let ((option (nth (1- (letter->integer (elt option 0))) options))) 46 | (when (and option (not (find (user ev) (cdr option)))) 47 | (setf (cdr option) (cons (user ev) (cdr option))) 48 | ;; If all users in the channel voted, end it automatically. 49 | (when (loop for user in (users (channel ev)) 50 | always (or (eql (name user) (username c)) 51 | (loop for option in options 52 | thereis (find user (rest option))))) 53 | (end-vote c ev))))))))) 54 | 55 | (define-command (vote end-vote) (c ev option) 56 | :command "end vote" 57 | (let ((options (gethash (channel ev) (votes c)))) 58 | (unless options 59 | (error "There is no vote going on in this channel.")) 60 | (unless (eql (first options) (user ev)) 61 | (error "Only the user who started the vote may end it.")) 62 | (end-vote c ev))) 63 | -------------------------------------------------------------------------------- /clients/relay/virtual-client.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.clients.relay) 2 | 3 | (define-consumer virtual-client (client) 4 | ((links :initarg :links :accessor links)) 5 | (:default-initargs 6 | :links ())) 7 | 8 | (defgeneric make-virtual-client (target &key name links)) 9 | 10 | (defmethod make-virtual-client ((target uuid:uuid) &key name links) 11 | (make-instance 'virtual-client :id target :name name :links links)) 12 | 13 | (defmethod make-virtual-client ((target string) &key name links) 14 | (make-virtual-client (uuid:make-uuid-from-string target) :name name :links links)) 15 | 16 | (defmethod make-virtual-client ((target named-entity) &key (name (name target)) links) 17 | (make-virtual-client (id target) :name name :links links)) 18 | 19 | (defmacro with-response-event ((response event client &key (timeout 60)) &body body) 20 | (let ((response-g (gensym "RESPONSE")) 21 | (event-g (gensym "EVENT")) 22 | (core-g (gensym "CORE")) 23 | (client-g (gensym "CLIENT"))) 24 | `(let* ((,client-g ,client) 25 | (,event-g ,event) 26 | (,core-g (first (cores ,client-g)))) 27 | (with-awaiting (,core-g response-event) (,response-g ,response) 28 | (relay ,event-g ,client (consumer 'relay ,core-g)) 29 | :filter `(uuid:uuid= deeds:identifier ,(deeds:identifier ,event-g)) 30 | :timeout ,timeout 31 | ,@body)))) 32 | 33 | (defmethod slot-missing (class (client virtual-client) slot operation &optional value) 34 | (let* ((core (first (cores client))) 35 | (event (ecase operation 36 | (setf (make-instance 'slot-setf-event :source core :object client :slot slot :value value)) 37 | (slot-makunbound (make-instance 'slot-makunbound-event :source core :object client :slot slot)) 38 | (slot-value (make-instance 'slot-value-event :source core :object client :slot slot)) 39 | (slot-boundp (make-instance 'slot-boundp-event :source core :object client :slot slot))))) 40 | (with-response-event (payload event core) 41 | payload))) 42 | 43 | ;; (defmacro define-virtual-client-method (name args) 44 | ;; (let ((form-g (gensym "FORM")) 45 | ;; (event-g (gensym "EVENT")) 46 | ;; (response-g (gensym "RESPONSE")) 47 | ;; (client (or (loop for arg in args 48 | ;; until (find arg lambda-list-keywords) 49 | ;; thereis (and (listp arg) (eql (second arg) 'virtual-client) 50 | ;; (first arg))) 51 | ;; (error "No ~s specializer in arguments list." 'virtual-client)))) 52 | ;; `(defmethod ,name ,args 53 | ;; (let* ((,form-g (list ',name ,@(loop for arg in args 54 | ;; unless (find arg lambda-list-keywords) 55 | ;; collect (if (listp arg) (first arg) arg)))) 56 | ;; (,event-g (make-instance 'generic-call-event :source (first (cores ,client)) :form ,form-g))) 57 | ;; (with-response-event ((,response-g response) ,event-g ,client) 58 | ;; ,response-g))))) 59 | -------------------------------------------------------------------------------- /agents/markov/interface.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.markov) 2 | 3 | (define-consumer markov (agent) 4 | ((generator :initform NIL) 5 | (save-counter :initform 0 :accessor save-counter))) 6 | 7 | (defun file (c) 8 | (with-storage (c) 9 | (defaulted-value 10 | (make-pathname :type "dat" :defaults (config-pathname 'dictionary)) 11 | :dictionary))) 12 | 13 | (defun save-frequency (c) 14 | (with-storage (c) 15 | (defaulted-value 20 :save-frequency))) 16 | 17 | (defun ramble-chance (c) 18 | (with-storage (c) 19 | (defaulted-value 1 :ramble-chance))) 20 | 21 | (defun (setf ramble-chance) (val c) 22 | (assert (<= 0.0 val 100.0) () "The chance must be in [0, 100].") 23 | (with-storage (c) 24 | (setf (value :ramble-chance) val))) 25 | 26 | (defmethod generator ((markov markov)) 27 | (or (slot-value markov 'generator) 28 | (setf (slot-value markov 'generator) 29 | (read-generator (file markov))))) 30 | 31 | (defun maybe-save (markov &key force) 32 | (incf (save-counter markov)) 33 | (when (or force (<= (save-frequency markov) (save-counter markov))) 34 | (setf (save-counter markov) 0) 35 | (ensure-directories-exist (file markov)) 36 | (write-generator (generator markov) (file markov)))) 37 | 38 | (define-handler (markov handle (and message-event passive-event)) (c ev message) 39 | :class activatable-handler 40 | :module #.*package* 41 | (learn message (generator c)) 42 | (maybe-save c) 43 | (when (< (random 100.0) (ramble-chance c)) 44 | (let ((topic (find-topic message (generator c)))) 45 | (reply ev "~a" (or (find-sentence (generator c) topic) 46 | (make-sentence (generator c))))))) 47 | 48 | (define-command (markov ramble) (c ev) 49 | :command "ramble" 50 | (reply ev "~a" (make-sentence (generator c)))) 51 | 52 | (define-command (markov ramble-about) (c ev &string topic) 53 | :command "ramble about" 54 | (let ((topic (unless (string= "" topic) topic))) 55 | (reply ev "~a" (or (find-sentence (generator c) topic) 56 | (format NIL "Couldn't think of anything~@[ about ~a~]." topic))))) 57 | 58 | (define-command (markov ramble-chance) (c ev) 59 | :command "ramble chance" 60 | (reply ev "The current chance of replying to a message is ~a." (ramble-chance c))) 61 | 62 | (define-command (markov set-ramble-chance) (c ev new-value) 63 | :command "set ramble chance" 64 | (setf (ramble-chance c) (parse-number:parse-real-number new-value)) 65 | (reply ev "The rambling chance has been set to ~a." new-value)) 66 | 67 | (defun count-uniques (seq) 68 | (let ((table (make-hash-table :test 'eql :size (length seq)))) 69 | (loop for a across seq do (setf (gethash a table) T)) 70 | (hash-table-count table))) 71 | 72 | (define-command (markov stats) (c ev) 73 | :command "markov stats" 74 | (reply ev "The markov dictionary knows ~,,'':d word~:p with ~,,'':d possible connection~:p." 75 | (length (words (generator c))) 76 | (loop for v being the hash-values of (chains (generator c)) 77 | summing (loop for c being the hash-values of v 78 | summing (count-uniques c))))) 79 | -------------------------------------------------------------------------------- /agents/silly/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.silly) 2 | 3 | (docs:define-docs 4 | (variable *silly-functions* 5 | "This holds a map from names to silly functions. 6 | 7 | A silly function should take two arguments, the first 8 | being the name of the sender who sent the message, and 9 | the second being a message text string. 10 | 11 | The silly function should, if it wants to handle the 12 | message, return a string which will be displayed to the 13 | user. 14 | 15 | See SILLY-FUNCTION 16 | See REMOVE-SILLY-FUNCTION 17 | See DISPATCH-SILLY 18 | See DEFINE-SILLY") 19 | 20 | (function silly-function 21 | "Accessor to the silly function of the given name. 22 | 23 | See *SILLY-FUNCTIONS* 24 | See REMOVE-SILLY-FUNCTION") 25 | 26 | (function remove-silly-function 27 | "Removes the silly function of the given name. 28 | 29 | See SILLY-FUNCTION 30 | See *SILLY-FUNCTIONS*") 31 | 32 | (function dispatch-silly 33 | "Dispatch the sender and message to the silly functions and gather all resulting messages into a list. 34 | 35 | See *SILLY-FUNCTIONS*") 36 | 37 | (function define-silly 38 | "Define a new silly function. 39 | 40 | See *SILLY-FUNCTIONS* 41 | See SILLY-FUNCTION") 42 | 43 | (function define-simple-silly 44 | "Define a simple silly function. 45 | 46 | The message is matched against REGEX and the regex' 47 | groups are destructured into the ARGS variables. 48 | The body should then be a format string followed by 49 | the format arguments. 50 | 51 | See DEFINE-SILLY 52 | See CL-PPCRE:REGISTER-GROUPS-BIND 53 | See CL:FORMAT") 54 | 55 | (function cut-to-first-vowel 56 | "Cut the word up until the first vowel, if possible. If not, just return the whole word.") 57 | 58 | (type silly 59 | "This module implements silly commands and responses.") 60 | 61 | (command eight 62 | "8") 63 | 64 | (command jerkcity 65 | "Respond with a randomly selected jerkcity comic strip.") 66 | 67 | (command roll 68 | "Roll some dice. Note that this is not provided with the intention of providing gambling means.") 69 | 70 | (command hello 71 | "Greet the bot.") 72 | 73 | (command present 74 | "Give the bot something nice!") 75 | 76 | (command you-are 77 | "Tell the bot what it is.") 78 | 79 | (command make 80 | "Order the bot to make you something nice.") 81 | 82 | (variable *fortunes* 83 | "Holds a list of \"fortune\" messages. 84 | 85 | Should be populated by the fortunes.txt file. 86 | 87 | See FORTUNE") 88 | 89 | (function fortune 90 | "Pick a fortune message for a user of the given name at the given time. 91 | 92 | The fortune to pick is decided on a hash of the time and name. 93 | It is thus deterministic, but highly volatile. In order to make 94 | it deterministic for a whole day, the timestamp is reduced to 95 | a counter for days. 96 | 97 | See *FORTUNES*") 98 | 99 | (command fortune 100 | "Display the fortune of today for you or for a user. It changes daily!") 101 | 102 | (command tell 103 | "Show someone else the output of a command.")) 104 | -------------------------------------------------------------------------------- /agents/trivia/trivia.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.trivia) 2 | 3 | (defvar *questions* (make-hash-table :test 'eql)) 4 | (defvar *categories* (make-hash-table :test 'equalp)) 5 | 6 | (defclass question () 7 | ((text :initarg :text :accessor text) 8 | (answers :initarg :answers :accessor answers) 9 | (hint :initarg :hint :accessor hint) 10 | (id :initarg :id :accessor id)) 11 | (:default-initargs :id (incf (gethash :next-id *questions* 0)))) 12 | 13 | (defmethod print-object ((question question) stream) 14 | (print-unreadable-object (question stream :type T) 15 | (format stream "~a ~s" (id question) (text question)))) 16 | 17 | (defmethod id ((id integer)) 18 | id) 19 | 20 | (defmethod check (answer (question question)) 21 | (loop for correct in (answers question) 22 | thereis (search correct answer :test #'char-equal))) 23 | 24 | (defun question (id) 25 | (gethash id *questions*)) 26 | 27 | (defun (setf question) (question id) 28 | (setf (gethash (id id) *questions*) question)) 29 | 30 | (defun remquestion (id) 31 | (remhash id *questions*)) 32 | 33 | (defun category (category) 34 | (mapcar #'question (or (gethash category *categories*) 35 | (error "No such category ~s." category)))) 36 | 37 | (defun add-category (category id) 38 | (pushnew (id id) (gethash category *categories*))) 39 | 40 | (defun remove-category (category &optional id) 41 | (if id 42 | (setf (gethash category *categories*) 43 | (remove (id id) (gethash category *categories*))) 44 | (remhash category *categories*))) 45 | 46 | (defun categories (&optional id) 47 | (if id 48 | (loop for k being the hash-keys of *categories* 49 | for v being the hash-values of *categories* 50 | when (find id v) collect k) 51 | (loop for k being the hash-keys of *categories* collect k))) 52 | 53 | (defun add-question (question answers &key hint categories) 54 | (let ((question (make-instance 'question :text question 55 | :answers (if (listp answers) answers (list answers)) 56 | :hint hint))) 57 | (dolist (category categories) 58 | (add-category category question)) 59 | (setf (question question) question))) 60 | 61 | (defun update-question (id &key question answers (hint NIL hint-p) (categories NIL cat-p)) 62 | (let ((q (or (question id) (error "No question with id ~a found." id)))) 63 | (when question (setf (question q) question)) 64 | (when answers (setf (answers q) answers)) 65 | (when hint-p (setf (hint q) hint)) 66 | (when cat-p 67 | (dolist (category (categories)) (remove-category category q)) 68 | (dolist (category categories) (add-category category q))) 69 | q)) 70 | 71 | (defun remove-question (id) 72 | (maphash (lambda (k v) (setf (gethash k *categories*) (remove id v))) *categories*) 73 | (remquestion id)) 74 | 75 | (defun load-questions () 76 | (setf *questions* (maiden-storage:restore 'question)) 77 | (setf *categories* (maiden-storage:restore 'categories))) 78 | 79 | (defun save-questions () 80 | (maiden-storage:offload 'question *questions*) 81 | (maiden-storage:offload 'categories *categories*)) 82 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | 3 | (defpackage #:maiden 4 | (:nicknames #:org.shirakumo.maiden) 5 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 6 | (:use #:cl #:deeds) 7 | (:shadow 8 | #:event-class 9 | #:event 10 | #:define-event 11 | #:define-handler 12 | #:define-command 13 | #:with-response 14 | #:with-awaiting 15 | #:do-issue 16 | #:broadcast 17 | #:message-event 18 | #:info-event 19 | #:warning-event 20 | #:error-event) 21 | ;; re-export from deeds 22 | (:export 23 | #:running 24 | #:start 25 | #:stop 26 | #:issue 27 | #:cancel) 28 | ;; agent.lisp 29 | (:export 30 | #:agent) 31 | ;; client.lisp 32 | (:export 33 | #:client) 34 | ;; conditions.lisp 35 | (:export 36 | #:maiden-condition 37 | #:core-condition 38 | #:core 39 | #:consumer-name-duplicated-warning 40 | #:existing-consumer 41 | #:new-consumer 42 | #:agent-condition 43 | #:agent 44 | #:agent-already-exists-error 45 | #:existing-agent 46 | #:client-condition 47 | #:client) 48 | ;; consumer.lisp 49 | (:export 50 | #:consumer-class 51 | #:direct-handlers 52 | #:effective-handlers 53 | #:instances 54 | #:consumer 55 | #:handlers 56 | #:cores 57 | #:lock 58 | #:core-handlers 59 | #:abstract-handler 60 | #:target-class 61 | #:options 62 | #:name 63 | #:add-to-consumer 64 | #:instantiate-handler 65 | #:define-handler 66 | #:remove-handler 67 | #:define-function-handler 68 | #:remove-function-handler 69 | #:define-instruction 70 | #:remove-instruction 71 | #:define-query 72 | #:remove-query 73 | #:define-consumer) 74 | ;; core.lisp 75 | (:export 76 | #:consumer 77 | #:add-consumer 78 | #:remove-consumer 79 | #:core 80 | #:abort-handling 81 | #:primary-loop 82 | #:block-loop 83 | #:consumers 84 | #:with-awaiting 85 | #:make-core 86 | #:add-to-core) 87 | ;; entity.lisp 88 | (:export 89 | #:matches 90 | #:entity 91 | #:id 92 | #:named-entity 93 | #:name 94 | #:data-entity 95 | #:data 96 | #:data-value) 97 | ;; event.lisp 98 | (:export 99 | #:advice 100 | #:event 101 | #:define-event) 102 | ;; standard-events.lisp 103 | (:export 104 | #:passive-event 105 | #:active-event 106 | #:instruction-event 107 | #:respond 108 | #:query-event 109 | #:response-event 110 | #:client-event 111 | #:client 112 | #:core-event 113 | #:consumer-added 114 | #:consumer-removed) 115 | ;; toolkit.lisp 116 | (:export 117 | #:*root* 118 | #:*debugger* 119 | #:maybe-invoke-debugger 120 | #:xor 121 | #:xnor 122 | #:kw 123 | #:enlist 124 | #:unlist 125 | #:starts-with 126 | #:with-default-encoding 127 | #:update-list 128 | #:with-retry-restart 129 | #:do-issue 130 | #:broadcast 131 | #:named-lambda 132 | #:universal-to-unix 133 | #:unix-to-universal 134 | #:get-unix-time 135 | #:format-relative-time 136 | #:format-absolute-time 137 | #:format-time 138 | #:find-consumer-in-package)) 139 | 140 | (defpackage #:maiden-user 141 | (:nicknames #:org.shirakumo.maiden.user) 142 | (:local-nicknames (#:v #:org.shirakumo.verbose)) 143 | (:use #:cl #:maiden)) 144 | -------------------------------------------------------------------------------- /agents/talk/codes.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.talk) 2 | 3 | (defvar *language-code-map* 4 | '(("Afrikaans" . "af") 5 | ("Albanian" . "sq") 6 | ("Amharic" . "am") 7 | ("Arabic" . "ar") 8 | ("Armenian" . "hy") 9 | ("Azeerbaijani" . "az") 10 | ("Basque" . "eu") 11 | ("Belarusian" . "be") 12 | ("Bengali" . "bn") 13 | ("Bosnian" . "bs") 14 | ("Bulgarian" . "bg") 15 | ("Catalan" . "ca") 16 | ("Cebuano" . "ceb") 17 | ("Chichewa" . "ny") 18 | ("Chinese" . "zh") 19 | ("Simplified Chinese" . "zh-CN") 20 | ("Traditional Chinese" . "zh-TW") 21 | ("Corsican" . "co") 22 | ("Croatian" . "hr") 23 | ("Czech" . "cs") 24 | ("Danish" . "da") 25 | ("Dutch" . "nl") 26 | ("English" . "en") 27 | ("Esperanto" . "eo") 28 | ("Estonian" . "et") 29 | ("Filipino" . "tl") 30 | ("Finnish" . "fi") 31 | ("French" . "fr") 32 | ("Frisian" . "fy") 33 | ("Galician" . "gl") 34 | ("Georgian" . "ka") 35 | ("German" . "de") 36 | ("Greek" . "el") 37 | ("Gujarati" . "gu") 38 | ("Haitian Creole" . "ht") 39 | ("Hausa" . "ha") 40 | ("Hawaiian" . "haw") 41 | ("Hebrew" . "iw") 42 | ("Hindi" . "hi") 43 | ("Hmong" . "hmn") 44 | ("Hungarian" . "hu") 45 | ("Icelandic" . "is") 46 | ("Igbo" . "ig") 47 | ("Indonesian" . "id") 48 | ("Irish" . "ga") 49 | ("Italian" . "it") 50 | ("Japanese" . "ja") 51 | ("Javanese" . "jw") 52 | ("Kannada" . "kn") 53 | ("Kazakh" . "kk") 54 | ("Khmer" . "km") 55 | ("Korean" . "ko") 56 | ("Kurdish" . "ku") 57 | ("Kyrgyz" . "ky") 58 | ("Lao" . "lo") 59 | ("Latin" . "la") 60 | ("Latvian" . "lv") 61 | ("Lithuanian" . "lt") 62 | ("Luxembourgish" . "lb") 63 | ("Macedonian" . "mk") 64 | ("Malagasy" . "mg") 65 | ("Malay" . "ms") 66 | ("Malayalam" . "ml") 67 | ("Maltese" . "mt") 68 | ("Maori" . "mi") 69 | ("Marathi" . "mr") 70 | ("Mongolian" . "mn") 71 | ("Burmese" . "my") 72 | ("Nepali" . "ne") 73 | ("Norwegian" . "no") 74 | ("Pashto" . "ps") 75 | ("Persian" . "fa") 76 | ("Polish" . "pl") 77 | ("Portuguese" . "pt") 78 | ("Punjabi" . "ma") 79 | ("Romanian" . "ro") 80 | ("Russian" . "ru") 81 | ("Samoan" . "sm") 82 | ("Scots Gaelic" . "gd") 83 | ("Serbian" . "sr") 84 | ("Sesotho" . "st") 85 | ("Shona" . "sn") 86 | ("Sindhi" . "sd") 87 | ("Sinhala" . "si") 88 | ("Slovak" . "sk") 89 | ("Slovenian" . "sl") 90 | ("Somali" . "so") 91 | ("Spanish" . "es") 92 | ("Sundanese" . "su") 93 | ("Swahili" . "sw") 94 | ("Swedish" . "sv") 95 | ("Tajik" . "tg") 96 | ("Tamil" . "ta") 97 | ("Telugu" . "te") 98 | ("Thai" . "th") 99 | ("Turkish" . "tr") 100 | ("Ukrainian" . "uk") 101 | ("Urdu" . "ur") 102 | ("Uzbek" . "uz") 103 | ("Vietnamese" . "vi") 104 | ("Welsh" . "cy") 105 | ("Xhosa" . "xh") 106 | ("Yiddish" . "yi") 107 | ("Yoruba" . "yo") 108 | ("Zulu" . "zu"))) 109 | 110 | (defun language-code (language) 111 | (or (loop for (name . code) in *language-code-map* 112 | do (when (or (search language name :test #'char-equal) 113 | (search name language :test #'char-equal)) 114 | (return code))) 115 | language)) 116 | -------------------------------------------------------------------------------- /maiden-logo.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 20 | 22 | 25 | 29 | 33 | 34 | 43 | 44 | 63 | 65 | 66 | 68 | image/svg+xml 69 | 71 | 72 | 73 | 74 | 75 | 80 | Maiden 91 | 92 | 93 | -------------------------------------------------------------------------------- /agents/notify/documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.notify) 2 | 3 | ;; interface.lisp 4 | (docs:define-docs 5 | (type notify 6 | "This agent implements an offline messaging system. It is useful for reminding people if they are not currently around.") 7 | 8 | (function handle-note-notification 9 | "This goes through all the notes for the user and replies to the even with each one of them, if the note's trigger matches the one given. 10 | 11 | All applicable notes are removed. 12 | 13 | See REMOVE-NOTE 14 | See TRIGGER 15 | See USER-NOTES") 16 | 17 | (function handle-note-creation 18 | "This handles the creation of a new note and takes care of some special cases. 19 | 20 | No note is created if the target is empty or the 21 | user themselves. 22 | 23 | See MAKE-NOTE 24 | See NORMALIZE-USER-NAME") 25 | 26 | (command forget-notes 27 | "Throws out all notes for yourself, or a specific user. Useful if you've already seen the notes, don't need them anymore, or addressed them to the wrong person.") 28 | 29 | (command send-join-note 30 | "Send a notification message that will be displayed as soon as the user joins a channel the bot is on again.") 31 | 32 | (command send-note 33 | "Send a notification message that will be displayed as soon as the user speaks again.")) 34 | 35 | ;; notes.lisp 36 | (docs:define-docs 37 | (type note 38 | "This class holds all relevant information for a notification. 39 | 40 | Notes are a way of reminding another user of something 41 | at a time where they're hopefully paying attention again. 42 | 43 | After a note instance has been created, it is 44 | automatically registered. 45 | 46 | See ID 47 | See FROM 48 | See TO 49 | See MESSAGE 50 | See DATE 51 | See TRIGGER 52 | See MAKE-NOTE 53 | See REGISTER-NOTE") 54 | 55 | (function from 56 | "Accessor to the source of the note. 57 | 58 | See NOTE") 59 | 60 | (function to 61 | "Accessor to the recipient of the note. 62 | 63 | See NOTE") 64 | 65 | (function date 66 | "Accessor to the universal-time that denotes the note's creation time. 67 | 68 | See NOTE") 69 | 70 | (function trigger 71 | "Accessor to the note's trigger condition. 72 | 73 | Can be one of 74 | - :MESSAGE The note is sent out when the user next 75 | writes a new message. 76 | - :JOIN The note is sent out when the user next 77 | joins a channel we can see.") 78 | 79 | (function make-note 80 | "Easily create a new note instance. 81 | 82 | See NOTE") 83 | 84 | (function next-note-id 85 | "Create a new ID for a note. 86 | 87 | This modifies the global note storage. 88 | 89 | See MAIDEN-STORAGE:WITH-STORAGE") 90 | 91 | (function normalize-user-name 92 | "Normalize the username by converting it into a string and downcasing it.") 93 | 94 | (function register-note 95 | "Register a note in the notes storage. 96 | 97 | This will ensure it is persisted to disk. 98 | 99 | See MAIDEN-STORAGE:WITH-STORAGE") 100 | 101 | (function remove-note 102 | "Remove the note from the storage. 103 | 104 | See MAIDEN-STORAGE:WITH-STORAGE") 105 | 106 | (function clear-notes 107 | "Clear all notes addressed to the given user. 108 | 109 | See MAIDEN-STORAGE:WITH-STORAGE") 110 | 111 | (function user-notes 112 | "Retrieve a fresh list of all notes addressed to the user. 113 | 114 | See MAIDEN-STORAGE:WITH-STORAGE")) 115 | -------------------------------------------------------------------------------- /agents/activatable/activatable.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.activatable) 2 | 3 | (defun short-package-name (pkg) 4 | (let ((name (package-name pkg))) 5 | (dolist (nick (package-nicknames pkg) name) 6 | (when (< (length nick) (length name)) 7 | (setf name nick))))) 8 | 9 | (defun trim-package-prefix (name) 10 | (cond ((starts-with "maiden-" name) (subseq name 7)) 11 | ((starts-with "org.shirakumo.maiden." name) (subseq name 21)) 12 | (T name))) 13 | 14 | (defun normalize-module-name (name) 15 | (trim-package-prefix 16 | (string-downcase 17 | (etypecase name 18 | (string name) 19 | (package (short-package-name name)) 20 | (symbol (symbol-name name)))))) 21 | 22 | (defun normalize-ident (thing) 23 | (etypecase thing 24 | (channel-event 25 | (normalize-ident 26 | (cons (name (client thing)) (name (channel thing))))) 27 | (client-event 28 | (normalize-ident 29 | (cons (name (client thing)) NIL))) 30 | (cons 31 | (destructuring-bind (client . channel) thing 32 | (cons (string-downcase 33 | (etypecase client 34 | (entity (name client)) 35 | (T (string client)))) 36 | (string-downcase 37 | (etypecase channel 38 | (entity (name channel)) 39 | (null NIL) 40 | (T (string channel))))))))) 41 | 42 | (defun activate (ident &rest modules) 43 | (let ((ident (normalize-ident ident))) 44 | (with-storage ('activatable) 45 | (setf (value ident) (union (value ident) (mapcar #'normalize-module-name modules) 46 | :test #'string-equal))))) 47 | 48 | (defun deactivate (ident &rest modules) 49 | (let ((ident (normalize-ident ident))) 50 | (with-storage ('activatable) 51 | (setf (value ident) (set-difference (value ident) (mapcar #'normalize-module-name modules) 52 | :test #'string-equal))))) 53 | 54 | (defun active-p (ident module) 55 | (with-storage ('activatable) 56 | (member (normalize-module-name module) 57 | (value (normalize-ident ident)) 58 | :test #'string-equal))) 59 | 60 | (defun list-active (ident) 61 | (with-storage ('activatable) 62 | (value (normalize-ident ident)))) 63 | 64 | (defclass activatable-handler (deeds:locally-blocking-handler) 65 | ((module :initarg :module :reader module)) 66 | (:default-initargs 67 | :module (error "MODULE required."))) 68 | 69 | (defmethod deeds:handle :around ((event client-event) (handler activatable-handler)) 70 | (when (active-p event (module handler)) 71 | (call-next-method))) 72 | 73 | (define-consumer activatable (agent) 74 | ()) 75 | 76 | (define-command (activatable activate) (c ev &rest modules) 77 | :advice (not public) 78 | (cond (modules 79 | (apply #'activate ev modules) 80 | (reply ev "Modules activated.")) 81 | (T 82 | (error "I need to know at least one module that should be activated.")))) 83 | 84 | (define-command (activatable deactivate) (c ev &rest modules) 85 | :advice (not public) 86 | (cond (modules 87 | (apply #'deactivate ev modules) 88 | (reply ev "Modules deactivated.")) 89 | (T 90 | (error "I need to know at least one module that should be deactivated.")))) 91 | 92 | (define-command (activatable list-active) (c ev) 93 | :command "list active" 94 | (reply ev "Active modules: ~{~a~^, ~}" (list-active ev))) 95 | -------------------------------------------------------------------------------- /agents/relay/relay.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:maiden-user) 2 | (defpackage #:maiden-channel-relay 3 | (:nicknames #:org.shirakumo.maiden.agents.channel-relay) 4 | (:use #:cl #:maiden #:maiden-storage #:maiden-commands #:maiden-client-entities) 5 | (:shadow #:relay) 6 | (:export 7 | #:relay 8 | #:mappings 9 | #:mapping 10 | #:id 11 | #:prefix-id 12 | #:prefix-user)) 13 | (in-package #:org.shirakumo.maiden.agents.channel-relay) 14 | 15 | (define-consumer relay (agent) 16 | ((mappings :accessor mappings))) 17 | 18 | (defclass mapping () 19 | ((id :initarg :id :accessor id) 20 | (prefix-id :initarg :prefix-id :accessor prefix-id) 21 | (prefix-user :initarg :prefix-user :accessor prefix-user)) 22 | (:default-initargs 23 | :id (error "id required") 24 | :prefix-id NIL 25 | :prefix-user T)) 26 | 27 | (defmethod initialize-instance :after ((relay relay) &key mappings) 28 | (with-storage (relay) 29 | (setf (mappings relay) (or mappings (value :mappings) (make-hash-table :test 'equalp))))) 30 | 31 | (define-stored-accessor relay mappings :mappings) 32 | 33 | (defun channel-id (channel) 34 | (list (name (client channel)) 35 | (name channel))) 36 | 37 | (defun id-channel (id consumer) 38 | (destructuring-bind (client channel) id 39 | (dolist (core (cores consumer)) 40 | (let ((consumer (consumer client core))) 41 | (when consumer 42 | (return (find-channel channel consumer))))))) 43 | 44 | (define-handler (relay message (and channel-event message-event)) (c ev user message channel) 45 | (dolist (mapping (gethash (channel-id channel) (mappings c))) 46 | (let ((other (id-channel (id mapping) c))) 47 | (when other 48 | ;; FIXME: This could be a lot more effectively done for protocols that support 49 | ;; assuming identities like Lichat. 50 | (reply other "~@[~a~]~@[<~a>~] ~a" 51 | (when (prefix-id mapping) (id mapping)) 52 | (when (prefix-user mapping) (name user)) 53 | message))))) 54 | 55 | (define-command (relay activate) (c ev client channel &key prefix-id (prefix-user T)) 56 | :command "relay from" 57 | (let ((id (list client channel))) 58 | (unless (id-channel id c) 59 | (error "The requested channel is not known.")) 60 | (when (find (channel-id (channel ev)) (gethash id (mappings c)) :test #'equalp :key #'id) 61 | (error "The requested channel is already relayed here.")) 62 | (when (equalp id (channel-id (channel ev))) 63 | (error "Why would I relay what's already here?")) 64 | (push (make-instance 'mapping :id (channel-id (channel ev)) 65 | :prefix-id prefix-id 66 | :prefix-user prefix-user) 67 | (gethash id (mappings c))) 68 | (setf (mappings c) (mappings c)) 69 | (reply ev "The channel ~a/~a is now being relayed here." client channel))) 70 | 71 | (define-command (relay deactivate) (c ev client channel) 72 | :command "stop relaying from" 73 | :advice (not public) 74 | (let ((id (list client channel))) 75 | (unless (id-channel id c) 76 | (error "The requested channel is not known.")) 77 | (unless (find (channel-id (channel ev)) (gethash id (mappings c)) :test #'equalp :key #'id) 78 | (error "The requested channel is not relayed here.")) 79 | (setf (gethash id (mappings c)) (remove (channel-id (channel ev)) (gethash id (mappings c)) :test #'equalp :key #'id)) 80 | (setf (mappings c) (mappings c)) 81 | (reply ev "The channel ~a/~a is no longer relayed here." client channel))) 82 | -------------------------------------------------------------------------------- /agents/talk/talk.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.maiden.agents.talk) 2 | 3 | (define-consumer talk (agent) 4 | ((server :initform NIL :accessor server) 5 | (voice :initform NIL :accessor voice))) 6 | 7 | (defmethod start :after ((talk talk)) 8 | (setf (server talk) (harmony:start (harmony:make-simple-server :latency 0.1)))) 9 | 10 | (defun get-speech-stream (text language) 11 | (multiple-value-bind (stream code) 12 | (drakma:http-request "http://translate.google.com/translate_tts" 13 | :parameters `(("ie" . "UTF-8") 14 | ("client" . "tw-ob") 15 | ("tl" . ,(language-code language)) 16 | ("q" . ,text)) 17 | :external-format-out :utf-8 18 | :external-format-in :utf-8 19 | :want-stream T) 20 | (if (/= 200 code) 21 | (error "Failed to translate into speech. This failure is most likely due to an invalid language.") 22 | stream))) 23 | 24 | (defun speech-file (text language) 25 | (let ((path (merge-pathnames (format NIL "maiden-talk-~d-~d.mp3" (get-universal-time) (random 1000)) 26 | (uiop:temporary-directory)))) 27 | (with-open-file (out path :if-exists :supersede 28 | :direction :output 29 | :element-type '(unsigned-byte 8)) 30 | (let ((in (get-speech-stream text language))) 31 | (uiop:copy-stream-to-stream in out :element-type '(unsigned-byte 8)) 32 | (close in))) 33 | path)) 34 | 35 | (defun split-word-boundary (text max) 36 | (let ((boundary (loop with space = 0 37 | for i downfrom (1- max) to 0 38 | do (case (char text i) 39 | ((#\. #\: #\? #\! #\！ #\？ #\。) 40 | (return (1+ i))) 41 | ((#\Space #\Tab #\　) 42 | (setf space (max space i)))) 43 | finally (return space)))) 44 | (if (< 0 boundary) 45 | (subseq text 0 boundary) 46 | (subseq text 0 (min max (length text)))))) 47 | 48 | (defmethod play ((talk talk) path &key effects immediate) 49 | (when (voice talk) 50 | (loop until (mixed:done-p (voice talk)) 51 | do (sleep 0.1) 52 | (when immediate (return)))) 53 | (setf (voice talk) (harmony:play path :server (server talk) :mixer :speech :effects effects))) 54 | 55 | (defmethod talk ((talk talk) text &key (language "en-US") output effects) 56 | (cond ((<= (length text) 200) 57 | (play talk (speech-file text language) :effects effects)) 58 | (T 59 | (let ((sub (split-word-boundary text 200))) 60 | (talk talk sub :language language :output output :effects effects) 61 | (talk talk (subseq text (length sub)) :language language :output output :effects effects))))) 62 | 63 | (define-command (talk talk-en) (c ev &string text) 64 | :command "talk" 65 | (v:info :test "test") 66 | (talk c text)) 67 | 68 | (define-command (talk talk-lang) (c ev language &string text) 69 | :command "talk in" 70 | (talk c text :language language)) 71 | 72 | (define-command (talk play) (c ev &string file) 73 | :command "play file" 74 | (play c (uiop:parse-native-namestring file))) 75 | 76 | (define-command (talk shut-up) (c ev) 77 | :command "shut up" 78 | :add-to-consumer NIL 79 | (when (voice c) 80 | (setf (mixed:done-p (voice c)) T))) 81 | --------------------------------------------------------------------------------