{-# Language PatternSynonyms #-}
module Hookup.Socks5
(
ClientHello(..)
, buildClientHello
, parseClientHello
, ServerHello(..)
, buildServerHello
, parseServerHello
, Request(..)
, buildRequest
, parseRequest
, Response(..)
, buildResponse
, parseResponse
, Address(..)
, Host(..)
, AuthMethod
( AuthNoAuthenticationRequired
, AuthGssApi
, AuthUsernamePassword
, AuthNoAcceptableMethods )
, Command
( Connect
, Bind
, UdpAssociate )
, CommandReply
( CommandReply
, Succeeded
, GeneralFailure
, NotAllowed
, NetUnreachable
, HostUnreachable
, ConnectionRefused
, TTLExpired
, CmdNotSupported
, AddrNotSupported )
)
where
import Control.Monad (replicateM)
import Data.Attoparsec.ByteString (Parser)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.Word (Word8, Word16)
import Network.Socket (HostAddress, HostAddress6, PortNumber,
hostAddressToTuple, hostAddress6ToTuple,
tupleToHostAddress, tupleToHostAddress6)
import qualified Data.Attoparsec.ByteString as Parser
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as L
newtype AuthMethod = AuthMethod Word8 deriving (AuthMethod -> AuthMethod -> Bool
(AuthMethod -> AuthMethod -> Bool)
-> (AuthMethod -> AuthMethod -> Bool) -> Eq AuthMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthMethod -> AuthMethod -> Bool
$c/= :: AuthMethod -> AuthMethod -> Bool
== :: AuthMethod -> AuthMethod -> Bool
$c== :: AuthMethod -> AuthMethod -> Bool
Eq, Int -> AuthMethod -> ShowS
[AuthMethod] -> ShowS
AuthMethod -> String
(Int -> AuthMethod -> ShowS)
-> (AuthMethod -> String)
-> ([AuthMethod] -> ShowS)
-> Show AuthMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthMethod] -> ShowS
$cshowList :: [AuthMethod] -> ShowS
show :: AuthMethod -> String
$cshow :: AuthMethod -> String
showsPrec :: Int -> AuthMethod -> ShowS
$cshowsPrec :: Int -> AuthMethod -> ShowS
Show)
pattern AuthNoAuthenticationRequired, AuthGssApi, AuthUsernamePassword, AuthNoAcceptableMethods :: AuthMethod
pattern $bAuthNoAuthenticationRequired :: AuthMethod
$mAuthNoAuthenticationRequired :: forall r. AuthMethod -> (Void# -> r) -> (Void# -> r) -> r
AuthNoAuthenticationRequired = AuthMethod 0x00
pattern $bAuthGssApi :: AuthMethod
$mAuthGssApi :: forall r. AuthMethod -> (Void# -> r) -> (Void# -> r) -> r
AuthGssApi = AuthMethod 0x01
pattern $bAuthUsernamePassword :: AuthMethod
$mAuthUsernamePassword :: forall r. AuthMethod -> (Void# -> r) -> (Void# -> r) -> r
AuthUsernamePassword = AuthMethod 0x02
pattern $bAuthNoAcceptableMethods :: AuthMethod
$mAuthNoAcceptableMethods :: forall r. AuthMethod -> (Void# -> r) -> (Void# -> r) -> r
AuthNoAcceptableMethods = AuthMethod 0xFF
newtype Command = Command Word8 deriving (Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)
pattern Connect, Bind, UdpAssociate :: Command
pattern $bConnect :: Command
$mConnect :: forall r. Command -> (Void# -> r) -> (Void# -> r) -> r
Connect = Command 1
pattern $bBind :: Command
$mBind :: forall r. Command -> (Void# -> r) -> (Void# -> r) -> r
Bind = Command 2
pattern $bUdpAssociate :: Command
$mUdpAssociate :: forall r. Command -> (Void# -> r) -> (Void# -> r) -> r
UdpAssociate = Command 3
newtype HostTag = HostTag Word8 deriving (HostTag -> HostTag -> Bool
(HostTag -> HostTag -> Bool)
-> (HostTag -> HostTag -> Bool) -> Eq HostTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostTag -> HostTag -> Bool
$c/= :: HostTag -> HostTag -> Bool
== :: HostTag -> HostTag -> Bool
$c== :: HostTag -> HostTag -> Bool
Eq, Int -> HostTag -> ShowS
[HostTag] -> ShowS
HostTag -> String
(Int -> HostTag -> ShowS)
-> (HostTag -> String) -> ([HostTag] -> ShowS) -> Show HostTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostTag] -> ShowS
$cshowList :: [HostTag] -> ShowS
show :: HostTag -> String
$cshow :: HostTag -> String
showsPrec :: Int -> HostTag -> ShowS
$cshowsPrec :: Int -> HostTag -> ShowS
Show)
pattern IPv4Tag, DomainNameTag, IPv6Tag :: HostTag
pattern $bIPv4Tag :: HostTag
$mIPv4Tag :: forall r. HostTag -> (Void# -> r) -> (Void# -> r) -> r
IPv4Tag = HostTag 1
pattern $bDomainNameTag :: HostTag
$mDomainNameTag :: forall r. HostTag -> (Void# -> r) -> (Void# -> r) -> r
DomainNameTag = HostTag 3
pattern $bIPv6Tag :: HostTag
$mIPv6Tag :: forall r. HostTag -> (Void# -> r) -> (Void# -> r) -> r
IPv6Tag = HostTag 4
newtype CommandReply = CommandReply Word8 deriving (CommandReply -> CommandReply -> Bool
(CommandReply -> CommandReply -> Bool)
-> (CommandReply -> CommandReply -> Bool) -> Eq CommandReply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandReply -> CommandReply -> Bool
$c/= :: CommandReply -> CommandReply -> Bool
== :: CommandReply -> CommandReply -> Bool
$c== :: CommandReply -> CommandReply -> Bool
Eq, Int -> CommandReply -> ShowS
[CommandReply] -> ShowS
CommandReply -> String
(Int -> CommandReply -> ShowS)
-> (CommandReply -> String)
-> ([CommandReply] -> ShowS)
-> Show CommandReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandReply] -> ShowS
$cshowList :: [CommandReply] -> ShowS
show :: CommandReply -> String
$cshow :: CommandReply -> String
showsPrec :: Int -> CommandReply -> ShowS
$cshowsPrec :: Int -> CommandReply -> ShowS
Show)
pattern Succeeded, GeneralFailure, NotAllowed, NetUnreachable, HostUnreachable,
ConnectionRefused, TTLExpired, CmdNotSupported, AddrNotSupported :: CommandReply
pattern $bSucceeded :: CommandReply
$mSucceeded :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
Succeeded = CommandReply 0
pattern $bGeneralFailure :: CommandReply
$mGeneralFailure :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
GeneralFailure = CommandReply 1
pattern $bNotAllowed :: CommandReply
$mNotAllowed :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
NotAllowed = CommandReply 2
pattern $bNetUnreachable :: CommandReply
$mNetUnreachable :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
NetUnreachable = CommandReply 3
pattern $bHostUnreachable :: CommandReply
$mHostUnreachable :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
HostUnreachable = CommandReply 4
pattern $bConnectionRefused :: CommandReply
$mConnectionRefused :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
ConnectionRefused = CommandReply 5
pattern $bTTLExpired :: CommandReply
$mTTLExpired :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
TTLExpired = CommandReply 6
pattern $bCmdNotSupported :: CommandReply
$mCmdNotSupported :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
CmdNotSupported = CommandReply 7
pattern $bAddrNotSupported :: CommandReply
$mAddrNotSupported :: forall r. CommandReply -> (Void# -> r) -> (Void# -> r) -> r
AddrNotSupported = CommandReply 8
data Address = Address Host PortNumber
deriving Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Address] -> ShowS
$cshowList :: [Address] -> ShowS
show :: Address -> String
$cshow :: Address -> String
showsPrec :: Int -> Address -> ShowS
$cshowsPrec :: Int -> Address -> ShowS
Show
data Host
= IPv4 HostAddress
| IPv6 HostAddress6
| DomainName ByteString
deriving Int -> Host -> ShowS
[Host] -> ShowS
Host -> String
(Int -> Host -> ShowS)
-> (Host -> String) -> ([Host] -> ShowS) -> Show Host
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> String
$cshow :: Host -> String
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Show
newtype ClientHello = ClientHello
{ ClientHello -> [AuthMethod]
cHelloMethods :: [AuthMethod]
}
deriving Int -> ClientHello -> ShowS
[ClientHello] -> ShowS
ClientHello -> String
(Int -> ClientHello -> ShowS)
-> (ClientHello -> String)
-> ([ClientHello] -> ShowS)
-> Show ClientHello
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientHello] -> ShowS
$cshowList :: [ClientHello] -> ShowS
show :: ClientHello -> String
$cshow :: ClientHello -> String
showsPrec :: Int -> ClientHello -> ShowS
$cshowsPrec :: Int -> ClientHello -> ShowS
Show
newtype ServerHello = ServerHello
{ ServerHello -> AuthMethod
sHelloMethod :: AuthMethod
}
deriving Int -> ServerHello -> ShowS
[ServerHello] -> ShowS
ServerHello -> String
(Int -> ServerHello -> ShowS)
-> (ServerHello -> String)
-> ([ServerHello] -> ShowS)
-> Show ServerHello
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerHello] -> ShowS
$cshowList :: [ServerHello] -> ShowS
show :: ServerHello -> String
$cshow :: ServerHello -> String
showsPrec :: Int -> ServerHello -> ShowS
$cshowsPrec :: Int -> ServerHello -> ShowS
Show
data Request = Request
{ Request -> Command
reqCommand :: Command
, Request -> Address
reqAddress :: Address
}
deriving Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show
data Response = Response
{ Response -> CommandReply
rspReply :: CommandReply
, Response -> Address
rspAddress :: Address
}
deriving Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show
runBuilder :: Builder -> ByteString
runBuilder :: Builder -> ByteString
runBuilder = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString
buildCommand :: Command -> Builder
buildCommand :: Command -> Builder
buildCommand (Command Word8
c) = Word8 -> Builder
Builder.word8 Word8
c
parseCommand :: Parser Command
parseCommand :: Parser Command
parseCommand = Word8 -> Command
Command (Word8 -> Command) -> Parser ByteString Word8 -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
Parser.anyWord8
buildHost :: Host -> Builder
buildHost :: Host -> Builder
buildHost (IPv4 HostAddress
hostAddr) = HostTag -> Builder
buildHostTag HostTag
IPv4Tag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> HostAddress -> Builder
buildHostAddress HostAddress
hostAddr
buildHost (IPv6 HostAddress6
hostAddr) = HostTag -> Builder
buildHostTag HostTag
IPv6Tag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> HostAddress6 -> Builder
buildHostAddress6 HostAddress6
hostAddr
buildHost (DomainName ByteString
dn) = HostTag -> Builder
buildHostTag HostTag
DomainNameTag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
buildDomainName ByteString
dn
parseHost :: Parser Host
parseHost :: Parser Host
parseHost =
do HostTag
tag <- Parser HostTag
parseHostTag
case HostTag
tag of
HostTag
IPv4Tag -> HostAddress -> Host
IPv4 (HostAddress -> Host)
-> Parser ByteString HostAddress -> Parser Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString HostAddress
parseHostAddress
HostTag
IPv6Tag -> HostAddress6 -> Host
IPv6 (HostAddress6 -> Host)
-> Parser ByteString HostAddress6 -> Parser Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString HostAddress6
parseHostAddress6
HostTag
DomainNameTag -> ByteString -> Host
DomainName (ByteString -> Host) -> Parser ByteString ByteString -> Parser Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
parseDomainName
HostTag
_ -> String -> Parser Host
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad address tag"
buildAddress :: Address -> Builder
buildAddress :: Address -> Builder
buildAddress (Address Host
host PortNumber
port) = Host -> Builder
buildHost Host
host Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PortNumber -> Builder
buildPort PortNumber
port
parseAddress :: Parser Address
parseAddress :: Parser Address
parseAddress = Host -> PortNumber -> Address
Address (Host -> PortNumber -> Address)
-> Parser Host -> Parser ByteString (PortNumber -> Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Host
parseHost Parser ByteString (PortNumber -> Address)
-> Parser ByteString PortNumber -> Parser Address
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString PortNumber
parsePort
buildHostTag :: HostTag -> Builder
buildHostTag :: HostTag -> Builder
buildHostTag (HostTag Word8
tag) = Word8 -> Builder
Builder.word8 Word8
tag
parseHostTag :: Parser HostTag
parseHostTag :: Parser HostTag
parseHostTag = Word8 -> HostTag
HostTag (Word8 -> HostTag) -> Parser ByteString Word8 -> Parser HostTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
Parser.anyWord8
buildHostAddress :: HostAddress -> Builder
buildHostAddress :: HostAddress -> Builder
buildHostAddress HostAddress
hostAddr =
case HostAddress -> (Word8, Word8, Word8, Word8)
hostAddressToTuple HostAddress
hostAddr of
(Word8
a1,Word8
a2,Word8
a3,Word8
a4) -> (Word8 -> Builder) -> [Word8] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Builder
Builder.word8 [Word8
a1,Word8
a2,Word8
a3,Word8
a4]
parseHostAddress :: Parser HostAddress
parseHostAddress :: Parser ByteString HostAddress
parseHostAddress =
do [Word8
a1,Word8
a2,Word8
a3,Word8
a4] <- Int -> Parser ByteString Word8 -> Parser ByteString [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Parser ByteString Word8
Parser.anyWord8
HostAddress -> Parser ByteString HostAddress
forall (m :: * -> *) a. Monad m => a -> m a
return (HostAddress -> Parser ByteString HostAddress)
-> HostAddress -> Parser ByteString HostAddress
forall a b. (a -> b) -> a -> b
$! (Word8, Word8, Word8, Word8) -> HostAddress
tupleToHostAddress (Word8
a1,Word8
a2,Word8
a3,Word8
a4)
buildHostAddress6 :: HostAddress6 -> Builder
buildHostAddress6 :: HostAddress6 -> Builder
buildHostAddress6 HostAddress6
hostAddr =
case HostAddress6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
hostAddress6ToTuple HostAddress6
hostAddr of
(Word16
a1,Word16
a2,Word16
a3,Word16
a4,Word16
a5,Word16
a6,Word16
a7,Word16
a8) ->
(Word16 -> Builder) -> [Word16] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word16 -> Builder
Builder.word16BE [Word16
a1,Word16
a2,Word16
a3,Word16
a4,Word16
a5,Word16
a6,Word16
a7,Word16
a8]
parseHostAddress6 :: Parser HostAddress6
parseHostAddress6 :: Parser ByteString HostAddress6
parseHostAddress6 =
do [Word16
a1,Word16
a2,Word16
a3,Word16
a4,Word16
a5,Word16
a6,Word16
a7,Word16
a8] <- Int -> Parser ByteString Word16 -> Parser ByteString [Word16]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
8 Parser ByteString Word16
parseWord16BE
HostAddress6 -> Parser ByteString HostAddress6
forall (m :: * -> *) a. Monad m => a -> m a
return (HostAddress6 -> Parser ByteString HostAddress6)
-> HostAddress6 -> Parser ByteString HostAddress6
forall a b. (a -> b) -> a -> b
$! (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> HostAddress6
tupleToHostAddress6 (Word16
a1,Word16
a2,Word16
a3,Word16
a4,Word16
a5,Word16
a6,Word16
a7,Word16
a8)
buildDomainName :: ByteString -> Builder
buildDomainName :: ByteString -> Builder
buildDomainName ByteString
bs
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 = Word8 -> Builder
Builder.word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
ByteString -> Builder
Builder.byteString ByteString
bs
| Bool
otherwise = String -> Builder
forall a. HasCallStack => String -> a
error String
"SOCKS5 domain name too long"
parseDomainName :: Parser ByteString
parseDomainName :: Parser ByteString ByteString
parseDomainName =
do Word8
len <- Parser ByteString Word8
Parser.anyWord8
Int -> Parser ByteString ByteString
Parser.take (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
buildPort :: PortNumber -> Builder
buildPort :: PortNumber -> Builder
buildPort PortNumber
port = Word16 -> Builder
Builder.word16BE (PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port)
parsePort :: Parser PortNumber
parsePort :: Parser ByteString PortNumber
parsePort = Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> PortNumber)
-> Parser ByteString Word16 -> Parser ByteString PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
parseWord16BE
buildVersion :: Builder
buildVersion :: Builder
buildVersion = Word8 -> Builder
Builder.word8 Word8
5
parseVersion :: Parser ()
parseVersion :: Parser ()
parseVersion = () () -> Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser ByteString Word8
Parser.word8 Word8
5
buildAuthMethod :: AuthMethod -> Builder
buildAuthMethod :: AuthMethod -> Builder
buildAuthMethod (AuthMethod Word8
x) = Word8 -> Builder
Builder.word8 Word8
x
parseAuthMethod :: Parser AuthMethod
parseAuthMethod :: Parser AuthMethod
parseAuthMethod = Word8 -> AuthMethod
AuthMethod (Word8 -> AuthMethod)
-> Parser ByteString Word8 -> Parser AuthMethod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
Parser.anyWord8
buildReply :: CommandReply -> Builder
buildReply :: CommandReply -> Builder
buildReply (CommandReply Word8
x) = Word8 -> Builder
Builder.word8 Word8
x
parseReply :: Parser CommandReply
parseReply :: Parser CommandReply
parseReply = Word8 -> CommandReply
CommandReply (Word8 -> CommandReply)
-> Parser ByteString Word8 -> Parser CommandReply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
Parser.anyWord8
buildReserved :: Builder
buildReserved :: Builder
buildReserved = Word8 -> Builder
Builder.word8 Word8
0
parseReserved :: Parser ()
parseReserved :: Parser ()
parseReserved = () () -> Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString Word8
Parser.anyWord8
buildListOf :: (a -> Builder) -> [a] -> Builder
buildListOf :: (a -> Builder) -> [a] -> Builder
buildListOf a -> Builder
builder [a]
xs
| [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 = Word8 -> Builder
Builder.word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
(a -> Builder) -> [a] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
builder [a]
xs
| Bool
otherwise = String -> Builder
forall a. HasCallStack => String -> a
error String
"buildListOf: list too long"
parseListOf :: Parser a -> Parser [a]
parseListOf :: Parser a -> Parser [a]
parseListOf Parser a
parser =
do Word8
n <- Parser ByteString Word8
Parser.anyWord8
Int -> Parser a -> Parser [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Parser a
parser
buildClientHello :: ClientHello -> ByteString
buildClientHello :: ClientHello -> ByteString
buildClientHello ClientHello
msg =
Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
Builder
buildVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
(AuthMethod -> Builder) -> [AuthMethod] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
buildListOf AuthMethod -> Builder
buildAuthMethod (ClientHello -> [AuthMethod]
cHelloMethods ClientHello
msg)
parseClientHello :: Parser ClientHello
parseClientHello :: Parser ClientHello
parseClientHello =
[AuthMethod] -> ClientHello
ClientHello
([AuthMethod] -> ClientHello)
-> Parser () -> Parser ByteString ([AuthMethod] -> ClientHello)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
parseVersion
Parser ByteString ([AuthMethod] -> ClientHello)
-> Parser ByteString [AuthMethod] -> Parser ClientHello
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AuthMethod -> Parser ByteString [AuthMethod]
forall a. Parser a -> Parser [a]
parseListOf Parser AuthMethod
parseAuthMethod
buildServerHello :: ServerHello -> ByteString
buildServerHello :: ServerHello -> ByteString
buildServerHello ServerHello
msg =
Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
Builder
buildVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
AuthMethod -> Builder
buildAuthMethod (ServerHello -> AuthMethod
sHelloMethod ServerHello
msg)
parseServerHello :: Parser ServerHello
parseServerHello :: Parser ServerHello
parseServerHello =
AuthMethod -> ServerHello
ServerHello
(AuthMethod -> ServerHello)
-> Parser () -> Parser ByteString (AuthMethod -> ServerHello)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
parseVersion
Parser ByteString (AuthMethod -> ServerHello)
-> Parser AuthMethod -> Parser ServerHello
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AuthMethod
parseAuthMethod
buildRequest :: Request -> ByteString
buildRequest :: Request -> ByteString
buildRequest Request
req =
Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
Builder
buildVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Command -> Builder
buildCommand (Request -> Command
reqCommand Request
req) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Builder
buildReserved Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Address -> Builder
buildAddress (Request -> Address
reqAddress Request
req)
parseRequest :: Parser Request
parseRequest :: Parser Request
parseRequest =
Command -> Address -> Request
Request
(Command -> Address -> Request)
-> Parser () -> Parser ByteString (Command -> Address -> Request)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
parseVersion
Parser ByteString (Command -> Address -> Request)
-> Parser Command -> Parser ByteString (Address -> Request)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
parseCommand
Parser ByteString (Address -> Request)
-> Parser () -> Parser ByteString (Address -> Request)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parseReserved
Parser ByteString (Address -> Request)
-> Parser Address -> Parser Request
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Address
parseAddress
buildResponse :: Response -> ByteString
buildResponse :: Response -> ByteString
buildResponse Response
msg =
Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
Builder
buildVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
CommandReply -> Builder
buildReply (Response -> CommandReply
rspReply Response
msg) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Builder
buildReserved Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Address -> Builder
buildAddress (Response -> Address
rspAddress Response
msg)
parseResponse :: Parser Response
parseResponse :: Parser Response
parseResponse =
CommandReply -> Address -> Response
Response
(CommandReply -> Address -> Response)
-> Parser ()
-> Parser ByteString (CommandReply -> Address -> Response)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
parseVersion
Parser ByteString (CommandReply -> Address -> Response)
-> Parser CommandReply -> Parser ByteString (Address -> Response)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CommandReply
parseReply
Parser ByteString (Address -> Response)
-> Parser () -> Parser ByteString (Address -> Response)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parseReserved
Parser ByteString (Address -> Response)
-> Parser Address -> Parser Response
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Address
parseAddress
parseWord16BE :: Parser Word16
parseWord16BE :: Parser ByteString Word16
parseWord16BE =
do Word8
hi <- Parser ByteString Word8
Parser.anyWord8
Word8
lo <- Parser ByteString Word8
Parser.anyWord8
Word16 -> Parser ByteString Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Parser ByteString Word16)
-> Word16 -> Parser ByteString Word16
forall a b. (a -> b) -> a -> b
$! Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
hi Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
0x100 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lo