-setHeader name value
- = do itr ← getInteraction
- liftIO $ atomically
- $ do state ← readTVar $ itrState itr
- when (state > DecidingHeader)
- $ fail "Too late to declare a response header field."
- res ← readTVar $ itrResponse itr
- let res' = H.setHeader name value res
- writeTVar (itrResponse itr) res'
- when (name ≡ "Content-Type")
- $ writeTVar (itrResponseHasCType itr) True
+setHeader name value = liftIO ∘ atomically ∘ go =≪ getInteraction
+ where
+ go ∷ NormalInteraction → STM ()
+ go (NI {..})
+ = do state ← readTVar niState
+ when (state > DecidingHeader) $
+ fail "Too late to declare a response header field."
+ res ← readTVar niResponse
+ writeTVar niResponse $ H.setHeader name value res
+ when (name ≡ "Content-Type") $
+ writeTVar niResponseHasCType True