module Web.Minion.Response (CanRespond (..), ToResponse (..), NoBody (..), IsResponse) where

import Data.ByteString qualified as Bytes
import Data.ByteString.Builder qualified as Bytes.Builder
import Data.Function (fix)
import Data.Maybe (isJust)
import Network.HTTP.Media
import Network.HTTP.Types
import Network.HTTP.Types qualified as Http
import Network.Wai qualified as Http
import Network.Wai qualified as Wai
import Web.Minion.Raw

type IsResponse m o = (CanRespond o, ToResponse m o)

class CanRespond o where
  canRespond ::
    -- | Accept header values
    [Bytes.ByteString] ->
    Bool

class ToResponse m r where
  toResponse :: [Bytes.ByteString] -> r -> m Http.Response

data NoBody = NoBody

instance CanRespond NoBody where
  canRespond :: [ByteString] -> Bool
canRespond [ByteString]
_ = Bool
True

instance (Monad m) => ToResponse m NoBody where
  toResponse :: [ByteString] -> NoBody -> m Response
toResponse [ByteString]
_ NoBody
_ = Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status -> ResponseHeaders -> Builder -> Response
Http.responseBuilder Status
Http.status200 [] Builder
forall a. Monoid a => a
mempty)

applicationOctetStream :: MediaType
applicationOctetStream :: MediaType
applicationOctetStream = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"octet-stream"

instance CanRespond Chunks where
  canRespond :: [ByteString] -> Bool
canRespond [] = Bool
True
  canRespond [ByteString]
l = (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe MediaType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MediaType -> Bool)
-> (ByteString -> Maybe MediaType) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MediaType] -> ByteString -> Maybe MediaType
forall a. Accept a => [a] -> ByteString -> Maybe a
matchAccept [Item [MediaType]
MediaType
applicationOctetStream]) [ByteString]
l

instance CanRespond LazyBytes where
  canRespond :: [ByteString] -> Bool
canRespond [] = Bool
True
  canRespond [ByteString]
l = (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe MediaType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MediaType -> Bool)
-> (ByteString -> Maybe MediaType) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MediaType] -> ByteString -> Maybe MediaType
forall a. Accept a => [a] -> ByteString -> Maybe a
matchAccept [Item [MediaType]
MediaType
applicationOctetStream]) [ByteString]
l

instance (Applicative m) => ToResponse m Chunks where
  toResponse :: [ByteString] -> Chunks -> m Response
toResponse [ByteString]
_ (Chunks IO ByteString
chunks) = Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> StreamingBody -> Response
Wai.responseStream
    Status
status200
    []
    \Builder -> IO ()
write IO ()
flush -> do
      IO ()
flush
      (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix \IO ()
continue -> do
        ByteString
ch <- IO ByteString
chunks
        if ByteString -> Bool
Bytes.null ByteString
ch
          then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          else Builder -> IO ()
write (ByteString -> Builder
Bytes.Builder.byteString ByteString
ch) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
flush IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
continue

instance (Applicative m) => ToResponse m LazyBytes where
  toResponse :: [ByteString] -> LazyBytes -> m Response
toResponse [ByteString]
_ (LazyBytes ByteString
bytes) =
    Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$
      Status -> ResponseHeaders -> Builder -> Response
Wai.responseBuilder
        Status
status200
        []
        (ByteString -> Builder
Bytes.Builder.lazyByteString ByteString
bytes)