{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Web.WebOptions where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.ByteString.UTF8 (fromString)
import Data.CaseInsensitive (CI, mk)
import Data.Default (Default(def))
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text)
import System.Environment (getArgs)
import Network.Wai as WAI
import Network.Wai.Middleware.Cors
import Hledger.Cli hiding (packageversion, progname, prognameandversion)
import Hledger.Web.Settings (defhost, defport, defbaseurl)
packageversion :: String
#ifdef VERSION
packageversion :: String
packageversion = VERSION
#else
packageversion = ""
#endif
progname :: String
progname :: String
progname = String
"hledger-web"
prognameandversion :: String
prognameandversion :: String
prognameandversion = String -> String
versionStringForProgname String
progname
webflags :: [Flag RawOpts]
webflags :: [Flag RawOpts]
webflags =
[ [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone
[String
"serve", String
"server"]
(String -> RawOpts -> RawOpts
setboolopt String
"serve")
String
"serve and log requests, don't browse or auto-exit"
, [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone
[String
"serve-api"]
(String -> RawOpts -> RawOpts
setboolopt String
"serve-api")
String
"like --serve, but serve only the JSON web API, without the server-side web UI"
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"cors"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"cors" String
s RawOpts
opts)
String
"ORIGIN"
(String
"allow cross-origin requests from the specified origin; setting ORIGIN to \"*\" allows requests from any origin")
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"socket"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"socket" String
s RawOpts
opts)
String
"SOCKET"
String
"use the given socket instead of the given IP and port (implies --serve)"
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"host"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"host" String
s RawOpts
opts)
String
"IPADDR"
(String
"listen on this IP address (default: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
defhost String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"port"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"port" String
s RawOpts
opts)
String
"PORT"
(String
"listen on this TCP port (default: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
defport String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"base-url"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"base-url" String
s RawOpts
opts)
String
"BASEURL"
String
"set the base url (default: http://IPADDR:PORT)"
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"file-url"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"file-url" String
s RawOpts
opts)
String
"FILEURL"
String
"set the static files url (default: BASEURL/static)"
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"capabilities"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"capabilities" String
s RawOpts
opts)
String
"CAP[,CAP..]"
String
"enable the view, add, and/or manage capabilities (default: view,add)"
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"capabilities-header"]
(\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"capabilities-header" String
s RawOpts
opts)
String
"HTTPHEADER"
String
"read capabilities to enable from a HTTP header, like X-Sandstorm-Permissions (default: disabled)"
, [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone
[String
"test"]
(String -> RawOpts -> RawOpts
setboolopt String
"test")
String
"run hledger-web's tests and exit. hspec test runner args may follow a --, eg: hledger-web --test -- --help"
]
webmode :: Mode RawOpts
webmode :: Mode RawOpts
webmode =
(String
-> RawOpts
-> String
-> Arg RawOpts
-> [Flag RawOpts]
-> Mode RawOpts
forall a. String -> a -> String -> Arg a -> [Flag a] -> Mode a
mode
String
"hledger-web"
(String -> String -> RawOpts -> RawOpts
setopt String
"command" String
"web" RawOpts
forall a. Default a => a
def)
String
"start serving the hledger web interface"
(String -> Arg RawOpts
argsFlag String
"[PATTERNS]")
[])
{ modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags =
Group :: forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group
{ groupUnnamed :: [Flag RawOpts]
groupUnnamed = [Flag RawOpts]
webflags
, groupHidden :: [Flag RawOpts]
groupHidden =
[Flag RawOpts]
hiddenflags
, groupNamed :: [(String, [Flag RawOpts])]
groupNamed = [(String, [Flag RawOpts])
generalflagsgroup1]
}
, modeHelpSuffix :: [String]
modeHelpSuffix = []
}
data WebOpts = WebOpts
{ WebOpts -> Bool
serve_ :: Bool
, WebOpts -> Bool
serve_api_ :: Bool
, WebOpts -> Maybe String
cors_ :: Maybe String
, WebOpts -> String
host_ :: String
, WebOpts -> Int
port_ :: Int
, WebOpts -> String
base_url_ :: String
, WebOpts -> Maybe String
file_url_ :: Maybe String
, WebOpts -> [Capability]
capabilities_ :: [Capability]
, :: Maybe (CI ByteString)
, WebOpts -> CliOpts
cliopts_ :: CliOpts
, WebOpts -> Maybe String
socket_ :: Maybe String
} deriving (Int -> WebOpts -> String -> String
[WebOpts] -> String -> String
WebOpts -> String
(Int -> WebOpts -> String -> String)
-> (WebOpts -> String)
-> ([WebOpts] -> String -> String)
-> Show WebOpts
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [WebOpts] -> String -> String
$cshowList :: [WebOpts] -> String -> String
show :: WebOpts -> String
$cshow :: WebOpts -> String
showsPrec :: Int -> WebOpts -> String -> String
$cshowsPrec :: Int -> WebOpts -> String -> String
Show)
defwebopts :: WebOpts
defwebopts :: WebOpts
defwebopts = WebOpts :: Bool
-> Bool
-> Maybe String
-> String
-> Int
-> String
-> Maybe String
-> [Capability]
-> Maybe (CI ByteString)
-> CliOpts
-> Maybe String
-> WebOpts
WebOpts
{ serve_ :: Bool
serve_ = Bool
False
, serve_api_ :: Bool
serve_api_ = Bool
False
, cors_ :: Maybe String
cors_ = Maybe String
forall a. Maybe a
Nothing
, host_ :: String
host_ = String
""
, port_ :: Int
port_ = Int
forall a. Default a => a
def
, base_url_ :: String
base_url_ = String
""
, file_url_ :: Maybe String
file_url_ = Maybe String
forall a. Maybe a
Nothing
, capabilities_ :: [Capability]
capabilities_ = [Capability
CapView, Capability
CapAdd]
, capabilitiesHeader_ :: Maybe (CI ByteString)
capabilitiesHeader_ = Maybe (CI ByteString)
forall a. Maybe a
Nothing
, cliopts_ :: CliOpts
cliopts_ = CliOpts
forall a. Default a => a
def
, socket_ :: Maybe String
socket_ = Maybe String
forall a. Maybe a
Nothing
}
instance Default WebOpts where def :: WebOpts
def = WebOpts
defwebopts
rawOptsToWebOpts :: RawOpts -> IO WebOpts
rawOptsToWebOpts :: RawOpts -> IO WebOpts
rawOptsToWebOpts RawOpts
rawopts =
WebOpts -> WebOpts
checkWebOpts (WebOpts -> WebOpts) -> IO WebOpts -> IO WebOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
CliOpts
cliopts <- RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts
let h :: String
h = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defhost (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> Maybe String
maybestringopt String
"host" RawOpts
rawopts
p :: Int
p = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defport (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> Maybe Int
maybeposintopt String
"port" RawOpts
rawopts
b :: String
b =
String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Int -> String
defbaseurl String
h Int
p) String -> String
stripTrailingSlash (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$
String -> RawOpts -> Maybe String
maybestringopt String
"base-url" RawOpts
rawopts
caps' :: [Text]
caps' = Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> [Text]) -> [String] -> [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> RawOpts -> [String]
listofstringopt String
"capabilities" RawOpts
rawopts
caps :: [Capability]
caps = case (Text -> Either Text Capability)
-> [Text] -> Either Text [Capability]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either Text Capability
capabilityFromText [Text]
caps' of
Left Text
e -> String -> [Capability]
forall a. String -> a
error' (String
"Unknown capability: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
e)
Right [] -> [Capability
CapView, Capability
CapAdd]
Right [Capability]
xs -> [Capability]
xs
sock :: Maybe String
sock = String -> String
stripTrailingSlash (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RawOpts -> Maybe String
maybestringopt String
"socket" RawOpts
rawopts
WebOpts -> IO WebOpts
forall (m :: * -> *) a. Monad m => a -> m a
return
WebOpts
defwebopts
{ serve_ :: Bool
serve_ = case Maybe String
sock of
Just String
_ -> Bool
True
Maybe String
Nothing -> String -> RawOpts -> Bool
boolopt String
"serve" RawOpts
rawopts
, serve_api_ :: Bool
serve_api_ = String -> RawOpts -> Bool
boolopt String
"serve-api" RawOpts
rawopts
, cors_ :: Maybe String
cors_ = String -> RawOpts -> Maybe String
maybestringopt String
"cors" RawOpts
rawopts
, host_ :: String
host_ = String
h
, port_ :: Int
port_ = Int
p
, base_url_ :: String
base_url_ = String
b
, file_url_ :: Maybe String
file_url_ = String -> String
stripTrailingSlash (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RawOpts -> Maybe String
maybestringopt String
"file-url" RawOpts
rawopts
, capabilities_ :: [Capability]
capabilities_ = [Capability]
caps
, capabilitiesHeader_ :: Maybe (CI ByteString)
capabilitiesHeader_ = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString)
-> (String -> ByteString) -> String -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack (String -> CI ByteString) -> Maybe String -> Maybe (CI ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RawOpts -> Maybe String
maybestringopt String
"capabilities-header" RawOpts
rawopts
, cliopts_ :: CliOpts
cliopts_ = CliOpts
cliopts
, socket_ :: Maybe String
socket_ = Maybe String
sock
}
where
stripTrailingSlash :: String -> String
stripTrailingSlash = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
checkWebOpts :: WebOpts -> WebOpts
checkWebOpts :: WebOpts -> WebOpts
checkWebOpts = WebOpts -> WebOpts
forall a. a -> a
id
getHledgerWebOpts :: IO WebOpts
getHledgerWebOpts :: IO WebOpts
getHledgerWebOpts = do
[String]
args <- ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
replaceNumericFlags (IO [String] -> IO [String])
-> ([String] -> IO [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO [String]
expandArgsAt ([String] -> IO [String]) -> IO [String] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs
RawOpts -> IO WebOpts
rawOptsToWebOpts (RawOpts -> IO WebOpts)
-> (Either String RawOpts -> RawOpts)
-> Either String RawOpts
-> IO WebOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> RawOpts)
-> (RawOpts -> RawOpts) -> Either String RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> RawOpts
forall a. String -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either String RawOpts -> IO WebOpts)
-> Either String RawOpts -> IO WebOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [String] -> Either String RawOpts
forall a. Mode a -> [String] -> Either String a
process Mode RawOpts
webmode [String]
args
data Capability
= CapView
| CapAdd
| CapManage
deriving (Capability -> Capability -> Bool
(Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool) -> Eq Capability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Capability -> Capability -> Bool
$c/= :: Capability -> Capability -> Bool
== :: Capability -> Capability -> Bool
$c== :: Capability -> Capability -> Bool
Eq, Eq Capability
Eq Capability
-> (Capability -> Capability -> Ordering)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Capability)
-> (Capability -> Capability -> Capability)
-> Ord Capability
Capability -> Capability -> Bool
Capability -> Capability -> Ordering
Capability -> Capability -> Capability
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Capability -> Capability -> Capability
$cmin :: Capability -> Capability -> Capability
max :: Capability -> Capability -> Capability
$cmax :: Capability -> Capability -> Capability
>= :: Capability -> Capability -> Bool
$c>= :: Capability -> Capability -> Bool
> :: Capability -> Capability -> Bool
$c> :: Capability -> Capability -> Bool
<= :: Capability -> Capability -> Bool
$c<= :: Capability -> Capability -> Bool
< :: Capability -> Capability -> Bool
$c< :: Capability -> Capability -> Bool
compare :: Capability -> Capability -> Ordering
$ccompare :: Capability -> Capability -> Ordering
$cp1Ord :: Eq Capability
Ord, Capability
Capability -> Capability -> Bounded Capability
forall a. a -> a -> Bounded a
maxBound :: Capability
$cmaxBound :: Capability
minBound :: Capability
$cminBound :: Capability
Bounded, Int -> Capability
Capability -> Int
Capability -> [Capability]
Capability -> Capability
Capability -> Capability -> [Capability]
Capability -> Capability -> Capability -> [Capability]
(Capability -> Capability)
-> (Capability -> Capability)
-> (Int -> Capability)
-> (Capability -> Int)
-> (Capability -> [Capability])
-> (Capability -> Capability -> [Capability])
-> (Capability -> Capability -> [Capability])
-> (Capability -> Capability -> Capability -> [Capability])
-> Enum Capability
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Capability -> Capability -> Capability -> [Capability]
$cenumFromThenTo :: Capability -> Capability -> Capability -> [Capability]
enumFromTo :: Capability -> Capability -> [Capability]
$cenumFromTo :: Capability -> Capability -> [Capability]
enumFromThen :: Capability -> Capability -> [Capability]
$cenumFromThen :: Capability -> Capability -> [Capability]
enumFrom :: Capability -> [Capability]
$cenumFrom :: Capability -> [Capability]
fromEnum :: Capability -> Int
$cfromEnum :: Capability -> Int
toEnum :: Int -> Capability
$ctoEnum :: Int -> Capability
pred :: Capability -> Capability
$cpred :: Capability -> Capability
succ :: Capability -> Capability
$csucc :: Capability -> Capability
Enum, Int -> Capability -> String -> String
[Capability] -> String -> String
Capability -> String
(Int -> Capability -> String -> String)
-> (Capability -> String)
-> ([Capability] -> String -> String)
-> Show Capability
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Capability] -> String -> String
$cshowList :: [Capability] -> String -> String
show :: Capability -> String
$cshow :: Capability -> String
showsPrec :: Int -> Capability -> String -> String
$cshowsPrec :: Int -> Capability -> String -> String
Show)
capabilityFromText :: Text -> Either Text Capability
capabilityFromText :: Text -> Either Text Capability
capabilityFromText Text
"view" = Capability -> Either Text Capability
forall a b. b -> Either a b
Right Capability
CapView
capabilityFromText Text
"add" = Capability -> Either Text Capability
forall a b. b -> Either a b
Right Capability
CapAdd
capabilityFromText Text
"manage" = Capability -> Either Text Capability
forall a b. b -> Either a b
Right Capability
CapManage
capabilityFromText Text
x = Text -> Either Text Capability
forall a b. a -> Either a b
Left Text
x
capabilityFromBS :: ByteString -> Either ByteString Capability
capabilityFromBS :: ByteString -> Either ByteString Capability
capabilityFromBS ByteString
"view" = Capability -> Either ByteString Capability
forall a b. b -> Either a b
Right Capability
CapView
capabilityFromBS ByteString
"add" = Capability -> Either ByteString Capability
forall a b. b -> Either a b
Right Capability
CapAdd
capabilityFromBS ByteString
"manage" = Capability -> Either ByteString Capability
forall a b. b -> Either a b
Right Capability
CapManage
capabilityFromBS ByteString
x = ByteString -> Either ByteString Capability
forall a b. a -> Either a b
Left ByteString
x
simplePolicyWithOrigin :: Origin -> CorsResourcePolicy
simplePolicyWithOrigin :: ByteString -> CorsResourcePolicy
simplePolicyWithOrigin ByteString
origin =
CorsResourcePolicy
simpleCorsResourcePolicy { corsOrigins :: Maybe ([ByteString], Bool)
corsOrigins = ([ByteString], Bool) -> Maybe ([ByteString], Bool)
forall a. a -> Maybe a
Just ([ByteString
origin], Bool
False) }
corsPolicyFromString :: String -> WAI.Middleware
corsPolicyFromString :: String -> Middleware
corsPolicyFromString String
origin =
let
policy :: CorsResourcePolicy
policy = case String
origin of
String
"*" -> CorsResourcePolicy
simpleCorsResourcePolicy
String
url -> ByteString -> CorsResourcePolicy
simplePolicyWithOrigin (ByteString -> CorsResourcePolicy)
-> ByteString -> CorsResourcePolicy
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString String
url
in
(Request -> Maybe CorsResourcePolicy) -> Middleware
cors (Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy
forall a b. a -> b -> a
const (Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy)
-> Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy
forall a b. (a -> b) -> a -> b
$ CorsResourcePolicy -> Maybe CorsResourcePolicy
forall a. a -> Maybe a
Just CorsResourcePolicy
policy)
corsPolicy :: WebOpts -> (Application -> Application)
corsPolicy :: WebOpts -> Middleware
corsPolicy WebOpts
opts =
Middleware -> (String -> Middleware) -> Maybe String -> Middleware
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Middleware
forall a. a -> a
id String -> Middleware
corsPolicyFromString (Maybe String -> Middleware) -> Maybe String -> Middleware
forall a b. (a -> b) -> a -> b
$ WebOpts -> Maybe String
cors_ WebOpts
opts