controlified

mateamt.cabal

@@ -26,6 +26,9 @@ executable mateamt
                      , Control
                      , Control.Buy
                      , Control.Journal
+                     , Control.User
+                     , Control.Product
+                     , Control.Auth
                      , Model
                      , Model.User
                      , Model.Product

src/Control.hs

@@ -4,3 +4,6 @@ module Control
 
 import Control.Buy as C
 import Control.Journal as C
+import Control.User as C
+import Control.Auth as C
+import Control.Product as C

src/Main.hs

@@ -112,121 +112,3 @@ authHandler conn = mkAuthHandler handler
         _       ->
           return Nothing
       return res
-
-
-authGet :: Int -> MateHandler AuthInfo
-authGet id =
-  getUserAuthInfo id
-
-authSend :: AuthRequest -> MateHandler AuthResult
-authSend = processAuthRequest
-
-authLogout :: Maybe Int -> Int -> MateHandler ()
-authLogout (Just muid) luid = do
-  if muid == luid
-  then
-    processLogout luid
-  else
-    throwError $ err403
-      { errBody = "Forbidden"
-      }
-authLogout Nothing _ = do
-  throwError $ err403
-    { errBody = "Forbidden"
-    }
-
-
-userNew :: UserSubmit -> MateHandler Int
-userNew us = do
-  now <- liftIO $ getCurrentTime
-  randSalt <- liftIO $ random 8
-  conn <- rsConnection <$> ask
-  insertUser us (utctDay now) randSalt conn
-
-userGet :: Maybe Int -> Int -> MateHandler UserDetails
-userGet Nothing _ =
-  throwError $ err403
-    { errBody = "No Authentication present"
-    }
-userGet (Just aid) id =
-  if aid == id
-  then do
-    now <- liftIO $ getCurrentTime
-    conn <- rsConnection <$> ask
-    -- void $ liftIO $ runUpdate_ conn (updateUser id us (utctDay now))
-    userDetailsSelect conn id
-  else
-    throwError $ err403
-      { errBody = "Wrong Authentication present"
-      }
-
-userUpdate :: Maybe Int -> Int -> UserDetailsSubmit -> MateHandler ()
-userUpdate Nothing _ _ =
-  throwError $ err403
-    { errBody = "No Authentication present"
-    }
-userUpdate (Just aid) id uds =
-  if aid == id
-  then do
-    now <- liftIO $ getCurrentTime
-    conn <- rsConnection <$> ask
-    void $ updateUserDetails id uds (utctDay now) conn
-  else
-    throwError $ err403
-      { errBody = "Wrong Authentication present"
-      }
-
-userList :: Maybe Int -> Maybe Refine -> MateHandler [User]
-userList muid ref = do
-  conn <- rsConnection <$> ask
-  userSelect conn ref
-
-
-productNew :: Maybe Int -> ProductSubmit -> MateHandler Int
-productNew (Just _) bevsub = do
-  conn <- rsConnection <$> ask
-  bevid <- insertProduct bevsub conn
-  void $ insertNewEmptyAmount bevid bevsub conn
-  return bevid
-productNew Nothing _ =
-  throwError $ err403
-
-productOverview :: Int -> MateHandler ProductOverview
-productOverview pid = do
-  conn <- rsConnection <$> ask
-  productOverviewSelectSingle pid conn
-
-productStockRefill :: Maybe Int -> [AmountRefill] -> MateHandler ()
-productStockRefill (Just _) amorefs = do
-  if all ((>= 0) . amountRefillAmount) amorefs
-  then do
-    conn <- rsConnection <$> ask
-    void $ manualProductAmountRefill amorefs conn
-  else
-    throwError $ err406
-      { errBody = "Amounts less than 0 are not acceptable"
-      }
-productStockRefill Nothing _ =
-  throwError $ err403
-    { errBody = "No Authentication present"
-    }
-
-productStockUpdate :: Maybe Int -> [AmountUpdate] -> MateHandler ()
-productStockUpdate (Just _) amoups = do
-  if all ((>= 0) . amountUpdateRealAmount) amoups
-  then do
-    conn <- rsConnection <$> ask
-    void $ manualProductAmountUpdate amoups conn
-  else
-    throwError $ err406
-      { errBody = "Amounts less than 0 are not acceptable"
-      }
-productStockUpdate Nothing _ =
-  throwError $ err403
-    { errBody = "No Authentication present"
-    }
-
-productList :: MateHandler [ProductOverview]
-productList = do
-  conn <- rsConnection <$> ask
-  productOverviewSelect conn