{-# 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.Default (Default(def))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import System.Environment (getArgs)
import Network.Wai as WAI
import Network.Wai.Middleware.Cors
import Safe (lastMay)
import Hledger.Cli hiding (packageversion, progname, prognameandversion)
import Hledger.Web.Settings (defhost, defport, defbaseurl)
import qualified Data.Text as T
import Data.Char (toLower)
packageversion :: PackageVersion
packageversion :: String
packageversion =
#ifdef VERSION
VERSION
#else
""
#endif
progname :: ProgramName
progname :: String
progname = String
"hledger-web"
prognameandversion :: VersionString
prognameandversion :: String
prognameandversion = String -> String -> String
versionString String
progname String
packageversion
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, not the web UI"
, [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
[String
"allow"]
(\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
"allow" String
s RawOpts
opts)
String
"view|add|edit"
String
"set the user's access level for changing data (default: `add`). It also accepts `sandstorm` for use on that platform (reads permissions from the `X-Sandstorm-Permissions` request header)."
, [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
"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
"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
"listen on the given unix socket instead of an IP address and port (unix only; implies --serve)"
, [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] -> (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
{ groupUnnamed = webflags
, groupHidden =
hiddenflags
, groupNamed = [generalflagsgroup1]
}
, 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 -> AccessLevel
allow_ :: !AccessLevel
, 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
$cshowsPrec :: Int -> WebOpts -> String -> String
showsPrec :: Int -> WebOpts -> String -> String
$cshow :: WebOpts -> String
show :: WebOpts -> String
$cshowList :: [WebOpts] -> String -> String
showList :: [WebOpts] -> String -> String
Show)
defwebopts :: WebOpts
defwebopts :: WebOpts
defwebopts = 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
, allow_ :: AccessLevel
allow_ = AccessLevel
AddAccess
, 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
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
access :: AccessLevel
access =
case [String] -> Maybe String
forall a. [a] -> Maybe a
lastMay ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> [String]
listofstringopt String
"allow" RawOpts
rawopts of
Maybe String
Nothing -> AccessLevel
AddAccess
Just String
t ->
case String -> Either String AccessLevel
parseAccessLevel String
t of
Right AccessLevel
al -> AccessLevel
al
Left String
err -> String -> AccessLevel
forall a. String -> a
error' (String
"Unknown access level: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
WebOpts -> IO WebOpts
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
WebOpts
defwebopts
{ serve_ = case sock of
Just String
_ -> Bool
True
Maybe String
Nothing -> String -> RawOpts -> Bool
boolopt String
"serve" RawOpts
rawopts
, serve_api_ = boolopt "serve-api" rawopts
, cors_ = maybestringopt "cors" rawopts
, host_ = h
, port_ = p
, base_url_ = b
, file_url_ = stripTrailingSlash <$> maybestringopt "file-url" rawopts
, allow_ = access
, cliopts_ = cliopts
, socket_ = 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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> [String]
replaceNumericFlags ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall {t :: * -> *}.
(Eq (t Char), IsString (t Char), Foldable t) =>
[t Char] -> [t Char]
ensureDebugHasArg) (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 Permission
= ViewPermission
| AddPermission
| EditPermission
deriving (Permission -> Permission -> Bool
(Permission -> Permission -> Bool)
-> (Permission -> Permission -> Bool) -> Eq Permission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Permission -> Permission -> Bool
== :: Permission -> Permission -> Bool
$c/= :: Permission -> Permission -> Bool
/= :: Permission -> Permission -> Bool
Eq, Eq Permission
Eq Permission =>
(Permission -> Permission -> Ordering)
-> (Permission -> Permission -> Bool)
-> (Permission -> Permission -> Bool)
-> (Permission -> Permission -> Bool)
-> (Permission -> Permission -> Bool)
-> (Permission -> Permission -> Permission)
-> (Permission -> Permission -> Permission)
-> Ord Permission
Permission -> Permission -> Bool
Permission -> Permission -> Ordering
Permission -> Permission -> Permission
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 :: Permission -> Permission -> Ordering
compare :: Permission -> Permission -> Ordering
$c< :: Permission -> Permission -> Bool
< :: Permission -> Permission -> Bool
$c<= :: Permission -> Permission -> Bool
<= :: Permission -> Permission -> Bool
$c> :: Permission -> Permission -> Bool
> :: Permission -> Permission -> Bool
$c>= :: Permission -> Permission -> Bool
>= :: Permission -> Permission -> Bool
$cmax :: Permission -> Permission -> Permission
max :: Permission -> Permission -> Permission
$cmin :: Permission -> Permission -> Permission
min :: Permission -> Permission -> Permission
Ord, Permission
Permission -> Permission -> Bounded Permission
forall a. a -> a -> Bounded a
$cminBound :: Permission
minBound :: Permission
$cmaxBound :: Permission
maxBound :: Permission
Bounded, Int -> Permission
Permission -> Int
Permission -> [Permission]
Permission -> Permission
Permission -> Permission -> [Permission]
Permission -> Permission -> Permission -> [Permission]
(Permission -> Permission)
-> (Permission -> Permission)
-> (Int -> Permission)
-> (Permission -> Int)
-> (Permission -> [Permission])
-> (Permission -> Permission -> [Permission])
-> (Permission -> Permission -> [Permission])
-> (Permission -> Permission -> Permission -> [Permission])
-> Enum Permission
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 :: Permission -> Permission
succ :: Permission -> Permission
$cpred :: Permission -> Permission
pred :: Permission -> Permission
$ctoEnum :: Int -> Permission
toEnum :: Int -> Permission
$cfromEnum :: Permission -> Int
fromEnum :: Permission -> Int
$cenumFrom :: Permission -> [Permission]
enumFrom :: Permission -> [Permission]
$cenumFromThen :: Permission -> Permission -> [Permission]
enumFromThen :: Permission -> Permission -> [Permission]
$cenumFromTo :: Permission -> Permission -> [Permission]
enumFromTo :: Permission -> Permission -> [Permission]
$cenumFromThenTo :: Permission -> Permission -> Permission -> [Permission]
enumFromThenTo :: Permission -> Permission -> Permission -> [Permission]
Enum, Int -> Permission -> String -> String
[Permission] -> String -> String
Permission -> String
(Int -> Permission -> String -> String)
-> (Permission -> String)
-> ([Permission] -> String -> String)
-> Show Permission
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Permission -> String -> String
showsPrec :: Int -> Permission -> String -> String
$cshow :: Permission -> String
show :: Permission -> String
$cshowList :: [Permission] -> String -> String
showList :: [Permission] -> String -> String
Show)
parsePermission :: ByteString -> Either Text Permission
parsePermission :: ByteString -> Either Text Permission
parsePermission ByteString
"view" = Permission -> Either Text Permission
forall a b. b -> Either a b
Right Permission
ViewPermission
parsePermission ByteString
"add" = Permission -> Either Text Permission
forall a b. b -> Either a b
Right Permission
AddPermission
parsePermission ByteString
"edit" = Permission -> Either Text Permission
forall a b. b -> Either a b
Right Permission
EditPermission
parsePermission ByteString
x = Text -> Either Text Permission
forall a b. a -> Either a b
Left (Text -> Either Text Permission) -> Text -> Either Text Permission
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack ByteString
x
showPermission :: Permission -> String
showPermission :: Permission -> String
showPermission Permission
p = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
10 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Permission -> String
forall a. Show a => a -> String
show Permission
p
data AccessLevel =
ViewAccess
| AddAccess
| EditAccess
| SandstormAccess
deriving (AccessLevel -> AccessLevel -> Bool
(AccessLevel -> AccessLevel -> Bool)
-> (AccessLevel -> AccessLevel -> Bool) -> Eq AccessLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessLevel -> AccessLevel -> Bool
== :: AccessLevel -> AccessLevel -> Bool
$c/= :: AccessLevel -> AccessLevel -> Bool
/= :: AccessLevel -> AccessLevel -> Bool
Eq, Eq AccessLevel
Eq AccessLevel =>
(AccessLevel -> AccessLevel -> Ordering)
-> (AccessLevel -> AccessLevel -> Bool)
-> (AccessLevel -> AccessLevel -> Bool)
-> (AccessLevel -> AccessLevel -> Bool)
-> (AccessLevel -> AccessLevel -> Bool)
-> (AccessLevel -> AccessLevel -> AccessLevel)
-> (AccessLevel -> AccessLevel -> AccessLevel)
-> Ord AccessLevel
AccessLevel -> AccessLevel -> Bool
AccessLevel -> AccessLevel -> Ordering
AccessLevel -> AccessLevel -> AccessLevel
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 :: AccessLevel -> AccessLevel -> Ordering
compare :: AccessLevel -> AccessLevel -> Ordering
$c< :: AccessLevel -> AccessLevel -> Bool
< :: AccessLevel -> AccessLevel -> Bool
$c<= :: AccessLevel -> AccessLevel -> Bool
<= :: AccessLevel -> AccessLevel -> Bool
$c> :: AccessLevel -> AccessLevel -> Bool
> :: AccessLevel -> AccessLevel -> Bool
$c>= :: AccessLevel -> AccessLevel -> Bool
>= :: AccessLevel -> AccessLevel -> Bool
$cmax :: AccessLevel -> AccessLevel -> AccessLevel
max :: AccessLevel -> AccessLevel -> AccessLevel
$cmin :: AccessLevel -> AccessLevel -> AccessLevel
min :: AccessLevel -> AccessLevel -> AccessLevel
Ord, AccessLevel
AccessLevel -> AccessLevel -> Bounded AccessLevel
forall a. a -> a -> Bounded a
$cminBound :: AccessLevel
minBound :: AccessLevel
$cmaxBound :: AccessLevel
maxBound :: AccessLevel
Bounded, Int -> AccessLevel
AccessLevel -> Int
AccessLevel -> [AccessLevel]
AccessLevel -> AccessLevel
AccessLevel -> AccessLevel -> [AccessLevel]
AccessLevel -> AccessLevel -> AccessLevel -> [AccessLevel]
(AccessLevel -> AccessLevel)
-> (AccessLevel -> AccessLevel)
-> (Int -> AccessLevel)
-> (AccessLevel -> Int)
-> (AccessLevel -> [AccessLevel])
-> (AccessLevel -> AccessLevel -> [AccessLevel])
-> (AccessLevel -> AccessLevel -> [AccessLevel])
-> (AccessLevel -> AccessLevel -> AccessLevel -> [AccessLevel])
-> Enum AccessLevel
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 :: AccessLevel -> AccessLevel
succ :: AccessLevel -> AccessLevel
$cpred :: AccessLevel -> AccessLevel
pred :: AccessLevel -> AccessLevel
$ctoEnum :: Int -> AccessLevel
toEnum :: Int -> AccessLevel
$cfromEnum :: AccessLevel -> Int
fromEnum :: AccessLevel -> Int
$cenumFrom :: AccessLevel -> [AccessLevel]
enumFrom :: AccessLevel -> [AccessLevel]
$cenumFromThen :: AccessLevel -> AccessLevel -> [AccessLevel]
enumFromThen :: AccessLevel -> AccessLevel -> [AccessLevel]
$cenumFromTo :: AccessLevel -> AccessLevel -> [AccessLevel]
enumFromTo :: AccessLevel -> AccessLevel -> [AccessLevel]
$cenumFromThenTo :: AccessLevel -> AccessLevel -> AccessLevel -> [AccessLevel]
enumFromThenTo :: AccessLevel -> AccessLevel -> AccessLevel -> [AccessLevel]
Enum, Int -> AccessLevel -> String -> String
[AccessLevel] -> String -> String
AccessLevel -> String
(Int -> AccessLevel -> String -> String)
-> (AccessLevel -> String)
-> ([AccessLevel] -> String -> String)
-> Show AccessLevel
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> AccessLevel -> String -> String
showsPrec :: Int -> AccessLevel -> String -> String
$cshow :: AccessLevel -> String
show :: AccessLevel -> String
$cshowList :: [AccessLevel] -> String -> String
showList :: [AccessLevel] -> String -> String
Show)
parseAccessLevel :: String -> Either String AccessLevel
parseAccessLevel :: String -> Either String AccessLevel
parseAccessLevel String
"view" = AccessLevel -> Either String AccessLevel
forall a b. b -> Either a b
Right AccessLevel
ViewAccess
parseAccessLevel String
"add" = AccessLevel -> Either String AccessLevel
forall a b. b -> Either a b
Right AccessLevel
AddAccess
parseAccessLevel String
"edit" = AccessLevel -> Either String AccessLevel
forall a b. b -> Either a b
Right AccessLevel
EditAccess
parseAccessLevel String
"sandstorm" = AccessLevel -> Either String AccessLevel
forall a b. b -> Either a b
Right AccessLevel
SandstormAccess
parseAccessLevel String
s = String -> Either String AccessLevel
forall a b. a -> Either a b
Left (String -> Either String AccessLevel)
-> String -> Either String AccessLevel
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", should be one of: view, add, edit, sandstorm"
accessLevelToPermissions :: AccessLevel -> [Permission]
accessLevelToPermissions :: AccessLevel -> [Permission]
accessLevelToPermissions AccessLevel
ViewAccess = [Permission
ViewPermission]
accessLevelToPermissions AccessLevel
AddAccess = [Permission
ViewPermission, Permission
AddPermission]
accessLevelToPermissions AccessLevel
EditAccess = [Permission
ViewPermission, Permission
AddPermission, Permission
EditPermission]
accessLevelToPermissions AccessLevel
SandstormAccess = []
simplePolicyWithOrigin :: Origin -> CorsResourcePolicy
simplePolicyWithOrigin :: ByteString -> CorsResourcePolicy
simplePolicyWithOrigin ByteString
origin =
CorsResourcePolicy
simpleCorsResourcePolicy { corsOrigins = Just ([origin], 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