1 {-# LANGUAGE CPP, OverloadedStrings #-} 2 module Controller.Root 3 ( viewRoot 4 , viewRootHandler 5 , viewConstantsHandler 6 , viewRobotsTxtHandler 7 , notFoundResponseHandler 8 ) where 9 10 import Control.Monad (when) 11 import qualified Data.Aeson.Types as JSON 12 import qualified Data.ByteString as BS 13 import Data.Maybe (isNothing) 14 import Data.Text (Text) 15 import Network.HTTP.Types (notFound404) 16 17 import Has 18 -- import qualified JSON as JSON 19 import Service.Types 20 import Action 21 import Controller.Angular 22 import View.Root 23 import Web.Constants 24 import View.Error (htmlNotFound) 25 26 -- TODO: remove when View.Template actionLink replaced 27 viewRoot :: ActionRoute API 28 viewRoot = action GET pathAPI $ \api -> viewRootHandler api [] 29 30 -- NEW HANDLERS 31 {- 32 getApiOrFail :: [(BS.ByteString, BS.ByteString)] -> Handler API 33 getApiOrFail params = 34 case params of 35 [] -> pure HTML 36 ("api", "api"):_ -> pure JSON 37 _ -> undefined -- TODO: action m error 38 -} 39 40 -- FIXME: JSON response ignores serviceDown 41 viewRootHandler :: API -> [(BS.ByteString, BS.ByteString)] -> Action 42 viewRootHandler api _ = -- TOOD: ensure GET 43 withAuth $ do 44 down <- peeks serviceDown 45 when (api == HTML && isNothing down) angular 46 case api of 47 JSON -> return $ okResponse [] JSON.emptyObject 48 HTML -> peeks $ okResponse [] . maybe htmlRoot htmlDown down 49 50 viewConstantsHandler :: [(BS.ByteString, BS.ByteString)] -> Action 51 viewConstantsHandler _ = -- TODO: ensure GET 52 withoutAuth $ return $ okResponse [] $ JSON.pairs constantsJSON 53 54 viewRobotsTxtHandler :: [(BS.ByteString, BS.ByteString)] -> Action 55 viewRobotsTxtHandler _ = -- TODO: ensure GET 56 withoutAuth $ return $ okResponse [] ("" :: Text) 57 -- NOTE: DEVEL/SANDBOX behavior wasn't copied here 58 59 notFoundResponseHandler :: [(BS.ByteString, BS.ByteString)] -> Action 60 notFoundResponseHandler _ = withoutAuth $ peeks $ response notFound404 [] . htmlNotFound