{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module WikiMusic.SSR.Servant.Utilities where
import Data.ByteString.Base16.Lazy qualified as B16
import Data.Map qualified as Map
import Data.Text qualified as T
import NeatInterpolation
import Principium
import Servant
import Servant.Multipart
import Text.Blaze.Html.Renderer.Utf8
import WikiMusic.SSR.Backend.Rest ()
import WikiMusic.SSR.Free.View
import WikiMusic.SSR.View.Html ()
fromForm :: MultipartData tag -> Text -> Text -> Text
fromForm :: forall tag. MultipartData tag -> Text -> Text -> Text
fromForm MultipartData tag
multipart Text
fallback Text
name =
Text -> (NonEmpty Text -> Text) -> Maybe (NonEmpty Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
fallback NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head
(Maybe (NonEmpty Text) -> Text)
-> ([Input] -> Maybe (NonEmpty Text)) -> [Input] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
([Text] -> Maybe (NonEmpty Text))
-> ([Input] -> [Text]) -> [Input] -> Maybe (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Text) -> [Input] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Text
iValue
([Input] -> [Text]) -> ([Input] -> [Input]) -> [Input] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Bool) -> [Input] -> [Input]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Input
i -> Input -> Text
iName Input
i Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name)
([Input] -> Text) -> [Input] -> Text
forall a b. (a -> b) -> a -> b
$ MultipartData tag -> [Input]
forall tag. MultipartData tag -> [Input]
inputs MultipartData tag
multipart
maybeFromForm :: MultipartData tag -> Text -> Maybe Text
maybeFromForm :: forall tag. MultipartData tag -> Text -> Maybe Text
maybeFromForm MultipartData tag
multipart Text
name = case Maybe Text
rawVal of
(Just Text
"") -> Maybe Text
forall a. Maybe a
Nothing
(Just Text
x) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
Maybe Text
Nothing -> Maybe Text
forall a. Maybe a
Nothing
where
rawVal :: Maybe Text
rawVal =
(NonEmpty Text -> Text) -> Maybe (NonEmpty Text) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head
(Maybe (NonEmpty Text) -> Maybe Text)
-> ([Input] -> Maybe (NonEmpty Text)) -> [Input] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
([Text] -> Maybe (NonEmpty Text))
-> ([Input] -> [Text]) -> [Input] -> Maybe (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Text) -> [Input] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Text
iValue
([Input] -> [Text]) -> ([Input] -> [Input]) -> [Input] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Bool) -> [Input] -> [Input]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Input
i -> Input -> Text
iName Input
i Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name)
([Input] -> Maybe Text) -> [Input] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ MultipartData tag -> [Input]
forall tag. MultipartData tag -> [Input]
inputs MultipartData tag
multipart
setCookieRoute :: (MonadError ServerError m) => CookieConfig -> Text -> Map Text Text -> m a
setCookieRoute :: forall (m :: * -> *) a.
MonadError ServerError m =>
CookieConfig -> Text -> Map Text Text -> m a
setCookieRoute CookieConfig
cookieConfig Text
newLocation Map Text Text
cookieMap =
ServerError -> m a
forall a. ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(ServerError -> m a) -> ServerError -> m a
forall a b. (a -> b) -> a -> b
$ ServerError
{ $sel:errHTTPCode:ServerError :: Int
errHTTPCode = Int
302,
$sel:errReasonPhrase:ServerError :: String
errReasonPhrase = String
"Found",
$sel:errBody:ServerError :: ByteString
errBody = ByteString
"",
$sel:errHeaders:ServerError :: [Header]
errHeaders =
(HeaderName
"Location", Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
newLocation) Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
cookieHeaders
}
where
mkCookieHeaders :: (Text, Text) -> Header
mkCookieHeaders (Text
cookieName, Text
cookieValue) =
( HeaderName
"Set-Cookie",
String -> ByteString
forall a. IsString a => String -> a
fromString
(String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
(Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CookieConfig -> Text -> Text
mkCookieData CookieConfig
cookieConfig
(Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [trimming|$cookieName=$cookieValue|]
)
cookieHeaders :: [Header]
cookieHeaders = ((Text, Text) -> Header) -> [(Text, Text)] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Header
mkCookieHeaders (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map Text Text
cookieMap)
mkCookieData :: CookieConfig -> Text -> Text
mkCookieData :: CookieConfig -> Text -> Text
mkCookieData CookieConfig
cookieConfig Text
dyn =
[trimming|
$dyn; HttpOnly; $sameSite; Domain=$domain; Path=/; Max-Age=$maxAge $secureSuffix
|]
where
maxAge :: Text
maxAge = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ CookieConfig
cookieConfig CookieConfig -> Optic' A_Lens NoIx CookieConfig Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CookieConfig Int
#maxAge
domain :: Text
domain = CookieConfig
cookieConfig CookieConfig -> Optic' A_Lens NoIx CookieConfig Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CookieConfig Text
#domain
sameSite :: Text
sameSite = CookieConfig
cookieConfig CookieConfig -> Optic' A_Lens NoIx CookieConfig Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CookieConfig Text
#sameSite
secureSuffix :: Text
secureSuffix = if CookieConfig
cookieConfig CookieConfig -> Optic' A_Lens NoIx CookieConfig Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CookieConfig Bool
#secure then Text
"; Secure" else Text
""
mkCookieMap :: Maybe Text -> Map Text Text
mkCookieMap :: Maybe Text -> Map Text Text
mkCookieMap Maybe Text
cookie = do
let diffCookies :: [Text]
diffCookies = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"; ") Maybe Text
cookie
cookieParser :: [b] -> Maybe (b, b)
cookieParser [b
a, b
b] = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
a, b
b)
cookieParser [b]
_ = Maybe (b, b)
forall a. Maybe a
Nothing
cookieMap :: Map Text Text
cookieMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Text] -> Maybe (Text, Text)
forall {b}. [b] -> Maybe (b, b)
cookieParser ([Text] -> Maybe (Text, Text))
-> (Text -> [Text]) -> Text -> Maybe (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"=") [Text]
diffCookies
Map Text Text
cookieMap
decodeToken :: Text -> Text
decodeToken :: Text -> Text
decodeToken = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
encodeToken :: Text -> Text
encodeToken :: Text -> Text
encodeToken = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
vvFromCookies :: Maybe Text -> ViewVars
vvFromCookies :: Maybe Text -> ViewVars
vvFromCookies Maybe Text
cookie = ViewVars {SortOrder
AuthToken
UiMode
Language
SongAsciiSize
Palette
language :: Language
uiMode :: UiMode
authToken :: AuthToken
songAsciiSize :: SongAsciiSize
artistSorting :: SortOrder
songSorting :: SortOrder
genreSorting :: SortOrder
palette :: Palette
$sel:language:ViewVars :: Language
$sel:uiMode:ViewVars :: UiMode
$sel:authToken:ViewVars :: AuthToken
$sel:songSorting:ViewVars :: SortOrder
$sel:artistSorting:ViewVars :: SortOrder
$sel:genreSorting:ViewVars :: SortOrder
$sel:songAsciiSize:ViewVars :: SongAsciiSize
$sel:palette:ViewVars :: Palette
..}
where
cookieMap :: Map Text Text
cookieMap = Maybe Text -> Map Text Text
mkCookieMap Maybe Text
cookie
language :: Language
language = Language {$sel:value:Language :: Text
value = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"en" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
localeCookieName)}
uiMode :: UiMode
uiMode = UiMode {$sel:value:UiMode :: Text
value = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"light" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
uiModeCookieName)}
authToken :: AuthToken
authToken = AuthToken {$sel:value:AuthToken :: Text
value = Text -> Text
decodeToken (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
authCookieName)}
songAsciiSize :: SongAsciiSize
songAsciiSize = SongAsciiSize {$sel:value:SongAsciiSize :: Text
value = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"sm" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
songAsciiSizeCookieName)}
artistSorting :: SortOrder
artistSorting =
SortOrder
{ $sel:value:SortOrder :: Text
value = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"created-at-desc" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
artistSortingCookieName)
}
songSorting :: SortOrder
songSorting =
SortOrder
{ $sel:value:SortOrder :: Text
value = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"created-at-desc" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
songSortingCookieName)
}
genreSorting :: SortOrder
genreSorting =
SortOrder
{ $sel:value:SortOrder :: Text
value = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"created-at-desc" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
genreSortingCookieName)
}
palette :: Palette
palette = Palette {$sel:value:Palette :: Text
value = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"purple" (Map Text Text
cookieMap Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
paletteCookieName)}
errorRoute :: (MonadIO m, MonadError ServerError m) => Env -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Text -> m Html
errorRoute :: forall (m :: * -> *).
(MonadIO m, MonadError ServerError m) =>
Env
-> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Text -> m Html
errorRoute Env
env Maybe Text
cookie Maybe Text
_ Maybe Int
maybeCode Maybe Text
maybeMessage = do
Html
h <- IO Html -> m Html
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Html -> m Html) -> IO Html -> m Html
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Exec f => Free f a -> IO a
exec @View (Env -> ViewVars -> Maybe Int -> Maybe Text -> Free View Html
forall (f :: * -> *).
(View :<: f) =>
Env -> ViewVars -> Maybe Int -> Maybe Text -> Free f Html
errorPage Env
env ViewVars
vv Maybe Int
maybeCode Maybe Text
maybeMessage)
ServerError -> m Html
forall a. ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(ServerError -> m Html) -> ServerError -> m Html
forall a b. (a -> b) -> a -> b
$ ServerError
{ $sel:errHTTPCode:ServerError :: Int
errHTTPCode = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
500 Maybe Int
maybeCode,
$sel:errReasonPhrase:ServerError :: String
errReasonPhrase = String
"Error!",
$sel:errBody:ServerError :: ByteString
errBody = Html -> ByteString
renderHtml Html
h,
$sel:errHeaders:ServerError :: [Header]
errHeaders = []
}
where
vv :: ViewVars
vv = Maybe Text -> ViewVars
vvFromCookies Maybe Text
cookie
data ServerResponse = ServerResponse
{ ServerResponse -> Int
code :: Int,
ServerResponse -> Maybe Text
cause :: Maybe Text,
ServerResponse -> Maybe Text
body :: Maybe Text,
:: [(Text, Text)]
}
deriving (ServerResponse -> ServerResponse -> Bool
(ServerResponse -> ServerResponse -> Bool)
-> (ServerResponse -> ServerResponse -> Bool) -> Eq ServerResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerResponse -> ServerResponse -> Bool
== :: ServerResponse -> ServerResponse -> Bool
$c/= :: ServerResponse -> ServerResponse -> Bool
/= :: ServerResponse -> ServerResponse -> Bool
Eq, Int -> ServerResponse -> ShowS
[ServerResponse] -> ShowS
ServerResponse -> String
(Int -> ServerResponse -> ShowS)
-> (ServerResponse -> String)
-> ([ServerResponse] -> ShowS)
-> Show ServerResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerResponse -> ShowS
showsPrec :: Int -> ServerResponse -> ShowS
$cshow :: ServerResponse -> String
show :: ServerResponse -> String
$cshowList :: [ServerResponse] -> ShowS
showList :: [ServerResponse] -> ShowS
Show)
makeFieldLabelsNoPrefix ''ServerResponse
serverResponse :: ServerResponse
serverResponse :: ServerResponse
serverResponse =
ServerResponse
{ $sel:code:ServerResponse :: Int
code = Int
200,
$sel:cause:ServerResponse :: Maybe Text
cause = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"OK",
$sel:body:ServerResponse :: Maybe Text
body = Maybe Text
forall a. Maybe a
Nothing,
$sel:headers:ServerResponse :: [(Text, Text)]
headers = []
}
withLocation :: (IsString a, IsString b) => Text -> (a, b)
withLocation :: forall a b. (IsString a, IsString b) => Text -> (a, b)
withLocation Text
location = (a
"Location", String -> b
forall a. IsString a => String -> a
fromString (String -> b) -> (Text -> String) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> b) -> Text -> b
forall a b. (a -> b) -> a -> b
$ Text
location)
respondWithHttp :: (MonadIO m, MonadError ServerError m) => ServerResponse -> m a
respondWithHttp :: forall (m :: * -> *) a.
(MonadIO m, MonadError ServerError m) =>
ServerResponse -> m a
respondWithHttp ServerResponse
sr =
ServerError -> m a
forall a. ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(ServerError -> m a) -> ServerError -> m a
forall a b. (a -> b) -> a -> b
$ ServerError
{ $sel:errHTTPCode:ServerError :: Int
errHTTPCode = ServerResponse
sr ServerResponse -> Optic' A_Lens NoIx ServerResponse Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ServerResponse Int
#code,
$sel:errReasonPhrase:ServerError :: String
errReasonPhrase = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ServerResponse
sr ServerResponse
-> Optic' A_Lens NoIx ServerResponse (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ServerResponse (Maybe Text)
#cause,
$sel:errBody:ServerError :: ByteString
errBody = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ServerResponse
sr ServerResponse
-> Optic' A_Lens NoIx ServerResponse (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ServerResponse (Maybe Text)
#body,
$sel:errHeaders:ServerError :: [Header]
errHeaders =
((Text, Text) -> Header) -> [(Text, Text)] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map
( (Text -> HeaderName)
-> (Text -> ByteString) -> (Text, Text) -> Header
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
(String -> HeaderName
forall a. IsString a => String -> a
fromString (String -> HeaderName) -> (Text -> String) -> Text -> HeaderName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpackText)
(String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpackText)
)
(ServerResponse
sr ServerResponse
-> Optic' A_Lens NoIx ServerResponse [(Text, Text)]
-> [(Text, Text)]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ServerResponse [(Text, Text)]
#headers)
}
httpFound :: ServerResponse
httpFound :: ServerResponse
httpFound = ServerResponse
serverResponse {code = 302}
callErrorPage :: (MonadIO m, MonadError ServerError m) => Text -> m a
callErrorPage :: forall (m :: * -> *) a.
(MonadIO m, MonadError ServerError m) =>
Text -> m a
callErrorPage Text
e = ServerResponse -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadError ServerError m) =>
ServerResponse -> m a
respondWithHttp ServerResponse
httpFound {cause = Just "Error occured!", headers = [withLocation newLocation]}
where
newLocation :: Text
newLocation =
Text
"/error?code="
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( String -> Text
T.pack
(String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall b a. (Show a, IsString b) => a -> b
show
(Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
500
)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&message="
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
(ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode
(ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
(String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
e
)
respondWithViewOrErr :: (MonadIO m, MonadError ServerError m) => Either Text t -> (t -> IO a) -> m a
respondWithViewOrErr :: forall (m :: * -> *) t a.
(MonadIO m, MonadError ServerError m) =>
Either Text t -> (t -> IO a) -> m a
respondWithViewOrErr Either Text t
x t -> IO a
eff = case Either Text t
x of
Left Text
e -> Text -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadError ServerError m) =>
Text -> m a
callErrorPage Text
e
Right t
r -> IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ t -> IO a
eff t
r
respondWithViewOrErr' :: (MonadIO m, MonadError ServerError m) => Either Text (Maybe t) -> (t -> IO a) -> m a
respondWithViewOrErr' :: forall (m :: * -> *) t a.
(MonadIO m, MonadError ServerError m) =>
Either Text (Maybe t) -> (t -> IO a) -> m a
respondWithViewOrErr' Either Text (Maybe t)
x t -> IO a
eff = case Either Text (Maybe t)
x of
Left Text
e -> Text -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadError ServerError m) =>
Text -> m a
callErrorPage Text
e
Right Maybe t
r -> case Maybe t
r of
Maybe t
Nothing -> Text -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadError ServerError m) =>
Text -> m a
callErrorPage Text
"Error!"
Just t
item -> IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ t -> IO a
eff t
item