{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Servant.Subscriber.Request where
import Data.Aeson
import Data.Bifunctor
import qualified Data.CaseInsensitive as Case
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import GHC.Generics
import qualified Network.HTTP.Types as H
import Servant.Subscriber.Types
type RequestHeader = (Text, Text)
type RequestHeaders = [RequestHeader]
data Request = Subscribe !HttpRequest
| Unsubscribe !HttpRequest
| SetPongRequest !HttpRequest
| SetCloseRequest !HttpRequest deriving (Generic)
instance FromJSON Request
instance ToJSON Request
data HttpRequest = HttpRequest {
httpMethod :: !Text
, httpPath :: !Path
, httpHeaders :: RequestHeaders
, httpQuery :: H.QueryText
, httpBody :: RequestBody
} deriving ( Generic, Eq, Ord, Show )
instance FromJSON HttpRequest
instance ToJSON HttpRequest
newtype RequestBody = RequestBody Text deriving (Generic, ToJSON, FromJSON, Eq, Ord, Show)
runRequestBody :: RequestBody -> Text
runRequestBody (RequestBody t) = t
toHTTPHeader :: RequestHeader -> H.Header
toHTTPHeader = bimap (Case.mk . T.encodeUtf8) T.encodeUtf8
toHTTPHeaders :: RequestHeaders -> H.RequestHeaders
toHTTPHeaders = map toHTTPHeader
requestPath :: Request -> Path
requestPath req = httpPath $ case req of
Subscribe hReq -> hReq
Unsubscribe hReq -> hReq
SetPongRequest hReq -> hReq
SetCloseRequest hReq -> hReq