1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.Controller.Periodic
    3   ( periodicHandler
    4     -- viewPeriodic
    5   , postPeriodic
    6   ) where
    7 
    8 import qualified Data.ByteString as BS
    9 import Control.Exception (throwTo)
   10 import Control.Monad.IO.Class (liftIO)
   11 import Network.HTTP.Types.Method (methodGet, methodPost)
   12 import qualified Network.HTTP.Types.Method as HTM
   13 
   14 import Databrary.Has
   15 import Databrary.Model.Periodic
   16 import Databrary.Service.Types
   17 import Databrary.Action
   18 import Databrary.HTTP.Form.Deform
   19 import Databrary.HTTP.Path.Parser
   20 import Databrary.Controller.Permission
   21 import Databrary.Controller.Form
   22 import Databrary.View.Periodic
   23 
   24 periodicHandler :: HTM.Method -> [(BS.ByteString, BS.ByteString)] -> Action
   25 periodicHandler method _
   26     | method == methodGet = viewPeriodicHandler
   27     | method == methodPost = postPeriodicHandler
   28     | otherwise = error "unhandled api/method combo" -- TODO: better error 
   29 
   30 {-
   31 viewPeriodic :: ActionRoute ()
   32 viewPeriodic = action GET ("admin" >/> "periodic") $ \() -> withAuth $ do
   33   checkMemberADMIN
   34   peeks $ blankForm . htmlPeriodic
   35 -}
   36 viewPeriodicHandler :: Action
   37 viewPeriodicHandler = withAuth $ do
   38   checkMemberADMIN
   39   peeks $ blankForm . htmlPeriodic
   40 
   41 postPeriodic :: ActionRoute ()
   42 postPeriodic = action POST ("admin" >/> "periodic") $ \() -> postPeriodicHandler
   43 
   44 postPeriodicHandler :: Action
   45 postPeriodicHandler = withAuth $ do
   46   checkMemberADMIN
   47   t <- peeks servicePeriodic
   48   w <- runForm (Just htmlPeriodic) $ "weekly" .:> deform
   49   liftIO $ mapM_ (`throwTo` if w then PeriodWeekly else PeriodDaily) t
   50   return $ okResponse [] (maybe "no" (const "ok") t :: String)
   51