Use a better project structure

5 files changed, 0 insertions, 296 deletions

diff --git a/src/server/Controller/Category.hs b/src/server/Controller/Category.hs
deleted file mode 100644
index 1a44083..0000000
--- a/src/server/Controller/Category.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.Category
-  ( create
-  , edit
-  , delete
-  ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import qualified Data.Text.Lazy as TL
-import Web.Scotty hiding (delete)
-
-import Common.Model.Category (CategoryId)
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import qualified Common.Model.CreateCategory as Json
-import qualified Common.Model.EditCategory as Json
-
-import Json (jsonId)
-import qualified Model.Category as Category
-import qualified Model.PaymentCategory as PaymentCategory
-import qualified Model.Query as Query
-import qualified Secure
-
-create :: Json.CreateCategory -> ActionM ()
-create (Json.CreateCategory name color) =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ Category.create name color) >>= jsonId
-  )
-
-edit :: Json.EditCategory -> ActionM ()
-edit (Json.EditCategory categoryId name color) =
-  Secure.loggedAction (\_ -> do
-    updated <- liftIO . Query.run $ Category.edit categoryId name color
-    if updated
-      then status ok200
-      else status badRequest400
-  )
-
-delete :: CategoryId -> ActionM ()
-delete categoryId =
-  Secure.loggedAction (\_ -> do
-    deleted <- liftIO . Query.run $ do
-      paymentCategories <- PaymentCategory.listByCategory categoryId
-      if null paymentCategories
-        then Category.delete categoryId
-        else return False
-    if deleted
-      then
-        status ok200
-      else do
-        status badRequest400
-        text . TL.fromStrict $ Message.get Key.Category_NotDeleted
-  )
diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
deleted file mode 100644
index 148b713..0000000
--- a/src/server/Controller/Income.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.Income
-  ( create
-  , editOwn
-  , deleteOwn
-  ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import qualified Data.Text.Lazy as TL
-import Web.Scotty
-
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (CreateIncome(..), EditIncome(..), IncomeId, User(..))
-
-import Json (jsonId)
-import qualified Model.Income as Income
-import qualified Model.Query as Query
-import qualified Secure
-
-create :: CreateIncome -> ActionM ()
-create (CreateIncome date amount) =
-  Secure.loggedAction (\user ->
-    (liftIO . Query.run $ Income.create (_user_id user) date amount) >>= jsonId
-  )
-
-editOwn :: EditIncome -> ActionM ()
-editOwn (EditIncome incomeId date amount) =
-  Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ Income.editOwn (_user_id user) incomeId date amount
-    if updated
-      then status ok200
-      else status badRequest400
-  )
-
-deleteOwn :: IncomeId -> ActionM ()
-deleteOwn incomeId =
-  Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ Income.deleteOwn user incomeId
-    if deleted
-      then
-        status ok200
-      else do
-        status badRequest400
-        text . TL.fromStrict $ Message.get Key.Income_NotDeleted
-  )
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
deleted file mode 100644
index 8473c5c..0000000
--- a/src/server/Controller/Index.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-module Controller.Index
-  ( get
-  , signOut
-  ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Data.Text (Text)
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
-import Network.HTTP.Types.Status (ok200)
-import Prelude hiding (error)
-import Web.Scotty hiding (get)
-
-import qualified Common.Message as Message
-import Common.Message.Key (Key)
-import qualified Common.Message.Key as Key
-import Common.Model (InitResult(..), User(..))
-
-import Conf (Conf(..))
-import Model.Init (getInit)
-import qualified LoginSession
-import qualified Model.Query as Query
-import qualified Model.SignIn as SignIn
-import qualified Model.User as User
-import Secure (getUserFromToken)
-import View.Page (page)
-
-get :: Conf -> Maybe Text -> ActionM ()
-get conf mbToken = do
-  initResult <- case mbToken of
-    Just token -> do
-      userOrError <- validateSignIn conf token
-      case userOrError of
-        Left errorKey ->
-          return . InitEmpty . Left . Message.get $ errorKey
-        Right user ->
-          liftIO . Query.run . fmap InitSuccess $ getInit user conf
-    Nothing -> do
-      mbLoggedUser <- getLoggedUser
-      case mbLoggedUser of
-        Nothing ->
-          return . InitEmpty . Right $ Nothing
-        Just user ->
-          liftIO . Query.run . fmap InitSuccess $ getInit user conf
-  html $ page initResult
-
-validateSignIn :: Conf -> Text -> ActionM (Either Key User)
-validateSignIn conf textToken = do
-  mbLoggedUser <- getLoggedUser
-  case mbLoggedUser of
-    Just loggedUser ->
-      return . Right $ loggedUser
-    Nothing -> do
-      mbSignIn <- liftIO . Query.run $ SignIn.getSignIn textToken
-      now <- liftIO getCurrentTime
-      case mbSignIn of
-        Nothing ->
-          return . Left $ Key.SignIn_LinkInvalid
-        Just signIn ->
-          if SignIn.isUsed signIn
-            then
-              return . Left $ Key.SignIn_LinkUsed
-            else
-              let diffTime = now `diffUTCTime` (SignIn.creation signIn)
-              in  if diffTime > signInExpiration conf
-                    then
-                      return . Left $ Key.SignIn_LinkExpired
-                    else do
-                      LoginSession.put conf (SignIn.token signIn)
-                      mbUser <- liftIO . Query.run $ do
-                        SignIn.signInTokenToUsed . SignIn.id $ signIn
-                        User.get . SignIn.email $ signIn
-                      return $ case mbUser of
-                        Nothing -> Left Key.Secure_Unauthorized
-                        Just user -> Right user
-
-getLoggedUser :: ActionM (Maybe User)
-getLoggedUser = do
-  mbToken <- LoginSession.get
-  case mbToken of
-    Nothing ->
-      return Nothing
-    Just token -> do
-      liftIO . Query.run . getUserFromToken $ token
-
-signOut :: Conf -> ActionM ()
-signOut conf = LoginSession.delete conf >> status ok200
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
deleted file mode 100644
index 6a9ede7..0000000
--- a/src/server/Controller/Payment.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.Payment
-  ( list
-  , create
-  , editOwn
-  , deleteOwn
-  ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import Web.Scotty
-
-import qualified Common.Model.CreatePayment as M
-import qualified Common.Model.EditPayment as M
-import Common.Model (PaymentId, User(..))
-
-import Json (jsonId)
-import qualified Model.Payment as Payment
-import qualified Model.PaymentCategory as PaymentCategory
-import qualified Model.Query as Query
-import qualified Secure
-
-list :: ActionM ()
-list =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ Payment.list) >>= json
-  )
-
-create :: M.CreatePayment -> ActionM ()
-create (M.CreatePayment name cost date category frequency) =
-  Secure.loggedAction (\user ->
-    (liftIO . Query.run $ do
-      PaymentCategory.save name category
-      Payment.create (_user_id user) name cost date frequency
-    ) >>= jsonId
-  )
-
-editOwn :: M.EditPayment -> ActionM ()
-editOwn (M.EditPayment paymentId name cost date category frequency) =
-  Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ do
-      edited <- Payment.editOwn (_user_id user) paymentId name cost date frequency
-      _ <- if edited
-        then PaymentCategory.save name category >> return ()
-        else return ()
-      return edited
-    if updated
-      then status ok200
-      else status badRequest400
-  )
-
-deleteOwn :: PaymentId -> ActionM ()
-deleteOwn paymentId =
-  Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ Payment.deleteOwn (_user_id user) paymentId
-    if deleted
-      then status ok200
-      else status badRequest400
-  )
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
deleted file mode 100644
index 932ce53..0000000
--- a/src/server/Controller/SignIn.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.SignIn
-  ( signIn
-  ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types.Status (ok200, badRequest400)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import qualified Data.Text.Lazy as TL
-import Web.Scotty
-
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import qualified Common.Model.SignIn as M
-
-import Conf (Conf)
-import qualified Conf
-import qualified Model.Query as Query
-import qualified Model.SignIn as SignIn
-import qualified Model.User as User
-import qualified SendMail
-import qualified Text.Email.Validate as Email
-import qualified View.Mail.SignIn as SignIn
-
-signIn :: Conf -> M.SignIn -> ActionM ()
-signIn conf (M.SignIn email) =
-  if Email.isValid (TE.encodeUtf8 email)
-    then do
-      maybeUser <- liftIO . Query.run $ User.get email
-      case maybeUser of
-        Just user -> do
-          token <- liftIO . Query.run $ SignIn.createSignInToken email
-          let url = T.concat [
-                      if Conf.https conf then "https://" else "http://",
-                      Conf.hostname conf,
-                      "?signInToken=",
-                      token
-                    ]
-          maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [email]
-          case maybeSentMail of
-            Right _ -> textKey ok200 Key.SignIn_EmailSent
-            Left _ -> textKey badRequest400 Key.SignIn_EmailSendFail
-        Nothing -> textKey badRequest400 Key.Secure_Unauthorized
-    else textKey badRequest400 Key.SignIn_EmailInvalid
-  where textKey st key = status st >> (text . TL.fromStrict $ Message.get key)