{-# 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 Control.Monad (join)
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 (progname, version)
import Hledger.Web.Settings (defhost, defport, defbaseurl)
progname, version :: String
progname :: String
progname = String
"hledger-web"
#ifdef VERSION
version :: String
version = VERSION
#else
version = ""
#endif
prognameandversion :: String
prognameandversion :: String
prognameandversion = String -> String
versiondescription 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 [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++
[ [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone
[String
"binary-filename"]
(String -> RawOpts -> RawOpts
setboolopt String
"binary-filename")
String
"show the download filename for this executable, and exit"
]
, 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]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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