-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (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,
   keepaliveConfig,
   handshake,
   setBlocking,

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

   -- * Authentication
   publicKeyAuthFile,
   usernamePasswordAuth,

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

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

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

   -- * SSH Agent functions
   Agent (..), AgentPublicKey,
   agentInit,
   agentConnect, agentDisconnect,
   agentListIdentities,
   agentGetIdentity,
   agentGetIdentities,
   agentFree,
   agentPublicKeyComment,
   agentPublicKeyBlob,
   agentUserAuth,
   agentAuthenticate,

   -- * 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.Exception (throw, tryJust)
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, withFdSocket)
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
  | KEY_ECDSA_256
  | KEY_ECDSA_384
  | KEY_ECDSA_521
  | KEY_ED25519
  | KEY_UNKNOWN
  deriving (KnownHostType -> KnownHostType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownHostType -> KnownHostType -> Bool
$c/= :: KnownHostType -> KnownHostType -> Bool
== :: KnownHostType -> KnownHostType -> Bool
$c== :: KnownHostType -> KnownHostType -> Bool
Eq, Int -> KnownHostType -> ShowS
[KnownHostType] -> ShowS
KnownHostType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownHostType] -> ShowS
$cshowList :: [KnownHostType] -> ShowS
show :: KnownHostType -> String
$cshow :: KnownHostType -> String
showsPrec :: Int -> KnownHostType -> ShowS
$cshowsPrec :: Int -> KnownHostType -> ShowS
Show)

kht2int :: KnownHostType -> CInt
kht2int :: KnownHostType -> CInt
kht2int KnownHostType
TYPE_MASK     = CInt
0xffff
kht2int KnownHostType
TYPE_PLAIN    = CInt
1
kht2int KnownHostType
TYPE_SHA1     = CInt
2
kht2int KnownHostType
TYPE_CUSTOM   = CInt
3
kht2int KnownHostType
KEYENC_MASK   = CInt
3 forall a. Bits a => a -> Int -> a
`shiftL` Int
16
kht2int KnownHostType
KEYENC_RAW    = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
16
kht2int KnownHostType
KEYENC_BASE64 = CInt
2 forall a. Bits a => a -> Int -> a
`shiftL` Int
16
kht2int KnownHostType
KEY_MASK      = CInt
15 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_SHIFT     = CInt
18
kht2int KnownHostType
KEY_RSA1      = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_SSHRSA    = CInt
2 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_SSHDSS    = CInt
3 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_ECDSA_256 = CInt
4 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_ECDSA_384 = CInt
5 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_ECDSA_521 = CInt
6 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_ED25519   = CInt
7 forall a. Bits a => a -> Int -> a
`shiftL` Int
18
kht2int KnownHostType
KEY_UNKNOWN   = CInt
15 forall a. Bits a => a -> Int -> a
`shiftL` Int
18

int2kht :: CInt -> KnownHostType
int2kht :: CInt -> KnownHostType
int2kht CInt
0xffff = KnownHostType
TYPE_MASK
int2kht CInt
1      = KnownHostType
TYPE_PLAIN
int2kht CInt
2      = KnownHostType
TYPE_SHA1
int2kht CInt
3      = KnownHostType
TYPE_CUSTOM
int2kht CInt
18     = KnownHostType
KEY_SHIFT
int2kht CInt
i
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
3 forall a. Bits a => a -> Int -> a
`shiftL` Int
16 = KnownHostType
KEYENC_MASK
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
16 = KnownHostType
KEYENC_RAW
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
2 forall a. Bits a => a -> Int -> a
`shiftL` Int
16 = KnownHostType
KEYENC_BASE64
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
15 forall a. Bits a => a -> Int -> a
`shiftL` Int
18 = KnownHostType
KEY_MASK
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
18 = KnownHostType
KEY_RSA1
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
2 forall a. Bits a => a -> Int -> a
`shiftL` Int
18 = KnownHostType
KEY_SSHRSA
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
3 forall a. Bits a => a -> Int -> a
`shiftL` Int
18 = KnownHostType
KEY_SSHDSS
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
4 forall a. Bits a => a -> Int -> a
`shiftL` Int
18  = KnownHostType
KEY_ECDSA_256
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
5 forall a. Bits a => a -> Int -> a
`shiftL` Int
18  = KnownHostType
KEY_ECDSA_384
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
6 forall a. Bits a => a -> Int -> a
`shiftL` Int
18  = KnownHostType
KEY_ECDSA_521
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
7 forall a. Bits a => a -> Int -> a
`shiftL` Int
18  = KnownHostType
KEY_ED25519
  | CInt
i forall a. Eq a => a -> a -> Bool
== CInt
15 forall a. Bits a => a -> Int -> a
`shiftL` Int
18 = KnownHostType
KEY_UNKNOWN
  | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unsupported known host type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CInt
i

typemask2int :: [KnownHostType] -> CInt
typemask2int :: [KnownHostType] -> CInt
typemask2int [KnownHostType]
list = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) CInt
0 (forall a b. (a -> b) -> [a] -> [b]
map KnownHostType -> CInt
kht2int [KnownHostType]
list)

-- | Host key types. See libssh2 documentation.
data HostKeyType =
    UNKNOWN
  | RSA
  | DSS
  | ECDSA_256
  | ECDSA_384
  | ECDSA_521
  | ED25519
  deriving (Int -> HostKeyType
HostKeyType -> Int
HostKeyType -> [HostKeyType]
HostKeyType -> HostKeyType
HostKeyType -> HostKeyType -> [HostKeyType]
HostKeyType -> HostKeyType -> HostKeyType -> [HostKeyType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HostKeyType -> HostKeyType -> HostKeyType -> [HostKeyType]
$cenumFromThenTo :: HostKeyType -> HostKeyType -> HostKeyType -> [HostKeyType]
enumFromTo :: HostKeyType -> HostKeyType -> [HostKeyType]
$cenumFromTo :: HostKeyType -> HostKeyType -> [HostKeyType]
enumFromThen :: HostKeyType -> HostKeyType -> [HostKeyType]
$cenumFromThen :: HostKeyType -> HostKeyType -> [HostKeyType]
enumFrom :: HostKeyType -> [HostKeyType]
$cenumFrom :: HostKeyType -> [HostKeyType]
fromEnum :: HostKeyType -> Int
$cfromEnum :: HostKeyType -> Int
toEnum :: Int -> HostKeyType
$ctoEnum :: Int -> HostKeyType
pred :: HostKeyType -> HostKeyType
$cpred :: HostKeyType -> HostKeyType
succ :: HostKeyType -> HostKeyType
$csucc :: HostKeyType -> HostKeyType
Enum, HostKeyType -> HostKeyType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostKeyType -> HostKeyType -> Bool
$c/= :: HostKeyType -> HostKeyType -> Bool
== :: HostKeyType -> HostKeyType -> Bool
$c== :: HostKeyType -> HostKeyType -> Bool
Eq, Eq HostKeyType
HostKeyType -> HostKeyType -> Bool
HostKeyType -> HostKeyType -> Ordering
HostKeyType -> HostKeyType -> HostKeyType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HostKeyType -> HostKeyType -> HostKeyType
$cmin :: HostKeyType -> HostKeyType -> HostKeyType
max :: HostKeyType -> HostKeyType -> HostKeyType
$cmax :: HostKeyType -> HostKeyType -> HostKeyType
>= :: HostKeyType -> HostKeyType -> Bool
$c>= :: HostKeyType -> HostKeyType -> Bool
> :: HostKeyType -> HostKeyType -> Bool
$c> :: HostKeyType -> HostKeyType -> Bool
<= :: HostKeyType -> HostKeyType -> Bool
$c<= :: HostKeyType -> HostKeyType -> Bool
< :: HostKeyType -> HostKeyType -> Bool
$c< :: HostKeyType -> HostKeyType -> Bool
compare :: HostKeyType -> HostKeyType -> Ordering
$ccompare :: HostKeyType -> HostKeyType -> Ordering
Ord)

instance Show HostKeyType where
  show :: HostKeyType -> String
show HostKeyType
UNKNOWN = String
"unknown"
  show HostKeyType
RSA = String
"ssh-rsa"
  show HostKeyType
DSS = String
"ssh-dss"
  show HostKeyType
ECDSA_256 = String
"ecdsa-sha2-nistp256"
  show HostKeyType
ECDSA_384 = String
"ecdsa-sha2-nistp384"
  show HostKeyType
ECDSA_521 = String
"ecdsa-sha2-nistp521"
  show HostKeyType
ED25519 = String
"ssh-ed25519"

int2hkt :: Integral n => n -> HostKeyType
int2hkt :: forall n. Integral n => n -> HostKeyType
int2hkt = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Result of matching host against known_hosts.
data KnownHostResult =
    MATCH
  | MISMATCH
  | NOTFOUND
  | FAILURE
  deriving (KnownHostResult -> KnownHostResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownHostResult -> KnownHostResult -> Bool
$c/= :: KnownHostResult -> KnownHostResult -> Bool
== :: KnownHostResult -> KnownHostResult -> Bool
$c== :: KnownHostResult -> KnownHostResult -> Bool
Eq, Int -> KnownHostResult -> ShowS
[KnownHostResult] -> ShowS
KnownHostResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownHostResult] -> ShowS
$cshowList :: [KnownHostResult] -> ShowS
show :: KnownHostResult -> String
$cshow :: KnownHostResult -> String
showsPrec :: Int -> KnownHostResult -> ShowS
$cshowsPrec :: Int -> KnownHostResult -> ShowS
Show, Eq KnownHostResult
KnownHostResult -> KnownHostResult -> Bool
KnownHostResult -> KnownHostResult -> Ordering
KnownHostResult -> KnownHostResult -> KnownHostResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KnownHostResult -> KnownHostResult -> KnownHostResult
$cmin :: KnownHostResult -> KnownHostResult -> KnownHostResult
max :: KnownHostResult -> KnownHostResult -> KnownHostResult
$cmax :: KnownHostResult -> KnownHostResult -> KnownHostResult
>= :: KnownHostResult -> KnownHostResult -> Bool
$c>= :: KnownHostResult -> KnownHostResult -> Bool
> :: KnownHostResult -> KnownHostResult -> Bool
$c> :: KnownHostResult -> KnownHostResult -> Bool
<= :: KnownHostResult -> KnownHostResult -> Bool
$c<= :: KnownHostResult -> KnownHostResult -> Bool
< :: KnownHostResult -> KnownHostResult -> Bool
$c< :: KnownHostResult -> KnownHostResult -> Bool
compare :: KnownHostResult -> KnownHostResult -> Ordering
$ccompare :: KnownHostResult -> KnownHostResult -> Ordering
Ord, Int -> KnownHostResult
KnownHostResult -> Int
KnownHostResult -> [KnownHostResult]
KnownHostResult -> KnownHostResult
KnownHostResult -> KnownHostResult -> [KnownHostResult]
KnownHostResult
-> KnownHostResult -> KnownHostResult -> [KnownHostResult]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KnownHostResult
-> KnownHostResult -> KnownHostResult -> [KnownHostResult]
$cenumFromThenTo :: KnownHostResult
-> KnownHostResult -> KnownHostResult -> [KnownHostResult]
enumFromTo :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
$cenumFromTo :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
enumFromThen :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
$cenumFromThen :: KnownHostResult -> KnownHostResult -> [KnownHostResult]
enumFrom :: KnownHostResult -> [KnownHostResult]
$cenumFrom :: KnownHostResult -> [KnownHostResult]
fromEnum :: KnownHostResult -> Int
$cfromEnum :: KnownHostResult -> Int
toEnum :: Int -> KnownHostResult
$ctoEnum :: Int -> KnownHostResult
pred :: KnownHostResult -> KnownHostResult
$cpred :: KnownHostResult -> KnownHostResult
succ :: KnownHostResult -> KnownHostResult
$csucc :: KnownHostResult -> KnownHostResult
Enum)

int2khresult :: CInt -> KnownHostResult
int2khresult :: CInt -> KnownHostResult
int2khresult = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

data KnownHost = KnownHost {
  KnownHost -> CUInt
khMagic :: CUInt,
  KnownHost -> Ptr ()
khNode :: Ptr (),
  KnownHost -> String
khName :: String,
  KnownHost -> String
khKey :: String,
  KnownHost -> [KnownHostType]
khTypeMask :: [KnownHostType] }
  deriving (KnownHost -> KnownHost -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownHost -> KnownHost -> Bool
$c/= :: KnownHost -> KnownHost -> Bool
== :: KnownHost -> KnownHost -> Bool
$c== :: KnownHost -> KnownHost -> Bool
Eq, Int -> KnownHost -> ShowS
[KnownHost] -> ShowS
KnownHost -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownHost] -> ShowS
$cshowList :: [KnownHost] -> ShowS
show :: KnownHost -> String
$cshow :: KnownHost -> String
showsPrec :: Int -> KnownHost -> ShowS
$cshowsPrec :: Int -> KnownHost -> ShowS
Show)

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

ssh2socket :: Socket
           -> IO CInt
ssh2socket :: Socket -> IO CInt
ssh2socket Socket
s =
  forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s forall (f :: * -> *) a. Applicative f => a -> f a
pure

initialize_ :: (Bool) -> IO ((Int))
initialize_ :: Bool -> IO Int
initialize_ Bool
a1 =
  let {a1' :: CInt
a1' = Bool -> CInt
init_crypto Bool
a1} in 
  CInt -> IO CInt
initialize_'_ CInt
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Initialize libssh2. Pass True to enable encryption
-- or False to disable it.
initialize :: Bool -> IO ()
initialize :: Bool -> IO ()
initialize Bool
flags = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. Maybe a
Nothing :: Maybe Session) forall a b. (a -> b) -> a -> b
$ Bool -> IO Int
initialize_ Bool
flags

-- | Deinitialize libssh2.
exit :: IO ()
exit :: IO ()
exit =
  IO ()
exit'_ forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

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


-- | Create Session object
initSession :: IO Session
initSession :: IO Session
initSession = forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (forall a. Maybe a
Nothing :: Maybe Session) Ptr () -> IO Session
sessionFromPointer forall a b. (a -> b) -> a -> b
$
  FunPtr (CULong -> Ptr (Ptr ()) -> IO (Ptr ()))
-> FunPtr (Ptr () -> Ptr (Ptr ()) -> IO ())
-> FunPtr (Ptr () -> CULong -> Ptr (Ptr ()) -> IO (Ptr ()))
-> Ptr ()
-> IO (Ptr ())
libssh2_session_init_ex forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr

freeSession_ :: (Session) -> IO ((Int))
freeSession_ :: Session -> IO Int
freeSession_ Session
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO CInt
freeSession_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  return (res')

{-# LINE 269 "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 :: Session -> Int -> String -> String -> IO Int
disconnectSessionEx Session
a1 Int
a2 String
a3 String
a4 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  let {a2' :: CInt
a2' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  forall a. String -> (Ptr CChar -> IO a) -> IO a
C2HSImp.withCString String
a3 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a3' -> 
  forall a. String -> (Ptr CChar -> IO a) -> IO a
C2HSImp.withCString String
a4 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a4' -> 
  Ptr () -> CInt -> Ptr CChar -> Ptr CChar -> IO CInt
disconnectSessionEx'_ Ptr ()
a1' CInt
a2' Ptr CChar
a3' Ptr CChar
a4' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = fromIntegral res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 276 "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 ""

keepaliveConfig :: (Session) -> (Bool) -> (Int) -> IO ()
keepaliveConfig :: Session -> Bool -> Int -> IO ()
keepaliveConfig Session
a1 Bool
a2 Int
a3 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  let {a2' :: CInt
a2' = Bool -> CInt
bool2int Bool
a2} in 
  let {a3' :: CUInt
a3' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a3} in 
  Ptr () -> CInt -> CUInt -> IO ()
keepaliveConfig'_ Ptr ()
a1' CInt
a2' CUInt
a3' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

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


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

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


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

session_handshake :: (Ptr ()) -> (CInt) -> IO ((Int))
session_handshake :: Ptr () -> CInt -> IO Int
session_handshake Ptr ()
a1 CInt
a2 =
  let {a1' :: Ptr ()
a1' = forall a. a -> a
id Ptr ()
a1} in 
  let {a2' :: CInt
a2' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
a2} in 
  Ptr () -> CInt -> IO CInt
session_handshake'_ Ptr ()
a1' CInt
a2' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


handshake_ :: Session -> Socket -> IO Int
handshake_ session socket = do
  session_handshake (toPointer session) =<< ssh2socket socket

-- | Run SSH handshake on network socket.
handshake :: Session -> Socket -> IO ()
handshake :: Session -> Socket -> IO ()
handshake Session
session Socket
socket = do
  Session -> Maybe Socket -> IO ()
sessionSetSocket Session
session (forall a. a -> Maybe a
Just Socket
socket)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just Session
session)
       forall a b. (a -> b) -> a -> b
$ Session -> Socket -> IO Int
handshake_ Session
session Socket
socket

initKnownHosts_ :: (Session) -> IO ((Ptr ()))
initKnownHosts_ :: Session -> IO (Ptr ())
initKnownHosts_ Session
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO (Ptr ())
initKnownHosts_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = forall a. a -> a
id Ptr ()
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


-- | Create KnownHosts object for given session.
initKnownHosts :: Session -> IO KnownHosts
initKnownHosts :: Session -> IO KnownHosts
initKnownHosts Session
session = forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (forall a. Maybe a
Nothing :: Maybe Session) Ptr () -> IO KnownHosts
knownHostsFromPointer forall a b. (a -> b) -> a -> b
$ Session -> IO (Ptr ())
initKnownHosts_ Session
session

-- | Free KnownHosts object's memory
freeKnownHosts :: (KnownHosts) -> IO ()
freeKnownHosts :: KnownHosts -> IO ()
freeKnownHosts KnownHosts
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer KnownHosts
a1} in 
  Ptr () -> IO ()
freeKnownHosts'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 322 "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 325 "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

getHostKey_ :: (Session) -> IO ((Ptr CChar), (Size), (CInt))
getHostKey_ :: Session -> IO (Ptr CChar, CULong, CInt)
getHostKey_ Session
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a2' -> 
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a3' -> 
  Ptr () -> Ptr CULong -> Ptr CInt -> IO (Ptr CChar)
getHostKey_'_ Ptr ()
a1' Ptr CULong
a2' Ptr CInt
a3' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CChar
res ->
  let {res' :: Ptr CChar
res' = forall a. a -> a
id Ptr CChar
res} in
  forall a. Storable a => Ptr a -> IO a
peek  Ptr CULong
a2'forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CULong
a2'' -> 
  forall a. Storable a => Ptr a -> IO a
peek  Ptr CInt
a3'forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
a3'' -> 
  forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CChar
res', CULong
a2'', CInt
a3'')

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


-- | Get remote host public key and its type
getHostKey :: Session -> IO (BSS.ByteString, HostKeyType)
getHostKey session = do
  (keyPtr, keySize, keyType) <- getHostKey_ session
  key <- BSS.packCStringLen (keyPtr, fromIntegral keySize)
  pure (key, int2hkt keyType)

checkKnownHost_ :: (KnownHosts) -> (String) -> (Int) -> (Ptr CChar) -> (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 
  let {a4' = id a4} in 
  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 350 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}


-- | Check host data against known hosts.
checkKnownHost :: KnownHosts         --
               -> String             -- ^ Host name
               -> Int                -- ^ Port number (usually 22)
               -> BSS.ByteString     -- ^ Host public key
               -> [KnownHostType]    -- ^ Host flags (see libssh2 documentation)
               -> IO KnownHostResult
checkKnownHost :: KnownHosts
-> String
-> Int
-> ByteString
-> [KnownHostType]
-> IO KnownHostResult
checkKnownHost KnownHosts
kh String
host Int
port ByteString
key [KnownHostType]
flags = forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSS.useAsCStringLen ByteString
key forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
keyPtr, Int
keySize) -> do
  KnownHosts
-> String
-> Int
-> Ptr CChar
-> Int
-> [KnownHostType]
-> Ptr ()
-> IO KnownHostResult
checkKnownHost_ KnownHosts
kh String
host Int
port Ptr CChar
keyPtr Int
keySize [KnownHostType]
flags forall a. Ptr a
nullPtr

-- TODO: I don't see the '&' in the libssh2 docs?
publicKeyAuthFile_ :: (Session) -> (String) -> (String) -> (String) -> (String) -> IO ((Int))
publicKeyAuthFile_ :: Session -> String -> String -> String -> String -> IO Int
publicKeyAuthFile_ Session
a1 String
a2 String
a3 String
a4 String
a5 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  (\String
s (Ptr CChar, CUInt) -> IO Int
f -> forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(Ptr CChar
p, Int
n) -> (Ptr CChar, CUInt) -> IO Int
f (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
a2'1, CUInt
a2'2) -> 
  forall a. String -> (Ptr CChar -> IO a) -> IO a
C2HSImp.withCString String
a3 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a3' -> 
  forall a. String -> (Ptr CChar -> IO a) -> IO a
C2HSImp.withCString String
a4 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a4' -> 
  forall a. String -> (Ptr CChar -> IO a) -> IO a
C2HSImp.withCString String
a5 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a5' -> 
  Ptr ()
-> Ptr CChar
-> CUInt
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> IO CInt
publicKeyAuthFile_'_ Ptr ()
a1' Ptr CChar
a2'1  CUInt
a2'2 Ptr CChar
a3' Ptr CChar
a4' Ptr CChar
a5' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 368 "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 -> String -> String -> String -> String -> IO ()
publicKeyAuthFile Session
session String
username String
public String
private String
passphrase = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just Session
session) forall a b. (a -> b) -> a -> b
$
  Session -> String -> String -> String -> String -> IO Int
publicKeyAuthFile_ Session
session String
username String
public String
private String
passphrase

-- | Perform username/password authentication.
usernamePasswordAuth :: Session -- ^ Session
                     -> String  -- ^ Username
                     -> String  -- ^ Password
                     -> IO ()
usernamePasswordAuth :: Session -> String -> String -> IO ()
usernamePasswordAuth Session
session String
username String
password =
  forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
username forall a b. (a -> b) -> a -> b
$ \Ptr CChar
usernameptr -> do
    forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
password forall a b. (a -> b) -> a -> b
$ \Ptr CChar
passwordptr -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just Session
session) forall a b. (a -> b) -> a -> b
$
        Ptr ()
-> Ptr CChar
-> CUInt
-> Ptr CChar
-> CUInt
-> FunPtr
     (Ptr () -> Ptr (Ptr CChar) -> Ptr CInt -> Ptr (Ptr ()) -> IO ())
-> IO CInt
libssh2_userauth_password_ex (forall p. ToPointer p => p -> Ptr ()
toPointer Session
session) Ptr CChar
usernameptr (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
username) Ptr CChar
passwordptr (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
password) forall a. FunPtr a
nullFunPtr

openSessionChannelEx :: (Session) -> (String) -> (Int) -> (Int) -> (String) -> IO ((Ptr ()))
openSessionChannelEx :: Session -> String -> Int -> Int -> String -> IO (Ptr ())
openSessionChannelEx Session
a1 String
a2 Int
a3 Int
a4 String
a5 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  (\String
s (Ptr CChar, CUInt) -> IO (Ptr ())
f -> forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(Ptr CChar
p, Int
n) -> (Ptr CChar, CUInt) -> IO (Ptr ())
f (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
a2'1, CUInt
a2'2) -> 
  let {a3' :: CUInt
a3' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a3} in 
  let {a4' :: CUInt
a4' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a4} in 
  (\String
s (Ptr CChar, CUInt) -> IO (Ptr ())
f -> forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(Ptr CChar
p, Int
n) -> (Ptr CChar, CUInt) -> IO (Ptr ())
f (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a5 forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
a5'1, CUInt
a5'2) -> 
  Ptr ()
-> Ptr CChar
-> CUInt
-> CUInt
-> CUInt
-> Ptr CChar
-> CUInt
-> IO (Ptr ())
openSessionChannelEx'_ Ptr ()
a1' Ptr CChar
a2'1  CUInt
a2'2 CUInt
a3' CUInt
a4' Ptr CChar
a5'1  CUInt
a5'2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = forall a. a -> a
id Ptr ()
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


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

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


directTcpIpEx :: Session -> String -> Int -> String -> Int -> IO Channel
directTcpIpEx s host port shost sport = handleNullPtr (Just s) (channelFromPointer s) $ directTcpIpEx_ s host port shost sport

-- | Open a channel for session.
openChannelSession :: Session -> IO Channel
openChannelSession :: Session -> IO Channel
openChannelSession Session
s = forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Channel
channelFromPointer Session
s) forall a b. (a -> b) -> a -> b
$
  Session -> String -> Int -> Int -> String -> IO (Ptr ())
openSessionChannelEx Session
s String
"session" Int
65536 Int
32768 String
""

channelProcess :: Channel -> String -> String -> IO ()
channelProcess :: Channel -> String -> String -> IO ()
channelProcess Channel
ch String
kind String
command = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Channel -> Session
channelSession Channel
ch) forall a b. (a -> b) -> a -> b
$
  Channel -> String -> String -> IO Int
channelProcessStartup_ Channel
ch String
kind String
command

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

channelProcessStartup_ :: (Channel) -> (String) -> (String) -> IO ((Int))
channelProcessStartup_ :: Channel -> String -> String -> IO Int
channelProcessStartup_ Channel
a1 String
a2 String
a3 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  (\String
s (Ptr CChar, CUInt) -> IO Int
f -> forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(Ptr CChar
p, Int
n) -> (Ptr CChar, CUInt) -> IO Int
f (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
a2'1, CUInt
a2'2) -> 
  (\String
s (Ptr CChar, CUInt) -> IO Int
f -> forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(Ptr CChar
p, Int
n) -> (Ptr CChar, CUInt) -> IO Int
f (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a3 forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
a3'1, CUInt
a3'2) -> 
  Ptr () -> Ptr CChar -> CUInt -> Ptr CChar -> CUInt -> IO CInt
channelProcessStartup_'_ Ptr ()
a1' Ptr CChar
a2'1  CUInt
a2'2 Ptr CChar
a3'1  CUInt
a3'2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 423 "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 :: Channel -> String -> String -> Int -> Int -> Int -> Int -> IO Int
requestPTYEx Channel
a1 String
a2 String
a3 Int
a4 Int
a5 Int
a6 Int
a7 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  (\String
s (Ptr CChar, CUInt) -> IO Int
f -> forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(Ptr CChar
p, Int
n) -> (Ptr CChar, CUInt) -> IO Int
f (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a2 forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
a2'1, CUInt
a2'2) -> 
  (\String
s (Ptr CChar, CUInt) -> IO Int
f -> forall a. String -> (CStringLen -> IO a) -> IO a
C2HSImp.withCStringLen String
s (\(Ptr CChar
p, Int
n) -> (Ptr CChar, CUInt) -> IO Int
f (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))) String
a3 forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
a3'1, CUInt
a3'2) -> 
  let {a4' :: CInt
a4' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a4} in 
  let {a5' :: CInt
a5' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a5} in 
  let {a6' :: CInt
a6' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a6} in 
  let {a7' :: CInt
a7' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a7} in 
  Ptr ()
-> Ptr CChar
-> CUInt
-> Ptr CChar
-> CUInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO CInt
requestPTYEx'_ Ptr ()
a1' Ptr CChar
a2'1  CUInt
a2'2 Ptr CChar
a3'1  CUInt
a3'2 CInt
a4' CInt
a5' CInt
a6' CInt
a7' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 437 "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 :: Channel -> CULong -> IO ByteString
readChannel Channel
c CULong
sz = Channel -> Int -> CULong -> IO ByteString
readChannelEx Channel
c Int
0 CULong
sz

-- | Read data from channel.
readChannelStderr :: Channel         --
                  -> Size             -- ^ Amount of data to read
                  -> IO BSS.ByteString
readChannelStderr :: Channel -> CULong -> IO ByteString
readChannelStderr Channel
c CULong
sz = Channel -> Int -> CULong -> IO ByteString
readChannelEx Channel
c Int
1 CULong
sz

-- | Write data to channel.
writeChannel :: Channel -> BSS.ByteString -> IO ()
writeChannel :: Channel -> ByteString -> IO ()
writeChannel Channel
ch ByteString
bs =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BSS.unsafeUseAsCString ByteString
bs forall a b. (a -> b) -> a -> b
$ Int -> CULong -> Ptr CChar -> IO ()
go Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BSS.length ByteString
bs)
  where
    go :: Int -> CULong -> CString -> IO ()
    go :: Int -> CULong -> Ptr CChar -> IO ()
go Int
offset CULong
len Ptr CChar
cstr = do
      CLong
written <- forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Channel -> Session
channelSession Channel
ch)
                           forall a b. (a -> b) -> a -> b
$ Ptr () -> CInt -> Ptr CChar -> CULong -> IO CLong
libssh2_channel_write_ex (forall p. ToPointer p => p -> Ptr ()
toPointer Channel
ch)
                                                         CInt
0
                                                         (Ptr CChar
cstr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
                                                         (forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
len)
      if forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
written forall a. Ord a => a -> a -> Bool
< CULong
len
        then Int -> CULong -> Ptr CChar -> IO ()
go (Int
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
written) (CULong
len forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
written) Ptr CChar
cstr
        else forall (m :: * -> *) a. Monad m => a -> m a
return ()

channelSendEOF_ :: (Channel) -> IO ((Int))
channelSendEOF_ :: Channel -> IO Int
channelSendEOF_ Channel
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
channelSendEOF_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 477 "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 483 "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 :: TraceFlag -> CInt
tf2int TraceFlag
T_TRANS = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
1
tf2int TraceFlag
T_KEX   = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2
tf2int TraceFlag
T_AUTH  = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
3
tf2int TraceFlag
T_CONN  = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
4
tf2int TraceFlag
T_SCP   = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
5
tf2int TraceFlag
T_SFTP  = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
6
tf2int TraceFlag
T_ERROR = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
7
tf2int TraceFlag
T_PUBLICKEY = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
8
tf2int TraceFlag
T_SOCKET = CInt
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
9

trace2int :: [TraceFlag] -> CInt
trace2int :: [TraceFlag] -> CInt
trace2int [TraceFlag]
flags = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) CInt
0 (forall a b. (a -> b) -> [a] -> [b]
map TraceFlag -> CInt
tf2int [TraceFlag]
flags)

setTraceMode :: (Session) -> ([TraceFlag]) -> IO ()
setTraceMode :: Session -> [TraceFlag] -> IO ()
setTraceMode Session
a1 [TraceFlag]
a2 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  let {a2' :: CInt
a2' = [TraceFlag] -> CInt
trace2int [TraceFlag]
a2} in 
  Ptr () -> CInt -> IO CInt
setTraceMode'_ Ptr ()
a1' CInt
a2' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 515 "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 535 "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 :: Channel -> Handle -> CLong -> IO Integer
readChannelToHandle Channel
ch Handle
h CLong
fileSize = do
    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buffer ->
        Channel
-> Ptr CChar
-> Int
-> CLong
-> (Ptr CChar -> Int -> IO ())
-> IO Integer
readChannelCB Channel
ch Ptr CChar
buffer Int
bufferSize CLong
fileSize forall {a}. Ptr a -> Int -> IO ()
callback
  where
    callback :: Ptr a -> Int -> IO ()
callback Ptr a
buffer Int
size = forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr a
buffer Int
size

    bufferSize :: Int
    bufferSize :: Int
bufferSize = Int
0x100000

readChannelCB :: Channel -> CString -> Int -> Offset -> (CString -> Int -> IO ()) -> IO Integer
readChannelCB :: Channel
-> Ptr CChar
-> Int
-> CLong
-> (Ptr CChar -> Int -> IO ())
-> IO Integer
readChannelCB Channel
ch Ptr CChar
buffer Int
bufferSize CLong
fileSize Ptr CChar -> Int -> IO ()
callback =
  let go :: t -> IO Integer
go t
got = do
        let toRead :: t
toRead = forall a. Ord a => a -> a -> a
min (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
fileSize forall a. Num a => a -> a -> a
- t
got) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufferSize)
        CLong
sz <- forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Channel -> Session
channelSession Channel
ch) forall a b. (a -> b) -> a -> b
$
                Ptr () -> CInt -> Ptr CChar -> CULong -> IO CLong
libssh2_channel_read_ex
{-# LINE 563 "src/Network/SSH/Client/LibSSH2/Foreign.chs" #-}

                  (toPointer ch)
                  0
                  buffer
                  (fromIntegral toRead)
        let isz :: Integer
            isz :: Integer
isz = forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sz
        Ptr CChar -> Int -> IO ()
callback Ptr CChar
buffer (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sz)
        CInt
eof <- Ptr () -> IO CInt
libssh2_channel_eof (forall p. ToPointer p => p -> Ptr ()
toPointer Channel
ch)
        let newGot :: t
newGot = t
got forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sz
        if  (CInt
eof forall a. Eq a => a -> a -> Bool
== CInt
1) Bool -> Bool -> Bool
|| (t
newGot forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
fileSize)
          then do
               forall (m :: * -> *) a. Monad m => a -> m a
return Integer
isz
          else do
               Integer
rest <- t -> IO Integer
go t
newGot
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
isz forall a. Num a => a -> a -> a
+ Integer
rest
  in forall {t}. Integral t => t -> IO Integer
go (Integer
0 :: Integer)

channelIsEOF :: (Channel) -> IO ((Bool))
channelIsEOF :: Channel -> IO Bool
channelIsEOF Channel
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
channelIsEOF'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  CInt -> IO Bool
handleBool CInt
res forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
res' ->
  forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 582 "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 585 "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_ :: Channel -> IO Int
freeChannel_ Channel
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
freeChannel_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  return (res')

{-# LINE 592 "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 :: Channel -> IO Int
channelExitStatus Channel
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Channel
a1} in 
  Ptr () -> IO CInt
channelExitStatus'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 600 "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 609 "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 622 "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 629 "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 :: Session -> String -> IO (Channel, CLong)
scpReceiveChannel Session
s String
path = do
  forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
path forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pathptr ->
     forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
144 forall a b. (a -> b) -> a -> b
$ \Ptr ()
statptr -> do
       Channel
channel <- forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Channel
channelFromPointer Session
s) forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr CChar -> Ptr () -> IO (Ptr ())
libssh2_scp_recv (forall p. ToPointer p => p -> Ptr ()
toPointer Session
s) Ptr CChar
pathptr Ptr ()
statptr
       CLong
size <- (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
48 :: IO C2HSImp.CLong}) Ptr ()
statptr
       forall (m :: * -> *) a. Monad m => a -> m a
return (Channel
channel, CLong
size)

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

pollChannelRead :: Channel -> IO Bool
pollChannelRead :: Channel -> IO Bool
pollChannelRead Channel
ch = do
  Maybe Socket
mbSocket <- Session -> IO (Maybe Socket)
sessionGetSocket (Channel -> Session
channelSession Channel
ch)
  case Maybe Socket
mbSocket of
    Maybe Socket
Nothing -> forall a. HasCallStack => String -> a
error String
"pollChannelRead without socket present"
    Just Socket
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

--
-- | Sftp support
--

-- SFTP File Transfer Flags. See libssh2 documentation
data SftpFileTransferFlags =
    FXF_READ
  | FXF_WRITE
  | FXF_APPEND
  | FXF_CREAT
  | FXF_TRUNC
  | FXF_EXCL
  deriving (SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
$c/= :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
== :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
$c== :: SftpFileTransferFlags -> SftpFileTransferFlags -> Bool
Eq, Int -> SftpFileTransferFlags -> ShowS
[SftpFileTransferFlags] -> ShowS
SftpFileTransferFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SftpFileTransferFlags] -> ShowS
$cshowList :: [SftpFileTransferFlags] -> ShowS
show :: SftpFileTransferFlags -> String
$cshow :: SftpFileTransferFlags -> String
showsPrec :: Int -> SftpFileTransferFlags -> ShowS
$cshowsPrec :: Int -> SftpFileTransferFlags -> ShowS
Show)

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

ftransferflags2int :: [SftpFileTransferFlags] -> CULong
ftransferflags2int :: [SftpFileTransferFlags] -> CULong
ftransferflags2int [SftpFileTransferFlags]
list = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) CULong
0 (forall a b. (a -> b) -> [a] -> [b]
map SftpFileTransferFlags -> CULong
ftf2int [SftpFileTransferFlags]
list)

-- | Flags for open_ex()
data OpenExFlags = OpenFile
                 | OpenDir
                 deriving (OpenExFlags -> OpenExFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenExFlags -> OpenExFlags -> Bool
$c/= :: OpenExFlags -> OpenExFlags -> Bool
== :: OpenExFlags -> OpenExFlags -> Bool
$c== :: OpenExFlags -> OpenExFlags -> Bool
Eq, Int -> OpenExFlags -> ShowS
[OpenExFlags] -> ShowS
OpenExFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenExFlags] -> ShowS
$cshowList :: [OpenExFlags] -> ShowS
show :: OpenExFlags -> String
$cshow :: OpenExFlags -> String
showsPrec :: Int -> OpenExFlags -> ShowS
$cshowsPrec :: Int -> OpenExFlags -> ShowS
Show)

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

sftpInit :: Session ->  IO Sftp
sftpInit :: Session -> IO Sftp
sftpInit Session
s = forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Sftp
sftpFromPointer Session
s) forall a b. (a -> b) -> a -> b
$
  Session -> IO (Ptr ())
sftpInit_ Session
s

sftpShutdown :: Sftp -> IO ()
sftpShutdown :: Sftp -> IO ()
sftpShutdown Sftp
sftp =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just Sftp
sftp) forall a b. (a -> b) -> a -> b
$ Sftp -> IO Int
sftpShutdown_ Sftp
sftp

sftpInit_ :: (Session) -> IO ((Ptr ()))
sftpInit_ :: Session -> IO (Ptr ())
sftpInit_ Session
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO (Ptr ())
sftpInit_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = forall a. a -> a
id Ptr ()
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


sftpShutdown_ :: (Sftp) -> IO ((Int))
sftpShutdown_ :: Sftp -> IO Int
sftpShutdown_ Sftp
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
a1} in 
  Ptr () -> IO CInt
sftpShutdown_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 703 "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 -> String -> IO SftpHandle
sftpOpenDir Sftp
sftp String
path =
  forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (forall a. a -> Maybe a
Just Sftp
sftp) ( Sftp -> Ptr () -> IO SftpHandle
sftpHandleFromPointer Sftp
sftp ) forall a b. (a -> b) -> a -> b
$
      Sftp
-> String
-> CLong
-> [SftpFileTransferFlags]
-> CInt
-> IO (Ptr ())
sftpOpen_ Sftp
sftp String
path CLong
0 [] (forall a. Num a => OpenExFlags -> a
oef2int OpenExFlags
OpenDir)

sftpOpen_ :: Sftp -> String -> CLong -> [SftpFileTransferFlags] -> CInt -> IO (Ptr ())
sftpOpen_ :: Sftp
-> String
-> CLong
-> [SftpFileTransferFlags]
-> CInt
-> IO (Ptr ())
sftpOpen_ Sftp
sftp String
path CLong
mode [SftpFileTransferFlags]
fl CInt
open_type =
  let flags :: CULong
flags = [SftpFileTransferFlags] -> CULong
ftransferflags2int [SftpFileTransferFlags]
fl
  in
    forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
path forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
pathP, Int
pathL) -> do
      Ptr ()
-> Ptr CChar -> CUInt -> CULong -> CLong -> CInt -> IO (Ptr ())
libssh2_sftp_open_ex (forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
sftp) Ptr CChar
pathP (forall a. Enum a => Int -> a
toEnum Int
pathL) CULong
flags CLong
mode CInt
open_type

-- | Read directory from file handler
sftpReadDir :: SftpHandle -> IO (Maybe (BSS.ByteString, SftpAttributes))
sftpReadDir :: SftpHandle -> IO (Maybe (ByteString, SftpAttributes))
sftpReadDir SftpHandle
sftph = do
  let bufflen :: Int
bufflen = Int
512
  forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufflen forall a b. (a -> b) -> a -> b
$ \Ptr CChar
bufptr -> do
    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 forall a b. (a -> b) -> a -> b
$ \Ptr ()
sftpattrptr -> do
      CInt
rc <- forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just SftpHandle
sftph) forall a b. (a -> b) -> a -> b
$
        Ptr ()
-> Ptr CChar -> CULong -> Ptr CChar -> CULong -> Ptr () -> IO CInt
libssh2_sftp_readdir_ex (forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph) Ptr CChar
bufptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufflen) forall a. Ptr a
nullPtr CULong
0 Ptr ()
sftpattrptr
      case CInt
rc forall a. Eq a => a -> a -> Bool
== CInt
0 of
        Bool
False -> do
         SftpAttributes
fstat    <- forall a. Ptr a -> IO SftpAttributes
parseSftpAttributes Ptr ()
sftpattrptr
         ByteString
filename <- CStringLen -> IO ByteString
BSS.packCStringLen (Ptr CChar
bufptr, forall a. IntResult a => a -> Int
intResult CInt
rc)
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (ByteString
filename, SftpAttributes
fstat)
        Bool
True ->
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Close file handle
sftpCloseHandle :: SftpHandle -> IO ()
sftpCloseHandle :: SftpHandle -> IO ()
sftpCloseHandle SftpHandle
sftph =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SftpHandle -> Sftp
sftpHandleSession SftpHandle
sftph) forall a b. (a -> b) -> a -> b
$
    Ptr () -> IO CInt
libssh2_sftp_close_handle (forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph)

data RenameFlag =
    RENAME_OVERWRITE
  | RENAME_ATOMIC
  | RENAME_NATIVE
  deriving (RenameFlag -> RenameFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenameFlag -> RenameFlag -> Bool
$c/= :: RenameFlag -> RenameFlag -> Bool
== :: RenameFlag -> RenameFlag -> Bool
$c== :: RenameFlag -> RenameFlag -> Bool
Eq, Int -> RenameFlag -> ShowS
[RenameFlag] -> ShowS
RenameFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenameFlag] -> ShowS
$cshowList :: [RenameFlag] -> ShowS
show :: RenameFlag -> String
$cshow :: RenameFlag -> String
showsPrec :: Int -> RenameFlag -> ShowS
$cshowsPrec :: Int -> RenameFlag -> ShowS
Show)

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

renameFlag2int :: [RenameFlag] -> CLong
renameFlag2int :: [RenameFlag] -> CLong
renameFlag2int [RenameFlag]
flags = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) CLong
0 (forall a b. (a -> b) -> [a] -> [b]
map RenameFlag -> CLong
rf2long [RenameFlag]
flags)

-- | Rename a file on the sftp server
sftpRenameFile :: Sftp     -- ^ Opened sftp session
               -> FilePath -- ^ Old file name
               -> FilePath -- ^ New file name
               -> IO ()
sftpRenameFile :: Sftp -> String -> String -> IO ()
sftpRenameFile Sftp
sftp String
src String
dest =
  Sftp -> String -> String -> [RenameFlag] -> IO ()
sftpRenameFileEx Sftp
sftp String
src String
dest [ RenameFlag
RENAME_NATIVE, RenameFlag
RENAME_ATOMIC, RenameFlag
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 -> String -> String -> [RenameFlag] -> IO ()
sftpRenameFileEx Sftp
sftp String
src String
dest [RenameFlag]
flags =
  forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
src forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
srcP, Int
srcL) ->
    forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
dest forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
destP, Int
destL) ->
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Sftp -> Session
sftpSession Sftp
sftp) forall a b. (a -> b) -> a -> b
$
         Ptr ()
-> Ptr CChar -> CUInt -> Ptr CChar -> CUInt -> CLong -> IO CInt
libssh2_sftp_rename_ex (forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
sftp) Ptr CChar
srcP (forall a. Enum a => Int -> a
toEnum Int
srcL) Ptr CChar
destP (forall a. Enum a => Int -> a
toEnum Int
destL) ([RenameFlag] -> CLong
renameFlag2int [RenameFlag]
flags )

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

    receive :: Int -> Ptr a -> Int -> IO Int
    receive :: forall a. Int -> Ptr a -> Int -> IO Int
receive Int
0 Ptr a
_ Int
read_sz = forall (m :: * -> *) a. Monad m => a -> m a
return Int
read_sz
    receive Int
toread Ptr a
buf Int
alreadyread = do
       CLong
received <- forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just SftpHandle
sftph)
                       forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr CChar -> CULong -> IO CLong
libssh2_sftp_read (forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph)
                                              (Ptr a
buf forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
alreadyread)
                                              (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
toread)
       forall a. Int -> Ptr a -> Int -> IO Int
receive (Int
toread forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
received) Ptr a
buf (Int
alreadyread forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
received)

    bufferSize :: Int
bufferSize = Int
0x100000

  in forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize forall a b. (a -> b) -> a -> b
$ forall a. Int -> Ptr a -> IO Int
go Int
0

-- | Upload file to the sftp server
sftpWriteFileFromHandler :: SftpHandle -> Handle -> IO Integer
sftpWriteFileFromHandler :: SftpHandle -> Handle -> IO Integer
sftpWriteFileFromHandler SftpHandle
sftph Handle
fh =
  let
    go :: Integer -> Ptr a -> IO Integer
    go :: forall a. Integer -> Ptr a -> IO Integer
go Integer
done Ptr a
buffer = do
      Int
sz <- forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
fh Ptr a
buffer Int
bufferSize
      forall a. Int -> CLong -> Ptr a -> IO ()
send Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) Ptr a
buffer
      let newDone :: Integer
newDone = Integer
done forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz
      if Int
sz forall a. Ord a => a -> a -> Bool
< Int
bufferSize
        then forall (m :: * -> *) a. Monad m => a -> m a
return Integer
newDone
        else forall a. Integer -> Ptr a -> IO Integer
go Integer
newDone Ptr a
buffer

    send :: Int -> CLong -> Ptr a -> IO ()
    send :: forall a. Int -> CLong -> Ptr a -> IO ()
send Int
_ CLong
0 Ptr a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    send Int
written CLong
size Ptr a
buf = do
      CLong
sent <- forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just SftpHandle
sftph)
                           forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr CChar -> CULong -> IO CLong
libssh2_sftp_write (forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph)
                                                   (Ptr a
buf forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
written)
                                                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
size)
      forall a. Int -> CLong -> Ptr a -> IO ()
send (Int
written forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sent) (CLong
size forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
sent) Ptr a
buf

    bufferSize :: Int
    bufferSize :: Int
bufferSize = Int
0x100000

  in forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize forall a b. (a -> b) -> a -> b
$ forall a. Integer -> Ptr a -> IO Integer
go Integer
0

-- | Upload bytes to the sftp server
-- Returns size of sent data.
sftpWriteFileFromBytes :: SftpHandle -> BSS.ByteString -> IO Integer
sftpWriteFileFromBytes :: SftpHandle -> ByteString -> IO Integer
sftpWriteFileFromBytes SftpHandle
sftph ByteString
bs = forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSS.useAsCStringLen ByteString
bs (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Ptr CChar -> Int -> IO Integer
send Int
0))
  where
    send :: Int -> Ptr CChar -> Int -> IO Integer
    send :: Int -> Ptr CChar -> Int -> IO Integer
send Int
written Ptr CChar
_ Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Integral a => a -> Integer
toInteger Int
written)
    send Int
written Ptr CChar
src Int
len = do
      let nBytes :: Int
nBytes = forall a. Ord a => a -> a -> a
min Int
len Int
bufferSize
      Int
sent <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just SftpHandle
sftph)
                           forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr CChar -> CULong -> IO CLong
libssh2_sftp_write (forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph)
                                                   Ptr CChar
src
                                                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nBytes)
      Int -> Ptr CChar -> Int -> IO Integer
send (Int
written forall a. Num a => a -> a -> a
+ Int
sent) (Ptr CChar
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
written) (Int
len forall a. Num a => a -> a -> a
- Int
sent)

    bufferSize :: Int
    bufferSize :: Int
bufferSize = Int
0x100000

data SftpAttributes = SftpAttributes {
  SftpAttributes -> CULong
saFlags :: CULong,
  SftpAttributes -> CULLong
saFileSize :: CULLong,
  SftpAttributes -> CULong
saUid :: CULong,
  SftpAttributes -> CULong
saGid :: CULong,
  SftpAttributes -> CULong
saPermissions :: CULong,
  SftpAttributes -> CULong
saAtime :: CULong,
  SftpAttributes -> CULong
saMtime :: CULong
  } deriving (Int -> SftpAttributes -> ShowS
[SftpAttributes] -> ShowS
SftpAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SftpAttributes] -> ShowS
$cshowList :: [SftpAttributes] -> ShowS
show :: SftpAttributes -> String
$cshow :: SftpAttributes -> String
showsPrec :: Int -> SftpAttributes -> ShowS
$cshowsPrec :: Int -> SftpAttributes -> ShowS
Show, SftpAttributes -> SftpAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SftpAttributes -> SftpAttributes -> Bool
$c/= :: SftpAttributes -> SftpAttributes -> Bool
== :: SftpAttributes -> SftpAttributes -> Bool
$c== :: SftpAttributes -> SftpAttributes -> Bool
Eq)

-- | Get sftp attributes from the sftp handler
sftpFstat :: SftpHandle
          -> IO (SftpAttributes)
sftpFstat :: SftpHandle -> IO SftpAttributes
sftpFstat SftpHandle
sftph = do
  forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 forall a b. (a -> b) -> a -> b
$ \Ptr ()
sftpattrptr -> do
    CInt
_ <- forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just SftpHandle
sftph) forall a b. (a -> b) -> a -> b
$
       Ptr () -> Ptr () -> CInt -> IO CInt
libssh2_sftp_fstat_ex (forall p. ToPointer p => p -> Ptr ()
toPointer SftpHandle
sftph) Ptr ()
sftpattrptr CInt
0
    forall a. Ptr a -> IO SftpAttributes
parseSftpAttributes Ptr ()
sftpattrptr

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

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CULong
-> CULLong
-> CULong
-> CULong
-> CULong
-> CULong
-> CULong
-> SftpAttributes
SftpAttributes CULong
flags CULLong
size CULong
uid CULong
gid CULong
perm CULong
atime CULong
mtime

-- | Delete file from SFTP server
sftpDeleteFile :: Sftp     -- ^ Opened sftp session
               -> FilePath -- ^ Path to the file to be deleted
               -> IO ()
sftpDeleteFile :: Sftp -> String -> IO ()
sftpDeleteFile Sftp
sftp String
path = do
  forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
path forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str,Int
len) -> do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just Sftp
sftp) forall a b. (a -> b) -> a -> b
$
      Ptr () -> Ptr CChar -> CUInt -> IO CInt
libssh2_sftp_unlink_ex (forall p. ToPointer p => p -> Ptr ()
toPointer Sftp
sftp) Ptr CChar
str (forall a. Enum a => Int -> a
toEnum Int
len)


--
-- | Agent support
--

-- | Initialize a new ssh agent handle.
agentInit :: Session -> IO Agent
agentInit :: Session -> IO Agent
agentInit Session
s = forall c a.
SshCtx c =>
Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr (forall a. a -> Maybe a
Just Session
s) (Session -> Ptr () -> IO Agent
agentFromPointer Session
s) forall a b. (a -> b) -> a -> b
$ Session -> IO (Ptr ())
agentInit_ Session
s

agentInit_ :: (Session) -> IO ((Ptr ()))
agentInit_ :: Session -> IO (Ptr ())
agentInit_ Session
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Session
a1} in 
  Ptr () -> IO (Ptr ())
agentInit_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
  let {res' :: Ptr ()
res' = forall a. a -> a
id Ptr ()
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

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


agentFree :: (Agent) -> IO ()
agentFree a1 =
  let {a1' = toPointer a1} in 
  agentFree'_ a1' >>
  return ()

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


-- | Attempt to establish a connection to an ssh agent process.
-- | The environment variable @SSH_AUTH_SOCK@ is used to determine where to connect on unix.
agentConnect :: Agent -> IO ()
agentConnect agent = void . handleInt (Just agent) $ agentConnect_ agent

agentConnect_ :: (Agent) -> IO ((Int))
agentConnect_ :: Agent -> IO Int
agentConnect_ Agent
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Agent
a1} in 
  Ptr () -> IO CInt
agentConnect_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Get or update the list of known identities. Must be called at least once.
agentListIdentities :: Agent -> IO ()
agentListIdentities agent = void . handleInt (Just agent) $ agentListIdentities_ agent

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

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


-- | Cleans up a connection to an ssh agent.
agentDisconnect :: Agent -> IO ()
agentDisconnect agent = void . handleInt (Just agent) $ agentDisconnect_ agent

agentDisconnect_ :: (Agent) -> IO ((Int))
agentDisconnect_ :: Agent -> IO Int
agentDisconnect_ Agent
a1 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Agent
a1} in 
  Ptr () -> IO CInt
agentDisconnect_'_ Ptr ()
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Copies all the keys from the agent to the local process.
agentGetIdentities :: Agent -> IO [AgentPublicKey]
agentGetIdentities agent = agentGetIdentities_ agent []
  where
    agentGetIdentities_ :: Agent -> [AgentPublicKey] -> IO [AgentPublicKey]
    agentGetIdentities_ agent' acc@[] = do
      k <- agentGetIdentity agent' Nothing
      case k of
        Just aKey -> agentGetIdentities_ agent' [aKey]
        Nothing -> return acc
    agentGetIdentities_ agent' acc = do
      k <- agentGetIdentity agent' $ Just $ head acc
      case k of
        Just aKey -> agentGetIdentities_ agent' (aKey:acc)
        Nothing -> return acc

agentNullPublicKey :: IO AgentPublicKey
agentNullPublicKey :: IO AgentPublicKey
agentNullPublicKey = Ptr () -> IO AgentPublicKey
agentPublicKeyFromPointer forall a. Ptr a
nullPtr

-- | Copies one identity from the agent to the local process.
agentGetIdentity :: Agent                     -- ^ Agent handle.
                 -> Maybe AgentPublicKey      -- ^ Previous key returned.
                 -> IO (Maybe AgentPublicKey)
agentGetIdentity :: Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
agent Maybe AgentPublicKey
Nothing = do
  AgentPublicKey
nullKey <- IO AgentPublicKey
agentNullPublicKey
  Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
agent (forall a. a -> Maybe a
Just AgentPublicKey
nullKey)
agentGetIdentity Agent
agent (Just AgentPublicKey
key) = do
  Agent -> AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity_ Agent
agent AgentPublicKey
key

agentGetIdentity_ :: Agent -> AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity_ :: Agent -> AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity_ Agent
a AgentPublicKey
pk = do
  forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
pk forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pkPtr -> do
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr -> do
      (CInt
res, Ptr ()
pptr) <- forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr ()
ptr forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
pkStore -> do
                CInt
x <- Ptr () -> Ptr (Ptr ()) -> Ptr () -> IO CInt
libssh2_agent_get_identity (forall p. ToPointer p => p -> Ptr ()
toPointer Agent
a) Ptr (Ptr ())
pkStore (forall a b. Ptr a -> Ptr b
castPtr Ptr AgentPublicKey
pkPtr)
                Ptr ()
pptr <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
pkStore
                forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
x, Ptr ()
pptr)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just Agent
a) (forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res)
      if CInt
res forall a. Eq a => a -> a -> Bool
== CInt
0
        then do
          AgentPublicKey
resPkPtr <- Ptr () -> IO AgentPublicKey
agentPublicKeyFromPointer Ptr ()
pptr
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just AgentPublicKey
resPkPtr
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Return the comment from the given agent public key.
agentPublicKeyComment :: AgentPublicKey -> IO BSS.ByteString
agentPublicKeyComment :: AgentPublicKey -> IO ByteString
agentPublicKeyComment AgentPublicKey
pk = do
  forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
pk forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pkPtr -> do
    Ptr CChar
c <- (\Ptr AgentPublicKey
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AgentPublicKey
ptr Int
32 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr AgentPublicKey
pkPtr
    Ptr CChar -> IO ByteString
BSS.packCString Ptr CChar
c

-- | Return the bytes of the given agent public key.
agentPublicKeyBlob :: AgentPublicKey -> IO BSS.ByteString
agentPublicKeyBlob :: AgentPublicKey -> IO ByteString
agentPublicKeyBlob AgentPublicKey
pk = do
  forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
pk forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pkPtr -> do
    Ptr CUChar
blobPtr <- (\Ptr AgentPublicKey
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AgentPublicKey
ptr Int
16 :: IO (C2HSImp.Ptr C2HSImp.CUChar)}) Ptr AgentPublicKey
pkPtr
    CULong
blobLen <- (\Ptr AgentPublicKey
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AgentPublicKey
ptr Int
24 :: IO C2HSImp.CULong}) Ptr AgentPublicKey
pkPtr
    CStringLen -> IO ByteString
BSS.packCStringLen (forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
blobPtr, forall a. Enum a => a -> Int
fromEnum CULong
blobLen)

-- | Perform agent based public key authentication.
-- You almost certainly want @agentAuthenticate instead of this, since this
-- only does one round of authentication with the agent.
agentUserAuth :: Agent          -- ^ Agent handle.
              -> String         -- ^ Username to authenticate with.
              -> AgentPublicKey -- ^ Public key to use from the agent.
              -> IO ()
agentUserAuth :: Agent -> String -> AgentPublicKey -> IO ()
agentUserAuth Agent
agent String
username AgentPublicKey
key = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ctx.
(IntResult a, SshCtx ctx) =>
Maybe ctx -> IO a -> IO a
handleInt (forall a. a -> Maybe a
Just Agent
agent) forall a b. (a -> b) -> a -> b
$ Agent -> String -> AgentPublicKey -> IO Int
agentUserAuth_ Agent
agent String
username AgentPublicKey
key

agentUserAuth_ :: (Agent) -> (String) -> (AgentPublicKey) -> IO ((Int))
agentUserAuth_ :: Agent -> String -> AgentPublicKey -> IO Int
agentUserAuth_ Agent
a1 String
a2 AgentPublicKey
a3 =
  let {a1' :: Ptr ()
a1' = forall p. ToPointer p => p -> Ptr ()
toPointer Agent
a1} in 
  forall a. String -> (Ptr CChar -> IO a) -> IO a
C2HSImp.withCString String
a2 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
a2' -> 
  forall a. AgentPublicKey -> (Ptr () -> IO a) -> IO a
withAgentPublicKeyVoidPtr AgentPublicKey
a3 forall a b. (a -> b) -> a -> b
$ \Ptr ()
a3' -> 
  Ptr () -> Ptr CChar -> Ptr () -> IO CInt
agentUserAuth_'_ Ptr ()
a1' Ptr CChar
a2' Ptr ()
a3' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

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


-- | Authenticate with an ssh agent.
-- Takes a user and an agent and tries each key from the agent in succession.
-- Throws AUTHENTICATION_FAILED if it's unable to authenticate.
-- If you call this, you need to call @agentListIdentities at least once.
agentAuthenticate :: String -- ^ Remote user name.
                  -> Agent  -- ^ Connection to an agent.
                  -> IO ()
agentAuthenticate :: String -> Agent -> IO ()
agentAuthenticate String
login Agent
agent = do
  Maybe AgentPublicKey
firstKey <- Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
agent forall a. Maybe a
Nothing
  String -> Agent -> Maybe AgentPublicKey -> IO ()
agentAuthenticate' String
login Agent
agent Maybe AgentPublicKey
firstKey
  where
      agentAuthenticate' :: String -> Agent -> Maybe AgentPublicKey -> IO ()
agentAuthenticate' String
_ Agent
_ Maybe AgentPublicKey
Nothing = forall a e. Exception e => e -> a
throw ErrorCode
AUTHENTICATION_FAILED
      agentAuthenticate' String
u Agent
a (Just AgentPublicKey
k) = do
          Either () ()
r <- forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust ErrorCode -> Maybe ()
isAuthenticationFailed (Agent -> String -> AgentPublicKey -> IO ()
agentUserAuth Agent
a String
u AgentPublicKey
k)
          case Either () ()
r of
              Left ()
_ -> do
                  Maybe AgentPublicKey
nextKey <- Agent -> Maybe AgentPublicKey -> IO (Maybe AgentPublicKey)
agentGetIdentity Agent
a forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just AgentPublicKey
k
                  String -> Agent -> Maybe AgentPublicKey -> IO ()
agentAuthenticate' String
u Agent
a Maybe AgentPublicKey
nextKey
              Right ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      isAuthenticationFailed :: ErrorCode -> Maybe ()
isAuthenticationFailed ErrorCode
AUTHENTICATION_FAILED = forall a. a -> Maybe a
Just ()
      isAuthenticationFailed ErrorCode
_ = forall a. Maybe a
Nothing

withAgentPublicKeyVoidPtr :: AgentPublicKey -> (Ptr () -> IO a) -> IO a
withAgentPublicKeyVoidPtr :: forall a. AgentPublicKey -> (Ptr () -> IO a) -> IO a
withAgentPublicKeyVoidPtr AgentPublicKey
p Ptr () -> IO a
f = forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey AgentPublicKey
p forall a b. (a -> b) -> a -> b
$ \Ptr AgentPublicKey
pp -> Ptr () -> IO a
f (forall a b. Ptr a -> Ptr b
castPtr Ptr AgentPublicKey
pp)

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_keepalive_config"
  keepaliveConfig'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO ()))))

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"
  session_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_direct_tcpip_ex"
  directTcpIpEx_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (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))))

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

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

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

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

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

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

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