-- 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 :: String -> (CStringCLen i -> IO a) -> IO a
withCStringLenIntConv String
str CStringCLen i -> IO a
fn =
  String -> (CStringLen -> IO a) -> IO a
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (\(Ptr CChar
ptr, Int
len) -> CStringCLen i -> IO a
fn (Ptr CChar
ptr, Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

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

peekMaybeCStringPtr :: Ptr CString -> IO (Maybe String)
peekMaybeCStringPtr :: Ptr (Ptr CChar) -> IO (Maybe String)
peekMaybeCStringPtr Ptr (Ptr CChar)
ptr = do
  Ptr CChar
strPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
  if Ptr CChar
strPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
    then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CChar -> IO String
peekCAString Ptr CChar
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 <- Maybe Socket -> IO (IORef (Maybe Socket))
forall a. a -> IO (IORef a)
newIORef Maybe Socket
forall a. Maybe a
Nothing
  Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> IO Session) -> Session -> IO Session
forall a b. (a -> b) -> a -> b
$ CSession -> IORef (Maybe Socket) -> Session
Session (CSession -> CSession
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 = IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef (IORef (Maybe Socket) -> IO (Maybe Socket))
-> (Session -> IORef (Maybe Socket))
-> Session
-> IO (Maybe Socket)
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 = IORef (Maybe Socket) -> Maybe Socket -> IO ()
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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CSession -> String
forall a. Show a => a -> String
show (Session -> CSession
sessionPtr Session
session) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer Session where
  toPointer :: Session -> CSession
toPointer = CSession -> CSession
forall a b. Ptr a -> Ptr b
castPtr (CSession -> CSession)
-> (Session -> CSession) -> Session -> CSession
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 = KnownHosts -> IO KnownHosts
forall (m :: * -> *) a. Monad m => a -> m a
return (KnownHosts -> IO KnownHosts) -> KnownHosts -> IO KnownHosts
forall a b. (a -> b) -> a -> b
$ Ptr KnownHosts -> KnownHosts
KnownHosts (CSession -> Ptr 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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ptr KnownHosts -> String
forall a. Show a => a -> String
show Ptr KnownHosts
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer KnownHosts where
  toPointer :: KnownHosts -> CSession
toPointer (KnownHosts Ptr KnownHosts
p) = Ptr KnownHosts -> CSession
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 = Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel -> IO Channel) -> Channel -> IO Channel
forall a b. (a -> b) -> a -> b
$ CSession -> Session -> Channel
Channel (CSession -> CSession
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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CSession -> String
forall a. Show a => a -> String
show (Channel -> CSession
channelPtr Channel
channel) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

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

-- | Session directions
data Direction = INBOUND | OUTBOUND
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
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
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
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 :: a -> [Direction]
int2dir a
1 = [Direction
INBOUND]
int2dir a
2 = [Direction
OUTBOUND]
int2dir a
3 = [Direction
INBOUND, Direction
OUTBOUND]
int2dir a
x = String -> [Direction]
forall a. HasCallStack => String -> a
error (String -> [Direction]) -> String -> [Direction]
forall a b. (a -> b) -> a -> b
$ String
"Unknown direction: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
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 = Sftp -> IO Sftp
forall (m :: * -> *) a. Monad m => a -> m a
return (Sftp -> IO Sftp) -> Sftp -> IO Sftp
forall a b. (a -> b) -> a -> b
$ CSession -> Session -> Sftp
Sftp (CSession -> CSession
forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) Session
session

type CSftp = C2HSImp.Ptr (())
{-# LINE 155 "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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CSession -> String
forall a. Show a => a -> String
show (Sftp -> CSession
sftpPtr Sftp
sftp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer Sftp where
  toPointer :: Sftp -> CSession
toPointer = CSession -> CSession
forall a b. Ptr a -> Ptr b
castPtr (CSession -> CSession) -> (Sftp -> CSession) -> Sftp -> CSession
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 = SftpHandle -> IO SftpHandle
forall (m :: * -> *) a. Monad m => a -> m a
return (SftpHandle -> IO SftpHandle) -> SftpHandle -> IO SftpHandle
forall a b. (a -> b) -> a -> b
$ CSession -> Sftp -> SftpHandle
SftpHandle (CSession -> CSession
forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) Sftp
sftp

type CSftpHandle = C2HSImp.Ptr (())
{-# LINE 170 "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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CSession -> String
forall a. Show a => a -> String
show (SftpHandle -> CSession
sftpHandlePtr SftpHandle
handle) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer SftpHandle where
  toPointer :: SftpHandle -> CSession
toPointer = CSession -> CSession
forall a b. Ptr a -> Ptr b
castPtr (CSession -> CSession)
-> (SftpHandle -> CSession) -> SftpHandle -> CSession
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 = Agent -> IO Agent
forall (m :: * -> *) a. Monad m => a -> m a
return (Agent -> IO Agent) -> Agent -> IO Agent
forall a b. (a -> b) -> a -> b
$ CSession -> Session -> Agent
Agent (CSession -> CSession
forall a b. Ptr a -> Ptr b
castPtr CSession
ptr) Session
session

type CAgent = C2HSImp.Ptr (())
{-# LINE 190 "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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CSession -> String
forall a. Show a => a -> String
show (Agent -> CSession
agentPtr Agent
agent) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

instance ToPointer Agent where
  toPointer :: Agent -> CSession
toPointer = CSession -> CSession
forall a b. Ptr a -> Ptr b
castPtr (CSession -> CSession) -> (Agent -> CSession) -> Agent -> CSession
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 :: AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
withAgentPublicKey (AgentPublicKey fptr) = ForeignPtr AgentPublicKey -> (Ptr AgentPublicKey -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
C2HSImp.withForeignPtr ForeignPtr AgentPublicKey
fptr
{-# LINE 200 "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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ForeignPtr AgentPublicKey -> String
forall a. Show a => a -> String
show ForeignPtr AgentPublicKey
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"