1 files changed, 47 insertions, 13 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 3f372f6..69cbdb4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,21 +1,39 @@
 {-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell,
-    TypeFamilies, ViewPatterns, LambdaCase #-}
+    TypeFamilies, ViewPatterns, LambdaCase, EmptyDataDecls,
+    FlexibleContexts, GADTs, GeneralizedNewtypeDeriving,
+    MultiParamTypeClasses, DerivingStrategies, StandaloneDeriving,
+    UndecidableInstances, DataKinds, FlexibleInstances, TypeOperators #-}
 
 module Main (main) where
 
-import Yesod
-import Network.Wai.Handler.Warp hiding (getPort, getHost)
+import Control.Monad.Logger (runStdoutLoggingT)
+import Control.Monad.Trans.Resource (runResourceT)
+import Control.Monad (unless)
+import Data.Char (isAlphaNum)
+import Database.Persist.Sqlite
 import Data.Function ((&))
 import Data.Functor ((<&>))
+import Network.Wai.Handler.Warp hiding (getPort, getHost)
+import Yesod
 
 import qualified Data.ByteString as BS
+import qualified Data.Text as T
 
-import Bangs
 import BangState
 import Config
 
+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
+PendingBang
+    name T.Text
+    url T.Text
+    displayName T.Text
+    UniqueBang name
+    deriving Show
+|]
+
 data Search = Search {
-    bangState :: BangState
+    bangState :: BangState,
+    sqlPool :: ConnectionPool
 }
 
 mkYesod "Search" [parseRoutes|
@@ -30,6 +48,11 @@ mkYesod "Search" [parseRoutes|
 instance Yesod Search where
     makeSessionBackend _ = return Nothing
 
+instance YesodPersist Search where
+    type YesodPersistBackend Search = SqlBackend
+
+    runDB action = getYesod >>= runSqlPool action . sqlPool
+
 getHomeR :: Handler ()
 getHomeR = sendFile typeHtml "index.html"
 
@@ -51,8 +74,15 @@ getBangsR = do
     bs <- liftIO . bangsAccessor . bangState =<< getYesod
     return $ TypedContent typeJson $ toContent bs
 
-postSubmitR :: Handler String
-postSubmitR = return "TODO"
+postSubmitR :: Handler ()
+postSubmitR = sequence (map lookupPostParam ["bang", "url", "name"])
+  >>= \l -> case sequence l of
+    Just [bn, bu, bdp] -> do
+        unless (T.all isAlphaNum bn)                   $ invalidArgs []
+        unless (all ((<255) . T.length) [bn, bu, bdp]) $ invalidArgs []
+        runDB $ insert400_ $ PendingBang bn bu bdp
+
+    _ -> invalidArgs []
 
 getOpenSearchR :: Handler TypedContent
 getOpenSearchR = do
@@ -67,14 +97,18 @@ getOpenSearchR = do
         <$> makeOpenSearch url
 
 main :: IO ()
-main = do
+main = runStdoutLoggingT $ withSqlitePool "banger.db" 2 $ \pool -> do
+    runResourceT $ flip runSqlPool pool $ runMigration migrateAll
+
     s <- Search
-        <$> initBangState
-    sApp <- toWaiApp s -- includes middlewares
+        <$> liftIO initBangState
+        <*> pure pool
+    sApp <- liftIO $ toWaiApp s -- includes middlewares
 
-    host <- getHost
-    port <- getPort
+    host <- liftIO getHost
+    port <- liftIO getPort
     let settings = defaultSettings
             & setHost host
             & setPort port
-    runSettings settings sApp
+
+    liftIO $ runSettings settings sApp