Comprendre pourquoi MVar ne met pas à jour?

Question

Dans le cas suivant l'application web « TinyUrl »:

import Prelude() 
import Prelude.Compat 
import Data.Aeson.Types 
import GHC.Generics 
import Lucid 
import Network.Wai 
import Network.Wai.Handler.Warp 
import Servant 
import Servant.HTML.Lucid 
import Control.Concurrent.MVar 
import Data.Map 
import Control.Monad.Except 

type API = "tinyUrl" :> ValueAPI 

type ValueAPI = Capture "value" String :> (
         Get '[JSON] ResolvedTinyUrl 
        :<|> ReqBody '[JSON] UpdatedTinyUrl :> PutNoContent '[JSON] NoContent 
     ) 

newtype TinyUrl = TinyUrl String deriving (Generic, Ord, Eq, Show) 

instance ToJSON TinyUrl 

newtype ResolvedTinyUrl = ResolvedTinyUrl { value :: TinyUrl } deriving Generic 

data UpdatedTinyUrl = UpdatedTinyUrl 
    { v :: String } deriving Generic 

instance ToJSON ResolvedTinyUrl 

instance FromJSON UpdatedTinyUrl 

newtype ResolvedUrls = ResolvedUrls (MVar (Map TinyUrl String)) 

tinyUrlAPI :: Proxy API 
tinyUrlAPI = Proxy 

server :: IO (MVar (Map TinyUrl String)) -> Server API 
server ioMap = tinyUrlOperations 

    where tinyUrlOperations v = 
      get v :<|> put v 

      where get :: String -> Handler ResolvedTinyUrl 
       get s = Handler $ do 
        map <- lift $ ioMap 
        m  <- lift $ readMVar map 
        _  <- lift $ putStrLn ("m " ++ show m) 
        found <- lift $ return $ Data.Map.lookup (TinyUrl s) m 
        case found of 
        Just a -> return $ ResolvedTinyUrl (TinyUrl a) 
        Nothing -> (lift $ putStrLn ("did not find " ++ s)) >> throwError err404 

       put :: String -> UpdatedTinyUrl -> Handler NoContent 
       put key (UpdatedTinyUrl value) = Handler $ do 
       map  <- lift $ ioMap 
       m  <- lift $ takeMVar map 
       updated <- lift $ return $ Data.Map.insert (TinyUrl key) value m 
       _  <- lift $ putStrLn $ "updated:" ++ (show updated) 
       _  <- lift $ putMVar map updated 
       return NoContent 


app :: IO (MVar (Map TinyUrl String)) -> Application 
app map = serve tinyUrlAPI (server map) 

main :: IO() 
main = run 8081 $ app (newMVar $ Data.Map.empty) 

Après avoir démarré l'application locale, je ne comprends pas pourquoi mon PUT ne met pas à jour le fait MVar Map.

$curl -i -X PUT -H "Content-Type: application/json" -d '{"v" : "bar"}' \ 
    localhost:8081/tinyUrl/foo 
HTTP/1.1 204 No Content 
Date: Fri, 20 Oct 2017 11:52:41 GMT 
Server: Warp/3.2.13 
Content-Type: application/json;charset=utf-8 

$curl -i localhost:8081/tinyUrl/foo 
HTTP/1.1 404 Not Found 
Transfer-Encoding: chunked 
Date: Fri, 20 Oct 2017 11:52:46 GMT 
Server: Warp/3.2.13 

Answer 1

Cela semble mal:

server :: IO (MVar (Map TinyUrl String)) -> Server API 
server ioMap = ... 

ioMap ci-dessus est une action IO qui, dans votre cas, va créer un nouveau MVar chaque fois qu'il est utilisé. Vos méthodes get/put génèrent leur propre carte à chaque fois et la rejettent!

Vous voulez quelque chose comme:

server :: MVar (Map TinyUrl String) -> Server API 
server map = ... 

app :: MVar (Map TinyUrl String) -> Application 
app map = serve tinyUrlAPI (server map) 

main :: IO() 
main = do 
    map <- newMVar $ Data.Map.empty -- run this only once 
    run 8081 $ app map