Blame Network/Socks5/Types.hs

Packit fc2124
{-# LANGUAGE DeriveDataTypeable #-}
Packit fc2124
-- |
Packit fc2124
-- Module      : Network.Socks5.Types
Packit fc2124
-- License     : BSD-style
Packit fc2124
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
Packit fc2124
-- Stability   : experimental
Packit fc2124
-- Portability : unknown
Packit fc2124
module Network.Socks5.Types
Packit fc2124
    ( SocksVersion(..)
Packit fc2124
    , SocksCommand(..)
Packit fc2124
    , SocksMethod(..)
Packit fc2124
    , SocksHostAddress(..)
Packit fc2124
    , SocksAddress(..)
Packit fc2124
    , SocksReply(..)
Packit fc2124
    , SocksVersionNotSupported(..)
Packit fc2124
    , SocksError(..)
Packit fc2124
    ) where
Packit fc2124
Packit fc2124
import Data.ByteString (ByteString)
Packit fc2124
import Data.Word
Packit fc2124
import Data.Data
Packit fc2124
import Network.Socket (HostAddress, HostAddress6, PortNumber)
Packit fc2124
import Control.Exception
Packit fc2124
import qualified Data.ByteString.Char8 as BC
Packit fc2124
import Numeric (showHex)
Packit fc2124
import Data.List (intersperse)
Packit fc2124
Packit fc2124
-- | Socks Version
Packit fc2124
data SocksVersion = SocksVer5
Packit fc2124
                  deriving (Show,Eq,Ord)
Packit fc2124
Packit fc2124
-- | Command that can be send and receive on the SOCKS protocol
Packit fc2124
data SocksCommand =
Packit fc2124
      SocksCommandConnect
Packit fc2124
    | SocksCommandBind
Packit fc2124
    | SocksCommandUdpAssociate
Packit fc2124
    | SocksCommandOther !Word8
Packit fc2124
    deriving (Show,Eq,Ord)
Packit fc2124
Packit fc2124
-- | Authentication methods available on the SOCKS protocol.
Packit fc2124
--
Packit fc2124
-- Only SocksMethodNone is effectively implemented, but
Packit fc2124
-- other value are enumerated for completeness.
Packit fc2124
data SocksMethod =
Packit fc2124
      SocksMethodNone
Packit fc2124
    | SocksMethodGSSAPI
Packit fc2124
    | SocksMethodUsernamePassword
Packit fc2124
    | SocksMethodOther !Word8
Packit fc2124
    | SocksMethodNotAcceptable
Packit fc2124
    deriving (Show,Eq,Ord)
Packit fc2124
Packit fc2124
-- | A Host address on the SOCKS protocol.
Packit fc2124
data SocksHostAddress =
Packit fc2124
      SocksAddrIPV4 !HostAddress
Packit fc2124
    | SocksAddrDomainName !ByteString
Packit fc2124
    | SocksAddrIPV6 !HostAddress6
Packit fc2124
    deriving (Eq,Ord)
Packit fc2124
Packit fc2124
instance Show SocksHostAddress where
Packit fc2124
    show (SocksAddrIPV4 ha)       = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")"
Packit fc2124
    show (SocksAddrIPV6 ha6)      = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")"
Packit fc2124
    show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ BC.unpack dn ++ ")"
Packit fc2124
Packit fc2124
-- | Converts a HostAddress to a String in dot-decimal notation
Packit fc2124
showHostAddress :: HostAddress -> String
Packit fc2124
showHostAddress num = concat [show q1, ".", show q2, ".", show q3, ".", show q4]
Packit fc2124
  where (num',q1)   = num `quotRem` 256
Packit fc2124
        (num'',q2)  = num' `quotRem` 256
Packit fc2124
        (num''',q3) = num'' `quotRem` 256
Packit fc2124
        (_,q4)      = num''' `quotRem` 256
Packit fc2124
Packit fc2124
-- | Converts a IPv6 HostAddress6 to standard hex notation
Packit fc2124
showHostAddress6 :: HostAddress6 -> String
Packit fc2124
showHostAddress6 (a,b,c,d) =
Packit fc2124
    (concat . intersperse ":" . map (flip showHex ""))
Packit fc2124
        [p1,p2,p3,p4,p5,p6,p7,p8]
Packit fc2124
    where (a',p2) = a `quotRem` 65536
Packit fc2124
          (_,p1)  = a' `quotRem` 65536
Packit fc2124
          (b',p4) = b `quotRem` 65536
Packit fc2124
          (_,p3)  = b' `quotRem` 65536
Packit fc2124
          (c',p6) = c `quotRem` 65536
Packit fc2124
          (_,p5)  = c' `quotRem` 65536
Packit fc2124
          (d',p8) = d `quotRem` 65536
Packit fc2124
          (_,p7)  = d' `quotRem` 65536
Packit fc2124
Packit fc2124
-- | Describe a Socket address on the SOCKS protocol
Packit fc2124
data SocksAddress = SocksAddress !SocksHostAddress !PortNumber
Packit fc2124
    deriving (Show,Eq,Ord)
Packit fc2124
Packit fc2124
-- | Type of reply on the SOCKS protocol
Packit fc2124
data SocksReply =
Packit fc2124
      SocksReplySuccess
Packit fc2124
    | SocksReplyError SocksError
Packit fc2124
    deriving (Show,Eq,Ord,Data,Typeable)
Packit fc2124
Packit fc2124
-- | SOCKS error that can be received or sent
Packit fc2124
data SocksError =
Packit fc2124
      SocksErrorGeneralServerFailure
Packit fc2124
    | SocksErrorConnectionNotAllowedByRule
Packit fc2124
    | SocksErrorNetworkUnreachable
Packit fc2124
    | SocksErrorHostUnreachable
Packit fc2124
    | SocksErrorConnectionRefused
Packit fc2124
    | SocksErrorTTLExpired
Packit fc2124
    | SocksErrorCommandNotSupported
Packit fc2124
    | SocksErrorAddrTypeNotSupported
Packit fc2124
    | SocksErrorOther Word8
Packit fc2124
    deriving (Show,Eq,Ord,Data,Typeable)
Packit fc2124
Packit fc2124
-- | Exception returned when using a SOCKS version that is not supported.
Packit fc2124
--
Packit fc2124
-- This package only implement version 5.
Packit fc2124
data SocksVersionNotSupported = SocksVersionNotSupported
Packit fc2124
    deriving (Show,Data,Typeable)
Packit fc2124
Packit fc2124
instance Exception SocksError
Packit fc2124
instance Exception SocksVersionNotSupported
Packit fc2124
Packit fc2124
instance Enum SocksCommand where
Packit fc2124
    toEnum 1 = SocksCommandConnect
Packit fc2124
    toEnum 2 = SocksCommandBind
Packit fc2124
    toEnum 3 = SocksCommandUdpAssociate
Packit fc2124
    toEnum w
Packit fc2124
        | w < 256   = SocksCommandOther $ fromIntegral w
Packit fc2124
        | otherwise = error "socks command is only 8 bits"
Packit fc2124
    fromEnum SocksCommandConnect      = 1
Packit fc2124
    fromEnum SocksCommandBind         = 2
Packit fc2124
    fromEnum SocksCommandUdpAssociate = 3
Packit fc2124
    fromEnum (SocksCommandOther w)    = fromIntegral w
Packit fc2124
Packit fc2124
instance Enum SocksMethod where
Packit fc2124
    toEnum 0    = SocksMethodNone
Packit fc2124
    toEnum 1    = SocksMethodGSSAPI
Packit fc2124
    toEnum 2    = SocksMethodUsernamePassword
Packit fc2124
    toEnum 0xff = SocksMethodNotAcceptable
Packit fc2124
    toEnum w
Packit fc2124
        | w < 256   = SocksMethodOther $ fromIntegral w
Packit fc2124
        | otherwise = error "socks method is only 8 bits"
Packit fc2124
    fromEnum SocksMethodNone             = 0
Packit fc2124
    fromEnum SocksMethodGSSAPI           = 1
Packit fc2124
    fromEnum SocksMethodUsernamePassword = 2
Packit fc2124
    fromEnum (SocksMethodOther w)        = fromIntegral w
Packit fc2124
    fromEnum SocksMethodNotAcceptable    = 0xff
Packit fc2124
Packit fc2124
instance Enum SocksError where
Packit fc2124
    fromEnum SocksErrorGeneralServerFailure       = 1
Packit fc2124
    fromEnum SocksErrorConnectionNotAllowedByRule = 2
Packit fc2124
    fromEnum SocksErrorNetworkUnreachable         = 3
Packit fc2124
    fromEnum SocksErrorHostUnreachable            = 4
Packit fc2124
    fromEnum SocksErrorConnectionRefused          = 5
Packit fc2124
    fromEnum SocksErrorTTLExpired                 = 6
Packit fc2124
    fromEnum SocksErrorCommandNotSupported        = 7
Packit fc2124
    fromEnum SocksErrorAddrTypeNotSupported       = 8
Packit fc2124
    fromEnum (SocksErrorOther w)                  = fromIntegral w
Packit fc2124
    toEnum 1 = SocksErrorGeneralServerFailure
Packit fc2124
    toEnum 2 = SocksErrorConnectionNotAllowedByRule
Packit fc2124
    toEnum 3 = SocksErrorNetworkUnreachable
Packit fc2124
    toEnum 4 = SocksErrorHostUnreachable
Packit fc2124
    toEnum 5 = SocksErrorConnectionRefused
Packit fc2124
    toEnum 6 = SocksErrorTTLExpired
Packit fc2124
    toEnum 7 = SocksErrorCommandNotSupported
Packit fc2124
    toEnum 8 = SocksErrorAddrTypeNotSupported
Packit fc2124
    toEnum w = SocksErrorOther $ fromIntegral w
Packit fc2124
Packit fc2124
instance Enum SocksReply where
Packit fc2124
    fromEnum SocksReplySuccess                    = 0
Packit fc2124
    fromEnum (SocksReplyError e)                  = fromEnum e
Packit fc2124
    toEnum 0 = SocksReplySuccess
Packit fc2124
    toEnum n = SocksReplyError (toEnum n)