--- \"Content-Type\" before applying this function. See
--- 'setContentType'.
-putBuilder ∷ Builder → Resource ()
-putBuilder b
- = do itr ← getInteraction
- liftIO $ atomically
- $ do driftTo' itr SendingBody
- hasCType ← readTVar $ itrResponseHasCType itr
- unless hasCType
- $ abortSTM InternalServerError []
- $ Just "putBuilder: Content-Type has not been set."
- putTMVar (itrBodyToSend itr) b
-
-driftTo ∷ InteractionState → Resource ()
-driftTo newState
- = do itr ← getInteraction
- liftIO $ atomically $ driftTo' itr newState
-
-driftTo' ∷ Interaction → InteractionState → STM ()
-driftTo' itr@(Interaction {..}) newState
- = do oldState ← readTVar itrState
+-- \"Content-Type\" before applying this function. See:
+-- 'setContentType'
+putBuilder ∷ Builder → Rsrc ()
+putBuilder b = liftIO ∘ atomically ∘ go =≪ getInteraction
+ where
+ -- FIXME: should see if resCanHaveBody.
+ go ∷ NormalInteraction → STM ()
+ go ni@(NI {..})
+ = do driftTo' ni SendingBody
+ hasCType ← readTVar niResponseHasCType
+ unless hasCType
+ $ throwSTM
+ $ mkAbortion' InternalServerError
+ "putBuilder: Content-Type has not been set."
+ putTMVar niBodyToSend b
+
+driftTo ∷ InteractionState → Rsrc ()
+driftTo = (getInteraction ≫=) ∘ ((liftIO ∘ atomically) ∘) ∘ flip driftTo'
+
+driftTo' ∷ NormalInteraction → InteractionState → STM ()
+driftTo' ni@(NI {..}) newState
+ = do oldState ← readTVar niState