{-# LANGUAGE UndecidableInstances #-}
module Mig.Core.Types.Http (
Request (..),
Response (..),
ResponseBody (..),
HeaderMap,
QueryMap,
ToText (..),
okResponse,
badResponse,
badRequest,
setContent,
noContentResponse,
setRespStatus,
addRespHeaders,
toFullPath,
) where
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as BL
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.String
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Text.Lazy qualified as TL
import Mig.Core.Class.MediaType (MediaType, ToMediaType (..), ToRespBody (..))
import Network.HTTP.Media.RenderHeader
import Network.HTTP.Types.Header (HeaderName, ResponseHeaders)
import Network.HTTP.Types.Method (Method)
import Network.HTTP.Types.Status (Status, ok200, status500)
data Response = Response
{ Response -> Status
status :: Status
, :: ResponseHeaders
, Response -> ResponseBody
body :: ResponseBody
}
deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show, Response -> Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq)
noContentResponse :: Status -> Response
noContentResponse :: Status -> Response
noContentResponse Status
status = Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
status [] (MediaType -> ByteString -> ResponseBody
RawResp MediaType
"*/*" ByteString
"")
data ResponseBody
= RawResp MediaType BL.ByteString
| FileResp FilePath
| StreamResp
deriving (Int -> ResponseBody -> ShowS
[ResponseBody] -> ShowS
ResponseBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseBody] -> ShowS
$cshowList :: [ResponseBody] -> ShowS
show :: ResponseBody -> String
$cshow :: ResponseBody -> String
showsPrec :: Int -> ResponseBody -> ShowS
$cshowsPrec :: Int -> ResponseBody -> ShowS
Show, ResponseBody -> ResponseBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseBody -> ResponseBody -> Bool
$c/= :: ResponseBody -> ResponseBody -> Bool
== :: ResponseBody -> ResponseBody -> Bool
$c== :: ResponseBody -> ResponseBody -> Bool
Eq)
data Request = Request
{ Request -> [Text]
path :: [Text]
, Request -> Map ByteString (Maybe ByteString)
query :: QueryMap
, Request -> CaptureMap
capture :: CaptureMap
, :: HeaderMap
, Request -> ByteString
method :: Method
, Request -> IO (Either Text ByteString)
readBody :: IO (Either Text BL.ByteString)
, Request -> Bool
isSecure :: Bool
}
type = Map HeaderName ByteString
type CaptureMap = Map Text Text
type QueryMap = Map ByteString (Maybe ByteString)
badRequest :: forall media a. (ToRespBody media a) => a -> Response
badRequest :: forall {k} (media :: k) a. ToRespBody media a => a -> Response
badRequest a
message = forall {k} (mime :: k) a.
ToRespBody mime a =>
Status -> a -> Response
badResponse @media Status
status500 a
message
class ToText a where
toText :: a -> Text
instance ToText TL.Text where
toText :: Text -> Text
toText = Text -> Text
TL.toStrict
instance ToText Text where
toText :: Text -> Text
toText = forall a. a -> a
id
instance ToText Int where
toText :: Int -> Text
toText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance ToText Float where
toText :: Float -> Text
toText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance ToText String where
toText :: String -> Text
toText = forall a. IsString a => String -> a
fromString
{-# INLINE setContent #-}
setContent :: MediaType -> ResponseHeaders
setContent :: MediaType -> ResponseHeaders
setContent MediaType
media =
[(HeaderName
"Content-Type", forall h. RenderHeader h => h -> ByteString
renderHeader MediaType
media)]
setRespStatus :: Status -> Response -> Response
setRespStatus :: Status -> Response -> Response
setRespStatus Status
status (Response Status
_ ResponseHeaders
headers ResponseBody
body) = Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
status ResponseHeaders
headers ResponseBody
body
addRespHeaders :: ResponseHeaders -> Response -> Response
ResponseHeaders
headers (Response Status
status ResponseHeaders
hs ResponseBody
body) = Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
status (ResponseHeaders
headers forall a. Semigroup a => a -> a -> a
<> ResponseHeaders
hs) ResponseBody
body
okResponse :: forall mime a. (ToRespBody mime a) => a -> Response
okResponse :: forall {k} (media :: k) a. ToRespBody media a => a -> Response
okResponse = Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
ok200 (MediaType -> ResponseHeaders
setContent MediaType
media) forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaType -> ByteString -> ResponseBody
RawResp MediaType
media forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (ty :: k) b. ToRespBody ty b => b -> ByteString
toRespBody @mime
where
media :: MediaType
media = forall {k} (a :: k). ToMediaType a => MediaType
toMediaType @mime
badResponse :: forall mime a. (ToRespBody mime a) => Status -> a -> Response
badResponse :: forall {k} (mime :: k) a.
ToRespBody mime a =>
Status -> a -> Response
badResponse Status
status = Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
status (MediaType -> ResponseHeaders
setContent MediaType
media) forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaType -> ByteString -> ResponseBody
RawResp MediaType
media forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (ty :: k) b. ToRespBody ty b => b -> ByteString
toRespBody @mime
where
media :: MediaType
media = forall {k} (a :: k). ToMediaType a => MediaType
toMediaType @mime
toFullPath :: Request -> Text
toFullPath :: Request -> Text
toFullPath Request
req = Text -> [Text] -> Text
Text.intercalate Text
"/" Request
req.path forall a. Semigroup a => a -> a -> a
<> Text
queries
where
queries :: Text
queries
| forall k a. Map k a -> Bool
Map.null Request
req.query = forall a. Monoid a => a
mempty
| Bool
otherwise = Text
"?" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"&" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, Maybe ByteString) -> Text
fromQuery (forall k a. Map k a -> [(k, a)]
Map.toList Request
req.query))
fromQuery :: (ByteString, Maybe ByteString) -> Text
fromQuery (ByteString
name, Maybe ByteString
mVal) = case Maybe ByteString
mVal of
Just ByteString
val -> Text
nameText forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeUtf8 ByteString
val
Maybe ByteString
Nothing -> Text
nameText
where
nameText :: Text
nameText = ByteString -> Text
Text.decodeUtf8 ByteString
name