getting close to parity

bonerbonerboner/bonerbonerboner.factor

@@ -1,29 +1,49 @@
 ! Copyright (C) 2020 .
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: kernel http.server http.server.responses http.server.dispatchers furnace.actions html.forms accessors namespaces io.servers io.sockets.secure.debug ;
+USING: kernel http.server http.server.responses http.server.dispatchers furnace.actions html.forms accessors namespaces io.servers io.sockets.secure.debug sequences validators ;
 USING: bonerbonerboner.services ;
 
+USING: prettyprint ;
 IN: bonerbonerboner
 
 TUPLE: bbb < dispatcher ;
 
+: bbb-themes ( -- themes )
+    { "bbb" "rocket" "hockey" } ;
+
+: v-valid-theme ( str -- theme )
+    dup bbb-themes member? [ "not a valid theme" throw ] unless ;
+
+: validate-theme ( -- )
+    {
+        { "theme" [ v-required v-valid-theme ] }
+    } validate-params ;
+
 : <theme-action> ( -- action )
 
-    <page-action> [ "bbb" "theme" set-value ] >>init
+    <page-action>
+
+    [
+        validate-theme
+    ] >>init
 
     { bbb "templates/themes" } >>template ;
 
-
+: <heartbeat-action> ( -- action )
-: <heartbeat-response> ( -- response )
+    <action> [ "bonerbonerboner" <text-content> ] >>display ;
-    "bonerbonerboner" <text-content> ;
 
 : <bbb> ( -- responder )
     bbb new-dispatcher
-    <heartbeat-response> "heartbeat" add-responder ;
+    <heartbeat-action> "heartbeat" add-responder
-!    <theme-action> "theme" add-responder ;
+    <slack-event-action> "slack-events" add-responder
+    <theme-action> "subdomain" add-responder ;
 
-SYMBOL: current-test-server
+SYMBOL: current-bbb-server
-: run-test-bbb ( -- )
+: run-bbb-server ( -- )
     <bbb> main-responder set-global
-    8080 httpd current-test-server set ;
+    8080 httpd current-bbb-server set ;
+
+: restart-bbb-server ( -- )
+    current-bbb-server get stop-server
+    run-bbb-server ;

bonerbonerboner/services/link-logger/link-logger.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2020 .
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: kernel sequences http http.server.dispatchers accessors vocabs.parser furnace.actions regexp db.types db.tuples math urls strings calendar ;
+USING: kernel sequences http http.server.dispatchers accessors vocabs.parser furnace.actions regexp db.types db.tuples math urls strings calendar assocs arrays formatting combinators.random ;
-USING: bonerbonerboner ;
+USING: bonerbonerboner.services bonerbonerboner.services.slack ;
 
 IN: bonerbonerboner.services.link-logger
 
@@ -32,10 +32,17 @@ link "links"
     [ dup repost-count>> 1 + >>repost-count ] dip >>updated-by now >>date-updated ;
 
 : add-link ( url who -- )
-    [ <link> insert-tuple ] with-bbb-db ;
+    ensure-link-logger [ <link> insert-tuple ] with-bbb-db ;
+
+: random-callout ( repost -- )
+    {
+        [ ]
+        [ created-by>> "%s already posted that" sprintf ]
+        [ drop "nice repost" ]
+    } call-random say-slack ;
 
 : update-repost ( link who -- )
-     [ <repost> update-tuple ] with-bbb-db ;
+    ensure-link-logger [ <repost> dup update-tuple ] with-bbb-db random-callout ;
 
 : repost? ( url -- link/f )
     link new swap >>url [ select-tuple ] with-bbb-db ;
@@ -47,7 +54,11 @@ link "links"
     url-regex all-matching-subseqs ;
 
 : check-repost ( url who -- )
-    [ dup repost? ] dip swap [  update-repost ] [ add-link ] if ;
+    [ dup repost? ] dip swap [  swap update-repost drop ] [ add-link ] if* ;
 
-! : check-links ( str -- )
+: check-link ( url who -- )
- !   strip-urls [ check-repost ] each ;
+    check-repost ;
+
+: check-links ( event -- )
+    [ "text" of strip-urls dup length ] [ "user" of ] bi <array>
+    [ check-link ] 2each ;

bonerbonerboner/services/mississippis/mississippis.factor

@@ -1,14 +1,37 @@
 ! Copyright (C) 2020 .
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.ranges math.order math.parser math.functions arrays sequences sequences.extras threads calendar io timers accessors random formatting combinators combinators.random http.server.responses ;
+USING: kernel math math.ranges math.order math.parser math.functions arrays sequences sequences.extras threads calendar io timers accessors random formatting combinators combinators.random http.server.responses regexp unicode peg peg.parsers assocs db.types db.tuples ;
-USING: prettyprint http furnace.actions http.server.dispatchers ;
+
-USING: bonerbonerboner.services.slack ;
+USING: bonerbonerboner.services bonerbonerboner.services.slack ;
 
 IN: bonerbonerboner.services.mississippis
 
 CONSTANT: max-mississippi-count 30
 CONSTANT: min-mississippi-count 1
 
+TUPLE: mississippis id standard-mississippi? terminal requester requested-on ;
+
+mississippis "mississippis"
+{
+    { "id" "id" +db-assigned-id+ }
+    { "standard-mississippi?" "is_standard" BOOLEAN }
+    { "terminal" "terminal" INTEGER }
+    { "requester" "requester" VARCHAR }
+    { "requested-on" "requested_on" TIMESTAMP }
+} define-persistent
+
+: <mississippis> ( event -- mississippis )
+    [ f ] dip
+    [
+        "text" of
+        >lower
+        integer-parser " standard" token [ >boolean ] action optional 2seq parse
+        [ second ] [ first ] bi
+    ]
+    [ "user" of slack-lookup-user ]
+    [ "event_ts" of string>number unix-time>timestamp ] tri
+    mississippis boa ;
+
 : random-stupid-word ( -- something-stupid )
     { "balls" "fart" "SIEEEEEEEEEEGE" "hey" "HONESTLY" "fuckface" "it's too late-TOOOOO LATE" }
     random ;
@@ -22,7 +45,7 @@ CONSTANT: min-mississippi-count 1
     random ;
 
 : nonstandard-mississippi-duration ( -- duration )
-    .25 5 uniform-random-float seconds ;
+    .5 1.5 uniform-random-float seconds ;
 
 : standard-mississippi-duration ( -- duration )
     1 seconds ;
@@ -34,8 +57,7 @@ CONSTANT: min-mississippi-count 1
     min-mississippi-count max-mississippi-count between? ;
 
 : announce ( str -- )
-    . flush ;
+    say-slack ;
-!    say-slack ;
 
 : announce-sip ( sip -- )
     "%d Mississippi" sprintf announce ;
@@ -60,13 +82,13 @@ CONSTANT: min-mississippi-count 1
         { .3   [ ] }
         { .1   [ announce-random-sip ] }
         { .075 [ announce-random-stupid-word ] }
-        { .025 [ terminal announce-fake-terminal ] }
+        { .025 [ terminal announce-fake-terminal nonstandard-mississippi-wait ] }
         { .5   [ sip announce-sip ] }
     } casep ;
 
 : announce-nonstandard-mississippis ( terminal -- )
     [
-        1 - [ dup <array> ] [ [1,b] ] bi
+        [ dup <array> ] [ 1 - [1,b] ] bi
         [ nonstandard-mississippi-wait announce-nonstandard-mississippi ] 2each
     ]
     [ announce-sip ] bi ;
@@ -78,3 +100,22 @@ CONSTANT: min-mississippi-count 1
     dup valid-mississippi-count?
     [ announce-go! swap announce-mississippis ]
     [ 2drop random-no-word announce ] if ;
+
+: log-mississippi-request ( mississippi -- )
+    [
+        mississippis ensure-table
+        insert-tuple
+    ] with-bbb-db ;
+
+: is-mississippi-request? ( str -- ? )
+    R/ ^\d\d? (standard )?mississippis? go!?/i matches? ;
+
+: check-mississippi-request ( event -- )
+    dup
+    "text" of is-mississippi-request?
+    [
+        <mississippis>
+        [ [ standard-mississippi?>> ] [ terminal>> ] bi mississippi-go! ]
+        [ log-mississippi-request ] bi
+    ]
+    [ drop ] if ;

bonerbonerboner/services/platzisms/platzisms.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2020 .
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel regexp sequences http.server http.server.responses db db.types db.tuples unicode formatting assocs ;
-USING: bonerbonerboner bonerbonerboner.services.slack ;
+USING: bonerbonerboner.services bonerbonerboner.services.slack ;
 
 IN: bonerbonerboner.services.platzisms
 
@@ -20,6 +20,7 @@ platzism "platzisms"
     [ f ] dip platzism boa ;
 
 : add-platzism ( str -- )
+    ensure-platzisms
     [ <platzism> insert-tuple ] with-bbb-db ;
 
 : platzism-exists? ( str -- ? )
@@ -32,6 +33,7 @@ platzism "platzisms"
     R/ ^steve platz is currently .+/i matches? ;
 
 : random-platzism ( -- platzism )
+    ensure-platzisms
     "SELECT quote from platzisms ORDER BY RANDOM() LIMIT 1" [ sql-query ] with-bbb-db
     dup empty? [ drop "I'm not sure what Platz is up to." ] [ first first ] if ;
 
@@ -55,7 +57,7 @@ platzism "platzisms"
 : check-platz ( event -- )
     "text" of
     [ is-platz? [ share-platzism ] when ]
-    [ is-platzism? [ log/confirm-platzism ] when* ] bi ;
+    [ dup is-platzism? [ log/confirm-platzism ] [ drop ] if  ] bi ;
 
-[ check-platz ] add-slack-handler
+! [ check-platz ] add-slack-handler
 

bonerbonerboner/services/services.factor

@@ -1,14 +1,21 @@
 ! Copyright (C) 2020 .
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: kernel fry db db.sqlite environment math.parser ;
+USING: kernel fry db db.sqlite environment math.parser io.pathnames ;
+USING: bonerbonerboner.services.slack ;
 
 IN: bonerbonerboner.services
 
 CONSTANT: bbb-default-port 8069
 
+: bbb-data-directory ( -- path )
+    home ".bonerbonerboner" append-path ;
+
+: <bbb-sqlite-db> ( -- db )
+    bbb-data-directory "bbb.db" append-path <sqlite-db> ;
+
 : with-bbb-db ( quot -- )
-    '[ "bbb.db" <sqlite-db> _ with-db ] call ; inline
+    '[ <bbb-sqlite-db> _ with-db ] call ; inline
 
 : bbb-api-port ( -- port )
     "BBB_API_PORT" os-env [ string>number ] [ bbb-default-port ] if* ;

bonerbonerboner/services/slack/slack.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2020 .
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: io.sockets.secure kernel http http.server http.server.dispatchers accessors furnace.actions namespaces http.server.responses io.servers io.sockets.secure.debug json.reader assocs combinators sequences arrays threads locals formatting json.writer urls http.client hashtables ;
+USING: io.sockets.secure kernel http http.server http.server.dispatchers accessors furnace.actions namespaces http.server.responses io.servers io.sockets.secure.debug json.reader assocs combinators sequences arrays threads locals formatting json.writer urls http.client hashtables math ;
-USING: prettyprint ;
+USING: prettyprint io.encodings.utf8 io io.files ;
 
 IN: bonerbonerboner.services.slack
 
@@ -10,18 +10,12 @@ SYMBOLS: slack-callbacks current-slack-webhook-url current-slack-authorization-t
 
 TUPLE: slack < dispatcher ;
 
-: add-slack-handler ( quot: ( event -- ) -- )
-    slack-callbacks get append slack-callbacks set ;
-
 : <bad-callback-response> ( -- response )
     "400" "unrecognized event type" <trivial-response> ;
 
 : <heartbeat-response> ( -- response )
     "slack" <text-content> ;
 
-: <ok-response> ( -- response )
-    "200" "OK" <trivial-response> ;
-
 : handle-challenge ( json -- response )
     "challenge" of <text-content> ;
 
@@ -31,7 +25,7 @@ TUPLE: slack < dispatcher ;
         slack-callbacks get length slack-event <array>
         slack-callbacks get [ curry "Slack Callback" spawn drop ] 2each
     ] unless
-    <ok-response> ;
+    <200> ;
 
 : <slack-event-action> ( -- action )
     <action>
@@ -40,13 +34,20 @@ TUPLE: slack < dispatcher ;
         "type" of
         {
             { "url_verification" [ handle-challenge ] }
-            { "event_callback" [ handle-slack-event ] }
+            { "event_callback" [ "event" of handle-slack-event ] }
             [ drop <bad-callback-response> ]
         } case
     ] >>submit ;
 
-: <heartbeat-action> ( -- action )
+: slack-lookup-user ( id -- name )
-    <action> [ <heartbeat-response> ] >>display ;
+    [
+        "https://slack.com/api/users.profile.get" >url
+        { "user" "token" }
+    ] dip
+    current-slack-authorization-token get 2array zip
+    set-query-params
+    http-get swap drop json>
+    "profile" of "real_name" of ;
 
 : slack-post-message ( payload -- )
     >json
@@ -55,10 +56,6 @@ TUPLE: slack < dispatcher ;
     http-request 2drop ;
 
 : say-slack ( str -- )
-    "text" associate
+    . flush ;
-    slack-post-message ;
+!    "text" associate
-
+!    slack-post-message ;
-: <slack> ( -- responder )
-    slack new-dispatcher
-    <slack-event-action> "slack-events" add-responder
-    <heartbeat-action> "heartbeat" add-responder ;

bonerbonerboner/templates/themes.xml

@@ -1,8 +1,10 @@
 <?xml version='1.0' ?>
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0" >
-    <html class="@theme" >
+    <html class="@theme" lang="en" >
         <head>
+          <title>boners</title>
             <meta name="viewport" content="width=device-width, initial-sale=1"/>
+            <link rel="stylesheet"  type="text/css" href="https://static.bonerbonerboner.com/css/bbb.css" />
         </head>
         <body/>
     </html>