{-# LANGUAGE OverloadedStrings #-}
module HttpWrite (proxyAndSave) where

import           Blaze.ByteString.Builder     (Builder, fromByteString)
import           Control.Concurrent.Async     (race_)
import           Control.Monad                (liftM)
import           Control.Monad.Trans.Class    (lift)
import           Control.Monad.Trans.Resource (MonadResource, runResourceT)
import qualified Data.ByteString.Char8        as S8
import qualified Data.Conduit                 as C
import qualified Data.Conduit.Binary          as CB
import           Data.Monoid                  (mappend)
import qualified Network.HTTP.Client          as HCl
import qualified Network.HTTP.Client.Conduit  as HCC
import qualified Network.HTTP.Conduit         as HC
import qualified Network.HTTP.Types           as HT
import qualified Network.Wai                  as Wai
import qualified Network.Wai.Conduit          as WC
import qualified Network.Wai.Handler.Warp     as Warp
import           System.IO                    (FilePath)

import           Control.Monad.IO.Class       (MonadIO)

-- proxy function that passes the response to the Wai.Application and saves
-- it to the given file
proxyAndSave :: HC.Manager -> HC.Request -> FilePath -> Wai.Application
proxyAndSave man req path _ respond = HCl.withResponse req man $ \res -> do

        let fileSaver :: MonadResource m => C.Conduit S8.ByteString m S8.ByteString
            fileSaver = CB.conduitFile path
            bodyReader :: HCl.BodyReader
            bodyReader = HCl.responseBody res
            bodySource :: MonadIO m => C.ConduitM () S8.ByteString m ()
            bodySource = HCC.bodyReaderSource bodyReader
            source2 = bodySource C.=$= fileSaver
            chunk :: S8.ByteString -> C.Flush Builder
            chunk = C.Chunk . fromByteString
            body :: C.ConduitM () (C.Flush Builder) IO()
            body = C.mapOutput chunk source2
            headers = filter removeEncodingHeaders $ HCl.responseHeaders res

        respond $ WC.responseSource (HCl.responseStatus res) headers body
  where
    -- remove encoding information
    removeEncodingHeaders (k, _) = k `notElem` [ "content-encoding", "content-length" ]