{-# LANGUAGE LambdaCase #-}

module Web.Hyperbole.Effect.Server where

import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.List qualified as L
import Data.Maybe (fromMaybe)
import Data.String.Conversions (cs)
import Data.Text (Text, pack)
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Static
import Effectful.State.Static.Local
import Network.HTTP.Types (HeaderName, Method, status200, status400, status401, status404, status500)
import Network.Wai qualified as Wai
import Network.Wai.Internal (ResponseReceived (..))
import Network.WebSockets (Connection)
import Network.WebSockets qualified as WS
import Web.Cookie (parseCookies)
import Web.Hyperbole.Effect.Session
import Web.Hyperbole.Route
import Web.View (Segment, View, renderLazyByteString, renderUrl)
import Network.HTTP.Types.URI (QueryText, queryToQueryText)


-- | Low level effect mapping request/response to either HTTP or WebSockets
data Server :: Effect where
  LoadRequest :: Server m Request
  SendResponse :: Session -> Response -> Server m ()


type instance DispatchOf Server = 'Dynamic


runServerWai
  :: (IOE :> es)
  => (BL.ByteString -> BL.ByteString)
  -> Wai.Request
  -> (Wai.Response -> IO ResponseReceived)
  -> Eff (Server : es) a
  -> Eff es (Maybe Wai.ResponseReceived)
runServerWai :: forall (es :: [Effect]) a.
(IOE :> es) =>
(ByteString -> ByteString)
-> Request
-> (Response -> IO ResponseReceived)
-> Eff (Server : es) a
-> Eff es (Maybe ResponseReceived)
runServerWai ByteString -> ByteString
toDoc Request
req Response -> IO ResponseReceived
respond =
  (Eff (State (Maybe ResponseReceived) : es) a
 -> Eff es (Maybe ResponseReceived))
-> EffectHandler Server (State (Maybe ResponseReceived) : es)
-> Eff (Server : es) a
-> Eff es (Maybe ResponseReceived)
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (State (Maybe ResponseReceived) : es) a
-> Eff es (Maybe ResponseReceived)
forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (State (Maybe ResponseReceived) : es) a
-> Eff es (Maybe ResponseReceived)
runLocal (EffectHandler Server (State (Maybe ResponseReceived) : es)
 -> Eff (Server : es) a -> Eff es (Maybe ResponseReceived))
-> EffectHandler Server (State (Maybe ResponseReceived) : es)
-> Eff (Server : es) a
-> Eff es (Maybe ResponseReceived)
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (State (Maybe ResponseReceived) : es)
_ -> \case
    Server (Eff localEs) a
LoadRequest -> do
      Request -> Eff (State (Maybe ResponseReceived) : es) Request
forall (m :: * -> *). MonadIO m => Request -> m Request
fromWaiRequest Request
req
    SendResponse Session
sess Response
r -> do
      ResponseReceived
rr <- IO ResponseReceived
-> Eff (State (Maybe ResponseReceived) : es) ResponseReceived
forall a. IO a -> Eff (State (Maybe ResponseReceived) : es) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived
 -> Eff (State (Maybe ResponseReceived) : es) ResponseReceived)
-> IO ResponseReceived
-> Eff (State (Maybe ResponseReceived) : es) ResponseReceived
forall a b. (a -> b) -> a -> b
$ Session -> Response -> IO ResponseReceived
sendResponse Session
sess Response
r
      Maybe ResponseReceived
-> Eff (State (Maybe ResponseReceived) : es) ()
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
s -> Eff es ()
put (ResponseReceived -> Maybe ResponseReceived
forall a. a -> Maybe a
Just ResponseReceived
rr)
 where
  runLocal :: (IOE :> es) => Eff (State (Maybe ResponseReceived) : es) a -> Eff es (Maybe ResponseReceived)
  runLocal :: forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (State (Maybe ResponseReceived) : es) a
-> Eff es (Maybe ResponseReceived)
runLocal = Maybe ResponseReceived
-> Eff (State (Maybe ResponseReceived) : es) a
-> Eff es (Maybe ResponseReceived)
forall s (es :: [Effect]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es s
execState Maybe ResponseReceived
forall a. Maybe a
Nothing

  sendResponse :: Session -> Response -> IO Wai.ResponseReceived
  sendResponse :: Session -> Response -> IO ResponseReceived
sendResponse Session
sess Response
r =
    Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> Response
response Response
r
   where
    response :: Response -> Wai.Response
    response :: Response -> Response
response Response
NotFound = Status -> ByteString -> Response
respError Status
status404 ByteString
"Not Found"
    response Response
Empty = Status -> ByteString -> Response
respError Status
status500 ByteString
"Empty Response"
    response (Err (ErrParse Text
e)) = Status -> ByteString -> Response
respError Status
status400 (ByteString
"Parse Error: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
e)
    response (Err (ErrParam Text
e)) = Status -> ByteString -> Response
respError Status
status400 (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ ByteString
"ErrParam: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
e
    response (Err (ErrOther Text
e)) = Status -> ByteString -> Response
respError Status
status500 (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ ByteString
"Server Error: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
e
    response (Err ResponseError
ErrAuth) = Status -> ByteString -> Response
respError Status
status401 ByteString
"Unauthorized"
    response (Err (ErrNotHandled Event Text Text
e)) = Status -> ByteString -> Response
respError Status
status400 (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Event Text Text -> String
errNotHandled Event Text Text
e
    response (Response TargetViewId
_ View () ()
vw) =
      ByteString -> Response
respHtml (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$
        Method -> ByteString -> ByteString
addDocument (Request -> Method
Wai.requestMethod Request
req) (View () () -> ByteString
renderLazyByteString View () ()
vw)
    response (Redirect Url
u) = do
      let url :: Text
url = Url -> Text
renderUrl Url
u
      -- We have to use a 200 javascript redirect because javascript
      -- will redirect the fetch(), while we want to redirect the whole page
      -- see index.ts sendAction()
      let headers :: [(HeaderName, Method)]
headers = (HeaderName
"Location", Text -> Method
forall a b. ConvertibleStrings a b => a -> b
cs Text
url) (HeaderName, Method)
-> [(HeaderName, Method)] -> [(HeaderName, Method)]
forall a. a -> [a] -> [a]
: ContentType -> (HeaderName, Method)
contentType ContentType
ContentHtml (HeaderName, Method)
-> [(HeaderName, Method)] -> [(HeaderName, Method)]
forall a. a -> [a] -> [a]
: [(HeaderName, Method)]
setCookies
      Status -> [(HeaderName, Method)] -> ByteString -> Response
Wai.responseLBS Status
status200 [(HeaderName, Method)]
headers (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ ByteString
"<script>window.location = '" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
url ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'</script>"

    respError :: Status -> ByteString -> Response
respError Status
s = Status -> [(HeaderName, Method)] -> ByteString -> Response
Wai.responseLBS Status
s [ContentType -> (HeaderName, Method)
contentType ContentType
ContentText]

    respHtml :: ByteString -> Response
respHtml ByteString
body =
      -- always set the session...
      let headers :: [(HeaderName, Method)]
headers = ContentType -> (HeaderName, Method)
contentType ContentType
ContentHtml (HeaderName, Method)
-> [(HeaderName, Method)] -> [(HeaderName, Method)]
forall a. a -> [a] -> [a]
: [(HeaderName, Method)]
setCookies
       in Status -> [(HeaderName, Method)] -> ByteString -> Response
Wai.responseLBS Status
status200 [(HeaderName, Method)]
headers ByteString
body

    setCookies :: [(HeaderName, Method)]
setCookies =
      [(HeaderName
"Set-Cookie", Session -> Method
sessionSetCookie Session
sess)]

  -- convert to document if full page request. Subsequent POST requests will only include fragments
  addDocument :: Method -> BL.ByteString -> BL.ByteString
  addDocument :: Method -> ByteString -> ByteString
addDocument Method
"GET" ByteString
bd = ByteString -> ByteString
toDoc ByteString
bd
  addDocument Method
_ ByteString
bd = ByteString
bd

  fromWaiRequest :: (MonadIO m) => Wai.Request -> m Request
  fromWaiRequest :: forall (m :: * -> *). MonadIO m => Request -> m Request
fromWaiRequest Request
wr = do
    ByteString
body <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.consumeRequestBodyLazy Request
wr
    let path :: [Text]
path = Request -> [Text]
Wai.pathInfo Request
wr
        query :: QueryText
query = Query -> QueryText
queryToQueryText (Request -> Query
Wai.queryString Request
wr)
        headers :: [(HeaderName, Method)]
headers = Request -> [(HeaderName, Method)]
Wai.requestHeaders Request
wr
        cookie :: Method
cookie = Method -> Maybe Method -> Method
forall a. a -> Maybe a -> a
fromMaybe Method
"" (Maybe Method -> Method) -> Maybe Method -> Method
forall a b. (a -> b) -> a -> b
$ HeaderName -> [(HeaderName, Method)] -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup HeaderName
"Cookie" [(HeaderName, Method)]
headers
        host :: Host
host = Method -> Host
Host (Method -> Host) -> Method -> Host
forall a b. (a -> b) -> a -> b
$ Method -> Maybe Method -> Method
forall a. a -> Maybe a -> a
fromMaybe Method
"" (Maybe Method -> Method) -> Maybe Method -> Method
forall a b. (a -> b) -> a -> b
$ HeaderName -> [(HeaderName, Method)] -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup HeaderName
"Host" [(HeaderName, Method)]
headers
        cookies :: Cookies
cookies = Method -> Cookies
parseCookies Method
cookie
        method :: Method
method = Request -> Method
Wai.requestMethod Request
wr
    Request -> m Request
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request{ByteString
body :: ByteString
body :: ByteString
body, [Text]
path :: [Text]
path :: [Text]
path, QueryText
query :: QueryText
query :: QueryText
query, Method
method :: Method
method :: Method
method, Cookies
cookies :: Cookies
cookies :: Cookies
cookies, Host
host :: Host
host :: Host
host}


runServerSockets
  :: (IOE :> es)
  => Connection
  -> Request
  -> Eff (Server : es) Response
  -> Eff es Response
runServerSockets :: forall (es :: [Effect]).
(IOE :> es) =>
Connection
-> Request -> Eff (Server : es) Response -> Eff es Response
runServerSockets Connection
conn Request
req = (Eff (Error SocketError : es) Response -> Eff es Response)
-> EffectHandler Server (Error SocketError : es)
-> Eff (Server : es) Response
-> Eff es Response
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Error SocketError : es) Response -> Eff es Response
runLocal (EffectHandler Server (Error SocketError : es)
 -> Eff (Server : es) Response -> Eff es Response)
-> EffectHandler Server (Error SocketError : es)
-> Eff (Server : es) Response
-> Eff es Response
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Error SocketError : es)
_ -> \case
  Server (Eff localEs) a
LoadRequest -> a -> Eff (Error SocketError : es) a
forall a. a -> Eff (Error SocketError : es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
Request
req -- receiveRequest conn
  SendResponse Session
sess Response
res -> do
    case Response
res of
      (Response TargetViewId
vid View () ()
vw) -> Metadata
-> TargetViewId -> View () () -> Eff (Error SocketError : es) ()
forall (es :: [Effect]).
(IOE :> es) =>
Metadata -> TargetViewId -> View () () -> Eff es ()
sendView (Session -> Metadata
sessionMeta Session
sess) TargetViewId
vid View () ()
vw
      (Err ResponseError
r) -> ResponseError -> Eff (Error SocketError : es) ()
forall (es :: [Effect]). (IOE :> es) => ResponseError -> Eff es ()
sendError ResponseError
r
      Response
Empty -> ResponseError -> Eff (Error SocketError : es) ()
forall (es :: [Effect]). (IOE :> es) => ResponseError -> Eff es ()
sendError (ResponseError -> Eff (Error SocketError : es) ())
-> ResponseError -> Eff (Error SocketError : es) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
ErrOther Text
"Empty"
      Response
NotFound -> ResponseError -> Eff (Error SocketError : es) ()
forall (es :: [Effect]). (IOE :> es) => ResponseError -> Eff es ()
sendError (ResponseError -> Eff (Error SocketError : es) ())
-> ResponseError -> Eff (Error SocketError : es) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
ErrOther Text
"NotFound"
      (Redirect Url
url) -> Metadata -> Url -> Eff (Error SocketError : es) ()
forall (es :: [Effect]).
(IOE :> es) =>
Metadata -> Url -> Eff es ()
sendRedirect (Session -> Metadata
sessionMeta Session
sess) Url
url
 where
  runLocal :: Eff (Error SocketError : es) Response -> Eff es Response
runLocal = forall e (es :: [Effect]) a.
HasCallStack =>
(e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
runErrorNoCallStackWith @SocketError SocketError -> Eff es Response
forall (es :: [Effect]).
(IOE :> es) =>
SocketError -> Eff es Response
onSocketError

  onSocketError :: (IOE :> es) => SocketError -> Eff es Response
  onSocketError :: forall (es :: [Effect]).
(IOE :> es) =>
SocketError -> Eff es Response
onSocketError SocketError
e = do
    let r :: ResponseError
r = Text -> ResponseError
ErrOther (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SocketError -> String
forall a. Show a => a -> String
show SocketError
e
    ResponseError -> Eff es ()
forall (es :: [Effect]). (IOE :> es) => ResponseError -> Eff es ()
sendError ResponseError
r
    Response -> Eff es Response
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> Eff es Response) -> Response -> Eff es Response
forall a b. (a -> b) -> a -> b
$ ResponseError -> Response
Err ResponseError
r

  sendMessage :: (MonadIO m) => Metadata -> BL.ByteString -> m ()
  sendMessage :: forall (m :: * -> *). MonadIO m => Metadata -> ByteString -> m ()
sendMessage Metadata
meta ByteString
cnt = do
    let msg :: ByteString
msg = Metadata -> ByteString
renderMetadata Metadata
meta ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cnt
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn ByteString
msg

  sendError :: (IOE :> es) => ResponseError -> Eff es ()
  sendError :: forall (es :: [Effect]). (IOE :> es) => ResponseError -> Eff es ()
sendError ResponseError
r = do
    -- TODO: better error handling!
    Metadata -> ByteString -> Eff es ()
forall (m :: * -> *). MonadIO m => Metadata -> ByteString -> m ()
sendMessage (ByteString -> Text -> Metadata
metadata ByteString
"ERROR" (String -> Text
pack (ResponseError -> String
forall a. Show a => a -> String
show ResponseError
r))) ByteString
""

  sendView :: (IOE :> es) => Metadata -> TargetViewId -> View () () -> Eff es ()
  sendView :: forall (es :: [Effect]).
(IOE :> es) =>
Metadata -> TargetViewId -> View () () -> Eff es ()
sendView Metadata
meta TargetViewId
vid View () ()
vw = do
    Metadata -> ByteString -> Eff es ()
forall (m :: * -> *). MonadIO m => Metadata -> ByteString -> m ()
sendMessage (TargetViewId -> Metadata
viewIdMeta TargetViewId
vid Metadata -> Metadata -> Metadata
forall a. Semigroup a => a -> a -> a
<> Metadata
meta) (View () () -> ByteString
renderLazyByteString View () ()
vw)

  renderMetadata :: Metadata -> BL.ByteString
  renderMetadata :: Metadata -> ByteString
renderMetadata (Metadata [(ByteString, Text)]
m) = ByteString -> [ByteString] -> ByteString
BL.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, Text) -> ByteString)
-> [(ByteString, Text)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Text -> ByteString)
-> (ByteString, Text) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Text -> ByteString
metaLine) [(ByteString, Text)]
m

  sendRedirect :: (IOE :> es) => Metadata -> Url -> Eff es ()
  sendRedirect :: forall (es :: [Effect]).
(IOE :> es) =>
Metadata -> Url -> Eff es ()
sendRedirect Metadata
meta Url
u = do
    -- conn <- ask @Connection
    let r :: Metadata
r = ByteString -> Text -> Metadata
metadata ByteString
"REDIRECT" (Url -> Text
renderUrl Url
u)
    Metadata -> ByteString -> Eff es ()
forall (m :: * -> *). MonadIO m => Metadata -> ByteString -> m ()
sendMessage (Metadata
r Metadata -> Metadata -> Metadata
forall a. Semigroup a => a -> a -> a
<> Metadata
meta) ByteString
""

  sessionMeta :: Session -> Metadata
  sessionMeta :: Session -> Metadata
sessionMeta Session
sess = [(ByteString, Text)] -> Metadata
Metadata [(ByteString
"SESSION", Method -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Session -> Method
sessionSetCookie Session
sess))]

  viewIdMeta :: TargetViewId -> Metadata
  viewIdMeta :: TargetViewId -> Metadata
viewIdMeta (TargetViewId Text
vid) = [(ByteString, Text)] -> Metadata
Metadata [(ByteString
"VIEW-ID", Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
vid)]

  metadata :: BL.ByteString -> Text -> Metadata
  metadata :: ByteString -> Text -> Metadata
metadata ByteString
name Text
value = [(ByteString, Text)] -> Metadata
Metadata [(ByteString
name, Text
value)]

  metaLine :: BL.ByteString -> Text -> BL.ByteString
  metaLine :: ByteString -> Text -> ByteString
metaLine ByteString
name Text
value = ByteString
"|" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
name ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"|" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
value


errNotHandled :: Event Text Text -> String
errNotHandled :: Event Text Text -> String
errNotHandled Event Text Text
ev =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
    String
"\n"
    [ String
"No Handler for Event viewId: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Event Text Text
ev.viewId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" action: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Event Text Text
ev.action
    , String
"<p>Remember to add a `hyper` handler in your page function</p>"
    , String
"<pre>"
    , String
"page :: (Hyperbole :> es) => Page es Response"
    , String
"page = do"
    , String
"  handle contentsHandler"
    , String
"  load $ do"
    , String
"    pure $ hyper Contents contentsView"
    , String
"</pre>"
    ]


data SocketError
  = InvalidMessage Text
  deriving (Int -> SocketError -> String -> String
[SocketError] -> String -> String
SocketError -> String
(Int -> SocketError -> String -> String)
-> (SocketError -> String)
-> ([SocketError] -> String -> String)
-> Show SocketError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SocketError -> String -> String
showsPrec :: Int -> SocketError -> String -> String
$cshow :: SocketError -> String
show :: SocketError -> String
$cshowList :: [SocketError] -> String -> String
showList :: [SocketError] -> String -> String
Show, SocketError -> SocketError -> Bool
(SocketError -> SocketError -> Bool)
-> (SocketError -> SocketError -> Bool) -> Eq SocketError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocketError -> SocketError -> Bool
== :: SocketError -> SocketError -> Bool
$c/= :: SocketError -> SocketError -> Bool
/= :: SocketError -> SocketError -> Bool
Eq)


data ContentType
  = ContentHtml
  | ContentText


contentType :: ContentType -> (HeaderName, BS.ByteString)
contentType :: ContentType -> (HeaderName, Method)
contentType ContentType
ContentHtml = (HeaderName
"Content-Type", Method
"text/html; charset=utf-8")
contentType ContentType
ContentText = (HeaderName
"Content-Type", Method
"text/plain; charset=utf-8")


newtype Metadata = Metadata [(BL.ByteString, Text)]
  deriving newtype (NonEmpty Metadata -> Metadata
Metadata -> Metadata -> Metadata
(Metadata -> Metadata -> Metadata)
-> (NonEmpty Metadata -> Metadata)
-> (forall b. Integral b => b -> Metadata -> Metadata)
-> Semigroup Metadata
forall b. Integral b => b -> Metadata -> Metadata
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Metadata -> Metadata -> Metadata
<> :: Metadata -> Metadata -> Metadata
$csconcat :: NonEmpty Metadata -> Metadata
sconcat :: NonEmpty Metadata -> Metadata
$cstimes :: forall b. Integral b => b -> Metadata -> Metadata
stimes :: forall b. Integral b => b -> Metadata -> Metadata
Semigroup, Semigroup Metadata
Metadata
Semigroup Metadata =>
Metadata
-> (Metadata -> Metadata -> Metadata)
-> ([Metadata] -> Metadata)
-> Monoid Metadata
[Metadata] -> Metadata
Metadata -> Metadata -> Metadata
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Metadata
mempty :: Metadata
$cmappend :: Metadata -> Metadata -> Metadata
mappend :: Metadata -> Metadata -> Metadata
$cmconcat :: [Metadata] -> Metadata
mconcat :: [Metadata] -> Metadata
Monoid)


newtype Host = Host {Host -> Method
text :: BS.ByteString}
  deriving (Int -> Host -> String -> String
[Host] -> String -> String
Host -> String
(Int -> Host -> String -> String)
-> (Host -> String) -> ([Host] -> String -> String) -> Show Host
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Host -> String -> String
showsPrec :: Int -> Host -> String -> String
$cshow :: Host -> String
show :: Host -> String
$cshowList :: [Host] -> String -> String
showList :: [Host] -> String -> String
Show)


data Request = Request
  { Request -> Host
host :: Host
  , Request -> [Text]
path :: [Segment]
  , Request -> QueryText
query :: QueryText
  , Request -> ByteString
body :: BL.ByteString
  , Request -> Method
method :: Method
  , Request -> Cookies
cookies :: [(BS.ByteString, BS.ByteString)]
  }
  deriving (Int -> Request -> String -> String
[Request] -> String -> String
Request -> String
(Int -> Request -> String -> String)
-> (Request -> String)
-> ([Request] -> String -> String)
-> Show Request
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Request -> String -> String
showsPrec :: Int -> Request -> String -> String
$cshow :: Request -> String
show :: Request -> String
$cshowList :: [Request] -> String -> String
showList :: [Request] -> String -> String
Show)


{- | Valid responses for a 'Hyperbole' effect. Use 'notFound', etc instead. Reminds you to use 'load' in your 'Page'

> myPage :: (Hyperbole :> es) => Page es Response
> myPage = do
>   -- compiler error: () does not equal Response
>   pure ()
-}
data Response
  = Response TargetViewId (View () ())
  | NotFound
  | Redirect Url
  | Err ResponseError
  | Empty


data ResponseError
  = ErrParse Text
  | ErrParam Text
  | ErrOther Text
  | ErrNotHandled (Event Text Text)
  | ErrAuth
  deriving (Int -> ResponseError -> String -> String
[ResponseError] -> String -> String
ResponseError -> String
(Int -> ResponseError -> String -> String)
-> (ResponseError -> String)
-> ([ResponseError] -> String -> String)
-> Show ResponseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ResponseError -> String -> String
showsPrec :: Int -> ResponseError -> String -> String
$cshow :: ResponseError -> String
show :: ResponseError -> String
$cshowList :: [ResponseError] -> String -> String
showList :: [ResponseError] -> String -> String
Show)


-- | Serialized ViewId
newtype TargetViewId = TargetViewId Text


-- | An action, with its corresponding id
data Event id act = Event
  { forall id act. Event id act -> id
viewId :: id
  , forall id act. Event id act -> act
action :: act
  }


instance (Show act, Show id) => Show (Event id act) where
  show :: Event id act -> String
show Event id act
e = String
"Event " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> id -> String
forall a. Show a => a -> String
show Event id act
e.viewId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> act -> String
forall a. Show a => a -> String
show Event id act
e.action