file-upload.purs

...
postFile :: forall b. ReadForeign b => URL -> FormData -> Aff (E b)
postFile url content = do
  cookie <- liftEffect getXSRFToken
  defaultRequest' <- sDefaultRequest
  let req = Record.merge defaultRequest' defaultRequest
      req' = Record.delete (SProxy :: SProxy "retryPolicy") req
  res <- try $ request $ req' { method = Left POST
                              , url = url
                              , content = Just $ RequestBody.formData content
                              , responseFormat = ResponseFormat.string
                              , headers = [ RequestHeader "X-XSRF-TOKEN" cookie
                                          , RequestHeader "X-Requested-With" "XMLHttpRequest"
                                          , Accept (MediaType "multipart/form-data")
                                          ]
                              }
  pure $ SA.handleResponse res
...

...
[ HH.input [ HP.class_ B.fileInput
           , HP.type_ HP.InputFile
           , HP.ref $ wrap "input"
           , HP.disabled loading
           , HE.onChange (HE.input_ Upload)
           ]
...

   eval (Upload next) = next <$ do
          s <- H.get
          H.modify_ (_ { loading = true })
          result <- runExceptT do
            em <- onNothing "no input found" =<< (lift <<< H.getHTMLElementRef $ wrap "input")
            el <- onNothing "conversion failed" $ fromHTMLElement em
            fs <- onNothing "no file found" =<< (lift <<< H.liftEffect <<< files $ el)
            onNothing "files was empty" $ item 0 fs
          case result of
            Left _ -> do
              H.liftEffect $ errorNotification "Error"
              pure unit
            Right file -> do
              fd <- H.liftEffect FD.new
              _ <- H.liftEffect $ FD.appendBlob (wrap "voucher") (toBlob file) (Just $ wrap $ name file) fd
              res <- H.liftAff $ SAX.postFile s.url fd
              case res of
                Right v -> do
                  H.modify_ (_ { vouchers = s.vouchers <> [v] })
                  H.liftEffect $ successNotification "Success"
                _ -> H.liftEffect $ errorNotification "Error"
              H.modify_ (_ { loading = false })
              pure unit
      where
        onNothing :: forall m. Monad m => String -> Maybe ~> ExceptT String m
        onNothing s = maybe (throwError s) pure