adding bonerbonerboner vocab
parent
e3e24c5c4b
commit
0179a4ce08
|
|
@ -0,0 +1,41 @@
|
||||||
|
USING: kernel furnace.actions sequences validators accessors html.forms http.server.responses http.server.dispatchers formatting ;
|
||||||
|
USING: bonerbonerboner.dns ;
|
||||||
|
|
||||||
|
IN: bonerbonerboner.actions
|
||||||
|
|
||||||
|
TUPLE: bbb-dispatcher < dispatcher ;
|
||||||
|
|
||||||
|
: v-valid-subdomain ( str -- subdomain )
|
||||||
|
dup get-subdomains member? [ "not a valid subdomain" throw ] unless ;
|
||||||
|
|
||||||
|
: validate-subdomain ( -- )
|
||||||
|
{
|
||||||
|
{ "name" [ v-required v-valid-subdomain ] }
|
||||||
|
} validate-params ;
|
||||||
|
|
||||||
|
: <subdomain-action> ( -- action )
|
||||||
|
<page-action>
|
||||||
|
[
|
||||||
|
validate-subdomain
|
||||||
|
"name" value "subdomain" set-value
|
||||||
|
] >>init
|
||||||
|
{ bbb-dispatcher "subdomains" } >>template ;
|
||||||
|
|
||||||
|
: <404-subdomain-action> ( -- action )
|
||||||
|
<page-action>
|
||||||
|
[ "_404" "subdomain" set-value ] >>init
|
||||||
|
{ bbb-dispatcher "subdomains" } >>template ;
|
||||||
|
|
||||||
|
: <heartbeat-action> ( -- action )
|
||||||
|
<action> [ "bonerbonerboner" <text-content> ] >>display ;
|
||||||
|
|
||||||
|
TUPLE: subdomain-link subdomain url ;
|
||||||
|
|
||||||
|
: <meta-action> ( -- action )
|
||||||
|
<page-action>
|
||||||
|
[
|
||||||
|
get-subdomains
|
||||||
|
[ dup "name" "https://%s.bonerbonerboner.com" sprintf subdomain-link boa ]
|
||||||
|
map "subdomains" set-value
|
||||||
|
] >>init
|
||||||
|
{ bbb-dispatcher "meta" } >>template ;
|
||||||
|
|
@ -0,0 +1,14 @@
|
||||||
|
<?xml version='1.0'?>
|
||||||
|
<!DOCTYPE html>
|
||||||
|
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||||
|
<html class="@subdomain" lang="en">
|
||||||
|
<head>
|
||||||
|
<title>boners</title>
|
||||||
|
<meta name="viewport"
|
||||||
|
content="width=device-width, initial-scale=1" />
|
||||||
|
<link rel="stylesheet" type="text/css"
|
||||||
|
href="https://static.bonerbonerboner.com/css/bbb.css" />
|
||||||
|
</head>
|
||||||
|
<body />
|
||||||
|
</html>
|
||||||
|
</t:chloe>
|
||||||
|
|
@ -0,0 +1,5 @@
|
||||||
|
USING: kernel regexp dns hashtables sequences splitting assocs urls arrays http http.client json json.http io.sockets.secure accessors ;
|
||||||
|
USING: prettyprint ;
|
||||||
|
USING: io.encodings.utf8 io.encodings.string ;
|
||||||
|
|
||||||
|
IN: bonerbonerboner
|
||||||
|
|
@ -0,0 +1,44 @@
|
||||||
|
USING: kernel regexp dns hashtables sequences splitting assocs urls arrays http http.client json json.http io.sockets.secure accessors ;
|
||||||
|
USING: prettyprint ;
|
||||||
|
|
||||||
|
IN: bonerbonerboner.dns
|
||||||
|
|
||||||
|
CONSTANT: bbb-domain "bonerbonerboner.com"
|
||||||
|
CONSTANT: meta R/ ^meta=/
|
||||||
|
CONSTANT: do-key "TODO: ADD TO ENV"
|
||||||
|
CONSTANT: do-api-base-url URL" https://api.digitalocean.com/v2/"
|
||||||
|
|
||||||
|
: get-subdomain-metadata ( -- assoc )
|
||||||
|
bbb-domain dns-TXT-query TXT-message>strings
|
||||||
|
H{ }
|
||||||
|
[
|
||||||
|
first dup
|
||||||
|
meta re-contains?
|
||||||
|
[ swap [ meta "" re-replace ":" split [ second ] [ first ] bi ] dip ?set-at ]
|
||||||
|
[ drop ] if
|
||||||
|
] reduce ;
|
||||||
|
|
||||||
|
: get-subdomains ( -- seq )
|
||||||
|
get-subdomain-metadata keys ;
|
||||||
|
|
||||||
|
: post-domain-records-url ( -- url )
|
||||||
|
do-api-base-url URL" domains/bonerbonerboner.com/records" derive-url ;
|
||||||
|
|
||||||
|
: add-authorization ( request -- request' )
|
||||||
|
"Bearer " do-key append "Authorization" set-header ;
|
||||||
|
|
||||||
|
: <json-post-request> ( data url -- post-request )
|
||||||
|
[ <json-post-data> ] dip
|
||||||
|
"POST" <json-request> swap >>post-data ;
|
||||||
|
|
||||||
|
: create-subdomain-meta ( name color -- )
|
||||||
|
2array ":" join "meta=" prepend
|
||||||
|
'H{
|
||||||
|
{ "data" _ }
|
||||||
|
{ "name" "@" }
|
||||||
|
{ "type" "TXT" }
|
||||||
|
}
|
||||||
|
post-domain-records-url
|
||||||
|
<json-post-request>
|
||||||
|
add-authorization
|
||||||
|
http-request 2drop ;
|
||||||
|
|
@ -0,0 +1,22 @@
|
||||||
|
USING: kernel http.server http.server.responses http.server.dispatchers accessors namespaces io.servers ;
|
||||||
|
USING: bonerbonerboner.actions ;
|
||||||
|
|
||||||
|
IN: bonerbonerboner.server
|
||||||
|
|
||||||
|
SYMBOL: current-bbb-server
|
||||||
|
|
||||||
|
: <bbb> ( -- responder )
|
||||||
|
bbb-dispatcher new-dispatcher
|
||||||
|
<404-subdomain-action> >>default
|
||||||
|
<heartbeat-action> "heartbeat" add-responder
|
||||||
|
<subdomain-action> "subdomains" add-responder
|
||||||
|
<meta-action> "meta" add-responder ;
|
||||||
|
|
||||||
|
: <bbb-website-server> ( -- threaded-server )
|
||||||
|
<http-server>
|
||||||
|
f >>secure
|
||||||
|
8069 >>insecure ;
|
||||||
|
|
||||||
|
: start-bbb-site ( -- )
|
||||||
|
<bbb> main-responder set-global
|
||||||
|
<bbb-website-server> start-server current-bbb-server set ;
|
||||||
Loading…
Reference in New Issue