1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.Controller.Angular 3 ( JSOpt(..) 4 , jsURL 5 , angular 6 -- * Used by servant 7 , angularRequest 8 ) where 9 10 import Control.Arrow (second) 11 import qualified Data.ByteString as BS 12 import qualified Data.ByteString.Builder as BSB 13 import Data.Default.Class (Default(..)) 14 import Network.HTTP.Types (hUserAgent, QueryLike(..)) 15 import qualified Network.Wai as Wai 16 import qualified Text.Regex.Posix as Regex 17 18 import Databrary.Has 19 import Databrary.Action 20 import Databrary.HTTP (encodePath') 21 import Databrary.HTTP.Request 22 import Databrary.View.Angular 23 import Databrary.Web 24 import Databrary.Web.Service (Web, getWebVersion) 25 26 data JSOpt 27 = JSDisabled 28 | JSDefault 29 | JSEnabled 30 deriving (Eq, Ord) 31 32 instance Default JSOpt where 33 def = JSDefault 34 35 instance Monoid JSOpt where 36 mempty = JSDefault 37 mappend JSDefault j = j 38 mappend j _ = j 39 40 instance QueryLike JSOpt where 41 toQuery JSDisabled = [("js", Just "0")] 42 toQuery JSDefault = [] 43 toQuery JSEnabled = [("js", Just "1")] 44 45 jsEnable :: Bool -> JSOpt 46 jsEnable False = JSDisabled 47 jsEnable True = JSEnabled 48 49 -- | Extract any \'js\' query param, passing its value back as the first part of 50 -- the tuple. Also return a modified query string (builder) that sets the \'js\' 51 -- param to the value specified as the first argument to this function. 52 jsURL 53 :: JSOpt -- ^ The value to use for the \'js\' param in the modified query string. 54 -> Wai.Request 55 -- ^ Incoming request where we get the original query string. 56 -- 57 -- FIXME: Just take the string itself, rather than the whole request. 58 -> (JSOpt, BSB.Builder) 59 -- ^ The extracted value of the original \'js\' param, plus a new query 60 -- string with the original param overridden. 61 jsURL js req = 62 second (encodePath' (Wai.pathInfo req) . (toQuery js ++)) 63 $ unjs 64 $ Wai.queryString req 65 where 66 unjs [] = (JSDefault, []) 67 unjs (("js", v) : q) = (jsEnable (boolParameterValue v), snd $ unjs q) 68 unjs (x : q) = second (x :) $ unjs q 69 70 -- | A regex of user agents we do not support. 71 browserBlacklist :: Regex.Regex 72 browserBlacklist = Regex.makeRegex 73 ("^Mozilla/.* \\(.*\\<(MSIE [0-9]\\.[0-9]|AppleWebKit/.* Version/[0-5]\\..* Safari/)" :: String) 74 75 -- | Enable angular when options and allowed browsers call for it. 76 enableAngular :: JSOpt -> Wai.Request -> Bool 77 enableAngular JSDisabled = const False 78 enableAngular JSDefault = not . any (Regex.matchTest browserBlacklist) . lookupRequestHeader hUserAgent 79 enableAngular JSEnabled = const True 80 81 -- | Shall this be an Angular-enabled response? If so, return a modified query 82 -- string (builder) that can be used to force an Angular-/disabled/ view. 83 angularRequest :: Wai.Request -> Maybe BSB.Builder 84 angularRequest req = 85 if enableAngular jsopt req 86 then Just nojs 87 else Nothing 88 where (jsopt, nojs) = jsURL JSDisabled req 89 90 angularResult :: BS.ByteString -> BSB.Builder -> RequestContext -> IO () 91 angularResult version nojs reqCtx = do 92 cssDeps <- (:[]) <$> makeWebFilePath "all.min.css" 93 jsDeps <- (:[]) <$> makeWebFilePath "all.min.js" 94 result $ okResponse [] (htmlAngular version cssDeps jsDeps nojs reqCtx) 95 96 -- | Do or do not send the SPA. There is no try. 97 -- 98 -- The decision is based on 'enableAngular', via 'angularRequest', which 99 -- confusingly returns a query string with which the user could override the use 100 -- of angular on a subsequent request. 101 -- 102 -- If the SPA is sent, the 'result' machinery causes a short-circuit, ignoring 103 -- any following actions in this Handler. If the SPA isn't sent, then nothing 104 -- happens whatsoever right here, and the rest of the Handler may proceed. 105 angular :: Handler () 106 angular = do 107 (servWeb :: Web) <- peek 108 let version = getWebVersion servWeb 109 (b :: Maybe BSB.Builder) <- peeks angularRequest 110 mapM_ (\nojsBldr -> focusIO (angularResult version nojsBldr)) b