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