module Web.Hyperbole.Server.Uploads where

import Control.Monad.Trans.Resource (InternalState, closeInternalState, createInternalState)
import Data.String.Conversions (cs)
import Effectful
import Effectful.Exception (bracket)
import Network.Wai qualified as Wai
import Network.Wai.Parse (File, FileInfo (..), ParseRequestBodyOptions)
import Network.Wai.Parse qualified as Wai
import Web.Hyperbole.Types.Request (FileParam, Param, UploadedFile (..))


withPostBody :: (IOE :> es) => ParseRequestBodyOptions -> Wai.Request -> ([Param] -> [FileParam] -> Eff es a) -> Eff es a
withPostBody :: forall (es :: [Effect]) a.
(IOE :> es) =>
ParseRequestBodyOptions
-> Request -> ([Param] -> [FileParam] -> Eff es a) -> Eff es a
withPostBody ParseRequestBodyOptions
options Request
req [Param] -> [FileParam] -> Eff es a
action = (InternalState -> Eff es a) -> Eff es a
forall (es :: [Effect]) a.
(IOE :> es) =>
(InternalState -> Eff es a) -> Eff es a
withUploadState ((InternalState -> Eff es a) -> Eff es a)
-> (InternalState -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \InternalState
state -> do
  (params, files) <- InternalState -> Eff es ([Param], [File FilePath])
forall (es :: [Effect]).
(IOE :> es) =>
InternalState -> Eff es ([Param], [File FilePath])
acceptFileUploads InternalState
state
  action params $ fmap fileParam files
 where
  withUploadState :: (IOE :> es) => (InternalState -> Eff es a) -> Eff es a
  withUploadState :: forall (es :: [Effect]) a.
(IOE :> es) =>
(InternalState -> Eff es a) -> Eff es a
withUploadState = Eff es InternalState
-> (InternalState -> Eff es ())
-> (InternalState -> Eff es a)
-> Eff es a
forall (es :: [Effect]) a b c.
Eff es a -> (a -> Eff es b) -> (a -> Eff es c) -> Eff es c
bracket Eff es InternalState
forall (m :: * -> *). MonadIO m => m InternalState
createInternalState InternalState -> Eff es ()
forall (m :: * -> *). MonadIO m => InternalState -> m ()
closeInternalState

  acceptFileUploads :: (IOE :> es) => InternalState -> Eff es ([Param], [File FilePath])
  acceptFileUploads :: forall (es :: [Effect]).
(IOE :> es) =>
InternalState -> Eff es ([Param], [File FilePath])
acceptFileUploads InternalState
state = do
    IO ([Param], [File FilePath]) -> Eff es ([Param], [File FilePath])
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Param], [File FilePath])
 -> Eff es ([Param], [File FilePath]))
-> IO ([Param], [File FilePath])
-> Eff es ([Param], [File FilePath])
forall a b. (a -> b) -> a -> b
$ ParseRequestBodyOptions
-> BackEnd FilePath -> Request -> IO ([Param], [File FilePath])
forall y.
ParseRequestBodyOptions
-> BackEnd y -> Request -> IO ([Param], [File y])
Wai.parseRequestBodyEx ParseRequestBodyOptions
options (InternalState -> BackEnd FilePath
forall ignored1 ignored2.
InternalState
-> ignored1 -> ignored2 -> IO ByteString -> IO FilePath
Wai.tempFileBackEnd InternalState
state) Request
req

  fileParam :: Wai.File FilePath -> FileParam
  fileParam :: File FilePath -> FileParam
fileParam (ByteString
key, FileInfo FilePath
f) = (ByteString
key, FileInfo FilePath -> UploadedFile
fileInfo FileInfo FilePath
f)

  fileInfo :: Wai.FileInfo FilePath -> UploadedFile
  fileInfo :: FileInfo FilePath -> UploadedFile
fileInfo FileInfo{ByteString
fileName :: ByteString
fileName :: forall c. FileInfo c -> ByteString
fileName, ByteString
fileContentType :: ByteString
fileContentType :: forall c. FileInfo c -> ByteString
fileContentType, FilePath
fileContent :: FilePath
fileContent :: forall c. FileInfo c -> c
fileContent} =
    UploadedFile
      { filePath :: FilePath
filePath = FilePath
fileContent
      , fileName :: Text
fileName = ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
fileName
      , contentType :: Text
contentType = ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
fileContentType
      }