Put.hs

module Network.Salvia.Handlers.Put (hPut) where

import Control.Monad.State
import Network.Protocol.Http
import Network.Salvia.Handlers.Error
import Network.Salvia.Httpd
import System.IO
import qualified Data.ByteString.Lazy as B

{- |
First naive handler for the PUT request. This probably does not handle all the
quirks that the HTTP protocol specifies, but it does the job for now. When a
'ContentLength' header field is available only this fixed number of bytes will
be spooled from socket to the resource. When both the KeepAlive' and
'ContentLength' header fields are not available the entire payload of the
request is spooled to the resource.
--}

hPut :: ResourceHandler ()
hPut name =
  safeIO (openBinaryFile name WriteMode)
    $ (contents >>=) . maybe putError . putOk
  where
    putError   = hError NotImplemented
    putOk fd c = lift (B.hPut fd c >> hClose fd)