-- 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/Types.chs" #-}
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, StandaloneDeriving #-}






{-# LINE 12 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


module Network.SSH.Client.LibSSH2.Types
  (Session,
   KnownHosts,
   Channel,
   Sftp,
   SftpHandle,
   Agent,
   AgentPublicKey,
   ToPointer (..),
   Direction (..),
   int2dir,
   CStringCLen,
   Size, SSize,
   withCStringLenIntConv,
   peekCStringPtr,
   peekMaybeCStringPtr,
   channelFromPointer,
   knownHostsFromPointer,
   sessionFromPointer,
   sessionGetSocket,
   sessionSetSocket,
   channelSession,
   sftpFromPointer,
   sftpSession,
   sftpHandlePtr,
   sftpHandleFromPointer,
   sftpHandleSession,
   agentFromPointer,
   agentSession,
   agentPublicKeyFromPointer,
   withAgentPublicKey
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign
import Foreign.C.String
import Data.Generics
import Data.IORef
import Network.Socket

type Size = (C2HSImp.CULong)
{-# LINE 53 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


type SSize = (C2HSImp.CLong)
{-# LINE 55 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


type CStringCLen i = (CString, i)

withCStringLenIntConv :: (Integral i) => String -> (CStringCLen i -> IO a) -> IO a
withCStringLenIntConv :: forall i a. Integral i => String -> (CStringCLen i -> IO a) -> IO a
withCStringLenIntConv String
str CStringCLen i -> IO a
fn =
  forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (\(CString
ptr, Int
len) -> CStringCLen i -> IO a
fn (CString
ptr, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

peekCStringPtr :: Ptr CString -> IO String
peekCStringPtr :: Ptr CString -> IO String
peekCStringPtr Ptr CString
ptr = CString -> IO String
peekCAString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr CString
ptr

peekMaybeCStringPtr :: Ptr CString -> IO (Maybe String)
peekMaybeCStringPtr :: Ptr CString -> IO (Maybe String)
peekMaybeCStringPtr Ptr CString
ptr = do
  CString
strPtr <- forall a. Storable a => Ptr a -> IO a
peek Ptr CString
ptr
  if CString
strPtr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CString -> IO String
peekCAString CString
strPtr


class ToPointer p where
  toPointer :: p -> Ptr ()

type CSession = C2HSImp.Ptr (())
{-# LINE 77 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


data Session = Session { Session -> CSession
sessionPtr       :: CSession
                       , Session -> IORef (Maybe Socket)
sessionSocketRef :: IORef (Maybe Socket)
                       }

sessionFromPointer :: Ptr () -> IO Session
sessionFromPointer :: CSession -> IO Session
sessionFromPointer CSession
ptr = do
  IORef (Maybe Socket)
socketRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CSession -> IORef (Maybe Socket) -> Session
Session (forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) IORef (Maybe Socket)
socketRef

sessionGetSocket :: Session -> IO (Maybe Socket)
sessionGetSocket :: Session -> IO (Maybe Socket)
sessionGetSocket = forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> IORef (Maybe Socket)
sessionSocketRef

sessionSetSocket :: Session -> Maybe Socket -> IO ()
sessionSetSocket :: Session -> Maybe Socket -> IO ()
sessionSetSocket Session
session = forall a. IORef a -> a -> IO ()
writeIORef (Session -> IORef (Maybe Socket)
sessionSocketRef Session
session)

deriving instance Eq Session
deriving instance Data Session
deriving instance Typeable Session

instance Show Session where
  show :: Session -> String
show Session
session = String
"<libssh2 session: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Session -> CSession
sessionPtr Session
session) forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer Session where
  toPointer :: Session -> CSession
toPointer = forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> CSession
sessionPtr 

newtype KnownHosts = KnownHosts (C2HSImp.Ptr (KnownHosts))
{-# LINE 104 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


knownHostsFromPointer :: Ptr () -> IO KnownHosts
knownHostsFromPointer :: CSession -> IO KnownHosts
knownHostsFromPointer CSession
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr KnownHosts -> KnownHosts
KnownHosts (forall a b. Ptr a -> Ptr b
castPtr CSession
ptr)

deriving instance Eq KnownHosts
deriving instance Data KnownHosts
deriving instance Typeable KnownHosts

instance Show KnownHosts where
  show :: KnownHosts -> String
show (KnownHosts Ptr KnownHosts
p) = String
"<libssh2 known hosts: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Ptr KnownHosts
p forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer KnownHosts where
  toPointer :: KnownHosts -> CSession
toPointer (KnownHosts Ptr KnownHosts
p) = forall a b. Ptr a -> Ptr b
castPtr Ptr KnownHosts
p

type CChannel = C2HSImp.Ptr (())
{-# LINE 119 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


data Channel = Channel { Channel -> CSession
channelPtr     :: CChannel
                       , Channel -> Session
channelSession :: Session
                       }

channelFromPointer :: Session -> Ptr () -> IO Channel
channelFromPointer :: Session -> CSession -> IO Channel
channelFromPointer Session
session CSession
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CSession -> Session -> Channel
Channel (forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) Session
session

deriving instance Eq Channel
deriving instance Data Channel
deriving instance Typeable Channel

instance Show Channel where
  show :: Channel -> String
show Channel
channel = String
"<libssh2 channel: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Channel -> CSession
channelPtr Channel
channel) forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer Channel where
  toPointer :: Channel -> CSession
toPointer = forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> CSession
channelPtr 

-- | Session directions
data Direction = INBOUND | OUTBOUND
  deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show)

int2dir :: (Eq a, Num a, Show a) => a -> [Direction]
int2dir :: forall a. (Eq a, Num a, Show a) => a -> [Direction]
int2dir a
0 = []
int2dir a
1 = [Direction
INBOUND]
int2dir a
2 = [Direction
OUTBOUND]
int2dir a
3 = [Direction
INBOUND, Direction
OUTBOUND]
int2dir a
x = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown direction: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x

--
-- | Sftp support
--

sftpFromPointer :: Session -> Ptr () -> IO Sftp
sftpFromPointer :: Session -> CSession -> IO Sftp
sftpFromPointer Session
session CSession
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CSession -> Session -> Sftp
Sftp (forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) Session
session

type CSftp = C2HSImp.Ptr (())
{-# LINE 156 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


data Sftp = Sftp { Sftp -> CSession
sftpPtr :: CSftp
                 , Sftp -> Session
sftpSession :: Session
                 }

instance Show Sftp where
  show :: Sftp -> String
show Sftp
sftp = String
"<libssh2 sftp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Sftp -> CSession
sftpPtr Sftp
sftp) forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer Sftp where
  toPointer :: Sftp -> CSession
toPointer = forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sftp -> CSession
sftpPtr

sftpHandleFromPointer :: Sftp -> Ptr () -> IO SftpHandle
sftpHandleFromPointer :: Sftp -> CSession -> IO SftpHandle
sftpHandleFromPointer Sftp
sftp CSession
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CSession -> Sftp -> SftpHandle
SftpHandle (forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) Sftp
sftp

type CSftpHandle = C2HSImp.Ptr (())
{-# LINE 171 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


data SftpHandle = SftpHandle { SftpHandle -> CSession
sftpHandlePtr :: CSftpHandle
                             , SftpHandle -> Sftp
sftpHandleSession :: Sftp
                             }

instance Show SftpHandle where
  show :: SftpHandle -> String
show SftpHandle
handle = String
"<libssh2 sftp handle: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SftpHandle -> CSession
sftpHandlePtr SftpHandle
handle) forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer SftpHandle where
  toPointer :: SftpHandle -> CSession
toPointer = forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. SftpHandle -> CSession
sftpHandlePtr


--
-- | Agent support
--

agentFromPointer :: Session -> Ptr () -> IO Agent
agentFromPointer :: Session -> CSession -> IO Agent
agentFromPointer Session
session CSession
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CSession -> Session -> Agent
Agent (forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) Session
session

type CAgent = C2HSImp.Ptr (())
{-# LINE 191 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


data Agent = Agent { Agent -> CSession
agentPtr :: CAgent, Agent -> Session
agentSession :: Session }

instance Show Agent where
  show :: Agent -> String
show Agent
agent = String
"<libssh2 agent: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Agent -> CSession
agentPtr Agent
agent) forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer Agent where
  toPointer :: Agent -> CSession
toPointer = forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Agent -> CSession
agentPtr

newtype AgentPublicKey = AgentPublicKey (C2HSImp.ForeignPtr (AgentPublicKey))
withAgentPublicKey :: AgentPublicKey -> (C2HSImp.Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey :: forall b. AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey (AgentPublicKey fptr) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
C2HSImp.withForeignPtr ForeignPtr AgentPublicKey
fptr
{-# LINE 201 "src/Network/SSH/Client/LibSSH2/Types.chs" #-}


agentPublicKeyFromPointer :: Ptr () -> IO AgentPublicKey
agentPublicKeyFromPointer ptr = do
  newPtr <- newForeignPtr_ ptr
  return $ AgentPublicKey $ castForeignPtr newPtr

deriving instance Eq AgentPublicKey
deriving instance Data AgentPublicKey
deriving instance Typeable AgentPublicKey

instance Show AgentPublicKey where
  show :: AgentPublicKey -> String
show (AgentPublicKey ForeignPtr AgentPublicKey
p) = String
"<libssh2 agent publickey: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ForeignPtr AgentPublicKey
p forall a. [a] -> [a] -> [a]
++ String
">"