{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Main
( main
) where
import Data.Aeson (FromJSON, parseJSON,
withObject, (.!=), (.:),
(.:?))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB (ByteString)
import Data.Maybe (fromMaybe)
import Data.Streaming.Network.Internal (HostPreference (Host))
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.Lazy as LT (Text)
import qualified Data.Yaml as Y
import Micro.Gateway (matchAny, optionsHandler,
proxyDELETEHandler,
proxyGETHandler,
proxyPOSTHandler,
proxyPUTHandler, requireApp,
verifySignature,
verifySignature',
wsProxyHandler)
import qualified Micro.Gateway as GW
import qualified Network.HTTP.Client as HTTP
import Network.URI (URI (..), URIAuth (..),
parseURI)
import qualified Network.Wai.Handler.Warp as W (defaultSettings,
runSettings, setHost,
setPort)
import Network.Wai.Handler.WebSockets (websocketsOr)
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors,
simpleCorsResourcePolicy)
import qualified Network.WebSockets as WS (defaultConnectionOptions)
import Options.Applicative
import Web.Scotty (ScottyM, delete, get,
middleware, options, post,
put, scottyApp)
newtype Options' = Options' {getConfigFile :: String}
parser :: Parser Options'
parser = Options' <$> strOption (long "config"
<> short 'c'
<> metavar "FILE"
<> help "config file."
<> value "config.yaml")
data AppConfig = AppConfig
{ key :: GW.AppKey
, secret :: GW.AppSecret
, baseUrl :: String
, secure :: Bool
, proxy :: Bool -- flag of only proxy
, wsUrl :: Maybe String
, replacePages :: [LT.Text]
, replaceName :: ByteString
-- allow page prefix
, allowPages :: [LT.Text]
-- deny page prefix
, denyPages :: [LT.Text]
}
data Config = Config
{ appList :: [AppConfig]
, connTimeout :: Int
-- default 10 seconds, unit seconds
, connPool :: Int
-- default 10
, host :: String
, port :: Int
}
instance FromJSON AppConfig where
parseJSON = withObject "AppConfig" $ \o -> do
key <- o .: "key"
secret <- o .: "secret"
baseUrl <- o .: "baseUrl"
secure <- o .:? "secure" .!= False
proxy <- o .:? "proxy" .!= False
wsUrl <- o .:? "wsUrl"
allowPages <- o .:? "allowPages" .!= []
denyPages <- o .:? "denyPages" .!= []
replacePages <- o .:? "replacePages" .!= []
rname <- o .:? "replaceName" .!= "__KEY__"
return AppConfig
{ replaceName = encodeUtf8 rname
, ..
}
instance FromJSON Config where
parseJSON = withObject "Config" $ \o -> do
appList <- o .: "appList"
connPool <- o .:? "connPool" .!= 10
connTimeout <- o .:? "connTimeout" .!= 10
host <- o .:? "host" .!= "127.0.0.1"
port <- o .:? "port" .!= 3000
return Config{..}
main :: IO ()
main = execParser opts >>= program
where
opts = info (helper <*> parser)
( fullDesc
<> progDesc "Simple Gateway"
<> header "simple-gateway - Simple Gateway" )
program :: Options' -> IO ()
program Options'{getConfigFile=configPath} = do
c <- Y.decodeFileEither configPath
case c of
Left e -> print e
Right Config{..} -> do
mgr <- HTTP.newManager HTTP.defaultManagerSettings
{ HTTP.managerConnCount = connPool
, HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro $ connTimeout * 10000000
}
let provider = GW.newProvider
{ GW.getAppByKey = getAppAndInitail mgr appList
}
sapp <- scottyApp $ application provider
let app = websocketsOr WS.defaultConnectionOptions (wsProxyHandler provider) sapp
W.runSettings (W.setPort port . W.setHost (Host host) $ W.defaultSettings) app
findApp :: [AppConfig] -> GW.AppKey -> Maybe AppConfig
findApp [] _ = Nothing
findApp (x:xs) k = if key x == k then Just x
else findApp xs k
getAppAndInitail :: HTTP.Manager -> [AppConfig] -> GW.AppKey -> IO (Maybe GW.App)
getAppAndInitail mgr configs k =
case findApp configs k of
Nothing -> return Nothing
Just AppConfig{..} -> do
let app = GW.newApp key secret secure proxy
app' = app
{ GW.doRequest = processRequest mgr baseUrl
, GW.prepareWsRequest = processWsRequest $ fromMaybe baseUrl wsUrl
, GW.allowPages = allowPages
, GW.denyPages = denyPages
, GW.replaceKeyName = replaceName
, GW.replaceKeyPages = replacePages
}
return $ Just app'
processRequest :: HTTP.Manager -> String
-> (HTTP.Request -> HTTP.Manager -> IO (HTTP.Response LB.ByteString))
-> String -> IO (HTTP.Response LB.ByteString)
processRequest mgr root req uri = do
r <- HTTP.parseRequest $ root ++ uri
req r mgr
processWsRequest :: String -> (String -> Int -> IO ()) -> IO ()
processWsRequest baseUrl next = next (uriRegName auth) (read . drop 1 $ uriPort auth)
where Just uri = parseURI baseUrl
Just auth = uriAuthority uri
application :: GW.Provider -> ScottyM ()
application provider = do
middleware $ cors (const $ Just policy)
get matchAny . requireApp provider $ verifySignature' proxyGETHandler
post matchAny . requireApp provider $ verifySignature proxyPOSTHandler
put matchAny . requireApp provider $ verifySignature proxyPUTHandler
delete matchAny . requireApp provider $ verifySignature proxyDELETEHandler
options matchAny optionsHandler
where policy = simpleCorsResourcePolicy
{ corsMethods = [ "GET", "POST", "PUT", "DELETE", "OPTIONS" ]
, corsRequestHeaders =
[ "X-REQUEST-KEY"
, "X-REQUEST-SIGNATURE"
, "X-REQUEST-TIME"
, "X-REQUEST-TYPE"
, "X-REQUEST-NONCE"
, "Content-Type"
, "User-Agent"
, "X-Real-IP"
, "Host"
, "X-Forwarded-For"
, "X-URI"
, "X-Query-String"
, "X-Scheme"
, "Cookie"
, "Authorization"
]
, corsMaxAge = Just 86400
}