module Network.FTP.Client (
withFTP,
withFTPS,
login,
pasv,
rename,
dele,
cwd,
size,
mkd,
rmd,
pwd,
quit,
nlst,
retr,
list,
stor,
mlsd,
mlst,
FTPCommand(..),
FTPResponse(..),
FTPMessage(..),
ResponseStatus(..),
MlsxResponse(..),
RTypeCode(..),
PortActivity(..),
ProtType(..),
Security(..),
Handle(..),
FTPException(..),
sIOHandleImpl,
tlsHandleImpl,
sendCommand,
sendCommandS,
recvAll,
sendAll,
sendAllS,
getLineResp,
getResponse,
getResponseS,
sendCommandLine,
createSendDataCommand,
createTLSSendDataCommand,
parseMlsxLine
) where
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import Data.List
import Data.Attoparsec.ByteString.Char8
import qualified Network.Socket as S
import qualified System.IO as SIO
import Data.Monoid ((<>))
import Control.Exception
import Control.Monad.Catch (MonadCatch, MonadMask)
import qualified Control.Monad.Catch as M
import Control.Monad
import Control.Monad.IO.Class
import Data.Bits
import Network.Connection
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import Data.Functor ((<$>))
import Control.Applicative ((<*>))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Control.Arrow
import Data.Typeable
debugging :: Bool
debugging :: Bool
debugging = Bool
False
debugPrint :: (Show a, MonadIO m) => a -> m ()
debugPrint :: forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint a
s = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugging (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ a -> IO ()
forall a. Show a => a -> IO ()
print a
s)
debugResponse :: (Show a, MonadIO m) => a -> m ()
debugResponse :: forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugResponse a
s = [Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Recieved: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
s
data Security = Clear | TLS
data Handle = Handle
{ Handle -> ByteString -> IO ()
send :: ByteString -> IO ()
, Handle -> ByteString -> IO ()
sendLine :: ByteString -> IO ()
, Handle -> Int -> IO ByteString
recv :: Int -> IO ByteString
, Handle -> IO ByteString
recvLine :: IO ByteString
, Handle -> Security
security :: Security
}
data FTPMessage = SingleLine ByteString | MultiLine [ByteString]
deriving FTPMessage -> FTPMessage -> Bool
(FTPMessage -> FTPMessage -> Bool)
-> (FTPMessage -> FTPMessage -> Bool) -> Eq FTPMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FTPMessage -> FTPMessage -> Bool
== :: FTPMessage -> FTPMessage -> Bool
$c/= :: FTPMessage -> FTPMessage -> Bool
/= :: FTPMessage -> FTPMessage -> Bool
Eq
instance Show FTPMessage where
show :: FTPMessage -> [Char]
show (SingleLine ByteString
message) = ByteString -> [Char]
C.unpack ByteString
message
show (MultiLine [ByteString]
messages) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
C.unpack (ByteString -> [Char]) -> [ByteString] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
messages
data FTPResponse = FTPResponse {
FTPResponse -> ResponseStatus
frStatus :: ResponseStatus,
FTPResponse -> Int
frCode :: Int,
FTPResponse -> FTPMessage
frMessage :: FTPMessage
} deriving FTPResponse -> FTPResponse -> Bool
(FTPResponse -> FTPResponse -> Bool)
-> (FTPResponse -> FTPResponse -> Bool) -> Eq FTPResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FTPResponse -> FTPResponse -> Bool
== :: FTPResponse -> FTPResponse -> Bool
$c/= :: FTPResponse -> FTPResponse -> Bool
/= :: FTPResponse -> FTPResponse -> Bool
Eq
instance Show FTPResponse where
show :: FTPResponse -> [Char]
show FTPResponse
fr = Int -> [Char]
forall a. Show a => a -> [Char]
show (FTPResponse -> Int
frCode FTPResponse
fr) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> FTPMessage -> [Char]
forall a. Show a => a -> [Char]
show (FTPResponse -> FTPMessage
frMessage FTPResponse
fr)
data ResponseStatus
= Wait
| Success
| Continue
| FailureRetry
| Failure
deriving (Int -> ResponseStatus -> [Char] -> [Char]
[ResponseStatus] -> [Char] -> [Char]
ResponseStatus -> [Char]
(Int -> ResponseStatus -> [Char] -> [Char])
-> (ResponseStatus -> [Char])
-> ([ResponseStatus] -> [Char] -> [Char])
-> Show ResponseStatus
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ResponseStatus -> [Char] -> [Char]
showsPrec :: Int -> ResponseStatus -> [Char] -> [Char]
$cshow :: ResponseStatus -> [Char]
show :: ResponseStatus -> [Char]
$cshowList :: [ResponseStatus] -> [Char] -> [Char]
showList :: [ResponseStatus] -> [Char] -> [Char]
Show, ResponseStatus -> ResponseStatus -> Bool
(ResponseStatus -> ResponseStatus -> Bool)
-> (ResponseStatus -> ResponseStatus -> Bool) -> Eq ResponseStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseStatus -> ResponseStatus -> Bool
== :: ResponseStatus -> ResponseStatus -> Bool
$c/= :: ResponseStatus -> ResponseStatus -> Bool
/= :: ResponseStatus -> ResponseStatus -> Bool
Eq)
data FTPException
= FailureRetryException FTPResponse
| FailureException FTPResponse
| UnsuccessfulException FTPResponse
| BogusResponseFormatException FTPResponse
| BadProtocolResponseException ByteString
deriving (Int -> FTPException -> [Char] -> [Char]
[FTPException] -> [Char] -> [Char]
FTPException -> [Char]
(Int -> FTPException -> [Char] -> [Char])
-> (FTPException -> [Char])
-> ([FTPException] -> [Char] -> [Char])
-> Show FTPException
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> FTPException -> [Char] -> [Char]
showsPrec :: Int -> FTPException -> [Char] -> [Char]
$cshow :: FTPException -> [Char]
show :: FTPException -> [Char]
$cshowList :: [FTPException] -> [Char] -> [Char]
showList :: [FTPException] -> [Char] -> [Char]
Show, Typeable)
instance Exception FTPException
responseStatus :: ByteString -> ResponseStatus
responseStatus :: ByteString -> ResponseStatus
responseStatus ByteString
cbs =
case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
cbs of
Just (Char
'1', ByteString
_) -> ResponseStatus
Wait
Just (Char
'2', ByteString
_) -> ResponseStatus
Success
Just (Char
'3', ByteString
_) -> ResponseStatus
Continue
Just (Char
'4', ByteString
_) -> ResponseStatus
FailureRetry
Just (Char
'5', ByteString
_) -> ResponseStatus
Failure
Maybe (Char, ByteString)
_ -> FTPException -> ResponseStatus
forall a e. Exception e => e -> a
throw (FTPException -> ResponseStatus) -> FTPException -> ResponseStatus
forall a b. (a -> b) -> a -> b
$ ByteString -> FTPException
BadProtocolResponseException ByteString
cbs
data RTypeCode = TA | TI
serialzeRTypeCode :: RTypeCode -> String
serialzeRTypeCode :: RTypeCode -> [Char]
serialzeRTypeCode RTypeCode
TA = [Char]
"A"
serialzeRTypeCode RTypeCode
TI = [Char]
"I"
data PortActivity = Active | Passive
data ProtType = P | C
data FTPCommand
= User String
| Pass String
| Acct String
| RType RTypeCode
| Retr String
| Nlst [String]
| Port S.HostAddress S.PortNumber
| Stor String
| List [String]
| Rnfr String
| Rnto String
| Dele String
| Size String
| Mkd String
| Rmd String
| Pbsz Int
| Prot ProtType
| Mlsd String
| Mlst String
| Cwd String
| Cdup
| Ccc
| Auth
| Pwd
| Abor
| Pasv
| Quit
instance Show FTPCommand where
show :: FTPCommand -> [Char]
show = FTPCommand -> [Char]
serializeCommand
formatPort :: S.HostAddress -> S.PortNumber -> String
formatPort :: HostAddress -> PortNumber -> [Char]
formatPort HostAddress
ha PortNumber
pn =
let (Word8
w1, Word8
w2, Word8
w3, Word8
w4) = HostAddress -> (Word8, Word8, Word8, Word8)
S.hostAddressToTuple HostAddress
ha
hn :: [[Char]]
hn = Word8 -> [Char]
forall a. Show a => a -> [Char]
show (Word8 -> [Char]) -> [Word8] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
w1, Word8
w2, Word8
w3, Word8
w4]
portParts :: [[Char]]
portParts = PortNumber -> [Char]
forall a. Show a => a -> [Char]
show (PortNumber -> [Char]) -> [PortNumber] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PortNumber
pn PortNumber -> PortNumber -> PortNumber
forall a. Integral a => a -> a -> a
`quot` PortNumber
256, PortNumber
pn PortNumber -> PortNumber -> PortNumber
forall a. Integral a => a -> a -> a
`mod` PortNumber
256]
in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]]
hn [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
portParts)
serializeCommand :: FTPCommand -> String
serializeCommand :: FTPCommand -> [Char]
serializeCommand (User [Char]
user) = [Char]
"USER " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
user
serializeCommand (Pass [Char]
pass) = [Char]
"PASS " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
pass
serializeCommand (Acct [Char]
acct) = [Char]
"ACCT " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
acct
serializeCommand (RType RTypeCode
rt) = [Char]
"TYPE " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> RTypeCode -> [Char]
serialzeRTypeCode RTypeCode
rt
serializeCommand (Retr [Char]
file) = [Char]
"RETR " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
file
serializeCommand (Nlst []) = [Char]
"NLST"
serializeCommand (Nlst [[Char]]
args) = [Char]
"NLST " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
unwords [[Char]]
args
serializeCommand (Port HostAddress
ha PortNumber
pn) = [Char]
"PORT " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> HostAddress -> PortNumber -> [Char]
formatPort HostAddress
ha PortNumber
pn
serializeCommand (Stor [Char]
loc) = [Char]
"STOR " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
loc
serializeCommand (List []) = [Char]
"LIST"
serializeCommand (List [[Char]]
args) = [Char]
"LIST " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
unwords [[Char]]
args
serializeCommand (Rnfr [Char]
from) = [Char]
"RNFR " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
from
serializeCommand (Rnto [Char]
to) = [Char]
"RNTO " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
to
serializeCommand (Dele [Char]
file) = [Char]
"DELE " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
file
serializeCommand (Size [Char]
file) = [Char]
"SIZE " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
file
serializeCommand (Mkd [Char]
dir) = [Char]
"MKD " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
dir
serializeCommand (Rmd [Char]
dir) = [Char]
"RMD " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
dir
serializeCommand (Pbsz Int
buf) = [Char]
"PBSZ " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
buf
serializeCommand (Prot ProtType
P) = [Char]
"PROT P"
serializeCommand (Prot ProtType
C) = [Char]
"PROT C"
serializeCommand (Mlsd [Char]
path) = [Char]
"MLSD " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path
serializeCommand (Mlst [Char]
path) = [Char]
"MLST " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path
serializeCommand (Cwd [Char]
dir) = [Char]
"CWD " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
dir
serializeCommand FTPCommand
Cdup = [Char]
"CDUP"
serializeCommand FTPCommand
Ccc = [Char]
"CCC"
serializeCommand FTPCommand
Auth = [Char]
"AUTH TLS"
serializeCommand FTPCommand
Pwd = [Char]
"PWD"
serializeCommand FTPCommand
Abor = [Char]
"ABOR"
serializeCommand FTPCommand
Pasv = [Char]
"PASV"
serializeCommand FTPCommand
Quit = [Char]
"QUIT"
stripCLRF :: ByteString -> ByteString
stripCLRF :: ByteString -> ByteString
stripCLRF = (Char -> Bool) -> ByteString -> ByteString
C.takeWhile ((Char -> Bool) -> ByteString -> ByteString)
-> (Char -> Bool) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') (Char -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b. (Char -> a -> b) -> (Char -> a) -> Char -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
getLineResp :: Handle -> IO ByteString
getLineResp :: Handle -> IO ByteString
getLineResp Handle
h = ByteString -> ByteString
stripCLRF (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
recvLine Handle
h
getResponse :: MonadIO m => Handle -> m FTPResponse
getResponse :: forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse Handle
h = do
ByteString
line <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
getLineResp Handle
h
let (ByteString
code, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
C.splitAt Int
3 ByteString
line
FTPMessage
message <- if ByteString -> Char
C.head ByteString
rest Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
then [ByteString] -> FTPMessage
MultiLine ([ByteString] -> FTPMessage) -> m [ByteString] -> m FTPMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> ByteString -> [ByteString] -> m [ByteString]
forall (m :: * -> *).
MonadIO m =>
Handle -> ByteString -> [ByteString] -> m [ByteString]
loopMultiLine Handle
h ByteString
code [ByteString
line]
else FTPMessage -> m FTPMessage
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FTPMessage -> m FTPMessage) -> FTPMessage -> m FTPMessage
forall a b. (a -> b) -> a -> b
$ ByteString -> FTPMessage
SingleLine ByteString
line
let codeDroppedMessage :: FTPMessage
codeDroppedMessage = case FTPMessage
message of
SingleLine ByteString
message -> ByteString -> FTPMessage
SingleLine (ByteString -> FTPMessage) -> ByteString -> FTPMessage
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
C.drop Int
4 ByteString
message
MultiLine [] -> [ByteString] -> FTPMessage
MultiLine []
MultiLine (ByteString
message:[ByteString]
messages) ->
[ByteString] -> FTPMessage
MultiLine ([ByteString] -> FTPMessage) -> [ByteString] -> FTPMessage
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
C.drop Int
4 ByteString
message ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
messages
let response :: FTPResponse
response = ResponseStatus -> Int -> FTPMessage -> FTPResponse
FTPResponse
(ByteString -> ResponseStatus
responseStatus ByteString
code)
([Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
C.unpack ByteString
code)
FTPMessage
codeDroppedMessage
case FTPResponse -> ResponseStatus
frStatus FTPResponse
response of
ResponseStatus
FailureRetry -> IO FTPResponse -> m FTPResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FTPResponse -> m FTPResponse)
-> IO FTPResponse -> m FTPResponse
forall a b. (a -> b) -> a -> b
$ FTPException -> IO FTPResponse
forall e a. Exception e => e -> IO a
throwIO (FTPException -> IO FTPResponse) -> FTPException -> IO FTPResponse
forall a b. (a -> b) -> a -> b
$ FTPResponse -> FTPException
FailureRetryException FTPResponse
response
ResponseStatus
Failure -> IO FTPResponse -> m FTPResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FTPResponse -> m FTPResponse)
-> IO FTPResponse -> m FTPResponse
forall a b. (a -> b) -> a -> b
$ FTPException -> IO FTPResponse
forall e a. Exception e => e -> IO a
throwIO (FTPException -> IO FTPResponse) -> FTPException -> IO FTPResponse
forall a b. (a -> b) -> a -> b
$ FTPResponse -> FTPException
FailureException FTPResponse
response
ResponseStatus
_ -> FTPResponse -> m FTPResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FTPResponse
response
loopMultiLine
:: MonadIO m
=> Handle
-> ByteString
-> [ByteString]
-> m [ByteString]
loopMultiLine :: forall (m :: * -> *).
MonadIO m =>
Handle -> ByteString -> [ByteString] -> m [ByteString]
loopMultiLine Handle
h ByteString
code [ByteString]
lines = do
ByteString
nextLine <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
getLineResp Handle
h
let newLines :: [ByteString]
newLines = [ByteString]
lines [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [(Char -> Bool) -> ByteString -> ByteString
C.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
nextLine]
nextCode :: ByteString
nextCode = Int -> ByteString -> ByteString
C.take Int
3 ByteString
nextLine
if ByteString
nextCode ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
code
then [ByteString] -> m [ByteString]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
newLines
else Handle -> ByteString -> [ByteString] -> m [ByteString]
forall (m :: * -> *).
MonadIO m =>
Handle -> ByteString -> [ByteString] -> m [ByteString]
loopMultiLine Handle
h ByteString
code [ByteString]
newLines
ensureSuccess :: MonadIO m => FTPResponse -> m FTPResponse
ensureSuccess :: forall (m :: * -> *). MonadIO m => FTPResponse -> m FTPResponse
ensureSuccess FTPResponse
resp =
case FTPResponse -> ResponseStatus
frStatus FTPResponse
resp of
ResponseStatus
Success -> FTPResponse -> m FTPResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FTPResponse
resp
ResponseStatus
_ -> IO FTPResponse -> m FTPResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FTPResponse -> m FTPResponse)
-> IO FTPResponse -> m FTPResponse
forall a b. (a -> b) -> a -> b
$ FTPException -> IO FTPResponse
forall e a. Exception e => e -> IO a
throwIO (FTPException -> IO FTPResponse) -> FTPException -> IO FTPResponse
forall a b. (a -> b) -> a -> b
$ FTPResponse -> FTPException
UnsuccessfulException FTPResponse
resp
getResponseS :: MonadIO m => Handle -> m FTPResponse
getResponseS :: forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponseS = FTPResponse -> m FTPResponse
forall (m :: * -> *). MonadIO m => FTPResponse -> m FTPResponse
ensureSuccess (FTPResponse -> m FTPResponse)
-> (Handle -> m FTPResponse) -> Handle -> m FTPResponse
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> m FTPResponse
forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse
sendCommandLine :: MonadIO m => Handle -> ByteString -> m ()
sendCommandLine :: forall (m :: * -> *). MonadIO m => Handle -> ByteString -> m ()
sendCommandLine Handle
h = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ()
send Handle
h (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n")
sendCommand :: MonadIO m => Handle -> FTPCommand -> m FTPResponse
sendCommand :: forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommand Handle
h FTPCommand
fc = do
let command :: [Char]
command = FTPCommand -> [Char]
serializeCommand FTPCommand
fc
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Sending: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
command
Handle -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Handle -> ByteString -> m ()
sendCommandLine Handle
h (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
C.pack [Char]
command
FTPResponse
resp <- Handle -> m FTPResponse
forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse Handle
h
FTPResponse -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugResponse FTPResponse
resp
FTPResponse -> m FTPResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FTPResponse
resp
sendCommandS :: MonadIO m => Handle -> FTPCommand -> m FTPResponse
sendCommandS :: forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h FTPCommand
fc = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommand Handle
h FTPCommand
fc m FTPResponse -> (FTPResponse -> m FTPResponse) -> m FTPResponse
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FTPResponse -> m FTPResponse
forall (m :: * -> *). MonadIO m => FTPResponse -> m FTPResponse
ensureSuccess
sendAll :: MonadIO m => Handle -> [FTPCommand] -> m [FTPResponse]
sendAll :: forall (m :: * -> *).
MonadIO m =>
Handle -> [FTPCommand] -> m [FTPResponse]
sendAll = (FTPCommand -> m FTPResponse) -> [FTPCommand] -> m [FTPResponse]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((FTPCommand -> m FTPResponse) -> [FTPCommand] -> m [FTPResponse])
-> (Handle -> FTPCommand -> m FTPResponse)
-> Handle
-> [FTPCommand]
-> m [FTPResponse]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommand
sendAllS :: MonadIO m => Handle -> [FTPCommand] -> m [FTPResponse]
sendAllS :: forall (m :: * -> *).
MonadIO m =>
Handle -> [FTPCommand] -> m [FTPResponse]
sendAllS = (FTPCommand -> m FTPResponse) -> [FTPCommand] -> m [FTPResponse]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((FTPCommand -> m FTPResponse) -> [FTPCommand] -> m [FTPResponse])
-> (Handle -> FTPCommand -> m FTPResponse)
-> Handle
-> [FTPCommand]
-> m [FTPResponse]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS
createSocket
:: MonadIO m
=> Maybe String
-> Int
-> S.AddrInfo
-> m (S.Socket, S.AddrInfo)
createSocket :: forall (m :: * -> *).
MonadIO m =>
Maybe [Char] -> Int -> AddrInfo -> m (Socket, AddrInfo)
createSocket Maybe [Char]
host Int
portNum AddrInfo
hints = do
AddrInfo
addr <- IO AddrInfo -> m AddrInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AddrInfo -> m AddrInfo) -> IO AddrInfo -> m AddrInfo
forall a b. (a -> b) -> a -> b
$ do
AddrInfo
a:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO [AddrInfo]
S.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) Maybe [Char]
host ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
portNum)
AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AddrInfo
a
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Addr: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> AddrInfo -> [Char]
forall a. Show a => a -> [Char]
show AddrInfo
addr
Socket
sock <- IO Socket -> m Socket
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ Family -> SocketType -> ProtocolNumber -> IO Socket
S.socket
(AddrInfo -> Family
S.addrFamily AddrInfo
addr)
(AddrInfo -> SocketType
S.addrSocketType AddrInfo
addr)
(AddrInfo -> ProtocolNumber
S.addrProtocol AddrInfo
addr)
(Socket, AddrInfo) -> m (Socket, AddrInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, AddrInfo
addr)
withSocketPassive
:: (MonadIO m, MonadMask m)
=> String
-> Int
-> (S.Socket -> m a)
-> m a
withSocketPassive :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> Int -> (Socket -> m a) -> m a
withSocketPassive [Char]
host Int
portNum Socket -> m a
f = do
let hints :: AddrInfo
hints = AddrInfo
S.defaultHints {
S.addrSocketType = S.Stream
}
m (Socket, AddrInfo)
-> ((Socket, AddrInfo) -> m ())
-> ((Socket, AddrInfo) -> m a)
-> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
M.bracketOnError
(Maybe [Char] -> Int -> AddrInfo -> m (Socket, AddrInfo)
forall (m :: * -> *).
MonadIO m =>
Maybe [Char] -> Int -> AddrInfo -> m (Socket, AddrInfo)
createSocket ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
host) Int
portNum AddrInfo
hints)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Socket, AddrInfo) -> IO ()) -> (Socket, AddrInfo) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
S.close (Socket -> IO ())
-> ((Socket, AddrInfo) -> Socket) -> (Socket, AddrInfo) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, AddrInfo) -> Socket
forall a b. (a, b) -> a
fst)
(\(Socket
sock, AddrInfo
addr) -> do
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint [Char]
"Connecting"
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
S.connect Socket
sock (AddrInfo -> SockAddr
S.addrAddress AddrInfo
addr)
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint [Char]
"Connected"
Socket -> m a
f Socket
sock
)
withSocketActive :: (MonadIO m, MonadMask m) => (S.Socket -> m a) -> m a
withSocketActive :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(Socket -> m a) -> m a
withSocketActive Socket -> m a
f = do
let hints :: AddrInfo
hints = AddrInfo
S.defaultHints {
S.addrSocketType = S.Stream,
S.addrFlags = [S.AI_PASSIVE]
}
m (Socket, AddrInfo)
-> ((Socket, AddrInfo) -> m ())
-> ((Socket, AddrInfo) -> m a)
-> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
M.bracketOnError
(Maybe [Char] -> Int -> AddrInfo -> m (Socket, AddrInfo)
forall (m :: * -> *).
MonadIO m =>
Maybe [Char] -> Int -> AddrInfo -> m (Socket, AddrInfo)
createSocket Maybe [Char]
forall a. Maybe a
Nothing Int
0 AddrInfo
hints)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Socket, AddrInfo) -> IO ()) -> (Socket, AddrInfo) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
S.close (Socket -> IO ())
-> ((Socket, AddrInfo) -> Socket) -> (Socket, AddrInfo) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, AddrInfo) -> Socket
forall a b. (a, b) -> a
fst)
(\(Socket
sock, AddrInfo
addr) -> do
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint [Char]
"Binding"
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
S.bind Socket
sock (AddrInfo -> SockAddr
S.addrAddress AddrInfo
addr)
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> Int -> IO ()
S.listen Socket
sock Int
1
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint [Char]
"Listening"
Socket -> m a
f Socket
sock
)
createSIOHandle :: (MonadIO m, MonadMask m) => String -> Int -> m SIO.Handle
createSIOHandle :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[Char] -> Int -> m Handle
createSIOHandle [Char]
host Int
portNum = [Char] -> Int -> (Socket -> m Handle) -> m Handle
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> Int -> (Socket -> m a) -> m a
withSocketPassive [Char]
host Int
portNum
((Socket -> m Handle) -> m Handle)
-> (Socket -> m Handle) -> m Handle
forall a b. (a -> b) -> a -> b
$ IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle)
-> (Socket -> IO Handle) -> Socket -> m Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IOMode -> IO Handle) -> IOMode -> Socket -> IO Handle
forall a b c. (a -> b -> c) -> b -> a -> c
flip Socket -> IOMode -> IO Handle
S.socketToHandle IOMode
SIO.ReadWriteMode
sIOHandleImpl :: SIO.Handle -> Handle
sIOHandleImpl :: Handle -> Handle
sIOHandleImpl Handle
h = Handle
{ send :: ByteString -> IO ()
send = Handle -> ByteString -> IO ()
C.hPut Handle
h
, sendLine :: ByteString -> IO ()
sendLine = Handle -> ByteString -> IO ()
C.hPutStrLn Handle
h
, recv :: Int -> IO ByteString
recv = Handle -> Int -> IO ByteString
C.hGetSome Handle
h
, recvLine :: IO ByteString
recvLine = Handle -> IO ByteString
C.hGetLine Handle
h
, security :: Security
security = Security
Clear
}
withSIOHandle
:: (MonadIO m, MonadMask m)
=> String
-> Int
-> (Handle -> m a)
-> m a
withSIOHandle :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> Int -> (Handle -> m a) -> m a
withSIOHandle [Char]
host Int
portNum Handle -> m a
f = m Handle -> (Handle -> m ()) -> (Handle -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
M.bracket
(IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> IO Handle
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[Char] -> Int -> m Handle
createSIOHandle [Char]
host Int
portNum)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
SIO.hClose)
(Handle -> m a
f (Handle -> m a) -> (Handle -> Handle) -> Handle -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Handle
sIOHandleImpl)
withFTP
:: (MonadIO m, MonadMask m)
=> String
-> Int
-> (Handle -> FTPResponse -> m a)
-> m a
withFTP :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> Int -> (Handle -> FTPResponse -> m a) -> m a
withFTP [Char]
host Int
portNum Handle -> FTPResponse -> m a
f = [Char] -> Int -> (Handle -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> Int -> (Handle -> m a) -> m a
withSIOHandle [Char]
host Int
portNum ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
FTPResponse
resp <- Handle -> m FTPResponse
forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse Handle
h
Handle -> FTPResponse -> m a
f Handle
h FTPResponse
resp
withDataSocketPasv
:: (MonadIO m, MonadMask m)
=> Handle
-> (S.Socket -> m a)
-> m a
withDataSocketPasv :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle -> (Socket -> m a) -> m a
withDataSocketPasv Handle
h Socket -> m a
f = do
([Char]
host, Int
portNum) <- Handle -> m ([Char], Int)
forall (m :: * -> *). MonadIO m => Handle -> m ([Char], Int)
pasv Handle
h
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Host: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
host
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Port: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
portNum
[Char] -> Int -> (Socket -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> Int -> (Socket -> m a) -> m a
withSocketPassive [Char]
host Int
portNum Socket -> m a
f
withDataSocketActive
:: (MonadIO m, MonadMask m)
=> Handle
-> (S.Socket -> m a)
-> m a
withDataSocketActive :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle -> (Socket -> m a) -> m a
withDataSocketActive Handle
h Socket -> m a
f = (Socket -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(Socket -> m a) -> m a
withSocketActive ((Socket -> m a) -> m a) -> (Socket -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Socket
socket -> do
(PortNumber
sPort, HostAddress
sHost) <- IO (PortNumber, HostAddress) -> m (PortNumber, HostAddress)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PortNumber, HostAddress) -> m (PortNumber, HostAddress))
-> IO (PortNumber, HostAddress) -> m (PortNumber, HostAddress)
forall a b. (a -> b) -> a -> b
$ do
(S.SockAddrInet PortNumber
p HostAddress
h) <- Socket -> IO SockAddr
S.getSocketName Socket
socket
(PortNumber, HostAddress) -> IO (PortNumber, HostAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PortNumber
p,HostAddress
h)
Handle -> HostAddress -> PortNumber -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> HostAddress -> PortNumber -> m FTPResponse
port Handle
h HostAddress
sHost PortNumber
sPort
Socket -> m a
f Socket
socket
withDataSocket
:: (MonadIO m, MonadMask m)
=> PortActivity
-> Handle
-> (S.Socket -> m a)
-> m a
withDataSocket :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
PortActivity -> Handle -> (Socket -> m a) -> m a
withDataSocket PortActivity
Active = Handle -> (Socket -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle -> (Socket -> m a) -> m a
withDataSocketActive
withDataSocket PortActivity
Passive = Handle -> (Socket -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle -> (Socket -> m a) -> m a
withDataSocketPasv
acceptData :: MonadIO m => PortActivity -> S.Socket -> m S.Socket
acceptData :: forall (m :: * -> *).
MonadIO m =>
PortActivity -> Socket -> m Socket
acceptData PortActivity
Passive = Socket -> m Socket
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
acceptData PortActivity
Active = Socket -> m Socket
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket -> m Socket)
-> ((Socket, SockAddr) -> Socket) -> (Socket, SockAddr) -> m Socket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst ((Socket, SockAddr) -> m Socket)
-> (Socket -> m (Socket, SockAddr)) -> Socket -> m Socket
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Socket, SockAddr) -> m (Socket, SockAddr)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Socket, SockAddr) -> m (Socket, SockAddr))
-> (Socket -> IO (Socket, SockAddr))
-> Socket
-> m (Socket, SockAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO (Socket, SockAddr)
S.accept
ensureSucessfulData :: MonadIO m => Handle -> FTPResponse -> m ()
ensureSucessfulData :: forall (m :: * -> *). MonadIO m => Handle -> FTPResponse -> m ()
ensureSucessfulData Handle
h FTPResponse
resp = do
FTPResponse
resp' <- case FTPResponse -> ResponseStatus
frStatus FTPResponse
resp of
ResponseStatus
Success -> do
FTPResponse
newResp <- Handle -> m FTPResponse
forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse Handle
h
FTPResponse -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugResponse FTPResponse
newResp
FTPResponse -> m FTPResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FTPResponse
newResp
ResponseStatus
_ -> FTPResponse -> m FTPResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FTPResponse
resp
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FTPResponse -> ResponseStatus
frStatus FTPResponse
resp' ResponseStatus -> ResponseStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= ResponseStatus
Wait)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FTPException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FTPException -> IO ()) -> FTPException -> IO ()
forall a b. (a -> b) -> a -> b
$ FTPResponse -> FTPException
UnsuccessfulException FTPResponse
resp
createSendDataCommand
:: (MonadIO m, MonadMask m)
=> Handle
-> PortActivity
-> FTPCommand
-> m SIO.Handle
createSendDataCommand :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> PortActivity -> FTPCommand -> m Handle
createSendDataCommand Handle
h PortActivity
pa FTPCommand
cmd = PortActivity -> Handle -> (Socket -> m Handle) -> m Handle
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
PortActivity -> Handle -> (Socket -> m a) -> m a
withDataSocket PortActivity
pa Handle
h ((Socket -> m Handle) -> m Handle)
-> (Socket -> m Handle) -> m Handle
forall a b. (a -> b) -> a -> b
$ \Socket
socket -> do
FTPResponse
resp <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommand Handle
h FTPCommand
cmd
Handle -> FTPResponse -> m ()
forall (m :: * -> *). MonadIO m => Handle -> FTPResponse -> m ()
ensureSucessfulData Handle
h FTPResponse
resp
Socket
acceptedSock <- PortActivity -> Socket -> m Socket
forall (m :: * -> *).
MonadIO m =>
PortActivity -> Socket -> m Socket
acceptData PortActivity
pa Socket
socket
IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ Socket -> IOMode -> IO Handle
S.socketToHandle Socket
acceptedSock IOMode
SIO.ReadWriteMode
withDataCommand
:: (MonadIO m, MonadMask m)
=> Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommand :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommand Handle
ch PortActivity
pa RTypeCode
code FTPCommand
cmd Handle -> m a
f = do
Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
ch (FTPCommand -> m FTPResponse) -> FTPCommand -> m FTPResponse
forall a b. (a -> b) -> a -> b
$ RTypeCode -> FTPCommand
RType RTypeCode
code
a
x <- m Handle -> (Handle -> m ()) -> (Handle -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
M.bracket
(Handle -> PortActivity -> FTPCommand -> m Handle
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> PortActivity -> FTPCommand -> m Handle
createSendDataCommand Handle
ch PortActivity
pa FTPCommand
cmd)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
SIO.hClose)
(Handle -> m a
f (Handle -> m a) -> (Handle -> Handle) -> Handle -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Handle
sIOHandleImpl)
FTPResponse
resp <- Handle -> m FTPResponse
forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse Handle
ch
FTPResponse -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugResponse FTPResponse
resp
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
getAllLineResp :: (MonadIO m, MonadCatch m) => Handle -> m ByteString
getAllLineResp :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Handle -> m ByteString
getAllLineResp Handle
h = Handle -> [ByteString] -> m ByteString
forall {m :: * -> *}.
(MonadCatch m, MonadIO m) =>
Handle -> [ByteString] -> m ByteString
getAllLineResp' Handle
h []
where
getAllLineResp' :: Handle -> [ByteString] -> m ByteString
getAllLineResp' Handle
h [ByteString]
ret = ( do
ByteString
line <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
getLineResp Handle
h
Handle -> [ByteString] -> m ByteString
getAllLineResp' Handle
h ([ByteString]
ret [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
line]))
m ByteString -> (IOError -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (IOError -> m a) -> m a
`M.catchIOError` (\IOError
_ -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
C.intercalate ByteString
"\n" [ByteString]
ret)
recvAll :: (MonadIO m, MonadCatch m) => Handle -> m ByteString
recvAll :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Handle -> m ByteString
recvAll Handle
h = ByteString -> m ByteString
forall {m :: * -> *}.
(MonadCatch m, MonadIO m) =>
ByteString -> m ByteString
recvAll' ByteString
""
where
recvAll' :: ByteString -> m ByteString
recvAll' ByteString
bs = ( do
ByteString
chunk <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
recv Handle
h Int
defaultChunkSize
if ByteString -> Bool
C.null ByteString
chunk
then ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
else ByteString -> m ByteString
recvAll' (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
chunk
) m ByteString -> (IOError -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (IOError -> m a) -> m a
`M.catchIOError` (\IOError
_ -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs)
connectTLS :: MonadIO m => SIO.Handle -> String -> Int -> m Connection
connectTLS :: forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> Int -> m Connection
connectTLS Handle
h [Char]
host Int
portNum = do
ConnectionContext
context <- IO ConnectionContext -> m ConnectionContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ConnectionContext
initConnectionContext
let tlsSettings :: TLSSettings
tlsSettings = TLSSettingsSimple
{ settingDisableCertificateValidation :: Bool
settingDisableCertificateValidation = Bool
True
, settingDisableSession :: Bool
settingDisableSession = Bool
False
, settingUseServerName :: Bool
settingUseServerName = Bool
False
}
connectionParams :: ConnectionParams
connectionParams = ConnectionParams
{ connectionHostname :: [Char]
connectionHostname = [Char]
host
, connectionPort :: PortNumber
connectionPort = Int -> PortNumber
forall a. Enum a => Int -> a
toEnum (Int -> PortNumber) -> (Int -> Int) -> Int -> PortNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> Int
fromEnum (Int -> PortNumber) -> Int -> PortNumber
forall a b. (a -> b) -> a -> b
$ Int
portNum
, connectionUseSecure :: Maybe TLSSettings
connectionUseSecure = TLSSettings -> Maybe TLSSettings
forall a. a -> Maybe a
Just TLSSettings
tlsSettings
, connectionUseSocks :: Maybe ProxySettings
connectionUseSocks = Maybe ProxySettings
forall a. Maybe a
Nothing
}
IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ ConnectionContext -> Handle -> ConnectionParams -> IO Connection
connectFromHandle ConnectionContext
context Handle
h ConnectionParams
connectionParams
createTLSConnection
:: (MonadIO m, MonadMask m)
=> String
-> Int
-> m (FTPResponse, Connection)
createTLSConnection :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[Char] -> Int -> m (FTPResponse, Connection)
createTLSConnection [Char]
host Int
portNum = do
Handle
h <- [Char] -> Int -> m Handle
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[Char] -> Int -> m Handle
createSIOHandle [Char]
host Int
portNum
let insecureH :: Handle
insecureH = Handle -> Handle
sIOHandleImpl Handle
h
FTPResponse
resp <- Handle -> m FTPResponse
forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse Handle
insecureH
Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommand Handle
insecureH FTPCommand
Auth
Connection
conn <- Handle -> [Char] -> Int -> m Connection
forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> Int -> m Connection
connectTLS Handle
h [Char]
host Int
portNum
(FTPResponse, Connection) -> m (FTPResponse, Connection)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FTPResponse
resp, Connection
conn)
tlsHandleImpl :: Connection -> Handle
tlsHandleImpl :: Connection -> Handle
tlsHandleImpl Connection
c = Handle
{ send :: ByteString -> IO ()
send = Connection -> ByteString -> IO ()
connectionPut Connection
c
, sendLine :: ByteString -> IO ()
sendLine = Connection -> ByteString -> IO ()
connectionPut Connection
c (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")
, recv :: Int -> IO ByteString
recv = Connection -> Int -> IO ByteString
connectionGet Connection
c
, recvLine :: IO ByteString
recvLine = Int -> Connection -> IO ByteString
connectionGetLine Int
forall a. Bounded a => a
maxBound Connection
c
, security :: Security
security = Security
TLS
}
withTLSHandle
:: (MonadMask m, MonadIO m)
=> String
-> Int
-> (Handle -> FTPResponse -> m a)
-> m a
withTLSHandle :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[Char] -> Int -> (Handle -> FTPResponse -> m a) -> m a
withTLSHandle [Char]
host Int
portNum Handle -> FTPResponse -> m a
f = m (FTPResponse, Connection)
-> ((FTPResponse, Connection) -> m ())
-> ((FTPResponse, Connection) -> m a)
-> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
M.bracket
([Char] -> Int -> m (FTPResponse, Connection)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[Char] -> Int -> m (FTPResponse, Connection)
createTLSConnection [Char]
host Int
portNum)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((FTPResponse, Connection) -> IO ())
-> (FTPResponse, Connection)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
connectionClose (Connection -> IO ())
-> ((FTPResponse, Connection) -> Connection)
-> (FTPResponse, Connection)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FTPResponse, Connection) -> Connection
forall a b. (a, b) -> b
snd)
(\(FTPResponse
resp, Connection
conn) -> Handle -> FTPResponse -> m a
f (Connection -> Handle
tlsHandleImpl Connection
conn) FTPResponse
resp)
withFTPS
:: (MonadMask m, MonadIO m)
=> String
-> Int
-> (Handle -> FTPResponse -> m a)
-> m a
withFTPS :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[Char] -> Int -> (Handle -> FTPResponse -> m a) -> m a
withFTPS = [Char] -> Int -> (Handle -> FTPResponse -> m a) -> m a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[Char] -> Int -> (Handle -> FTPResponse -> m a) -> m a
withTLSHandle
createTLSSendDataCommand
:: (MonadIO m, MonadMask m)
=> Handle
-> PortActivity
-> FTPCommand
-> m Connection
createTLSSendDataCommand :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> PortActivity -> FTPCommand -> m Connection
createTLSSendDataCommand Handle
ch PortActivity
pa FTPCommand
cmd = do
Handle -> [FTPCommand] -> m [FTPResponse]
forall (m :: * -> *).
MonadIO m =>
Handle -> [FTPCommand] -> m [FTPResponse]
sendAllS Handle
ch [Int -> FTPCommand
Pbsz Int
0, ProtType -> FTPCommand
Prot ProtType
P]
PortActivity -> Handle -> (Socket -> m Connection) -> m Connection
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
PortActivity -> Handle -> (Socket -> m a) -> m a
withDataSocket PortActivity
pa Handle
ch ((Socket -> m Connection) -> m Connection)
-> (Socket -> m Connection) -> m Connection
forall a b. (a -> b) -> a -> b
$ \Socket
socket -> do
FTPResponse
resp <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommand Handle
ch FTPCommand
cmd
Handle -> FTPResponse -> m ()
forall (m :: * -> *). MonadIO m => Handle -> FTPResponse -> m ()
ensureSucessfulData Handle
ch FTPResponse
resp
Socket
acceptedSock <- PortActivity -> Socket -> m Socket
forall (m :: * -> *).
MonadIO m =>
PortActivity -> Socket -> m Socket
acceptData PortActivity
pa Socket
socket
(PortNumber
sPort, HostAddress
sHost) <- IO (PortNumber, HostAddress) -> m (PortNumber, HostAddress)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PortNumber, HostAddress) -> m (PortNumber, HostAddress))
-> IO (PortNumber, HostAddress) -> m (PortNumber, HostAddress)
forall a b. (a -> b) -> a -> b
$ do
(S.SockAddrInet PortNumber
p HostAddress
h) <- Socket -> IO SockAddr
S.getSocketName Socket
acceptedSock
(PortNumber, HostAddress) -> IO (PortNumber, HostAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PortNumber
p, HostAddress
h)
let (Word8
h1, Word8
h2, Word8
h3, Word8
h4) = HostAddress -> (Word8, Word8, Word8, Word8)
S.hostAddressToTuple HostAddress
sHost
hostName :: [Char]
hostName = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (Word8 -> Int) -> Word8 -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Word8 -> [Char]) -> [Word8] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
h1, Word8
h2, Word8
h3, Word8
h4]
Handle
h <- IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ Socket -> IOMode -> IO Handle
S.socketToHandle Socket
acceptedSock IOMode
SIO.ReadWriteMode
IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> Int -> IO Connection
forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> Int -> m Connection
connectTLS Handle
h [Char]
hostName (PortNumber -> Int
forall a. Enum a => a -> Int
fromEnum PortNumber
sPort)
withTLSDataCommand
:: (MonadIO m, MonadMask m)
=> Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withTLSDataCommand :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withTLSDataCommand Handle
ch PortActivity
pa RTypeCode
code FTPCommand
cmd Handle -> m a
f = do
Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
ch (FTPCommand -> m FTPResponse) -> FTPCommand -> m FTPResponse
forall a b. (a -> b) -> a -> b
$ RTypeCode -> FTPCommand
RType RTypeCode
code
a
x <- m Connection -> (Connection -> m ()) -> (Connection -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
M.bracket
(Handle -> PortActivity -> FTPCommand -> m Connection
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> PortActivity -> FTPCommand -> m Connection
createTLSSendDataCommand Handle
ch PortActivity
pa FTPCommand
cmd)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Connection -> IO ()) -> Connection -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
connectionClose)
(Handle -> m a
f (Handle -> m a) -> (Connection -> Handle) -> Connection -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Handle
tlsHandleImpl)
FTPResponse
resp <- Handle -> m FTPResponse
forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
getResponse Handle
ch
[Char] -> m ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
debugPrint ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Recieved: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> FTPResponse -> [Char]
forall a. Show a => a -> [Char]
show FTPResponse
resp
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
parseResponse :: MonadIO m => FTPResponse -> Parser a -> m a
parseResponse :: forall (m :: * -> *) a. MonadIO m => FTPResponse -> Parser a -> m a
parseResponse FTPResponse
resp Parser a
p =
let parsableMessage :: ByteString
parsableMessage = case FTPResponse -> FTPMessage
frMessage FTPResponse
resp of
SingleLine ByteString
message -> ByteString
message
MultiLine [ByteString]
messages -> ByteString -> [ByteString] -> ByteString
C.intercalate ByteString
"\n" [ByteString]
messages
in case Parser a -> ByteString -> Either [Char] a
forall a. Parser a -> ByteString -> Either [Char] a
parseOnly Parser a
p ByteString
parsableMessage of
Right a
x -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Left [Char]
_ -> IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ FTPException -> IO a
forall e a. Exception e => e -> IO a
throwIO
(FTPException -> IO a) -> FTPException -> IO a
forall a b. (a -> b) -> a -> b
$ ByteString -> FTPException
BadProtocolResponseException ByteString
parsableMessage
ensureCode :: MonadIO m => FTPResponse -> Int -> m ()
ensureCode :: forall (m :: * -> *). MonadIO m => FTPResponse -> Int -> m ()
ensureCode FTPResponse
resp Int
code =
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FTPResponse -> Int
frCode FTPResponse
resp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
code)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FTPException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FTPException -> IO ()) -> FTPException -> IO ()
forall a b. (a -> b) -> a -> b
$ FTPResponse -> FTPException
UnsuccessfulException FTPResponse
resp
parse227 :: Parser (String, Int)
parse227 :: Parser ([Char], Int)
parse227 = do
(Char -> Bool) -> Parser ()
skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(') Parser () -> Parser ByteString Char -> Parser ByteString Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString Char
char Char
'('
[[Char]
h1,[Char]
h2,[Char]
h3,[Char]
h4,[Char]
p1,[Char]
p2] <- Parser ByteString Char -> Parser ByteString [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString Char
digit Parser ByteString [Char]
-> Parser ByteString Char -> Parser ByteString [[Char]]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser ByteString Char
char Char
','
let host :: [Char]
host = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." [[Char]
h1,[Char]
h2,[Char]
h3,[Char]
h4]
highBits :: Int
highBits = [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
p1
lowBits :: Int
lowBits = [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
p2
portNum :: Int
portNum = (Int
highBits Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lowBits
([Char], Int) -> Parser ([Char], Int)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
host, Int
portNum)
parse257 :: Parser String
parse257 :: Parser ByteString [Char]
parse257 = do
Char -> Parser ByteString Char
char Char
'"'
ByteString -> [Char]
C.unpack (ByteString -> [Char])
-> Parser ByteString ByteString -> Parser ByteString [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"')
login :: MonadIO m => Handle -> String -> String -> m FTPResponse
login :: forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> [Char] -> m FTPResponse
login Handle
h [Char]
user [Char]
pass = do
FTPResponse
resp <- [FTPResponse] -> FTPResponse
forall a. HasCallStack => [a] -> a
last ([FTPResponse] -> FTPResponse) -> m [FTPResponse] -> m FTPResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> [FTPCommand] -> m [FTPResponse]
forall (m :: * -> *).
MonadIO m =>
Handle -> [FTPCommand] -> m [FTPResponse]
sendAll Handle
h [[Char] -> FTPCommand
User [Char]
user, [Char] -> FTPCommand
Pass [Char]
pass]
FTPResponse -> m FTPResponse
forall (m :: * -> *). MonadIO m => FTPResponse -> m FTPResponse
ensureSuccess FTPResponse
resp
pasv :: MonadIO m => Handle -> m (String, Int)
pasv :: forall (m :: * -> *). MonadIO m => Handle -> m ([Char], Int)
pasv Handle
h = do
FTPResponse
resp <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h FTPCommand
Pasv
FTPResponse -> Int -> m ()
forall (m :: * -> *). MonadIO m => FTPResponse -> Int -> m ()
ensureCode FTPResponse
resp Int
227
FTPResponse -> Parser ([Char], Int) -> m ([Char], Int)
forall (m :: * -> *) a. MonadIO m => FTPResponse -> Parser a -> m a
parseResponse FTPResponse
resp Parser ([Char], Int)
parse227
port :: MonadIO m => Handle -> S.HostAddress -> S.PortNumber -> m FTPResponse
port :: forall (m :: * -> *).
MonadIO m =>
Handle -> HostAddress -> PortNumber -> m FTPResponse
port Handle
h HostAddress
ha PortNumber
pn = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h (HostAddress -> PortNumber -> FTPCommand
Port HostAddress
ha PortNumber
pn)
acct :: MonadIO m => Handle -> String -> m FTPResponse
acct :: forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> m FTPResponse
acct Handle
h [Char]
pass = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h ([Char] -> FTPCommand
Acct [Char]
pass)
rename :: MonadIO m => Handle -> String -> String -> m FTPResponse
rename :: forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> [Char] -> m FTPResponse
rename Handle
h [Char]
from [Char]
to = do
FTPResponse
res <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommand Handle
h ([Char] -> FTPCommand
Rnfr [Char]
from)
case FTPResponse -> ResponseStatus
frStatus FTPResponse
res of
ResponseStatus
Continue -> Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h ([Char] -> FTPCommand
Rnto [Char]
to)
ResponseStatus
_ -> FTPResponse -> m FTPResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FTPResponse
res
dele :: MonadIO m => Handle -> String -> m FTPResponse
dele :: forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> m FTPResponse
dele Handle
h [Char]
file = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h ([Char] -> FTPCommand
Dele [Char]
file)
cwd :: MonadIO m => Handle -> String -> m FTPResponse
cwd :: forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> m FTPResponse
cwd Handle
h [Char]
dir =
Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h (FTPCommand -> m FTPResponse) -> FTPCommand -> m FTPResponse
forall a b. (a -> b) -> a -> b
$ if [Char]
dir [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".."
then FTPCommand
Cdup
else [Char] -> FTPCommand
Cwd [Char]
dir
size :: MonadIO m => Handle -> String -> m Int
size :: forall (m :: * -> *). MonadIO m => Handle -> [Char] -> m Int
size Handle
h [Char]
file = do
FTPResponse
resp <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h ([Char] -> FTPCommand
Size [Char]
file)
FTPResponse -> Int -> m ()
forall (m :: * -> *). MonadIO m => FTPResponse -> Int -> m ()
ensureCode FTPResponse
resp Int
213
Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ case FTPResponse -> FTPMessage
frMessage FTPResponse
resp of
SingleLine ByteString
message -> [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> (ByteString -> [Char]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.unpack (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ByteString
message
MultiLine [ByteString]
_ -> Int
0
mkd :: MonadIO m => Handle -> String -> m String
mkd :: forall (m :: * -> *). MonadIO m => Handle -> [Char] -> m [Char]
mkd Handle
h [Char]
dir = do
FTPResponse
resp <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h ([Char] -> FTPCommand
Mkd [Char]
dir)
FTPResponse -> Int -> m ()
forall (m :: * -> *). MonadIO m => FTPResponse -> Int -> m ()
ensureCode FTPResponse
resp Int
257
FTPResponse -> Parser ByteString [Char] -> m [Char]
forall (m :: * -> *) a. MonadIO m => FTPResponse -> Parser a -> m a
parseResponse FTPResponse
resp Parser ByteString [Char]
parse257
rmd :: MonadIO m => Handle -> String -> m FTPResponse
rmd :: forall (m :: * -> *).
MonadIO m =>
Handle -> [Char] -> m FTPResponse
rmd Handle
h [Char]
dir = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h ([Char] -> FTPCommand
Rmd [Char]
dir)
pwd :: MonadIO m => Handle -> m String
pwd :: forall (m :: * -> *). MonadIO m => Handle -> m [Char]
pwd Handle
h = do
FTPResponse
resp <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h FTPCommand
Pwd
FTPResponse -> Int -> m ()
forall (m :: * -> *). MonadIO m => FTPResponse -> Int -> m ()
ensureCode FTPResponse
resp Int
257
FTPResponse -> Parser ByteString [Char] -> m [Char]
forall (m :: * -> *) a. MonadIO m => FTPResponse -> Parser a -> m a
parseResponse FTPResponse
resp Parser ByteString [Char]
parse257
quit :: MonadIO m => Handle -> m FTPResponse
quit :: forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
quit Handle
h = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h FTPCommand
Quit
mlst :: (MonadIO m, MonadMask m) => Handle -> String -> m MlsxResponse
mlst :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> [Char] -> m MlsxResponse
mlst Handle
h [Char]
path = do
FTPResponse
resp <- Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h ([Char] -> FTPCommand
Mlst [Char]
path)
case FTPResponse -> FTPMessage
frMessage FTPResponse
resp of
SingleLine ByteString
message -> MlsxResponse -> m MlsxResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MlsxResponse -> m MlsxResponse) -> MlsxResponse -> m MlsxResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> MlsxResponse
parseMlsxLine ByteString
message
MultiLine [ByteString]
messages -> if [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
messages Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
then MlsxResponse -> m MlsxResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MlsxResponse -> m MlsxResponse) -> MlsxResponse -> m MlsxResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> MlsxResponse
parseMlsxLine (ByteString -> MlsxResponse) -> ByteString -> MlsxResponse
forall a b. (a -> b) -> a -> b
$ [ByteString]
messages [ByteString] -> Int -> ByteString
forall a. HasCallStack => [a] -> Int -> a
!! Int
1
else IO MlsxResponse -> m MlsxResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MlsxResponse -> m MlsxResponse)
-> IO MlsxResponse -> m MlsxResponse
forall a b. (a -> b) -> a -> b
$ FTPException -> IO MlsxResponse
forall e a. Exception e => e -> IO a
throwIO (FTPException -> IO MlsxResponse)
-> FTPException -> IO MlsxResponse
forall a b. (a -> b) -> a -> b
$ FTPResponse -> FTPException
BogusResponseFormatException FTPResponse
resp
pbsz :: MonadIO m => Handle -> Int -> m FTPResponse
pbsz :: forall (m :: * -> *). MonadIO m => Handle -> Int -> m FTPResponse
pbsz Handle
h = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h (FTPCommand -> m FTPResponse)
-> (Int -> FTPCommand) -> Int -> m FTPResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FTPCommand
Pbsz
prot :: MonadIO m => Handle -> ProtType -> m FTPResponse
prot :: forall (m :: * -> *).
MonadIO m =>
Handle -> ProtType -> m FTPResponse
prot Handle
h = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h (FTPCommand -> m FTPResponse)
-> (ProtType -> FTPCommand) -> ProtType -> m FTPResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtType -> FTPCommand
Prot
ccc :: MonadIO m => Handle -> m FTPResponse
ccc :: forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
ccc Handle
h = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h FTPCommand
Ccc
auth :: MonadIO m => Handle -> m FTPResponse
auth :: forall (m :: * -> *). MonadIO m => Handle -> m FTPResponse
auth Handle
h = Handle -> FTPCommand -> m FTPResponse
forall (m :: * -> *).
MonadIO m =>
Handle -> FTPCommand -> m FTPResponse
sendCommandS Handle
h FTPCommand
Auth
sendType :: MonadIO m => RTypeCode -> ByteString -> Handle -> m ()
sendType :: forall (m :: * -> *).
MonadIO m =>
RTypeCode -> ByteString -> Handle -> m ()
sendType RTypeCode
TA ByteString
dat Handle
h = (ByteString -> m ()) -> [ByteString] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Handle -> ByteString -> m ()
sendCommandLine Handle
h) ([ByteString] -> m ()) -> [ByteString] -> m ()
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
C.split Char
'\n' ByteString
dat
sendType RTypeCode
TI ByteString
dat Handle
h = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
send Handle
h ByteString
dat
withDataCommandSecurity
:: (MonadIO m, MonadMask m)
=> Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommandSecurity :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommandSecurity Handle
h =
case Handle -> Security
security Handle
h of
Security
Clear -> Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommand Handle
h
Security
TLS -> Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withTLSDataCommand Handle
h
nlst :: (MonadIO m, MonadMask m) => Handle -> [String] -> m ByteString
nlst :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> [[Char]] -> m ByteString
nlst Handle
h [[Char]]
args = Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m ByteString)
-> m ByteString
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommandSecurity Handle
h PortActivity
Passive RTypeCode
TA ([[Char]] -> FTPCommand
Nlst [[Char]]
args) Handle -> m ByteString
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Handle -> m ByteString
getAllLineResp
retr :: (MonadIO m, MonadMask m) => Handle -> String -> m ByteString
retr :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> [Char] -> m ByteString
retr Handle
h [Char]
path = Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m ByteString)
-> m ByteString
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommandSecurity Handle
h PortActivity
Passive RTypeCode
TI ([Char] -> FTPCommand
Retr [Char]
path) Handle -> m ByteString
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Handle -> m ByteString
recvAll
list :: (MonadIO m, MonadMask m) => Handle -> [String] -> m ByteString
list :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> [[Char]] -> m ByteString
list Handle
h [[Char]]
args = Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m ByteString)
-> m ByteString
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommandSecurity Handle
h PortActivity
Passive RTypeCode
TA ([[Char]] -> FTPCommand
List [[Char]]
args) Handle -> m ByteString
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Handle -> m ByteString
getAllLineResp
stor
:: (MonadIO m, MonadMask m)
=> Handle
-> String
-> B.ByteString
-> RTypeCode
-> m ()
stor :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> [Char] -> ByteString -> RTypeCode -> m ()
stor Handle
h [Char]
loc ByteString
dat RTypeCode
rtype =
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m ())
-> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommandSecurity Handle
h PortActivity
Passive RTypeCode
rtype ([Char] -> FTPCommand
Stor [Char]
loc) ((Handle -> m ()) -> m ()) -> (Handle -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ RTypeCode -> ByteString -> Handle -> m ()
forall (m :: * -> *).
MonadIO m =>
RTypeCode -> ByteString -> Handle -> m ()
sendType RTypeCode
rtype ByteString
dat
data MlsxResponse = MlsxResponse {
MlsxResponse -> [Char]
mrFilename :: String,
MlsxResponse -> Map [Char] [Char]
mrFacts :: Map String String
} deriving (Int -> MlsxResponse -> [Char] -> [Char]
[MlsxResponse] -> [Char] -> [Char]
MlsxResponse -> [Char]
(Int -> MlsxResponse -> [Char] -> [Char])
-> (MlsxResponse -> [Char])
-> ([MlsxResponse] -> [Char] -> [Char])
-> Show MlsxResponse
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> MlsxResponse -> [Char] -> [Char]
showsPrec :: Int -> MlsxResponse -> [Char] -> [Char]
$cshow :: MlsxResponse -> [Char]
show :: MlsxResponse -> [Char]
$cshowList :: [MlsxResponse] -> [Char] -> [Char]
showList :: [MlsxResponse] -> [Char] -> [Char]
Show)
splitApart :: Char -> ByteString -> (ByteString, ByteString)
splitApart :: Char -> ByteString -> (ByteString, ByteString)
splitApart Char
on ByteString
s =
let (ByteString
x0, ByteString
x1) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
on) ByteString
s
in (ByteString
x0, Int -> ByteString -> ByteString
C.drop Int
1 ByteString
x1)
parseMlsxLine :: ByteString -> MlsxResponse
parseMlsxLine :: ByteString -> MlsxResponse
parseMlsxLine ByteString
line =
let (ByteString
factLine, ByteString
filename) = Char -> ByteString -> (ByteString, ByteString)
splitApart Char
' ' ByteString
line
bFacts :: [(ByteString, ByteString)]
bFacts = Char -> ByteString -> (ByteString, ByteString)
splitApart Char
'=' (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ByteString -> [ByteString]
C.split Char
';' ByteString
factLine
facts :: Map [Char] [Char]
facts
= [([Char], [Char])] -> Map [Char] [Char]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([([Char], [Char])] -> Map [Char] [Char])
-> [([Char], [Char])] -> Map [Char] [Char]
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (([Char], [Char]) -> Bool) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst)
([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ ((ByteString -> [Char])
-> (ByteString -> [Char])
-> (ByteString, ByteString)
-> ([Char], [Char]))
-> (ByteString -> [Char])
-> (ByteString, ByteString)
-> ([Char], [Char])
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ByteString -> [Char])
-> (ByteString -> [Char])
-> (ByteString, ByteString)
-> ([Char], [Char])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) ByteString -> [Char]
C.unpack ((ByteString, ByteString) -> ([Char], [Char]))
-> [(ByteString, ByteString)] -> [([Char], [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ByteString, ByteString)]
bFacts
in [Char] -> Map [Char] [Char] -> MlsxResponse
MlsxResponse (ByteString -> [Char]
C.unpack ByteString
filename) Map [Char] [Char]
facts
getMlsxResponse :: (MonadIO m, MonadCatch m) => Handle -> m [MlsxResponse]
getMlsxResponse :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Handle -> m [MlsxResponse]
getMlsxResponse Handle
h = Handle -> [MlsxResponse] -> m [MlsxResponse]
forall {m :: * -> *}.
(MonadCatch m, MonadIO m) =>
Handle -> [MlsxResponse] -> m [MlsxResponse]
getMlsxResponse' Handle
h []
where
getMlsxResponse' :: Handle -> [MlsxResponse] -> m [MlsxResponse]
getMlsxResponse' Handle
h [MlsxResponse]
ret = ( do
ByteString
line <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
getLineResp Handle
h
Handle -> [MlsxResponse] -> m [MlsxResponse]
getMlsxResponse' Handle
h ([MlsxResponse] -> m [MlsxResponse])
-> [MlsxResponse] -> m [MlsxResponse]
forall a b. (a -> b) -> a -> b
$
if ByteString -> Bool
C.null ByteString
line
then [MlsxResponse]
ret
else ByteString -> MlsxResponse
parseMlsxLine ByteString
line MlsxResponse -> [MlsxResponse] -> [MlsxResponse]
forall a. a -> [a] -> [a]
: [MlsxResponse]
ret
) m [MlsxResponse]
-> (IOError -> m [MlsxResponse]) -> m [MlsxResponse]
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (IOError -> m a) -> m a
`M.catchIOError` (\IOError
_ -> [MlsxResponse] -> m [MlsxResponse]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [MlsxResponse]
ret)
mlsd :: (MonadIO m, MonadMask m) => Handle -> String -> m [MlsxResponse]
mlsd :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Handle -> [Char] -> m [MlsxResponse]
mlsd Handle
h [Char]
path = Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m [MlsxResponse])
-> m [MlsxResponse]
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Handle
-> PortActivity
-> RTypeCode
-> FTPCommand
-> (Handle -> m a)
-> m a
withDataCommandSecurity Handle
h PortActivity
Passive RTypeCode
TA ([Char] -> FTPCommand
Mlsd [Char]
path) Handle -> m [MlsxResponse]
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Handle -> m [MlsxResponse]
getMlsxResponse