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