-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}







{-# LINE 13 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


module Network.SSH.Client.LibSSH2.Foreign
  (-- * Types
   KnownHosts, KnownHostResult (..), KnownHostType (..), KnownHost (..),

   -- * Session functions
   initialize, exit,
   initSession, freeSession, disconnectSession,
   handshake,
   setBlocking,

   -- * Known hosts functions
   initKnownHosts, freeKnownHosts, knownHostsReadFile,
   getHostKey, checkKnownHost,

   -- * Authentication
   publicKeyAuthFile,
   usernamePasswordAuth,

   -- * Channel functions
   openChannelSession, closeChannel, freeChannel,
   channelSendEOF, channelWaitEOF, channelIsEOF,
   readChannel, writeChannel,
   writeChannelFromHandle, readChannelToHandle,
   channelProcess, channelExecute, channelShell,
   requestPTY, requestPTYEx,
   channelExitStatus, channelExitSignal,
   scpSendChannel, scpReceiveChannel, pollChannelRead,

   -- * SFTP functions
   sftpInit, sftpShutdown,
   sftpOpenDir, sftpReadDir, sftpCloseHandle,
   sftpOpenFile,
   sftpRenameFile, sftpRenameFileEx,
   sftpWriteFileFromHandler, sftpReadFileToHandler,
   sftpFstat, sftpDeleteFile,

   RenameFlag (..), SftpFileTransferFlags (..),
   SftpAttributes (..),

   -- * Debug
   TraceFlag (..), setTraceMode
  ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Control.Monad (void)
import Data.Time.Clock.POSIX
import Foreign hiding (void)
import Foreign.C.Types
import Foreign.C.String
import System.IO
import Network.Socket (Socket(MkSocket), isReadable)
import qualified Data.ByteString as BSS
import qualified Data.ByteString.Unsafe as BSS

import Network.SSH.Client.LibSSH2.Types
import Network.SSH.Client.LibSSH2.Errors



-- Known host flags. See libssh2 documentation.
data KnownHostType =
    TYPE_MASK
  | TYPE_PLAIN
  | TYPE_SHA1
  | TYPE_CUSTOM
  | KEYENC_MASK
  | KEYENC_RAW
  | KEYENC_BASE64
  | KEY_MASK
  | KEY_SHIFT
  | KEY_RSA1
  | KEY_SSHRSA
  | KEY_SSHDSS
  deriving (Eq, Show)

kht2int :: KnownHostType -> CInt
kht2int TYPE_MASK   = 0xffff
kht2int TYPE_PLAIN  = 1
kht2int TYPE_SHA1   = 2
kht2int TYPE_CUSTOM = 3
kht2int KEYENC_MASK = 3 `shiftL` 16
kht2int KEYENC_RAW  = 1 `shiftL` 16
kht2int KEYENC_BASE64 = 2 `shiftL` 16
kht2int KEY_MASK    = 3 `shiftL` 18
kht2int KEY_SHIFT   = 18
kht2int KEY_RSA1    = 1 `shiftL` 18
kht2int KEY_SSHRSA  = 2 `shiftL` 18
kht2int KEY_SSHDSS  = 3 `shiftL` 18

typemask2int :: [KnownHostType] -> CInt
typemask2int list = foldr (.|.) 0 (map kht2int list)

-- Result of matching host against known_hosts.
data KnownHostResult =
    MATCH
  | MISMATCH
  | NOTFOUND
  | FAILURE
  deriving (Eq, Show, Ord, Enum)

int2khresult :: CInt -> KnownHostResult
int2khresult = toEnum . fromIntegral

data KnownHost = KnownHost {
  khMagic :: CUInt,
  khNode :: Ptr (),
  khName :: String,
  khKey :: String,
  khTypeMask :: [KnownHostType] }
  deriving (Eq, Show)

init_crypto :: Bool -> CInt
init_crypto False = 1
init_crypto True  = 0

ssh2socket :: Socket
           -> CInt
ssh2socket (MkSocket s _ _ _ _) =
  s

initialize_ :: (Bool) -> IO ((Int))
initialize_ a1 =
  let {a1' = init_crypto a1} in
  initialize_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 150 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Initialize libssh2. Pass True to enable encryption
-- or False to disable it.
initialize :: Bool -> IO ()
initialize flags = void . handleInt (Nothing :: Maybe Session) $ initialize_ flags

-- | Deinitialize libssh2.
exit :: IO ()
exit =
  exit'_ >>
  return ()

{-# LINE 167 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Create Session object
initSession :: IO Session
initSession = handleNullPtr (Nothing :: Maybe Session) sessionFromPointer $
  libssh2_session_init_ex nullFunPtr nullFunPtr nullFunPtr nullPtr

freeSession_ :: (Session) -> IO ((Int))
freeSession_ a1 =
  let {a1' = toPointer a1} in
  freeSession_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 175 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Free Session object's memory
freeSession :: Session -> IO ()
freeSession session = void . handleInt (Just session) $ freeSession_ session

disconnectSessionEx :: (Session) -> (Int) -> (String) -> (String) -> IO ((Int))
disconnectSessionEx a1 a2 a3 a4 =
  let {a1' = toPointer a1} in
  let {a2' = fromIntegral a2} in
  C2HSImp.withCString a3 $ \a3' ->
  C2HSImp.withCString a4 $ \a4' ->
  disconnectSessionEx'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 182 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Disconnect session (but do not free memory)
disconnectSession :: Session
                  -> String  -- ^ Goodbye message
                  -> IO ()
disconnectSession s msg = void . handleInt (Just s) $ disconnectSessionEx s 11 msg ""

setBlocking :: (Session) -> (Bool) -> IO ()
setBlocking a1 a2 =
  let {a1' = toPointer a1} in
  let {a2' = bool2int a2} in
  setBlocking'_ a1' a2' >>
  return ()

{-# LINE 191 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


bool2int :: Bool -> CInt
bool2int True  = 1
bool2int False = 0

handshake_ :: (Session) -> (Socket) -> IO ((Int))
handshake_ a1 a2 =
  let {a1' = toPointer a1} in
  let {a2' = ssh2socket a2} in
  handshake_'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 198 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Run SSH handshake on network socket.
handshake :: Session -> Socket -> IO ()
handshake session socket = do
  sessionSetSocket session (Just socket)
  void . handleInt (Just session) $ handshake_ session socket

initKnownHosts_ :: (Session) -> IO ((Ptr ()))
initKnownHosts_ a1 =
  let {a1' = toPointer a1} in
  initKnownHosts_'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 207 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Create KnownHosts object for given session.
initKnownHosts :: Session -> IO KnownHosts
initKnownHosts session = handleNullPtr (Nothing :: Maybe Session) knownHostsFromPointer $ initKnownHosts_ session

-- | Free KnownHosts object's memory
freeKnownHosts :: (KnownHosts) -> IO ()
freeKnownHosts a1 =
  let {a1' = toPointer a1} in
  freeKnownHosts'_ a1' >>
  return ()

{-# LINE 215 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


knownHostsReadFile_ :: (KnownHosts) -> (String) -> (CInt) -> IO ((Int))
knownHostsReadFile_ a1 a2 a3 =
  let {a1' = toPointer a1} in
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = id a3} in
  knownHostsReadFile_'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 218 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Read known hosts from file
knownHostsReadFile :: KnownHosts
                   -> FilePath   -- ^ Path to known_hosts file
                   -> IO Int
knownHostsReadFile kh path = handleInt (Nothing :: Maybe Session) $ knownHostsReadFile_ kh path 1

-- | Get remote host public key
getHostKey :: (Session) -> IO ((String), (Size), (CInt))
getHostKey a1 =
  let {a1' = toPointer a1} in
  alloca $ \a2' ->
  alloca $ \a3' ->
  getHostKey'_ a1' a2' a3' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  peek  a2'>>= \a2'' ->
  peek  a3'>>= \a3'' ->
  return (res', a2'', a3'')

{-# LINE 228 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


checkKnownHost_ :: (KnownHosts) -> (String) -> (Int) -> (String) -> (Int) -> ([KnownHostType]) -> (Ptr ()) -> IO ((KnownHostResult))
checkKnownHost_ a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = toPointer a1} in
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  C2HSImp.withCString a4 $ \a4' ->
  let {a5' = fromIntegral a5} in
  let {a6' = typemask2int a6} in
  let {a7' = castPtr a7} in
  checkKnownHost_'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = int2khresult res} in
  return (res')

{-# LINE 237 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Check host data against known hosts.
checkKnownHost :: KnownHosts         --
               -> String             -- ^ Host name
               -> Int                -- ^ Port number (usually 22)
               -> String             -- ^ Host public key
               -> [KnownHostType]    -- ^ Host flags (see libssh2 documentation)
               -> IO KnownHostResult
checkKnownHost kh host port key flags = checkKnownHost_ kh host port key (length key) flags nullPtr

-- TODO: I don't see the '&' in the libssh2 docs?
publicKeyAuthFile_ :: (Session) -> (String) -> (String) -> (String) -> (String) -> IO ((Int))
publicKeyAuthFile_ a1 a2 a3 a4 a5 =
  let {a1' = toPointer a1} in
  (\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
  C2HSImp.withCString a3 $ \a3' ->
  C2HSImp.withCString a4 $ \a4' ->
  C2HSImp.withCString a5 $ \a5' ->
  publicKeyAuthFile_'_ a1' a2'1  a2'2 a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 254 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Perform public key authentication.
publicKeyAuthFile :: Session -- ^ Session
                  -> String  -- ^ Username
                  -> String  -- ^ Path to public key
                  -> String  -- ^ Path to private key
                  -> String  -- ^ Passphrase
                  -> IO ()
publicKeyAuthFile session username public private passphrase = void . handleInt (Just session) $
  publicKeyAuthFile_ session username public private passphrase

-- | Perform username/password authentication.
usernamePasswordAuth :: Session -- ^ Session
                     -> String  -- ^ Username
                     -> String  -- ^ Password
                     -> IO ()
usernamePasswordAuth session username password =
  withCString username $ \usernameptr -> do
    withCString password $ \passwordptr -> do
      void . handleInt (Just session) $
        libssh2_userauth_password_ex (toPointer session) usernameptr (toEnum $ length username) passwordptr (toEnum $ length password) nullFunPtr

openSessionChannelEx :: (Session) -> (String) -> (Int) -> (Int) -> (String) -> IO ((Ptr ()))
openSessionChannelEx a1 a2 a3 a4 a5 =
  let {a1' = toPointer a1} in
  (\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  (\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a5 $ \(a5'1, a5'2) ->
  openSessionChannelEx'_ a1' a2'1  a2'2 a3' a4' a5'1  a5'2 >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 281 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Open a channel for session.
openChannelSession :: Session -> IO Channel
openChannelSession s = handleNullPtr (Just s) (channelFromPointer s) $
  openSessionChannelEx s "session" 65536 32768 ""

channelProcess :: Channel -> String -> String -> IO ()
channelProcess ch kind command = void . handleInt (Just $ channelSession ch) $
  channelProcessStartup_ ch kind command

-- | Execute command
channelExecute :: Channel -> String -> IO ()
channelExecute c command = channelProcess c "exec" command

channelProcessStartup_ :: (Channel) -> (String) -> (String) -> IO ((Int))
channelProcessStartup_ a1 a2 a3 =
  let {a1' = toPointer a1} in
  (\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
  (\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a3 $ \(a3'1, a3'2) ->
  channelProcessStartup_'_ a1' a2'1  a2'2 a3'1  a3'2 >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 299 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Execute shell command
channelShell :: Channel -> IO ()
channelShell c = void . handleInt (Just $ channelSession c) $ do
  withCStringLen "shell" $ \(s,l) -> do
    res <- channelProcessStartup_'_ (toPointer c) s (fromIntegral l) nullPtr 0
    return $ (res :: CInt)

requestPTYEx :: (Channel) -> (String) -> (String) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ((Int))
requestPTYEx a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = toPointer a1} in
  (\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a2 $ \(a2'1, a2'2) ->
  (\s f -> C2HSImp.withCStringLen s (\(p, n) -> f (p, fromIntegral n))) a3 $ \(a3'1, a3'2) ->
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  let {a7' = fromIntegral a7} in
  requestPTYEx'_ a1' a2'1  a2'2 a3'1  a3'2 a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 313 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


requestPTY :: Channel -> String -> IO ()
requestPTY ch term = void . handleInt (Just $ channelSession ch) $ requestPTYEx ch term "" 0 0 0 0

readChannelEx :: Channel -> Int -> Size -> IO BSS.ByteString
readChannelEx ch i size = do
  allocaBytes (fromIntegral size) $ \buffer -> do
    rc <- handleInt (Just $ channelSession ch) $ libssh2_channel_read_ex (toPointer ch) (fromIntegral i) buffer size
    BSS.packCStringLen (buffer, fromIntegral rc)

-- | Read data from channel.
readChannel :: Channel         --
            -> Size             -- ^ Amount of data to read
            -> IO BSS.ByteString
readChannel c sz = readChannelEx c 0 sz

-- | Write data to channel.
writeChannel :: Channel -> BSS.ByteString -> IO ()
writeChannel ch bs =
    BSS.unsafeUseAsCString bs $ go 0 (fromIntegral $ BSS.length bs)
  where
    go :: Int -> CULong -> CString -> IO ()
    go offset len cstr = do
      written <- handleInt (Just $ channelSession ch)
                           $ libssh2_channel_write_ex (toPointer ch)
                                                         0
                                                         (cstr `plusPtr` offset)
                                                         (fromIntegral len)
      if fromIntegral written < len
        then go (offset + fromIntegral written) (len - fromIntegral written) cstr
        else return ()

channelSendEOF_ :: (Channel) -> IO ((Int))
channelSendEOF_ a1 =
  let {a1' = toPointer a1} in
  channelSendEOF_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 347 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


channelSendEOF :: Channel -> IO ()
channelSendEOF channel = void . handleInt (Just $ channelSession channel) $ channelSendEOF_ channel

channelWaitEOF_ :: (Channel) -> IO ((Int))
channelWaitEOF_ a1 =
  let {a1' = toPointer a1} in
  channelWaitEOF_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 353 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


channelWaitEOF :: Channel -> IO ()
channelWaitEOF channel = void . handleInt (Just $ channelSession channel) $ channelWaitEOF_ channel

data TraceFlag =
    T_TRANS
  | T_KEX
  | T_AUTH
  | T_CONN
  | T_SCP
  | T_SFTP
  | T_ERROR
  | T_PUBLICKEY
  | T_SOCKET
  deriving (Eq, Show)

tf2int :: TraceFlag -> CInt
tf2int T_TRANS = 1 `shiftL` 1
tf2int T_KEX   = 1 `shiftL` 2
tf2int T_AUTH  = 1 `shiftL` 3
tf2int T_CONN  = 1 `shiftL` 4
tf2int T_SCP   = 1 `shiftL` 5
tf2int T_SFTP  = 1 `shiftL` 6
tf2int T_ERROR = 1 `shiftL` 7
tf2int T_PUBLICKEY = 1 `shiftL` 8
tf2int T_SOCKET = 1 `shiftL` 9

trace2int :: [TraceFlag] -> CInt
trace2int flags = foldr (.|.) 0 (map tf2int flags)

setTraceMode :: (Session) -> ([TraceFlag]) -> IO ()
setTraceMode a1 a2 =
  let {a1' = toPointer a1} in
  let {a2' = trace2int a2} in
  setTraceMode'_ a1' a2' >>
  return ()

{-# LINE 385 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Write all data to channel from handle.
-- Returns amount of transferred data.
writeChannelFromHandle :: Channel -> Handle -> IO Integer
writeChannelFromHandle ch h =
  let
    go :: Integer -> Ptr a -> IO Integer
    go done buffer = do
      sz <- hGetBuf h buffer bufferSize
      send 0 (fromIntegral sz) buffer
      let newDone = done + fromIntegral sz
      if sz < bufferSize
        then return newDone
        else go newDone buffer

    send :: Int -> CLong -> Ptr a -> IO ()
    send _ 0 _ = return ()
    send written size buffer = do
      sent <- handleInt (Just $ channelSession ch) $
                libssh2_channel_write_ex
{-# LINE 405 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}

                  (toPointer ch)
                  0
                  (plusPtr buffer written)
                  (fromIntegral size)
      send (written + fromIntegral sent) (size - fromIntegral sent) buffer

    bufferSize = 0x100000

  in allocaBytes bufferSize $ go 0

-- | Read all data from channel to handle.
-- Returns amount of transferred data.
readChannelToHandle :: Channel -> Handle -> Offset -> IO Integer
readChannelToHandle ch h fileSize = do
    allocaBytes bufferSize $ \buffer ->
        readChannelCB ch buffer bufferSize fileSize callback
  where
    callback buffer size = hPutBuf h buffer size

    bufferSize :: Int
    bufferSize = 0x100000

readChannelCB :: Channel -> CString -> Int -> Offset -> (CString -> Int -> IO ()) -> IO Integer
readChannelCB ch buffer bufferSize fileSize callback =
  let go got = do
        let toRead = min (fromIntegral fileSize - got) (fromIntegral bufferSize)
        sz <- handleInt (Just $ channelSession ch) $
                libssh2_channel_read_ex
{-# LINE 433 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}

                  (toPointer ch)
                  0
                  buffer
                  (fromIntegral toRead)
        let isz :: Integer
            isz = fromIntegral sz
        callback buffer (fromIntegral sz)
        eof <- libssh2_channel_eof (toPointer ch)
        let newGot = got + fromIntegral sz
        if  (eof == 1) || (newGot == fromIntegral fileSize)
          then do
               return isz
          else do
               rest <- go newGot
               return $ isz + rest
  in go (0 :: Integer)

channelIsEOF :: (Channel) -> IO ((Bool))
channelIsEOF a1 =
  let {a1' = toPointer a1} in
  channelIsEOF'_ a1' >>= \res ->
  handleBool res >>= \res' ->
  return (res')

{-# LINE 452 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


closeChannel_ :: (Channel) -> IO ((Int))
closeChannel_ a1 =
  let {a1' = toPointer a1} in
  closeChannel_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 455 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Close channel (but do not free memory)
closeChannel :: Channel -> IO ()
closeChannel channel = void . handleInt (Just $ channelSession channel) $ closeChannel_ channel

freeChannel_ :: (Channel) -> IO ((Int))
freeChannel_ a1 =
  let {a1' = toPointer a1} in
  freeChannel_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 462 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Free channel object's memory
freeChannel :: Channel -> IO ()
freeChannel channel = void . handleInt (Just $ channelSession channel) $ freeChannel_ channel

-- | Get channel exit status
channelExitStatus :: (Channel) -> IO ((Int))
channelExitStatus a1 =
  let {a1' = toPointer a1} in
  channelExitStatus'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 470 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


channelExitSignal_ :: (Channel) -> (Ptr Int) -> (Ptr Int) -> (Ptr Int) -> IO ((Int), (String), (Maybe String), (Maybe String))
channelExitSignal_ a1 a3 a5 a7 =
  let {a1' = toPointer a1} in
  alloca $ \a2' ->
  let {a3' = castPtr a3} in
  alloca $ \a4' ->
  let {a5' = castPtr a5} in
  alloca $ \a6' ->
  let {a7' = castPtr a7} in
  channelExitSignal_'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  peekCStringPtr  a2'>>= \a2'' ->
  peekMaybeCStringPtr  a4'>>= \a4'' ->
  peekMaybeCStringPtr  a6'>>= \a6'' ->
  return (res', a2'', a4'', a6'')

{-# LINE 479 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Get channel exit signal. Returns:
-- (possibly error code, exit signal name, possibly error message, possibly language code).
channelExitSignal :: Channel -> IO (Int, String, Maybe String, Maybe String)
channelExitSignal ch = handleInt (Just $ channelSession ch) $ channelExitSignal_ ch nullPtr nullPtr nullPtr

scpSendChannel_ :: (Session) -> (String) -> (Int) -> (Int64) -> (POSIXTime) -> (POSIXTime) -> IO ((Ptr ()))
scpSendChannel_ a1 a2 a3 a4 a5 a6 =
  let {a1' = toPointer a1} in
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = round a5} in
  let {a6' = round a6} in
  scpSendChannel_'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 492 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Create SCP file send channel.
scpSendChannel :: Session -> String -> Int -> Int64 -> POSIXTime -> POSIXTime -> IO Channel
scpSendChannel session remotePath mode size mtime atime = handleNullPtr (Just session) (channelFromPointer session) $
  scpSendChannel_ session remotePath mode size mtime atime

type Offset = (C2HSImp.CLong)
{-# LINE 499 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- {# pointer *stat_t as Stat newtype #}

-- | Create SCP file receive channel.
-- TODO: receive struct stat also.
scpReceiveChannel :: Session -> FilePath -> IO (Channel, Offset)
scpReceiveChannel s path = do
  withCString path $ \pathptr ->
     allocaBytes 144 $ \statptr -> do
       channel <- handleNullPtr (Just s) (channelFromPointer s) $ libssh2_scp_recv (toPointer s) pathptr statptr
       size <- (\ptr -> do {C2HSImp.peekByteOff ptr 48 :: IO C2HSImp.CLong}) statptr
       return (channel, size)

-- {# fun poll_channel_read as pollChannelRead_
--     { toPointer `Channel' } -> `Int' #}

pollChannelRead :: Channel -> IO Bool
pollChannelRead ch = do
  mbSocket <- sessionGetSocket (channelSession ch)
  case mbSocket of
    Nothing -> error "pollChannelRead without socket present"
    Just socket -> isReadable socket

--
-- | Sftp support
--

-- SFTP File Transfer Flags. See libssh2 documentation
data SftpFileTransferFlags =
    FXF_READ
  | FXF_WRITE
  | FXF_APPEND
  | FXF_CREAT
  | FXF_TRUNC
  | FXF_EXCL
  deriving (Eq, Show)

ftf2int :: SftpFileTransferFlags -> CULong
ftf2int FXF_READ   = 0x00000001
ftf2int FXF_WRITE  = 0x00000002
ftf2int FXF_APPEND = 0x00000004
ftf2int FXF_CREAT  = 0x00000008
ftf2int FXF_TRUNC  = 0x00000010
ftf2int FXF_EXCL   = 0x00000020

ftransferflags2int :: [SftpFileTransferFlags] -> CULong
ftransferflags2int list = foldr (.|.) 0 (map ftf2int list)

-- | Flags for open_ex()
data OpenExFlags = OpenFile
                 | OpenDir
                 deriving (Eq, Show)

oef2int :: (Num a) => OpenExFlags -> a
oef2int OpenFile = 0
oef2int OpenDir  = 1

sftpInit :: Session ->  IO Sftp
sftpInit s = handleNullPtr (Just s) (sftpFromPointer s) $
  sftpInit_ s

sftpShutdown :: Sftp -> IO ()
sftpShutdown sftp =
  void . handleInt (Just sftp) $ sftpShutdown_ sftp

sftpInit_ :: (Session) -> IO ((Ptr ()))
sftpInit_ a1 =
  let {a1' = toPointer a1} in
  sftpInit_'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 566 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


sftpShutdown_ :: (Sftp) -> IO ((Int))
sftpShutdown_ a1 =
  let {a1' = toPointer a1} in
  sftpShutdown_'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 569 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Open regular file handler
sftpOpenFile :: Sftp -> String -> Int -> [SftpFileTransferFlags] -> IO SftpHandle
sftpOpenFile sftp path mode flags =
  handleNullPtr (Just sftp) ( sftpHandleFromPointer sftp ) $
      sftpOpen_ sftp path (toEnum mode) flags (oef2int OpenFile)

-- | Open directory file handler
sftpOpenDir :: Sftp -> String -> IO SftpHandle
sftpOpenDir sftp path =
  handleNullPtr (Just sftp) ( sftpHandleFromPointer sftp ) $
      sftpOpen_ sftp path 0 [] (oef2int OpenDir)

sftpOpen_ :: Sftp -> String -> CLong -> [SftpFileTransferFlags] -> CInt -> IO (Ptr ())
sftpOpen_ sftp path mode fl open_type =
  let flags = ftransferflags2int fl
  in
    withCStringLen path $ \(pathP, pathL) -> do
      libssh2_sftp_open_ex (toPointer sftp) pathP (toEnum pathL) flags mode open_type

-- | Read directory from file handler
sftpReadDir :: SftpHandle -> IO (Maybe (BSS.ByteString, SftpAttributes))
sftpReadDir sftph = do
  let bufflen = 512
  allocaBytes bufflen $ \bufptr -> do
    allocaBytes 56 $ \sftpattrptr -> do
      rc <- handleInt (Just sftph) $
        libssh2_sftp_readdir_ex (toPointer sftph) bufptr (fromIntegral bufflen) nullPtr 0 sftpattrptr
      case rc == 0 of
        False -> do
         fstat    <- parseSftpAttributes sftpattrptr
         filename <- BSS.packCStringLen (bufptr, intResult rc)
         return $ Just (filename, fstat)
        True ->
           return Nothing

-- | Close file handle
sftpCloseHandle :: SftpHandle -> IO ()
sftpCloseHandle sftph =
  void . handleInt (Just $ sftpHandleSession sftph) $
    libssh2_sftp_close_handle (toPointer sftph)

data RenameFlag =
    RENAME_OVERWRITE
  | RENAME_ATOMIC
  | RENAME_NATIVE
  deriving (Eq, Show)

rf2long :: RenameFlag -> CLong
rf2long RENAME_OVERWRITE = 0x00000001
rf2long RENAME_ATOMIC    = 0x00000002
rf2long RENAME_NATIVE    = 0x00000004

renameFlag2int :: [RenameFlag] -> CLong
renameFlag2int flags = foldr (.|.) 0 (map rf2long flags)

-- | Rename a file on the sftp server
sftpRenameFile :: Sftp     -- ^ Opened sftp session
               -> FilePath -- ^ Old file name
               -> FilePath -- ^ New file name
               -> IO ()
sftpRenameFile sftp src dest =
  sftpRenameFileEx sftp src dest [ RENAME_NATIVE, RENAME_ATOMIC, RENAME_OVERWRITE]

-- | Rename a file on the sftp server
sftpRenameFileEx :: Sftp         -- ^ Opened sftp session
                 -> FilePath     -- ^ Old file name
                 -> FilePath     -- ^ New file name
                 -> [RenameFlag] -- ^ Rename flags
                 -> IO ()
sftpRenameFileEx sftp src dest flags =
  withCStringLen src $ \(srcP, srcL) ->
    withCStringLen dest $ \(destP, destL) ->
      void . handleInt (Just $ sftpSession sftp) $
         libssh2_sftp_rename_ex (toPointer sftp) srcP (toEnum srcL) destP (toEnum destL) (renameFlag2int flags )

-- | Download file from the sftp server
sftpReadFileToHandler :: SftpHandle -> Handle -> Int -> IO Int
sftpReadFileToHandler sftph fh fileSize =
  let
    go :: Int -> Ptr a -> IO Int
    go received buffer = do
      let toRead :: Int
          toRead = min (fromIntegral fileSize - received) bufferSize
      sz <- receive toRead buffer 0
      _ <- hPutBuf fh buffer sz
      let newreceived :: Int
          newreceived = (received + fromIntegral sz)
      if newreceived < fromIntegral fileSize
         then go newreceived buffer
         else return $ fromIntegral newreceived

    receive :: Int -> Ptr a -> Int -> IO Int
    receive 0 _ read_sz = return read_sz
    receive toread buf alreadyread = do
       received <- handleInt (Just sftph)
                       $ libssh2_sftp_read (toPointer sftph)
                                              (buf `plusPtr` alreadyread)
                                              (fromIntegral toread)
       receive (toread - fromIntegral received) buf (alreadyread + fromIntegral received)

    bufferSize = 0x100000

  in allocaBytes bufferSize $ go 0

-- | Upload file to the sftp server
sftpWriteFileFromHandler :: SftpHandle -> Handle -> IO Integer
sftpWriteFileFromHandler sftph fh =
  let
    go :: Integer -> Ptr a -> IO Integer
    go done buffer = do
      sz <- hGetBuf fh buffer bufferSize
      send 0 (fromIntegral sz) buffer
      let newDone = done + fromIntegral sz
      if sz < bufferSize
        then return newDone
        else go newDone buffer

    send :: Int -> CLong -> Ptr a -> IO ()
    send _ 0 _ = return ()
    send written size buf = do
      sent <- handleInt (Just sftph)
                           $ libssh2_sftp_write (toPointer sftph)
                                                   (buf `plusPtr` written)
                                                   (fromIntegral size)
      send (written + fromIntegral sent) (size - fromIntegral sent) buf

    bufferSize :: Int
    bufferSize = 0x100000

  in allocaBytes bufferSize $ go 0

data SftpAttributes = SftpAttributes {
  saFlags :: CULong,
  saFileSize :: CULLong,
  saUid :: CULong,
  saGid :: CULong,
  saPermissions :: CULong,
  saAtime :: CULong,
  saMtime :: CULong
  } deriving (Show, Eq)

-- | Get sftp attributes from the sftp handler
sftpFstat :: SftpHandle
          -> IO (SftpAttributes)
sftpFstat sftph = do
  allocaBytes 56 $ \sftpattrptr -> do
    _ <- handleInt (Just sftph) $
       libssh2_sftp_fstat_ex (toPointer sftph) sftpattrptr 0
    parseSftpAttributes sftpattrptr

parseSftpAttributes :: Ptr a -> IO SftpAttributes -- TODO why not storable?
parseSftpAttributes sftpattrptr = do
    flags<- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CULong}) sftpattrptr
    size <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CULLong}) sftpattrptr
    uid  <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CULong}) sftpattrptr
    gid  <- (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CULong}) sftpattrptr
    perm <- (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CULong}) sftpattrptr
    atime<- (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO C2HSImp.CULong}) sftpattrptr
    mtime<- (\ptr -> do {C2HSImp.peekByteOff ptr 48 :: IO C2HSImp.CULong}) sftpattrptr

    return $ SftpAttributes flags size uid gid perm atime mtime

-- | Delete file from SFTP server
sftpDeleteFile :: Sftp     -- ^ Opened sftp session
               -> FilePath -- ^ Path to the file to be deleted
               -> IO ()
sftpDeleteFile sftp path = do
  withCStringLen path $ \(str,len) -> do
    void . handleInt (Just sftp) $
      libssh2_sftp_unlink_ex (toPointer sftp) str (toEnum len)

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_init"
  initialize_'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_exit"
  exit'_ :: (IO ())

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_init_ex"
  libssh2_session_init_ex :: ((C2HSImp.FunPtr (C2HSImp.CULong -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO (C2HSImp.Ptr ()))))) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO ())))) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO (C2HSImp.Ptr ())))))) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_free"
  freeSession_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_disconnect_ex"
  disconnectSessionEx'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_set_blocking"
  setBlocking'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_handshake"
  handshake_'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_init"
  initKnownHosts_'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_free"
  freeKnownHosts'_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_readfile"
  knownHostsReadFile_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_session_hostkey"
  getHostKey'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_knownhost_checkp"
  checkKnownHost_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_userauth_publickey_fromfile_ex"
  publicKeyAuthFile_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_userauth_password_ex"
  libssh2_userauth_password_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO ())))))) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_open_ex"
  openSessionChannelEx'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO (C2HSImp.Ptr ())))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_process_startup"
  channelProcessStartup_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_request_pty_ex"
  requestPTYEx'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_read_ex"
  libssh2_channel_read_ex :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_write_ex"
  libssh2_channel_write_ex :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong)))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_send_eof"
  channelSendEOF_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_wait_eof"
  channelWaitEOF_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_trace"
  setTraceMode'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
  libssh2_channel_eof :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_eof"
  channelIsEOF'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_close"
  closeChannel_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_free"
  freeChannel_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_status"
  channelExitStatus'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_channel_get_exit_signal"
  channelExitSignal_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_send64"
  scpSendChannel_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CLLong -> (C2HSImp.CLong -> (C2HSImp.CLong -> (IO (C2HSImp.Ptr ()))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_scp_recv"
  libssh2_scp_recv :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_init"
  sftpInit_'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_shutdown"
  sftpShutdown_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_open_ex"
  libssh2_sftp_open_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CULong -> (C2HSImp.CLong -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_readdir_ex"
  libssh2_sftp_readdir_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_close_handle"
  libssh2_sftp_close_handle :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_rename_ex"
  libssh2_sftp_rename_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CLong -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_read"
  libssh2_sftp_read :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_write"
  libssh2_sftp_write :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CLong))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_fstat_ex"
  libssh2_sftp_fstat_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Network/SSH/Client/LibSSH2/Foreign.chs.h libssh2_sftp_unlink_ex"
  libssh2_sftp_unlink_ex :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))