{- |
Description :  libssh bindings
Maintainer  :  defanor <defanor@uberspace.net>
Stability   :  unstable
Portability :  non-portable

See [the libssh documentation](https://api.libssh.org/stable/) for its
API reference and a usage tutorial.

These bindings are intended to be simple, predictable, and stay close
to the original library, only providing a Haskell API with more
conventional types, replacing error codes with exceptions, helping to
ensure that allocated resources are freed (using the "with"
functions). All the used types and utility functions are exposed.

A usage example:

@
import Network.LibSSH as SSH
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = 'withSSH' $
  'withSession' [OptHost "example.com", OptPort 22, OptUser (Just "user"),
               OptKnownhosts Nothing, OptTimeout 600] $ \\session ->
  'withConnection' session $ do
  'authenticateWithKeys' session Nothing "id_rsa.pub" "id_rsa" Nothing
  'withSessionChannel' session $ \\channel ->
    'channelRequestExec' channel "uname -a"
    >> 'channelReadAll' channel >>= BS.putStrLn
  'withSFTPSession' session $ \\sftp -> do
    'sftpRead' sftp "\/tmp\/example.txt" >>= BS.putStrLn
    'sftpUnlink' sftp "\/tmp\/example.txt"
@

-}

module Network.LibSSH where

import Network.LibSSH.Core
import qualified Data.ByteString.Char8 as BS
import Control.Exception
import Foreign
import Foreign.C
import Foreign.Ptr


-- | Invokes 'ssh_init' and 'ssh_finalize'. Library usage must be
-- wrapped into it for correct functioning if libssh is linked
-- statically, or with its versions before 0.8.0. Not necessary, but
-- still safe to use otherwise.
withSSH :: IO a -> IO a
withSSH :: forall a. IO a -> IO a
withSSH IO a
a = IO CInt
ssh_init IO CInt -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
a IO a -> IO CInt -> IO a
forall a b. IO a -> IO b -> IO a
`finally` IO CInt
ssh_finalize


-- * Public Key Infrastructure

-- | Imports a public key from a file or a PKCS #11 device, performs
-- an action with it.
withPublicKeyFile :: FilePath -> (SSHKey -> IO a) -> IO a
withPublicKeyFile :: forall a. FilePath -> (SSHKey -> IO a) -> IO a
withPublicKeyFile FilePath
path SSHKey -> IO a
f =
  FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
pubKeyPath ->
  (Ptr SSHKey -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr SSHKey -> IO a) -> IO a) -> (Ptr SSHKey -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr SSHKey
pubKeyPtr -> do
  FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_pki_import_pubkey_file"
    (CString -> Ptr SSHKey -> IO CInt
ssh_pki_import_pubkey_file CString
pubKeyPath Ptr SSHKey
pubKeyPtr)
  SSHKey
pubKey <- Ptr SSHKey -> IO SSHKey
forall a. Storable a => Ptr a -> IO a
peek Ptr SSHKey
pubKeyPtr
  SSHKey -> IO a
f SSHKey
pubKey IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` SSHKey -> IO ()
ssh_key_free SSHKey
pubKey

-- | Imports a private key from a file or a PKCS #11 device, performs
-- an action with it.
withPrivateKeyFile :: FilePath -> Maybe String -> (SSHKey -> IO a) -> IO a
withPrivateKeyFile :: forall a. FilePath -> Maybe FilePath -> (SSHKey -> IO a) -> IO a
withPrivateKeyFile FilePath
privKeyPath Maybe FilePath
passphrase SSHKey -> IO a
f =
  FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
privKeyPath ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
privKeyPathCStr ->
  Maybe FilePath -> (CString -> IO a) -> IO a
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
passphrase ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
passphraseCStr ->
  (Ptr SSHKey -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr SSHKey -> IO a) -> IO a) -> (Ptr SSHKey -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr SSHKey
privKeyPtr -> do
  -- Skipping a callback to ssh_pki_import_privkey_file here, though
  -- it may be nice to implement in the future.
  FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_pki_import_privkey_file"
    (CString
-> CString -> SSHAuthCallback -> Ptr () -> Ptr SSHKey -> IO CInt
ssh_pki_import_privkey_file
     CString
privKeyPathCStr CString
passphraseCStr SSHAuthCallback
forall a. FunPtr a
nullFunPtr Ptr ()
forall a. Ptr a
nullPtr Ptr SSHKey
privKeyPtr)
  SSHKey
privKey <- Ptr SSHKey -> IO SSHKey
forall a. Storable a => Ptr a -> IO a
peek Ptr SSHKey
privKeyPtr
  SSHKey -> IO a
f SSHKey
privKey IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` SSHKey -> IO ()
ssh_key_free SSHKey
privKey


-- * Session

data SSHOption = OptHost String
               | OptPort Int
               | OptPortStr String
               | OptFd Int
               | OptBindaddr String
               | OptUser (Maybe String)
               | OptSSHDir (Maybe FilePath)
               | OptKnownhosts (Maybe FilePath)
               --  | OptGlobalKnownhosts (Maybe FilePath)
               | OptIdentity String
               | OptTimeout Int
               | OptTimeoutUsec Int

setOption :: SSHSession -> SSHOption -> IO ()
setOption :: SSHSession -> SSHOption -> IO ()
setOption SSHSession
session SSHOption
option =
  let so :: CInt -> Ptr a -> IO ()
so CInt
opt Ptr a
val = FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_options_set"
                   (SSHSession -> CInt -> Ptr () -> IO CInt
ssh_options_set SSHSession
session CInt
opt (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
val))
                   IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  in case SSHOption
option of
    OptHost FilePath
host -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
host (CInt -> CString -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsHost)
    OptPort Int
port -> CInt -> (Ptr CInt -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port :: CInt) (CInt -> Ptr CInt -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsPort)
    OptPortStr FilePath
host -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
host (CInt -> CString -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsPortStr)
    OptFd Int
fd -> CInt -> (Ptr CInt -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fd :: CInt) (CInt -> Ptr CInt -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsFd)
    OptBindaddr FilePath
addr -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
addr (CInt -> CString -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsBindaddr)
    OptUser Maybe FilePath
user -> Maybe FilePath -> (CString -> IO ()) -> IO ()
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
user (CInt -> CString -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsUser)
    OptSSHDir Maybe FilePath
dir -> Maybe FilePath -> (CString -> IO ()) -> IO ()
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
dir (CInt -> CString -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsSSHDir)
    OptKnownhosts Maybe FilePath
hf -> Maybe FilePath -> (CString -> IO ()) -> IO ()
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
hf (CInt -> CString -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsKnownhosts)
    -- OptGlobalKnownhosts ghf -> withCStringMaybe ghf (so sshOptionsGlobalKnownhosts)
    OptIdentity FilePath
idfn -> FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
idfn (CInt -> CString -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsIdentity)
    OptTimeout Int
sec -> CInt -> (Ptr CInt -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sec :: CInt) (CInt -> Ptr CInt -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsTimeout)
    OptTimeoutUsec Int
usec -> CInt -> (Ptr CInt -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
usec :: CInt) (CInt -> Ptr CInt -> IO ()
forall {a}. CInt -> Ptr a -> IO ()
so CInt
sshOptionsTimeoutUsec)

-- | Performs an action with a new session, with options set for it.
withSession :: [SSHOption] -> (SSHSession -> IO a) -> IO a
withSession :: forall a. [SSHOption] -> (SSHSession -> IO a) -> IO a
withSession [SSHOption]
options SSHSession -> IO a
action =
  IO SSHSession
-> (SSHSession -> IO ()) -> (SSHSession -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO SSHSession -> IO SSHSession
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
throwOnNull FilePath
"ssh_new" IO SSHSession
ssh_new) SSHSession -> IO ()
ssh_free ((SSHSession -> IO a) -> IO a) -> (SSHSession -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \SSHSession
session ->
  (SSHOption -> IO ()) -> [SSHOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SSHSession -> SSHOption -> IO ()
setOption SSHSession
session) [SSHOption]
options IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SSHSession -> IO a
action SSHSession
session

-- | Connects, performs an action, disconnects.
withConnection :: SSHSession -> IO a -> IO a
withConnection :: forall a. SSHSession -> IO a -> IO a
withConnection SSHSession
session IO a
action =
  FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_connect" (SSHSession -> IO CInt
ssh_connect SSHSession
session)
  IO CInt -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (IO a
action IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` (SSHSession -> IO ()
ssh_disconnect SSHSession
session))


-- ** Authentication

-- | Authenticates using the provided key pair.
authenticateWithKeys :: SSHSession
                     -> Maybe String
                     -- ^ Username, SHOULD be 'Nothing'.
                     -> FilePath
                     -- ^ Public key file
                     -> FilePath
                     -- ^ Private key file
                     -> Maybe String
                     -- ^ Passphrase
                     -> IO ()
authenticateWithKeys :: SSHSession
-> Maybe FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> IO ()
authenticateWithKeys SSHSession
session Maybe FilePath
username FilePath
pubKeyFile FilePath
privKeyFile Maybe FilePath
passphrase =
  Maybe FilePath -> (CString -> IO ()) -> IO ()
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
username ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
usernameCStr ->
  FilePath -> (SSHKey -> IO CInt) -> IO CInt
forall a. FilePath -> (SSHKey -> IO a) -> IO a
withPublicKeyFile FilePath
pubKeyFile
  (\SSHKey
pubKey -> FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_userauth_try_publickey"
    (SSHSession -> CString -> SSHKey -> IO CInt
ssh_userauth_try_publickey SSHSession
session CString
usernameCStr SSHKey
pubKey))
  IO CInt -> IO CInt -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath -> Maybe FilePath -> (SSHKey -> IO CInt) -> IO CInt
forall a. FilePath -> Maybe FilePath -> (SSHKey -> IO a) -> IO a
withPrivateKeyFile FilePath
privKeyFile Maybe FilePath
passphrase
      (\SSHKey
privKey -> FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_userauth_publickey"
        (SSHSession -> CString -> SSHKey -> IO CInt
ssh_userauth_publickey SSHSession
session CString
usernameCStr SSHKey
privKey)))
  IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Authenticates using a password
authenticateWithPassword :: SSHSession
                         -> Maybe String
                         -- ^ Username, SHOULD be 'Nothing'.
                         -> String
                         -- ^ Password
                         -> IO ()
authenticateWithPassword :: SSHSession -> Maybe FilePath -> FilePath -> IO ()
authenticateWithPassword SSHSession
session Maybe FilePath
username FilePath
password =
  Maybe FilePath -> (CString -> IO ()) -> IO ()
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
username ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
usernameCStr ->
  FilePath -> (CString -> IO CInt) -> IO CInt
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
password
  (\CString
passwordCStr ->
     FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_userauth_password"
    (SSHSession -> CString -> CString -> IO CInt
ssh_userauth_password SSHSession
session CString
usernameCStr CString
passwordCStr))
  IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Authenticates using SSH agent.
authenticateWithAgent :: SSHSession
                      -> Maybe String
                      -- ^ Username, SHOULD be 'Nothing'.
                      -> IO ()
authenticateWithAgent :: SSHSession -> Maybe FilePath -> IO ()
authenticateWithAgent SSHSession
session Maybe FilePath
username =
  Maybe FilePath -> (CString -> IO ()) -> IO ()
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
username ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
usernameCStr ->
  (FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_userauth_agent"
    (SSHSession -> CString -> IO CInt
ssh_userauth_agent SSHSession
session CString
usernameCStr))
  IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Authenticates using the "none" method.
authenticateWithNone :: SSHSession
                     -> Maybe String
                     -- ^ Username, SHOULD be 'Nothing'.
                     -> IO ()
authenticateWithNone :: SSHSession -> Maybe FilePath -> IO ()
authenticateWithNone SSHSession
session Maybe FilePath
username =
  Maybe FilePath -> (CString -> IO ()) -> IO ()
forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
username ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
usernameCStr ->
  (FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_userauth_none"
    (SSHSession -> CString -> IO CInt
ssh_userauth_none SSHSession
session CString
usernameCStr))
  IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- * Channels

-- | Performs an action with a new channel ('ssh_channel_new').
withChannel :: SSHSession -> (SSHChannel -> IO a) -> IO a
withChannel :: forall a. SSHSession -> (SSHChannel -> IO a) -> IO a
withChannel SSHSession
session =
  IO SSHChannel
-> (SSHChannel -> IO ()) -> (SSHChannel -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO SSHChannel -> IO SSHChannel
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
throwOnNull FilePath
"ssh_channel_new" (IO SSHChannel -> IO SSHChannel) -> IO SSHChannel -> IO SSHChannel
forall a b. (a -> b) -> a -> b
$ SSHSession -> IO SSHChannel
ssh_channel_new SSHSession
session)
  SSHChannel -> IO ()
ssh_channel_free

-- | Performs an action with a new session channel
-- ('ssh_channel_open_session').
withSessionChannel :: SSHSession -> (SSHChannel -> IO a) -> IO a
withSessionChannel :: forall a. SSHSession -> (SSHChannel -> IO a) -> IO a
withSessionChannel SSHSession
session SSHChannel -> IO a
f = SSHSession -> (SSHChannel -> IO a) -> IO a
forall a. SSHSession -> (SSHChannel -> IO a) -> IO a
withChannel SSHSession
session ((SSHChannel -> IO a) -> IO a) -> (SSHChannel -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \SSHChannel
channel -> do
  FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_channel_open_session" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ SSHChannel -> IO CInt
ssh_channel_open_session SSHChannel
channel
  SSHChannel -> IO a
f SSHChannel
channel IO a -> IO CInt -> IO a
forall a b. IO a -> IO b -> IO a
`finally` SSHChannel -> IO CInt
ssh_channel_close SSHChannel
channel

-- | Executes a shell command with 'ssh_channel_request_exec'.
channelRequestExec :: SSHChannel -> String -> IO CInt
channelRequestExec :: SSHChannel -> FilePath -> IO CInt
channelRequestExec SSHChannel
channel FilePath
cmd = do
  FilePath -> (CString -> IO CInt) -> IO CInt
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
cmd ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
cmdCStr ->
    FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"ssh_channel_request_exec"
    (SSHChannel -> CString -> IO CInt
ssh_channel_request_exec SSHChannel
channel CString
cmdCStr)

-- | Reads all data from a channel with 'ssh_channel_read' and
-- 'readAll'.
channelReadAll :: SSHChannel -> IO BS.ByteString
channelReadAll :: SSHChannel -> IO ByteString
channelReadAll SSHChannel
channel =
  FilePath -> (CString -> CUInt -> IO CInt) -> IO ByteString
forall a b.
(Integral a, Integral b) =>
FilePath -> (CString -> a -> IO b) -> IO ByteString
readAll FilePath
"ssh_channel_read" (\CString
buf CUInt
len -> SSHChannel -> CString -> CUInt -> CInt -> IO CInt
ssh_channel_read SSHChannel
channel CString
buf CUInt
len CInt
0)


-- * SFTP

-- | Performs an action with a new SFTP session.
withSFTPSession :: SSHSession -> (SFTPSession -> IO a) -> IO a
withSFTPSession :: forall a. SSHSession -> (SFTPSession -> IO a) -> IO a
withSFTPSession SSHSession
session SFTPSession -> IO a
f =
  IO SFTPSession
-> (SFTPSession -> IO ()) -> (SFTPSession -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO SFTPSession -> IO SFTPSession
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
throwOnNull FilePath
"sftp_new" (IO SFTPSession -> IO SFTPSession)
-> IO SFTPSession -> IO SFTPSession
forall a b. (a -> b) -> a -> b
$ SSHSession -> IO SFTPSession
sftp_new SSHSession
session) SFTPSession -> IO ()
sftp_free ((SFTPSession -> IO a) -> IO a) -> (SFTPSession -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \SFTPSession
sftp -> do
  FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"sftp_init" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ SFTPSession -> IO CInt
sftp_init SFTPSession
sftp
  SFTPSession -> IO a
f SFTPSession
sftp

-- | Reads file contents over SFTP.
sftpRead :: SFTPSession -> FilePath -> IO BS.ByteString
sftpRead :: SFTPSession -> FilePath -> IO ByteString
sftpRead SFTPSession
sftp FilePath
path = FilePath -> (CString -> IO ByteString) -> IO ByteString
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
pathCStr ->
  IO (Ptr SFTPFileStruct)
-> (Ptr SFTPFileStruct -> IO CInt)
-> (Ptr SFTPFileStruct -> IO ByteString)
-> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO (Ptr SFTPFileStruct) -> IO (Ptr SFTPFileStruct)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
throwOnNull FilePath
"sftp_open" (IO (Ptr SFTPFileStruct) -> IO (Ptr SFTPFileStruct))
-> IO (Ptr SFTPFileStruct) -> IO (Ptr SFTPFileStruct)
forall a b. (a -> b) -> a -> b
$ SFTPSession -> CString -> CInt -> CInt -> IO (Ptr SFTPFileStruct)
sftp_open SFTPSession
sftp CString
pathCStr CInt
0 CInt
0) Ptr SFTPFileStruct -> IO CInt
sftp_close ((Ptr SFTPFileStruct -> IO ByteString) -> IO ByteString)
-> (Ptr SFTPFileStruct -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
  \Ptr SFTPFileStruct
file -> FilePath -> (CString -> CSize -> IO CInt) -> IO ByteString
forall a b.
(Integral a, Integral b) =>
FilePath -> (CString -> a -> IO b) -> IO ByteString
readAll FilePath
"sftp_read" (Ptr SFTPFileStruct -> CString -> CSize -> IO CInt
sftp_read Ptr SFTPFileStruct
file)

-- | Unlinks (deletes, removes) a remote file.
sftpUnlink :: SFTPSession -> FilePath -> IO ()
sftpUnlink :: SFTPSession -> FilePath -> IO ()
sftpUnlink SFTPSession
session FilePath
path = FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
pathCStr ->
  FilePath -> IO CInt -> IO CInt
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
"sftp_unlink" (SFTPSession -> CString -> IO CInt
sftp_unlink SFTPSession
session CString
pathCStr) IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- * Utility functions and exceptions

data SSHErrorType = SSHErrorCode Int | SSHNull
  deriving (Int -> SSHErrorType -> ShowS
[SSHErrorType] -> ShowS
SSHErrorType -> FilePath
(Int -> SSHErrorType -> ShowS)
-> (SSHErrorType -> FilePath)
-> ([SSHErrorType] -> ShowS)
-> Show SSHErrorType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SSHErrorType] -> ShowS
$cshowList :: [SSHErrorType] -> ShowS
show :: SSHErrorType -> FilePath
$cshow :: SSHErrorType -> FilePath
showsPrec :: Int -> SSHErrorType -> ShowS
$cshowsPrec :: Int -> SSHErrorType -> ShowS
Show)

data SSHError = SSHError String SSHErrorType
  deriving (Int -> SSHError -> ShowS
[SSHError] -> ShowS
SSHError -> FilePath
(Int -> SSHError -> ShowS)
-> (SSHError -> FilePath) -> ([SSHError] -> ShowS) -> Show SSHError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SSHError] -> ShowS
$cshowList :: [SSHError] -> ShowS
show :: SSHError -> FilePath
$cshow :: SSHError -> FilePath
showsPrec :: Int -> SSHError -> ShowS
$cshowsPrec :: Int -> SSHError -> ShowS
Show)

instance Exception SSHError

-- | Throws an exception if the number returned by the provided action
-- is less than 0.
throwOnError :: Integral a
             => String
             -- ^ Function name
             -> IO a
             -- ^ Action to run
             -> IO a
throwOnError :: forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
fname IO a
action = do
  a
result <- IO a
action
  if a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
result Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
    then SSHError -> IO a
forall a e. Exception e => e -> a
throw (FilePath -> SSHErrorType -> SSHError
SSHError FilePath
fname (Int -> SSHErrorType
SSHErrorCode (Int -> SSHErrorType) -> Int -> SSHErrorType
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
result))
    else a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

-- | Throws an exception if the performed action returns a NULL.
throwOnNull :: String
            -- ^ Function name
            -> IO (Ptr a)
            -- ^ Action to run
            -> IO (Ptr a)
throwOnNull :: forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
throwOnNull FilePath
fname IO (Ptr a)
action = do
  Ptr a
result <- IO (Ptr a)
action
  if Ptr a
result Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
    then SSHError -> IO (Ptr a)
forall a e. Exception e => e -> a
throw (FilePath -> SSHErrorType -> SSHError
SSHError FilePath
fname SSHErrorType
SSHNull)
    else Ptr a -> IO (Ptr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr a
result

-- | Reads data using a provided action, until the returned number is
-- 0 (indicating EOF) or less (indicating an error, leading to an
-- exception).
readAll :: (Integral a, Integral b)
        => String
        -- ^ Function name
        -> (CString -> a -> IO b)
        -- ^ A reader action, such as 'ssh_channel_read' or 'sftp_read'
        -> IO BS.ByteString
readAll :: forall a b.
(Integral a, Integral b) =>
FilePath -> (CString -> a -> IO b) -> IO ByteString
readAll FilePath
fname CString -> a -> IO b
f =
  let readChunks :: IO [ByteString]
readChunks = Int -> (CString -> IO [ByteString]) -> IO [ByteString]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
4096 ((CString -> IO [ByteString]) -> IO [ByteString])
-> (CString -> IO [ByteString]) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ \CString
buf -> do
        b
chunkLen <- FilePath -> IO b -> IO b
forall a. Integral a => FilePath -> IO a -> IO a
throwOnError FilePath
fname (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ CString -> a -> IO b
f CString
buf (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
4096)
        if b
chunkLen b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0
          then [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          else (:)
               (ByteString -> [ByteString] -> [ByteString])
-> IO ByteString -> IO ([ByteString] -> [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (CString
buf, b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
chunkLen)
               IO ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [ByteString]
readChunks
  in [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
readChunks

-- | Like 'withCString', but provides a 'nullPtr' on 'Nothing'.
withCStringMaybe :: Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe :: forall a. Maybe FilePath -> (CString -> IO a) -> IO a
withCStringMaybe Maybe FilePath
Nothing CString -> IO a
a = CString -> IO a
a CString
forall a. Ptr a
nullPtr
withCStringMaybe (Just FilePath
s) CString -> IO a
a = FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
s CString -> IO a
a