3 files changed, 31 insertions, 3 deletions
diff --git a/src/BangState.hs b/src/BangState.hs
index d53fc47..019f219 100644
--- a/src/BangState.hs
+++ b/src/BangState.hs
@@ -12,6 +12,7 @@ module BangState (
 import Codec.Compression.Brotli (compress)
 import Control.Applicative ((<|>))
 import Control.Concurrent.STM.TChan
+import Control.Concurrent.STM.TVar
 import Control.Monad (forever)
 import Crypto.Hash (hashlazy, Digest, SHA512)
 import Data.Aeson
@@ -70,6 +71,7 @@ loadOwnBangs = eitherDecodeFileStrict "bangs.json" <|> return (Left "") >>= \cas
 -- also spawns a thread for disk synchronization
 initBangState :: IO BangState
 initBangState = do
+    -- TODO error handling for ddg bang polling, as well as regular polling
     ans <- (httpJSON "https://duckduckgo.com/bang.v255.js") :: IO (Response DDGBangs)
     s <- BangState
         <$> (loadOwnBangs >>= newTVarIO)
@@ -89,7 +91,9 @@ getBangsBrotli :: BangState -> IO ByteString
 getBangsBrotli s = readTVarIO $ brotliBangs s
 
 addBang :: Text -> Text -> Text -> BangState -> IO ()
-addBang _ _ _ _ = error $ "TODO"
+addBang bn bu bdp s = atomically $ do
+    modifyTVar (ownBangs s) (singletonBangs bn bu bdp <>)
+    reserialize s
 
 getBangsHash :: BangState -> IO Text
 getBangsHash s = readTVarIO $ serializedHash s
diff --git a/src/Data/Bang.hs b/src/Data/Bang.hs
index 2bf0966..d6c3bd3 100644
--- a/src/Data/Bang.hs
+++ b/src/Data/Bang.hs
@@ -3,7 +3,8 @@
 module Data.Bang (
     DDGBangs,
     toBangs,
-    Bangs
+    Bangs,
+    singletonBangs
 ) where
 
 import GHC.Prim
@@ -17,6 +18,9 @@ newtype Bangs = Bangs {
     unBangs :: M.Map Text (Text, Text)
 } deriving (Show, Generic)
 
+singletonBangs :: Text -> Text -> Text -> Bangs
+singletonBangs bn bu bdp = Bangs $ M.singleton bn (bu, bdp)
+
 instance FromJSON Bangs where
     parseJSON b = parseJSON b >>= fmap Bangs . sequence . fmap getInfo
       where getInfo v = (,) <$> v .: "url" <*> v .: "name"
diff --git a/src/Main.hs b/src/Main.hs
index 8a82da3..0733c61 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -10,7 +10,7 @@ module Main (main) where
 
 import Control.Monad.Logger (runStdoutLoggingT)
 import Control.Monad.Trans.Resource (runResourceT)
-import Control.Monad (unless)
+import Control.Monad (when, unless)
 import Data.Aeson
 import Database.Persist.Sqlite
 import Data.Char (isAlphaNum)
@@ -65,6 +65,8 @@ mkYesod "Search" [parseRoutes|
 /bangs.json   BangsR GET
 /search.xml   OpenSearchR GET
 /submitBang   SubmitR POST
+/acceptBang   AcceptR POST
+/rejectBang   RejectR POST
 /pendingBangs PendingR GET
 |]
 
@@ -131,6 +133,24 @@ getOpenSearchR = do
         .   toContent
         <$> makeOpenSearch url
 
+postVerdictR :: Bool -> Handler ()
+postVerdictR b = do
+    ensureAuth
+
+    (PendingBang n u dp mayEm) <- requireCheckJsonBody
+    -- NOTE: known race condition: the bang bang may be deleted from the database
+    -- before the updated bangs are written to disk, leading to the loss of
+    -- a pending bang on very specific crash timing.
+    st <- bangState <$> getYesod
+    when b $ liftIO $ addBang n u dp st
+    --sendEmail mayEm $ "your bang was " <> bool b "rejected" "accepted" -- TODO
+    runDB $ deleteBy $ UniqueBang n
+    return ()
+
+postAcceptR, postRejectR :: Handler ()
+postAcceptR = postVerdictR True
+postRejectR = postVerdictR False
+
 getPendingR :: Handler Value
 getPendingR = do
     ensureAuth