1 {-# LANGUAGE CPP, OverloadedStrings #-} 2 module Databrary.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 Databrary.Has 18 -- import qualified Databrary.JSON as JSON 19 import Databrary.Service.Types 20 import Databrary.Action 21 import Databrary.Controller.Angular 22 import Databrary.View.Root 23 import Databrary.Web.Constants 24 import Databrary.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