refactor: move PendingBang out of Main

1 files changed, 4 insertions, 41 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 626983c..ec4204a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,8 +1,5 @@
 {-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell,
-    TypeFamilies, ViewPatterns, LambdaCase, EmptyDataDecls,
-    FlexibleContexts, GADTs, GeneralizedNewtypeDeriving,
-    MultiParamTypeClasses, DerivingStrategies, StandaloneDeriving,
-    UndecidableInstances, DataKinds, FlexibleInstances, TypeOperators #-}
+    TypeFamilies, LambdaCase, EmptyDataDecls #-}
 
 {-# OPTIONS -Wno-unused-top-binds #-}
 
@@ -11,11 +8,8 @@ module Main (main) where
 import Control.Monad.Logger (runStdoutLoggingT)
 import Control.Monad.Trans.Resource (runResourceT)
 import Control.Monad (when, unless)
-import Data.Aeson
 import Database.Persist.Sqlite
-import Data.Char (isAlphaNum)
 import Data.Function ((&))
-import Data.Maybe (maybeToList)
 import Network.Wai.Handler.Warp hiding (getPort, getHost)
 import Yesod
 
@@ -25,35 +19,7 @@ import qualified Data.Text as T
 import Auth
 import BangState
 import Config
-
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-PendingBang
-    bang T.Text
-    url T.Text
-    displayName T.Text
-    notifyEmail (Maybe T.Text)
-    UniqueBang bang url displayName
-    deriving Show
-|]
-
-instance ToJSON PendingBang where
-    toJSON (PendingBang b u dp em) = object $
-        ["bang" .= b, "url" .= u, "name" .= dp] ++ case em of
-            Nothing -> []
-            Just e -> ["email" .= e]
-
-    toEncoding (PendingBang b u dp em) = pairs $ case em of
-        Nothing -> withoutEmail
-        Just e -> withoutEmail <> "email" .= e
-      where withoutEmail = "bang" .= b <> "url" .= u <> "name" .= dp
-
-instance FromJSON PendingBang where
-    parseJSON = withObject "PendingBang" $ \ob ->
-        PendingBang
-        <$> ob .:  "bang"
-        <*> ob .:  "url"
-        <*> ob .:  "name"
-        <*> ob .:? "email"
+import Data.PendingBang
 
 data Search = Search {
     bangState :: BangState,
@@ -117,11 +83,8 @@ getBangsR = do
 
 postSubmitR :: Handler ()
 postSubmitR = do
-    pb@(PendingBang n u dp mayEm) <- requireCheckJsonBody
-    unless (T.all isAlphaNum n) $ invalidArgs []
-    let strings = [n, u, dp] <> maybeToList mayEm
-    unless (all ((<255) . T.length) strings) $ invalidArgs []
-
+    pb <- requireCheckJsonBody
+    unless (verifyPendingBang pb) $ invalidArgs []
     runDB $ insert400_ pb
 
 getOpenSearchR :: Handler TypedContent