powershellTransport :: ConfiguredProgram -> HttpTransport
powershellTransport prog =
    HttpTransport gethttp posthttp posthttpfile True False
  where
    gethttp verbosity uri etag destPath =
        withTempFile (takeDirectory destPath)
                     "psScript.ps1" $ \tmpFile tmpHandle -> do
           hPutStr tmpHandle script
           hClose tmpHandle
           let args = ["-InputFormat", "None", "-File", tmpFile]
           resp <- getProgramInvocationOutput verbosity
                     (programInvocation prog args)
           parseResponse resp
      where
        script =
          concatMap (++";\n") $
            [ "$wc = new-object system.net.webclient"
            , "$wc.Headers.Add(\"user-agent\","++escape userAgent++")"]
         ++ [ "$wc.Headers.Add(\"If-None-Match\"," ++ t ++ ")"
            | t <- maybeToList etag ]
         ++ [ "Try {"
            ,  "$wc.DownloadFile("++ escape (show uri) ++
                              "," ++ escape destPath ++ ")"
            , "} Catch {Write-Error $_; Exit(5);}"
            , "Write-Host \"200\""
            , "Write-Host $wc.ResponseHeaders.Item(\"ETag\")"
            , "Exit" ]

        escape x = '"' : x ++ "\"" --TODO write/find real escape.

        parseResponse x = case readMaybe . unlines . take 1 . lines $ trim x of
          Just i  -> return (i, Nothing) -- TODO extract real etag
          Nothing -> statusParseFail uri x

    posthttp = noPostYet

    posthttpfile verbosity uri path auth =
        withTempFile (takeDirectory path)
                     (takeFileName path) $ \tmpFile tmpHandle ->
        withTempFile (takeDirectory path)
                     "psScript.ps1" $ \tmpScriptFile tmpScriptHandle -> do
          (body, boundary) <- generateMultipartBody path
          BS.hPut tmpHandle body
          hClose tmpHandle

          fullPath <- canonicalizePath tmpFile
          hPutStr tmpScriptHandle (script fullPath boundary)
          hClose tmpScriptHandle
          let args = ["-InputFormat", "None", "-File", tmpScriptFile]
          resp <- getProgramInvocationOutput verbosity
                    (programInvocation prog args)
          parseResponse resp
      where
        script fullPath boundary = 
          concatMap (++";\n") $
            [ "$wc = new-object system.net.webclient"
            , "$wc.Headers.Add(\"user-agent\","++escape userAgent++")"
            , "$wc.Headers.Add(\"Content-type\"," ++
                              "\"multipart/form-data; " ++
                              "boundary="++boundary++"\")" ]
         ++ [ "$wc.Credentials = new-object System.Net.NetworkCredential("
              ++ escape uname ++ "," ++ escape passwd ++ ",\"\")"
            | (uname,passwd) <- maybeToList auth ]
         ++ [ "Try {"
            , "$bytes = [System.IO.File]::ReadAllBytes("++escape fullPath++")"
            , "$wc.UploadData("++ escape (show uri) ++ ",$bytes)"
            , "} Catch {Write-Error $_; Exit(1);}"
            , "Write-Host \"200\""
            , "Exit" ]

        escape x = show x

        parseResponse x = case readMaybe . unlines . take 1 . lines $ trim x of
          Just i -> return (i, x) -- TODO extract real etag
          Nothing -> statusParseFail uri x


------------------------------------------------------------------------------
-- The builtin plain HttpTransport
--
powershellTransport :: ConfiguredProgram -> HttpTransport
powershellTransport prog =
    HttpTransport gethttp posthttp posthttpfile True False
  where
    gethttp verbosity uri etag destPath =
        withTempFile (takeDirectory destPath)
                     "psScript.ps1" $ \tmpFile tmpHandle -> do
           hPutStr tmpHandle script
           hClose tmpHandle
           let args = ["-InputFormat", "None", "-File", tmpFile]
           resp <- getProgramInvocationOutput verbosity
                     (programInvocation prog args)
           parseResponse resp
      where
        script =
          concatMap (++";\n") $
            [ "$wc = new-object system.net.webclient"
            , "$wc.Headers.Add(\"user-agent\","++escape userAgent++")"]
         ++ [ "$wc.Headers.Add(\"If-None-Match\"," ++ t ++ ")"
            | t <- maybeToList etag ]
         ++ [ "Try {"
            ,  "$wc.DownloadFile("++ escape (show uri) ++
                              "," ++ escape destPath ++ ")"
            , "} Catch {Write-Error $_; Exit(5);}"
            , "Write-Host \"200\""
            , "Write-Host $wc.ResponseHeaders.Item(\"ETag\")"
            , "Exit" ]

        escape x = '"' : x ++ "\"" --TODO write/find real escape.

        parseResponse x = case readMaybe . unlines . take 1 . lines $ trim x of
          Just i  -> return (i, Nothing) -- TODO extract real etag
          Nothing -> statusParseFail uri x

    posthttp = noPostYet

    posthttpfile verbosity uri path auth =
        withTempFile (takeDirectory path)
                     (takeFileName path) $ \tmpFile tmpHandle ->
        withTempFile (takeDirectory path)
                     "psScript.ps1" $ \tmpScriptFile tmpScriptHandle -> do
          (body, boundary) <- generateMultipartBody path
          BS.hPut tmpHandle body
          hClose tmpHandle

          fullPath <- canonicalizePath tmpFile
          hPutStr tmpScriptHandle (script fullPath boundary)
          hClose tmpScriptHandle
          let args = ["-InputFormat", "None", "-File", tmpScriptFile]
          resp <- getProgramInvocationOutput verbosity
                    (programInvocation prog args)
          parseResponse resp
      where
        script fullPath boundary = 
          concatMap (++";\n") $
            [ "$wc = new-object system.net.webclient"
            , "$wc.Headers.Add(\"user-agent\","++escape userAgent++")"
            , "$wc.Headers.Add(\"Content-type\"," ++
                              "\"multipart/form-data; " ++
                              "boundary="++boundary++"\")" ]
         ++ [ "$wc.Credentials = new-object System.Net.NetworkCredential("
              ++ escape uname ++ "," ++ escape passwd ++ ",\"\")"
            | (uname,passwd) <- maybeToList auth ]
         ++ [ "Try {"
            , "$bytes = [System.IO.File]::ReadAllBytes("++escape fullPath++")"
            , "$wc.UploadData("++ escape (show uri) ++ ",$bytes)"
            , "} Catch {Write-Error $_; Exit(1);}"
            , "Write-Host \"200\""
            , "Exit" ]

        escape x = show x

        parseResponse x = case readMaybe . unlines . take 1 . lines $ trim x of
          Just i -> return (i, x) -- TODO extract real etag
          Nothing -> statusParseFail uri x


------------------------------------------------------------------------------
-- The builtin plain HttpTransport
--
powershellTransport prog =
    HttpTransport gethttp posthttp posthttpfile True False
  where
    gethttp verbosity uri etag destPath =
        withTempFile (takeDirectory destPath)
                     "psScript.ps1" $ \tmpFile tmpHandle -> do
           hPutStr tmpHandle script
           hClose tmpHandle
           let args = ["-InputFormat", "None", "-File", tmpFile]
           resp <- getProgramInvocationOutput verbosity
                     (programInvocation prog args)
           parseResponse resp
      where
        script =
          concatMap (++";\n") $
            [ "$wc = new-object system.net.webclient"
            , "$wc.Headers.Add(\"user-agent\","++escape userAgent++")"]
         ++ [ "$wc.Headers.Add(\"If-None-Match\"," ++ t ++ ")"
            | t <- maybeToList etag ]
         ++ [ "Try {"
            ,  "$wc.DownloadFile("++ escape (show uri) ++
                              "," ++ escape destPath ++ ")"
            , "} Catch {Write-Error $_; Exit(5);}"
            , "Write-Host \"200\""
            , "Write-Host $wc.ResponseHeaders.Item(\"ETag\")"
            , "Exit" ]

        escape x = '"' : x ++ "\"" --TODO write/find real escape.

        parseResponse x = case readMaybe . unlines . take 1 . lines $ trim x of
          Just i  -> return (i, Nothing) -- TODO extract real etag
          Nothing -> statusParseFail uri x

    posthttp = noPostYet

    posthttpfile verbosity uri path auth =
        withTempFile (takeDirectory path)
                     (takeFileName path) $ \tmpFile tmpHandle ->
        withTempFile (takeDirectory path)
                     "psScript.ps1" $ \tmpScriptFile tmpScriptHandle -> do
          (body, boundary) <- generateMultipartBody path
          BS.hPut tmpHandle body
          hClose tmpHandle

          fullPath <- canonicalizePath tmpFile
          hPutStr tmpScriptHandle (script fullPath boundary)
          hClose tmpScriptHandle
          let args = ["-InputFormat", "None", "-File", tmpScriptFile]
          resp <- getProgramInvocationOutput verbosity
                    (programInvocation prog args)
          parseResponse resp
      where
        script fullPath boundary = 
          concatMap (++";\n") $
            [ "$wc = new-object system.net.webclient"
            , "$wc.Headers.Add(\"user-agent\","++escape userAgent++")"
            , "$wc.Headers.Add(\"Content-type\"," ++
                              "\"multipart/form-data; " ++
                              "boundary="++boundary++"\")" ]
         ++ [ "$wc.Credentials = new-object System.Net.NetworkCredential("
              ++ escape uname ++ "," ++ escape passwd ++ ",\"\")"
            | (uname,passwd) <- maybeToList auth ]
         ++ [ "Try {"
            , "$bytes = [System.IO.File]::ReadAllBytes("++escape fullPath++")"
            , "$wc.UploadData("++ escape (show uri) ++ ",$bytes)"
            , "} Catch {Write-Error $_; Exit(1);}"
            , "Write-Host \"200\""
            , "Exit" ]

        escape x = show x

        parseResponse x = case readMaybe . unlines . take 1 . lines $ trim x of
          Just i -> return (i, x) -- TODO extract real etag
          Nothing -> statusParseFail uri x


------------------------------------------------------------------------------
-- The builtin plain HttpTransport
--