Servant

Question

'da yanıt üstbilgisi ekleme Servant'da CORS yanıt üstbilgisini nasıl ekleyeceğimi anlamaya çalışıyorum (temel olarak, bir "Access-Control-Allow-Origin: *" yanıt tepkisini ayarlayın). addHeader işlevine sahip küçük bir test vakası yazdım ama hata veriyor. Aşağıdaki hatayı çözme konusunda yardımcı olacağım.

Kodu:

{-# LANGUAGE CPP   #-} 
{-# LANGUAGE DataKinds  #-} 
{-# LANGUAGE DeriveGeneriC#-} 
{-# LANGUAGE TypeFamilies #-} 
{-# LANGUAGE TypeOperators #-} 
{-# LANGUAGE OverloadedStrings #-} 
module Main where 

import Data.Aeson 
import GHC.Generics 
import Network.Wai 
import Servant 
import Network.Wai.Handler.Warp (run) 
import Control.Monad.Trans.Either 
import Control.Monad.IO.Class (liftIO) 
import Control.Monad (when, (<$!>)) 
import Data.Text as T 
import Data.Configurator as C 
import Data.Maybe 
import System.Exit (exitFailure) 

data User = User 
    { name    :: T.Text 
    , password   :: T.Text 
    } deriving (Eq, Show, Generic) 

instance ToJSON User 
instance FromJSON User 

type Token = T.Text 

type UserAPI = "grant" :> ReqBody '[JSON] User :> Post '[JSON] (Headers '[Header "Access-Control-Allow-Origin" T.Text] Token) 

userAPI :: Proxy UserAPI 
userAPI = Proxy 

authUser :: User -> Bool 
authUser u = case (password u) of 
    "somepass" -> True 
    _  -> False 

server :: Server UserAPI 
server = users 
    where users :: User -> EitherT ServantErr IO Token 
     users u = case (authUser u) of 
      True -> return $ addHeader "*" $ ("ok" :: Token) 
      False -> return $ addHeader "*" $ ("notok" :: Token) 

app :: Application 
app = serve userAPI server 

main :: IO() 
main = run 8081 app 

En fazla bu hatadır:

src/Test.hs:43:10: 
    Couldn't match type ‘Headers 
          '[Header "Access-Control-Allow-Origin" Text] Text’ 
        with ‘Text’ 
    Expected type: Server UserAPI 
     Actual type: User -> EitherT ServantErr IO Token 
    In the expression: users 
    In an equation for ‘server’: 
     server 
      = users 
      where 
       users :: User -> EitherT ServantErr IO Token 
       users u 
       = case (authUser u) of { 
        True -> return $ addHeader "*" $ ("something" :: Token) 
        False -> return $ addHeader "*" $ ("something" :: Token) } 

src/Test.hs:46:28: 
    Couldn't match type ‘Text’ with ‘Headers '[Header h v0] Text’ 
    In the expression: addHeader "*" 
    In the second argument of ‘($)’, namely 
     ‘addHeader "*" $ ("something" :: Token)’ 
    In the expression: return $ addHeader "*" $ ("something" :: Token) 

src/Test.hs:47:29: 
    Couldn't match type ‘Text’ with ‘Headers '[Header h1 v1] Text’ 
    In the expression: addHeader "*" 
    In the second argument of ‘($)’, namely 
     ‘addHeader "*" $ ("something" :: Token)’ 
    In the expression: return $ addHeader "*" $ ("something" :: Token) 

bunun işe yaradığını (GET basit) daha basit bir API ile çalışan bir sürümü var. Ancak, yukarıdaki UserAPI için, hata veriyor. addHeader işlev türü, tür imzası hakkında düşündüğüm şekilde aynı fikirde gibi görünüyor. Kesinlikle burada bir şey eksik ya da bu gibi hata olmaz.

Answer 1

Madjar zaten bu önermiş, ancak bunun üzerine genişletmek için: addHeader dönüş türü değiştirir: Either ServantErr IO (Headers '[Header "Access-Control-Allow-Origin" T.Text] Token

dönmek bağlayıcı nerede durumda

x :: Int 
x = 5 

y :: Headers '[Header "SomeHeader" String] Int 
y = addHeader "headerVal" y 

, bu users tipini güncellemek zorunda anlamına gelir

Daha genel olarak, eşanlamlı tipin ne için genişlediğini görmek için ghci'de :kind! Server UserAPI'u kullanabilirsiniz.

Answer 2

CORS başlıklarını yanıtlamaya eklemenin en kolay yolunun, hizmetkârın üstünde bir ara yazılım kullanılması olduğunu düşünüyorum. wai-cors oldukça kolaylaştırır:

gerçek cevap almak için

import Network.Wai.Middleware.Cors 

[...] 

app :: Application 
app = simpleCors (serve userAPI server) 

---

, sana tip Headers '[Header "Access-Control-Allow-Origin" T.Text bir değere dönüştürüldüğünde tip Text değeri çevirmek addHeader kullanmak gerekir sanırım.