module Web.Minion.Examples.Multipart (app) where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Data.ByteString.Lazy qualified as Bytes.Lazy
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text.Encode
import Data.Void
import Network.Wai.Parse (FileInfo (..))
import System.Environment (getArgs)
import Web.Minion
import Web.Minion.Request.Multipart

app :: IO (ApplicationM IO)
app :: IO (ApplicationM IO)
app =
  IO [String]
getArgs IO [String]
-> ([String] -> IO (ApplicationM IO)) -> IO (ApplicationM IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [Item [String]
"tmp"] -> do
      String -> IO ()
putStrLn String
"Tmp mode running"
      ApplicationM IO -> IO (ApplicationM IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
        Router' Void Void IO -> ApplicationM IO
forall (m :: * -> *) i.
(MonadIO m, MonadCatch m) =>
Router' i Void m -> ApplicationM m
serve Router' Void Void IO
apiMem
    [Item [String]
"mem"] -> do
      String -> IO ()
putStrLn String
"Mem mode running"
      ApplicationM IO -> IO (ApplicationM IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
        \Request
req Response -> IO ResponseReceived
resp -> ResourceT IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (Router' Void Void (ResourceT IO) -> ApplicationM (ResourceT IO)
forall (m :: * -> *) i.
(MonadIO m, MonadCatch m) =>
Router' i Void m -> ApplicationM m
serve Router' Void Void (ResourceT IO)
apiTmp Request
req Response -> IO ResponseReceived
resp)
    [String]
_ -> String -> IO (ApplicationM IO)
forall a. HasCallStack => String -> a
error String
"Mode required"

data ReportMem = ReportMem
  { ReportMem -> Text
reporter :: Text
  , ReportMem -> ByteString
report :: Bytes.Lazy.ByteString
  }

data ReportTmp = ReportTmp
  { ReportTmp -> Text
reporter :: Text
  , ReportTmp -> String
report :: FilePath
  }

instance FromMultipart Mem ReportMem where
  fromMultipart :: MultipartM Mem ReportMem
fromMultipart =
    Text -> ByteString -> ReportMem
ReportMem
      (Text -> ByteString -> ReportMem)
-> ReaderT (MultipartData Mem) (Except Text) Text
-> ReaderT
     (MultipartData Mem) (Except Text) (ByteString -> ReportMem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Text
Text.Encode.decodeUtf8 (ByteString -> Text)
-> ReaderT (MultipartData Mem) (Except Text) ByteString
-> ReaderT (MultipartData Mem) (Except Text) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ReaderT (MultipartData Mem) (Except Text) ByteString
forall {k} (backend :: k).
ByteString -> MultipartM backend ByteString
getParam ByteString
"reporter")
      ReaderT (MultipartData Mem) (Except Text) (ByteString -> ReportMem)
-> ReaderT (MultipartData Mem) (Except Text) ByteString
-> MultipartM Mem ReportMem
forall a b.
ReaderT (MultipartData Mem) (Except Text) (a -> b)
-> ReaderT (MultipartData Mem) (Except Text) a
-> ReaderT (MultipartData Mem) (Except Text) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FileInfo ByteString -> ByteString
forall c. FileInfo c -> c
fileContent (FileInfo ByteString -> ByteString)
-> ReaderT (MultipartData Mem) (Except Text) (FileInfo ByteString)
-> ReaderT (MultipartData Mem) (Except Text) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> MultipartM Mem (FileInfo (BackendFile Mem))
forall {k} (backend :: k).
ByteString -> MultipartM backend (FileInfo (BackendFile backend))
getFile ByteString
"report")

instance FromMultipart Tmp ReportTmp where
  fromMultipart :: MultipartM Tmp ReportTmp
fromMultipart =
    Text -> String -> ReportTmp
ReportTmp
      (Text -> String -> ReportTmp)
-> ReaderT (MultipartData Tmp) (Except Text) Text
-> ReaderT (MultipartData Tmp) (Except Text) (String -> ReportTmp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Text
Text.Encode.decodeUtf8 (ByteString -> Text)
-> ReaderT (MultipartData Tmp) (Except Text) ByteString
-> ReaderT (MultipartData Tmp) (Except Text) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ReaderT (MultipartData Tmp) (Except Text) ByteString
forall {k} (backend :: k).
ByteString -> MultipartM backend ByteString
getParam ByteString
"reporter")
      ReaderT (MultipartData Tmp) (Except Text) (String -> ReportTmp)
-> ReaderT (MultipartData Tmp) (Except Text) String
-> MultipartM Tmp ReportTmp
forall a b.
ReaderT (MultipartData Tmp) (Except Text) (a -> b)
-> ReaderT (MultipartData Tmp) (Except Text) a
-> ReaderT (MultipartData Tmp) (Except Text) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FileInfo String -> String
forall c. FileInfo c -> c
fileContent (FileInfo String -> String)
-> ReaderT (MultipartData Tmp) (Except Text) (FileInfo String)
-> ReaderT (MultipartData Tmp) (Except Text) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> MultipartM Tmp (FileInfo (BackendFile Tmp))
forall {k} (backend :: k).
ByteString -> MultipartM backend (FileInfo (BackendFile backend))
getFile ByteString
"report")

apiMem :: Router Void IO
apiMem :: Router' Void Void IO
apiMem =
  Router' Void Void IO -> Router' Void Void IO
"api"
    (Router' Void Void IO -> Router' Void Void IO)
-> Router' Void Void IO -> Router' Void Void IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Void Void IO -> Router' Void Void IO
"multipart"
    (Router' Void Void IO -> Router' Void Void IO)
-> Router' Void Void IO -> Router' Void Void IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall {k} (backend :: k) r (m :: * -> *) i ts.
(Introspection i 'Request (Multipart backend r), MonadThrow m,
 FromMultipart backend r, Backend m backend) =>
ValueCombinator i (WithReq m (Multipart backend r)) ts m
forall backend r (m :: * -> *) i ts.
(Introspection i 'Request (Multipart backend r), MonadThrow m,
 FromMultipart backend r, Backend m backend) =>
ValueCombinator i (WithReq m (Multipart backend r)) ts m
multipartBody @Mem @ReportMem
    ValueCombinator Void (WithReq IO (Multipart Mem ReportMem)) Void IO
-> ValueCombinator
     Void (WithReq IO (Multipart Mem ReportMem)) Void IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handle @NoBody ByteString
POST DelayedArgs '[WithReq IO (Multipart Mem ReportMem)] ~> IO NoBody
ReportMem -> IO NoBody
endpoint
 where
  endpoint :: ReportMem -> IO NoBody
endpoint ReportMem{Text
ByteString
$sel:reporter:ReportMem :: ReportMem -> Text
$sel:report:ReportMem :: ReportMem -> ByteString
reporter :: Text
report :: ByteString
..} = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Reporter: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
reporter
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Report size: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show (ByteString -> Int64
Bytes.Lazy.length ByteString
report)
    NoBody -> IO NoBody
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoBody
NoBody

-- multipartBody @Tmp requires MonadResource
apiTmp :: Router Void (ResourceT IO)
apiTmp :: Router' Void Void (ResourceT IO)
apiTmp =
  Router' Void Void (ResourceT IO)
-> Router' Void Void (ResourceT IO)
"api"
    (Router' Void Void (ResourceT IO)
 -> Router' Void Void (ResourceT IO))
-> Router' Void Void (ResourceT IO)
-> Router' Void Void (ResourceT IO)
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Void Void (ResourceT IO)
-> Router' Void Void (ResourceT IO)
"multipart"
    (Router' Void Void (ResourceT IO)
 -> Router' Void Void (ResourceT IO))
-> Router' Void Void (ResourceT IO)
-> Router' Void Void (ResourceT IO)
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall {k} (backend :: k) r (m :: * -> *) i ts.
(Introspection i 'Request (Multipart backend r), MonadThrow m,
 FromMultipart backend r, Backend m backend) =>
ValueCombinator i (WithReq m (Multipart backend r)) ts m
forall backend r (m :: * -> *) i ts.
(Introspection i 'Request (Multipart backend r), MonadThrow m,
 FromMultipart backend r, Backend m backend) =>
ValueCombinator i (WithReq m (Multipart backend r)) ts m
multipartBody @Tmp @ReportTmp
    ValueCombinator
  Void
  (WithReq (ResourceT IO) (Multipart Tmp ReportTmp))
  Void
  (ResourceT IO)
-> ValueCombinator
     Void
     (WithReq (ResourceT IO) (Multipart Tmp ReportTmp))
     Void
     (ResourceT IO)
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handle @NoBody ByteString
POST DelayedArgs '[WithReq (ResourceT IO) (Multipart Tmp ReportTmp)]
~> ResourceT IO NoBody
ReportTmp -> ResourceT IO NoBody
forall {m :: * -> *}. MonadIO m => ReportTmp -> m NoBody
endpoint
 where
  endpoint :: ReportTmp -> m NoBody
endpoint ReportTmp{String
Text
$sel:reporter:ReportTmp :: ReportTmp -> Text
$sel:report:ReportTmp :: ReportTmp -> String
reporter :: Text
report :: String
..} = IO NoBody -> m NoBody
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Reporter: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
reporter
    Int64
reportSize <- ByteString -> Int64
Bytes.Lazy.length (ByteString -> Int64) -> IO ByteString -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
Bytes.Lazy.readFile String
report
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Report size: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
reportSize
    NoBody -> IO NoBody
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoBody
NoBody