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