{-|
Module      : Network.FTP.Client
Description : Transfer files over FTP and FTPS
License     : Public Domain
Stability   : experimental
Portability : POSIX
-}
module Network.FTP.Client (
    -- * Main Entrypoints
    withFTP,
    withFTPS,
    -- * Control Commands
    login,
    pasv,
    rename,
    dele,
    cwd,
    size,
    mkd,
    rmd,
    pwd,
    quit,
    -- * Data Commands
    nlst,
    retr,
    list,
    stor,
    mlsd,
    mlst,
    -- * Types
    FTPCommand(..),
    FTPResponse(..),
    FTPMessage(..),
    ResponseStatus(..),
    MlsxResponse(..),
    RTypeCode(..),
    PortActivity(..),
    ProtType(..),
    Security(..),
    Handle(..),
    -- * Exceptions
    FTPException(..),
    -- * Handle Implementations
    sIOHandleImpl,
    tlsHandleImpl,
    -- * Lower Level Functions
    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

-- | Can send and recieve a 'Data.ByteString.ByteString'.
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

-- | Response from an FTP command. ex "200 Welcome!"
data FTPResponse = FTPResponse {
    FTPResponse -> ResponseStatus
frStatus :: ResponseStatus, -- ^ Interpretation of the first digit of an FTP response code
    FTPResponse -> Int
frCode :: Int, -- ^ The three digit response code
    FTPResponse -> FTPMessage
frMessage :: FTPMessage -- ^ Text of the response
} 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)

-- | First digit of an FTP response
data ResponseStatus
    = Wait -- ^ 1
    | Success -- ^ 2
    | Continue -- ^ 3
    | FailureRetry -- ^ 4
    | Failure -- ^ 5
    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

-- | Commands according to the FTP specification
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')

-- | Get a line from the server
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

-- | Get a full response from the server
-- Used in 'sendCommand'
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")

-- | Send a command to the server and get a response back.
-- Some commands use a data 'Handle', and their data is not returned here.
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

-- | Equvalent to
--
-- > mapM . sendCommand
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

-- | Equvalent to
--
-- > mapM . sendCommandS
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

-- Control connection

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)

-- | Takes a host name and port. A handle for interacting with the server
-- will be returned in a callback.
--
-- @
-- withFTP "ftp.server.com" 21 $ \h welcome -> do
--     print welcome
--     login h "username" "password"
--     print =<< nlst h []
-- @
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

-- Data connection

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

-- | Open a socket that can be used for data transfers
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

-- Response to data commands should be 150 but apparently
-- some servers will respond with 200 before 150 so just ignore it
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

-- | Send setup commands to the server and
-- create a data 'System.IO.Handle'
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

-- | Provides a data 'Handle' in a callback for a command
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

-- | Recieve data and interpret it linewise
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)

-- | Recieve all data and return it as a 'Data.ByteString.ByteString'
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)

-- TLS connection

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)

-- | Takes a host name and port. A handle for interacting with the server
-- will be returned in a callback. The commands will be protected with TLS.
--
-- @
-- withFTPS "ftps.server.com" 21 $ \h welcome -> do
--     print welcome
--     login h "username" "password"
--     print =<< nlst h []
-- @
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

-- TLS data connection

-- | Send setup commands to the server and
-- create a data TLS connection
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
'"')

-- Control commands

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

-- TLS commands

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

-- Data commands

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