module Network.GnuTLS.Internals where
import Foreign
import Foreign.C
import System.Time(ClockTime(TOD))
import Network.GnuTLS.RefCount
import Data.ByteString.Internal
import Data.ByteString.Unsafe
data Session a = Session (ForeignPtr ())! RefCount
data CipherAlgorithm = CipherUnknown
| CipherNull
| CipherArcfour128
| Cipher3desCbc
| CipherAes128Cbc
| CipherAes256Cbc
| CipherArcfour40
| CipherCamellia128Cbc
| CipherCamellia256Cbc
| CipherRc240Cbc
| CipherDesCbc
| CipherIdeaPgpCfb
| Cipher3desPgpCfb
| CipherCast5PgpCfb
| CipherBlowfishPgpCfb
| CipherSaferSk128PgpCfb
| CipherAes128PgpCfb
| CipherAes192PgpCfb
| CipherAes256PgpCfb
| CipherTwofishPgpCfb
instance Enum CipherAlgorithm where
fromEnum CipherUnknown = 0
fromEnum CipherNull = 1
fromEnum CipherArcfour128 = 2
fromEnum Cipher3desCbc = 3
fromEnum CipherAes128Cbc = 4
fromEnum CipherAes256Cbc = 5
fromEnum CipherArcfour40 = 6
fromEnum CipherCamellia128Cbc = 7
fromEnum CipherCamellia256Cbc = 8
fromEnum CipherRc240Cbc = 90
fromEnum CipherDesCbc = 91
fromEnum CipherIdeaPgpCfb = 200
fromEnum Cipher3desPgpCfb = 201
fromEnum CipherCast5PgpCfb = 202
fromEnum CipherBlowfishPgpCfb = 203
fromEnum CipherSaferSk128PgpCfb = 204
fromEnum CipherAes128PgpCfb = 205
fromEnum CipherAes192PgpCfb = 206
fromEnum CipherAes256PgpCfb = 207
fromEnum CipherTwofishPgpCfb = 208
toEnum 0 = CipherUnknown
toEnum 1 = CipherNull
toEnum 2 = CipherArcfour128
toEnum 3 = Cipher3desCbc
toEnum 4 = CipherAes128Cbc
toEnum 5 = CipherAes256Cbc
toEnum 6 = CipherArcfour40
toEnum 7 = CipherCamellia128Cbc
toEnum 8 = CipherCamellia256Cbc
toEnum 90 = CipherRc240Cbc
toEnum 91 = CipherDesCbc
toEnum 200 = CipherIdeaPgpCfb
toEnum 201 = Cipher3desPgpCfb
toEnum 202 = CipherCast5PgpCfb
toEnum 203 = CipherBlowfishPgpCfb
toEnum 204 = CipherSaferSk128PgpCfb
toEnum 205 = CipherAes128PgpCfb
toEnum 206 = CipherAes192PgpCfb
toEnum 207 = CipherAes256PgpCfb
toEnum 208 = CipherTwofishPgpCfb
toEnum unmatched = error ("CipherAlgorithm.toEnum: Cannot match " ++ show unmatched)
data KxAlgorithm = KxUnknown
| KxRsa
| KxDheDss
| KxDheRsa
| KxAnonDh
| KxSrp
| KxRsaExport
| KxSrpRsa
| KxSrpDss
| KxPsk
| KxDhePsk
deriving (Eq)
instance Enum KxAlgorithm where
fromEnum KxUnknown = 0
fromEnum KxRsa = 1
fromEnum KxDheDss = 2
fromEnum KxDheRsa = 3
fromEnum KxAnonDh = 4
fromEnum KxSrp = 5
fromEnum KxRsaExport = 6
fromEnum KxSrpRsa = 7
fromEnum KxSrpDss = 8
fromEnum KxPsk = 9
fromEnum KxDhePsk = 10
toEnum 0 = KxUnknown
toEnum 1 = KxRsa
toEnum 2 = KxDheDss
toEnum 3 = KxDheRsa
toEnum 4 = KxAnonDh
toEnum 5 = KxSrp
toEnum 6 = KxRsaExport
toEnum 7 = KxSrpRsa
toEnum 8 = KxSrpDss
toEnum 9 = KxPsk
toEnum 10 = KxDhePsk
toEnum unmatched = error ("KxAlgorithm.toEnum: Cannot match " ++ show unmatched)
data ParamsType = ParamsRsaExport
| ParamsDh
instance Enum ParamsType where
fromEnum ParamsRsaExport = 1
fromEnum ParamsDh = 2
toEnum 1 = ParamsRsaExport
toEnum 2 = ParamsDh
toEnum unmatched = error ("ParamsType.toEnum: Cannot match " ++ show unmatched)
data CredentialsType = CrdCertificate
| CrdAnon
| CrdSrp
| CrdPsk
| CrdIa
deriving (Eq)
instance Enum CredentialsType where
fromEnum CrdCertificate = 1
fromEnum CrdAnon = 2
fromEnum CrdSrp = 3
fromEnum CrdPsk = 4
fromEnum CrdIa = 5
toEnum 1 = CrdCertificate
toEnum 2 = CrdAnon
toEnum 3 = CrdSrp
toEnum 4 = CrdPsk
toEnum 5 = CrdIa
toEnum unmatched = error ("CredentialsType.toEnum: Cannot match " ++ show unmatched)
data MacAlgorithm = MacUnknown
| MacNull
| MacMd5
| MacSha1
| MacRmd160
| MacMd2
| MacSha256
| MacSha384
| MacSha512
instance Enum MacAlgorithm where
fromEnum MacUnknown = 0
fromEnum MacNull = 1
fromEnum MacMd5 = 2
fromEnum MacSha1 = 3
fromEnum MacRmd160 = 4
fromEnum MacMd2 = 5
fromEnum MacSha256 = 6
fromEnum MacSha384 = 7
fromEnum MacSha512 = 8
toEnum 0 = MacUnknown
toEnum 1 = MacNull
toEnum 2 = MacMd5
toEnum 3 = MacSha1
toEnum 4 = MacRmd160
toEnum 5 = MacMd2
toEnum 6 = MacSha256
toEnum 7 = MacSha384
toEnum 8 = MacSha512
toEnum unmatched = error ("MacAlgorithm.toEnum: Cannot match " ++ show unmatched)
data DigestAlgorithm = DigNull
| DigMd5
| DigSha1
| DigRmd160
| DigMd2
| DigSha256
| DigSha384
| DigSha512
| DigSha224
deriving (Show)
instance Enum DigestAlgorithm where
fromEnum DigNull = 1
fromEnum DigMd5 = 2
fromEnum DigSha1 = 3
fromEnum DigRmd160 = 4
fromEnum DigMd2 = 5
fromEnum DigSha256 = 6
fromEnum DigSha384 = 7
fromEnum DigSha512 = 8
fromEnum DigSha224 = 9
toEnum 1 = DigNull
toEnum 2 = DigMd5
toEnum 3 = DigSha1
toEnum 4 = DigRmd160
toEnum 5 = DigMd2
toEnum 6 = DigSha256
toEnum 7 = DigSha384
toEnum 8 = DigSha512
toEnum 9 = DigSha224
toEnum unmatched = error ("DigestAlgorithm.toEnum: Cannot match " ++ show unmatched)
data CompressionMethod = CompUnknown
| CompNull
| CompDeflate
| CompLzo
instance Enum CompressionMethod where
fromEnum CompUnknown = 0
fromEnum CompNull = 1
fromEnum CompDeflate = 2
fromEnum CompLzo = 3
toEnum 0 = CompUnknown
toEnum 1 = CompNull
toEnum 2 = CompDeflate
toEnum 3 = CompLzo
toEnum unmatched = error ("CompressionMethod.toEnum: Cannot match " ++ show unmatched)
data ConnectionEnd = Server
| Client
instance Enum ConnectionEnd where
fromEnum Server = 1
fromEnum Client = 2
toEnum 1 = Server
toEnum 2 = Client
toEnum unmatched = error ("ConnectionEnd.toEnum: Cannot match " ++ show unmatched)
data AlertLevel = AlWarning
| AlFatal
instance Enum AlertLevel where
fromEnum AlWarning = 1
fromEnum AlFatal = 2
toEnum 1 = AlWarning
toEnum 2 = AlFatal
toEnum unmatched = error ("AlertLevel.toEnum: Cannot match " ++ show unmatched)
data AlertDescription = ACloseNotify
| AUnexpectedMessage
| ABadRecordMac
| ADecryptionFailed
| ARecordOverflow
| ADecompressionFailure
| AHandshakeFailure
| ASsl3NoCertificate
| ABadCertificate
| AUnsupportedCertificate
| ACertificateRevoked
| ACertificateExpired
| ACertificateUnknown
| AIllegalParameter
| AUnknownCa
| AAccessDenied
| ADecodeError
| ADecryptError
| AExportRestriction
| AProtocolVersion
| AInsufficientSecurity
| AInternalError
| AUserCanceled
| ANoRenegotiation
| AUnsupportedExtension
| ACertificateUnobtainable
| AUnrecognizedName
| AUnknownPskIdentity
| AInnerApplicationFailure
| AInnerApplicationVerification
instance Enum AlertDescription where
fromEnum ACloseNotify = 0
fromEnum AUnexpectedMessage = 10
fromEnum ABadRecordMac = 20
fromEnum ADecryptionFailed = 21
fromEnum ARecordOverflow = 22
fromEnum ADecompressionFailure = 30
fromEnum AHandshakeFailure = 40
fromEnum ASsl3NoCertificate = 41
fromEnum ABadCertificate = 42
fromEnum AUnsupportedCertificate = 43
fromEnum ACertificateRevoked = 44
fromEnum ACertificateExpired = 45
fromEnum ACertificateUnknown = 46
fromEnum AIllegalParameter = 47
fromEnum AUnknownCa = 48
fromEnum AAccessDenied = 49
fromEnum ADecodeError = 50
fromEnum ADecryptError = 51
fromEnum AExportRestriction = 60
fromEnum AProtocolVersion = 70
fromEnum AInsufficientSecurity = 71
fromEnum AInternalError = 80
fromEnum AUserCanceled = 90
fromEnum ANoRenegotiation = 100
fromEnum AUnsupportedExtension = 110
fromEnum ACertificateUnobtainable = 111
fromEnum AUnrecognizedName = 112
fromEnum AUnknownPskIdentity = 115
fromEnum AInnerApplicationFailure = 208
fromEnum AInnerApplicationVerification = 209
toEnum 0 = ACloseNotify
toEnum 10 = AUnexpectedMessage
toEnum 20 = ABadRecordMac
toEnum 21 = ADecryptionFailed
toEnum 22 = ARecordOverflow
toEnum 30 = ADecompressionFailure
toEnum 40 = AHandshakeFailure
toEnum 41 = ASsl3NoCertificate
toEnum 42 = ABadCertificate
toEnum 43 = AUnsupportedCertificate
toEnum 44 = ACertificateRevoked
toEnum 45 = ACertificateExpired
toEnum 46 = ACertificateUnknown
toEnum 47 = AIllegalParameter
toEnum 48 = AUnknownCa
toEnum 49 = AAccessDenied
toEnum 50 = ADecodeError
toEnum 51 = ADecryptError
toEnum 60 = AExportRestriction
toEnum 70 = AProtocolVersion
toEnum 71 = AInsufficientSecurity
toEnum 80 = AInternalError
toEnum 90 = AUserCanceled
toEnum 100 = ANoRenegotiation
toEnum 110 = AUnsupportedExtension
toEnum 111 = ACertificateUnobtainable
toEnum 112 = AUnrecognizedName
toEnum 115 = AUnknownPskIdentity
toEnum 208 = AInnerApplicationFailure
toEnum 209 = AInnerApplicationVerification
toEnum unmatched = error ("AlertDescription.toEnum: Cannot match " ++ show unmatched)
data HandshakeDescription = HandshakeHelloRequest
| HandshakeClientHello
| HandshakeServerHello
| HandshakeCertificatePkt
| HandshakeServerKeyExchange
| HandshakeCertificateRequest
| HandshakeServerHelloDone
| HandshakeCertificateVerify
| HandshakeClientKeyExchange
| HandshakeFinished
| HandshakeSupplemental
instance Enum HandshakeDescription where
fromEnum HandshakeHelloRequest = 0
fromEnum HandshakeClientHello = 1
fromEnum HandshakeServerHello = 2
fromEnum HandshakeCertificatePkt = 11
fromEnum HandshakeServerKeyExchange = 12
fromEnum HandshakeCertificateRequest = 13
fromEnum HandshakeServerHelloDone = 14
fromEnum HandshakeCertificateVerify = 15
fromEnum HandshakeClientKeyExchange = 16
fromEnum HandshakeFinished = 20
fromEnum HandshakeSupplemental = 23
toEnum 0 = HandshakeHelloRequest
toEnum 1 = HandshakeClientHello
toEnum 2 = HandshakeServerHello
toEnum 11 = HandshakeCertificatePkt
toEnum 12 = HandshakeServerKeyExchange
toEnum 13 = HandshakeCertificateRequest
toEnum 14 = HandshakeServerHelloDone
toEnum 15 = HandshakeCertificateVerify
toEnum 16 = HandshakeClientKeyExchange
toEnum 20 = HandshakeFinished
toEnum 23 = HandshakeSupplemental
toEnum unmatched = error ("HandshakeDescription.toEnum: Cannot match " ++ show unmatched)
data CertificateStatus = CertInvalid
| CertRevoked
| CertSignerNotFound
| CertSignerNotCa
| CertInsecureAlgorithm
| CertNotActivated
| CertExpired
deriving (Show,Eq)
instance Enum CertificateStatus where
fromEnum CertInvalid = 2
fromEnum CertRevoked = 32
fromEnum CertSignerNotFound = 64
fromEnum CertSignerNotCa = 128
fromEnum CertInsecureAlgorithm = 256
fromEnum CertNotActivated = 512
fromEnum CertExpired = 1024
toEnum 2 = CertInvalid
toEnum 32 = CertRevoked
toEnum 64 = CertSignerNotFound
toEnum 128 = CertSignerNotCa
toEnum 256 = CertInsecureAlgorithm
toEnum 512 = CertNotActivated
toEnum 1024 = CertExpired
toEnum unmatched = error ("CertificateStatus.toEnum: Cannot match " ++ show unmatched)
data CertificateRequest = CertIgnore
| CertRequest
| CertRequire
instance Enum CertificateRequest where
fromEnum CertIgnore = 0
fromEnum CertRequest = 1
fromEnum CertRequire = 2
toEnum 0 = CertIgnore
toEnum 1 = CertRequest
toEnum 2 = CertRequire
toEnum unmatched = error ("CertificateRequest.toEnum: Cannot match " ++ show unmatched)
data CloseRequest = ShutRdwr
| ShutWr
instance Enum CloseRequest where
fromEnum ShutRdwr = 0
fromEnum ShutWr = 1
toEnum 0 = ShutRdwr
toEnum 1 = ShutWr
toEnum unmatched = error ("CloseRequest.toEnum: Cannot match " ++ show unmatched)
data Protocol = Ssl3
| Tls10
| Tls11
| Tls12
| VersionUnknown
instance Enum Protocol where
fromEnum Ssl3 = 1
fromEnum Tls10 = 2
fromEnum Tls11 = 3
fromEnum Tls12 = 4
fromEnum VersionUnknown = 255
toEnum 1 = Ssl3
toEnum 2 = Tls10
toEnum 3 = Tls11
toEnum 4 = Tls12
toEnum 255 = VersionUnknown
toEnum unmatched = error ("Protocol.toEnum: Cannot match " ++ show unmatched)
data CertificateType = CrtUnknown
| CrtX509
| CrtOpenpgp
instance Enum CertificateType where
fromEnum CrtUnknown = 0
fromEnum CrtX509 = 1
fromEnum CrtOpenpgp = 2
toEnum 0 = CrtUnknown
toEnum 1 = CrtX509
toEnum 2 = CrtOpenpgp
toEnum unmatched = error ("CertificateType.toEnum: Cannot match " ++ show unmatched)
data X509CertificateFormat = X509FmtDer
| X509FmtPem
deriving (Enum)
data PkAlgorithm = PkUnknown
| PkRsa
| PkDsa
instance Enum PkAlgorithm where
fromEnum PkUnknown = 0
fromEnum PkRsa = 1
fromEnum PkDsa = 2
toEnum 0 = PkUnknown
toEnum 1 = PkRsa
toEnum 2 = PkDsa
toEnum unmatched = error ("PkAlgorithm.toEnum: Cannot match " ++ show unmatched)
data SignAlgorithm = SignUnknown
| SignRsaSha1
| SignDsaSha1
| SignRsaMd5
| SignRsaMd2
| SignRsaRmd160
| SignRsaSha256
| SignRsaSha384
| SignRsaSha512
| SignRsaSha224
instance Enum SignAlgorithm where
fromEnum SignUnknown = 0
fromEnum SignRsaSha1 = 1
fromEnum SignDsaSha1 = 2
fromEnum SignRsaMd5 = 3
fromEnum SignRsaMd2 = 4
fromEnum SignRsaRmd160 = 5
fromEnum SignRsaSha256 = 6
fromEnum SignRsaSha384 = 7
fromEnum SignRsaSha512 = 8
fromEnum SignRsaSha224 = 9
toEnum 0 = SignUnknown
toEnum 1 = SignRsaSha1
toEnum 2 = SignDsaSha1
toEnum 3 = SignRsaMd5
toEnum 4 = SignRsaMd2
toEnum 5 = SignRsaRmd160
toEnum 6 = SignRsaSha256
toEnum 7 = SignRsaSha384
toEnum 8 = SignRsaSha512
toEnum 9 = SignRsaSha224
toEnum unmatched = error ("SignAlgorithm.toEnum: Cannot match " ++ show unmatched)
integralToClockTime :: Integral n => n -> ClockTime
integralToClockTime ct = TOD (fromIntegral ct) 0
enumCInt :: Enum e => e -> CInt
enumCInt x = fromIntegral $ fromEnum x
cintEnum :: Enum e => CInt -> e
cintEnum x = toEnum $ fromIntegral x
safePeekCString :: CString -> IO String
safePeekCString pointer = if pointer == nullPtr then return "" else peekCString pointer
withEnumList0 :: Enum e => [e] -> (Ptr CInt -> IO ()) -> IO ()
withEnumList0 es f = withArray0 0 is f
where is = map enumCInt es
withSession :: Session t -> (Ptr () -> IO a) -> IO a
withSession (Session s _) = withForeignPtr s
throwGnutlsIf :: Integral n => n -> IO ()
throwGnutlsIf 0 = return ()
throwGnutlsIf v = gnutls_strerror (fromIntegral v) >>= safePeekCString >>= (\str -> fail (str++" ("++show v++")"))
throwGnutlsIfNeg :: (Num b, Integral a) => a -> IO b
throwGnutlsIfNeg v = if v < 0 then throwGnutlsIf v >> return 0 else return (fromIntegral v)
peekEnum :: (Storable s, Integral s, Num e, Enum e) => Ptr s -> IO e
peekEnum pointer = peek pointer >>= return . fromIntegral
isZero, isNonZero :: (Num a) => a -> Bool
isZero x = x == 0
isNonZero x = x /= 0
ptrDeS :: Ptr (Ptr ()) -> IO a
ptrDeS p = deRefStablePtr $ castPtrToStablePtr $ castPtr p
peekDatum :: Ptr a -> IO (Ptr CChar,Int)
peekDatum pntr = do pv <- (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CUChar)}) (castPtr pntr)
iv <- (\ptr -> do {peekByteOff ptr 4 ::IO CUInt}) (castPtr pntr)
return (castPtr pv, fromIntegral iv)
peekDatumArray :: Int -> Ptr a -> IO [(Ptr CChar,Int)]
peekDatumArray i pntr = loop i (plusPtr pntr (i*8)) []
where loop 0 pointer acc = do d <- peekDatum pointer
return (d:acc)
loop k pointer acc = do d <- peekDatum pointer
loop (k1) (plusPtr pointer (08)) (d:acc)
class Datum a where
withDatum :: a -> (Ptr () -> IO b) -> IO b
instance Datum String where
withDatum s p = withCStringLen s (\v -> withDatum v p)
instance Datum (Ptr CChar,Int) where
withDatum (p,l) c = allocaBytes 8 $ \dptr -> do
(\ptr val -> do {pokeByteOff ptr 0 (val::(Ptr CUChar))}) dptr (castPtr p)
(\ptr val -> do {pokeByteOff ptr 4 (val::CUInt)}) dptr (fromIntegral l)
c dptr
instance Datum ByteString where
withDatum bs f = unsafeUseAsCStringLen bs (\v -> withDatum v f)
datumBase64Decode :: (Datum d) => Int -> d -> IO ByteString
datumBase64Decode sz dat = withDatum dat $
\p1 -> createAndTrim sz $
\pointer -> with (fromIntegral sz::CSize) $
\sptr -> do
gnutls_pem_base64_decode nullPtr p1 (castPtr pointer) (castPtr sptr) >>= throwGnutlsIf
peek sptr >>= return . fromIntegral
foreign import ccall safe "Network/GnuTLS/Internals.chs.h gnutls_strerror"
gnutls_strerror :: (CInt -> (IO (Ptr CChar)))
foreign import ccall safe "Network/GnuTLS/Internals.chs.h gnutls_pem_base64_decode"
gnutls_pem_base64_decode :: ((Ptr CChar) -> ((Ptr ()) -> ((Ptr CUChar) -> ((Ptr CUInt) -> (IO CInt)))))