Comment écrire un point de terminaison JSON dans Yesod qui reçoit des téléchargements de fichiers/images?

Question

Je vois beaucoup de messages qui impliquent l'écriture d'un widget de formulaire pour gérer les téléchargements d'images, mais mon serveur Yesod est juste une API JSON. Je recevrais la demande de poste via le téléchargement de fichier angulaire.

Answer 1

Une façon simple de le faire est de coder le fichier en tant que données base64 et puis de l'envoyer dans le cadre de JSON. Mais l'inconvénient de cette méthode est qu'elle augmente la taille des données.

Exemple:

#!/usr/bin/env stack 
{- stack 
    --resolver lts-6.24 
    --install-ghc 
    runghc 
    --package yesod 
    --package yesod-core 
    --package persistent 
    --package text 
    --package aeson 
    --package bytestring 
    --package base64-bytestring 
-} 

{-# LANGUAGE DeriveDataTypeable #-} 
{-# LANGUAGE FlexibleContexts #-} 
{-# LANGUAGE GADTs #-} 
{-# LANGUAGE GeneralizedNewtypeDeriving #-} 
{-# LANGUAGE MultiParamTypeClasses #-} 
{-# LANGUAGE OverloadedStrings #-} 
{-# LANGUAGE QuasiQuotes #-} 
{-# LANGUAGE TemplateHaskell #-} 
{-# LANGUAGE TypeFamilies #-} 
{-# LANGUAGE FlexibleInstances#-} 
{-# LANGUAGE OverloadedStrings#-} 
{-# LANGUAGE ScopedTypeVariables #-} 

import Control.Monad (join) 
import Control.Applicative 
import Data.Text (Text, unpack) 
import qualified Data.Text.Lazy.Encoding 
import Data.Typeable (Typeable) 
import Text.Blaze.Html.Renderer.Utf8 (renderHtml) 
import Yesod 
import Data.Aeson 
import Data.Aeson.Types 
import qualified Data.ByteString as BS 
import Data.ByteString (ByteString) 
import qualified Data.ByteString.Base64 as BS 
import qualified Data.Text.Encoding as T 

data App = App 

mkYesod 
    "App" 
    [parseRoutes| 
/json/test TestR POST 
|] 

instance Yesod App where 
    approot = ApprootStatic "http://localhost:3006" 

instance RenderMessage App FormMessage where 
    renderMessage _ _ = defaultFormMessage 

data Test = Test { 
     fileData :: Text, 
     name :: String 
} deriving (Show, Eq, Ord) 

instance FromJSON Test where 
    parseJSON (Object v) = Test <$> 
          v .: "fileData" <*> 
          v .: "name" 
    parseJSON _ = empty 

postTestR :: Handler TypedContent 
postTestR = do 
    testData :: Test <- requireJsonBody 
    let fileData' = BS.decode (T.encodeUtf8 $ fileData testData) 
    case fileData' of 
    Left err -> error err 
    Right dat -> liftIO $ BS.writeFile "/home/sibi/myfile" dat 
    selectRep $ provideRep $ return emptyObject 

main :: IO() 
main = warp 3006 App 

Lors de l'exécution:

$ curl -H "Content-Type: application/json" -H "Accept: application/json" -X POST -d '{"fileData":"aGVsbG8gd29ybGQ=","name":"Filename"}' http://127.0.0.1:3006/json/test 
$ cat /home/sibi/myfile 
hello world