Предотвращение ошибок, вызванных вводом-выводом при обращении к базе данных внутри обработчика WAI

Question

Я пишу веб-сервис на haskell, используя warp, wai и acid-state. На данный момент у меня есть две функции-обработчики, которые требуют взаимодействия с базой данных, последняя из которых доставляет мне неприятности.

Первое, это регистрация:

registerUser :: AcidState UserDatabase -> Maybe (Map.Map String String) -> Response
registerUser db maybeUserMap =
  case maybeUserMap of
    (Just u) -> let _ = fmap (\id -> update db (StoreUser (toString id) u)) (nextRandom)
                in resPlain status200 "User Created."
    Nothing  -> resPlain status401 "Invalid user JSON."

Как видите, мне удается избежать IO от заражения ответа путем выполнения обновления в let _ = ..,

В функции входа в систему (которая в настоящее время возвращает только карту пользователя), я не могу избежать IOпотому что мне нужно на самом деле отправить результат в ответ:

loginUser :: AcidState UserDatabase -> String -> Response
loginUser db username = do
  maybeUserMap <- (query db (FetchUser username))
  case maybeUserMap of
    (Just u) -> resJSON u
    Nothing  -> resPlain status401 "Invalid username."

Это вызывает следующую ошибку:

src/Main.hs:40:3:
    Couldn't match type ‘IO b0’ with ‘Response’
    Expected type: IO (EventResult FetchUser)
                   -> (EventResult FetchUser -> IO b0) -> Response
      Actual type: IO (EventResult FetchUser)
                   -> (EventResult FetchUser -> IO b0) -> IO b0
    In a stmt of a 'do' block:
      maybeUserMap <- (query db (FetchUser username))
    In the expression:
      do { maybeUserMap <- (query db (FetchUser username));
           case maybeUserMap of {
             (Just u) -> resJSON u
             Nothing -> resPlain status401 "Invalid username." } }
    In an equation for ‘loginUser’:
        loginUser db username
          = do { maybeUserMap <- (query db (FetchUser username));
                 case maybeUserMap of {
                   (Just u) -> resJSON u
                   Nothing -> resPlain status401 "Invalid username." } }

src/Main.hs:42:17:
    Couldn't match expected type ‘IO b0’ with actual type ‘Response’
    In the expression: resJSON u
    In a case alternative: (Just u) -> resJSON u

src/Main.hs:43:17:
    Couldn't match expected type ‘IO b0’ with actual type ‘Response’
    In the expression: resPlain status401 "Invalid username."
    In a case alternative:
        Nothing -> resPlain status401 "Invalid username."

Я считаю, что ошибка вызвана тем, что запрос базы данных возвращает IO значение. Моей первой мыслью было изменить Response в подписи типа к IO Response, но затем функция верхнего уровня жаловалась, так как она нуждается в Responseне IO Response,

На похожую заметку хотелось бы написать registerUser как это:

registerUser :: AcidState UserDatabase -> Maybe (Map.Map String String) -> Response
registerUser db maybeUserMap =
  case maybeUserMap of
    (Just u) -> do uuid <- (nextRandom)
                   update db (StoreUser (toString uuid) u)
                   resPlain status200 (toString uuid)
    Nothing  -> resPlain status401 "Invalid user JSON."

Но это вызывает очень похожую ошибку.

Для полноты, вот функция, которая вызывает registerUser а также loginUser:

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> Response
authRoutes db request path body =
  case path of
    ("register":rest) -> registerUser db (decode (LB.pack body) :: Maybe (Map.Map String String))
    ("login":rest) -> loginUser db body
    ("access":rest) -> resPlain status404 "Not implemented."
    _ -> resPlain status404 "Not Found."

Как я могу избежать этих ошибок ввода-вывода?

Answer 1

Похоже, у вас возникли проблемы с тем, как работать с типом ввода-вывода в Haskell. Ваш вопрос на самом деле не имеет отношения к деформации, вай или кислотному состоянию. Я постараюсь объяснить это в контексте того, что вы задали вопрос.

Итак, первое, что вам нужно знать, это то, что вы не можете избежатьIO заражать ваши типы, когда вы на самом деле выполняете IO, Разговор с базой данных по своей сути IO операции, поэтому они будут заражены. Ваш первый пример на самом деле ничего не добавляет в базу данных. Вы можете пойти в GHCI и попробовать это:

> let myStrangeId x = let _ = print "Haskell is fun!" in x

Теперь проверьте тип этой функции:

>:t myStrangeId
myStrangeId :: a -> a

Теперь попробуйте запустить его:

> myStrangeId "Hello"
"Hello"

Как видите, он никогда не печатает сообщение, а просто возвращает аргумент. Так что на самом деле код, определенный в операторе let, полностью мертв, он вообще ничего не делает. То же самое верно в вашем registerUser функция.

Итак, как я уже говорил выше, вы не можете избежать IO типа, потому что вы хотите сделать IO в функциях. Это может показаться проблемой, но на самом деле это очень хорошая вещь, потому что она четко показывает, какие части вашей программы делают IO а которые нет. Вам нужно изучить способ haskell, который заключается в объединении IO действия вместе, чтобы сделать полную программу.

Если вы посмотрите на Application введите Wai вы увидите, что это просто синоним типа, который выглядит так:

type Application = Request -> IO Response

Когда вы закончите свою программу, это та подпись, которую вы хотите получить. Как вы можете видеть Response завернут в IO Вот.

Итак, давайте начнем с вашей верхней функции authRoutes, В настоящее время он имеет эту подпись:

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> Response

Мы на самом деле хотим, чтобы он имел немного другую подпись, Response вместо этого должно быть IO Response:

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> IO Response

Заворачивать что-то в IO это довольно легко. поскольку IO это монада, вы можете использовать return :: a -> IO a функция, чтобы сделать это. Чтобы получить необходимую подпись, вы можете просто добавить return после = в вашем определении функции. Это, однако, не выполняет то, что вы хотите, потому что loginUser а также registerUser также вернет IO ResponseТаким образом, вы получите несколько дважды завернутых ответов. Вместо этого вы можете начать с упаковки чистых ответов:

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> IO Response
authRoutes db request path body =
  case path of
    ("register":rest) -> registerUser db (decode (LB.pack body) :: Maybe (Map.Map String String))
    ("login":rest)    -> loginUser db body
    ("access":rest)   -> return $ resPlain status404 "Not implemented."
    _                 -> return $ resPlain status404 "Not Found."

Обратите внимание, что я добавил return до resPlain обернуть их в IO.

Теперь давайте посмотрим на registerUser, На самом деле его очень легко написать так, как вы хотите. Я собираюсь предположить, что nextRandom имеет подпись, которая выглядит примерно так: nextRandom :: IO somethingтогда вы можете сделать:

registerUser :: AcidState UserDatabase -> Maybe (Map.Map String String) -> IO Response
registerUser db maybeUserMap =
  case maybeUserMap of
    (Just u) -> do
        uuid <- nextRandom 
        update db (StoreUser (toString uuid) u)
        return $ resPlain status200 (toString uuid)
    Nothing  -> return $ resPlain status401 "Invalid user JSON."

И ваш loginUser функция требует лишь небольших изменений:

loginUser :: AcidState UserDatabase -> String -> IO Response
loginUser db username = do
  maybeUserMap <- query db (FetchUser username)
  case maybeUserMap of
    (Just u) -> return $ resJSON u
    Nothing  -> return $ resPlain status401 "Invalid username."

Подводя итог, вы не можете избежать IO заражать ваши типы, когда вы действительно хотите сделать IO, Вместо этого вы должны принять это, и обернуть ваши значения не IO в IO, Рекомендуется ограничить IO самая маленькая часть вашего приложения, которая возможна. Если вы можете написать функцию без IO в подписи вы должны, а затем скорее заверните его return потом. Однако очень логично, что loginUser Функция должна выполнять некоторые операции ввода-вывода, поэтому не проблема в том, что она имеет эту подпись.

Редактировать:

Итак, как вы сказали в комментарии, Wai изменил тип приложения на:

type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

Вы можете прочитать о том, почему здесь и здесь.

Чтобы использовать ваш IO Response Типы с этим вы можете сделать:

myApp :: Application
myApp request respond = do
    response <- authRoutes db request path body
    respond response

Answer 2

Вы смешиваете значение в контексте, т.е. IO (* ->) и значение (). Вы не можете сделать синтаксис типа "do" для значения. Простым решением было бы использовать unsafePerformIO. Использование зависит от вашего контекста (обращая внимание на слово "небезопасно"). Рекомендуемый подход - использовать монадный стек трансформаторов с IO в конце, а затем использовать liftIO для выполнения ваших действий IO.