diff --git a/examples/httpPullTlsCl.hs b/examples/httpPullTlsCl.hs
--- a/examples/httpPullTlsCl.hs
+++ b/examples/httpPullTlsCl.hs
@@ -17,7 +17,8 @@
 	testPusher (undefined :: HttpPullTlsCl Handle) (One h) (HttpPullTlsClArgs
 		(HttpPullClArgs "localhost" 443 "/" gtPth mkPoll
 			pendingQ (Just 10000000) drtn)
-		(TlsArgs "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] ca [(k, c)]) )
+		(TlsArgs "localhost" (const Nothing)
+			["TLS_RSA_WITH_AES_128_CBC_SHA"] ca [(k, c)]) )
 
 mkPoll :: IO XmlNode
 mkPoll = return $ XmlNode (nullQ "poll") [] [] []
diff --git a/examples/httpPushTlsE.hs b/examples/httpPushTlsE.hs
--- a/examples/httpPushTlsE.hs
+++ b/examples/httpPushTlsE.hs
@@ -19,7 +19,8 @@
 	testPusher (undefined :: HttpPushTls Handle) (Two (Just ch) Nothing) (HttpPushTlsArgs
 		(HttpPushArgs (const Nothing) getServerHandle
 			(Just ("localhost", 80, "")) gtPth wntRspns)
-		(tlsArgsCl "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] ca
+		(tlsArgsCl "localhost" (const Nothing)
+			["TLS_RSA_WITH_AES_128_CBC_SHA"] ca
 			[(k', c')])
 		(tlsArgsSv gtNm (const Nothing)
 			["TLS_RSA_WITH_AES_128_CBC_SHA"]
diff --git a/examples/httpPushTlsT.hs b/examples/httpPushTlsT.hs
--- a/examples/httpPushTlsT.hs
+++ b/examples/httpPushTlsT.hs
@@ -1,12 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import Control.Monad
+import Data.List
+import Data.Char
+import Data.X509
+import Data.X509.Validation
 import System.IO
 import Text.XML.Pipe
 import Network
 import Network.XmlPush.HttpPush.Tls
 import Network.PeyoTLS.ReadFile
+import Numeric
 
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC
 
 import TestPusher
@@ -23,12 +29,26 @@
 			(HttpPushTlsArgs
 				(HttpPushArgs getClientHandle Nothing
 					Nothing gtPth wntRspns)
-				(tlsArgsCl "Yoshikuni"
+				(tlsArgsCl "Yoshikuni" checkCertXml
 					["TLS_RSA_WITH_AES_128_CBC_SHA"]
 						ca [(k', c')])
 				(tlsArgsSv gtNm (const Nothing)
 					["TLS_RSA_WITH_AES_128_CBC_SHA"]
 					(Just ca) [(k', c')]) )
+
+checkCertXml :: XmlNode -> Maybe (SignedCertificate -> Bool)
+checkCertXml = const $ Just checkCert
+
+checkCert :: SignedCertificate -> Bool
+checkCert c = cutFingerprint (getFingerprint c HashSHA256) `elem` [
+	"81:9A:16:4A:57:AE:82:92:78:E0" ]
+
+cutFingerprint :: Fingerprint -> String
+cutFingerprint (Fingerprint bs) = lastN 29 .
+	intercalate ":" . map (map toUpper . flip showHex "") $ BS.unpack bs
+
+lastN :: Int -> [a] -> [a]
+lastN n xs = drop (length xs - n) xs
 
 getClientHandle :: XmlNode -> Maybe (IO Handle, String, Int, FilePath)
 getClientHandle (XmlNode (_, "client") [] [] [XmlCharData hn]) = Just (
diff --git a/examples/xmppTls.hs b/examples/xmppTls.hs
--- a/examples/xmppTls.hs
+++ b/examples/xmppTls.hs
@@ -23,7 +23,8 @@
 	testPusher (undefined :: XmppTls Handle) (One h) (XmppTlsArgs
 		(XmppArgs ["EXTERNAL", "SCRAM-SHA-1", "DIGEST-MD5", "PLAIN"]
 			(toJid me) ps (toJid you) iNdRspns wntRspns)
-		(TlsArgs "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] ca [(k, c)]) )
+		(TlsArgs "localhost" (const Nothing)
+			["TLS_RSA_WITH_AES_128_CBC_SHA"] ca [(k, c)]) )
 
 wntRspns :: XmlNode -> Bool
 wntRspns (XmlNode (_, "monologue") _ [] []) = False
diff --git a/src/Network/XmlPush/HttpPull/Tls/Client.hs b/src/Network/XmlPush/HttpPull/Tls/Client.hs
--- a/src/Network/XmlPush/HttpPull/Tls/Client.hs
+++ b/src/Network/XmlPush/HttpPull/Tls/Client.hs
@@ -77,7 +77,7 @@
 makeHttpPull :: (ValidateHandle h, MonadBaseControl IO (HandleMonad h)) =>
 	One h -> HttpPullTlsClArgs h -> HandleMonad h (HttpPullTlsCl h)
 makeHttpPull (One h) (HttpPullTlsClArgs
-	(HttpPullClArgs hn pn fp gp pl ip d gd) (TlsArgs dn cs ca kcs)) = do
+	(HttpPullClArgs hn pn fp gp pl ip d gd) (TlsArgs dn _ cs ca kcs)) = do
 	dr <- liftBase . atomically $ newTVar d
 	(inc, otc) <- do
 		(g :: SystemRNG) <- liftBase $ cprgCreate <$> createEntropyPool
diff --git a/src/Network/XmlPush/HttpPush.hs b/src/Network/XmlPush/HttpPush.hs
--- a/src/Network/XmlPush/HttpPush.hs
+++ b/src/Network/XmlPush/HttpPush.hs
@@ -78,7 +78,7 @@
 		runPipe_ $ fromTChan otc
 			=$= filter isJust
 			=$= convert fromJust
-			=$= clientLoop h hn pn pt gp
+			=$= clientLoop h hn pn pt gp (convert id)
 			=$= convert (, False)
 			=$= toTChan inc
 	return (inc, otc)
diff --git a/src/Network/XmlPush/HttpPush/Common.hs b/src/Network/XmlPush/HttpPush/Common.hs
--- a/src/Network/XmlPush/HttpPush/Common.hs
+++ b/src/Network/XmlPush/HttpPush/Common.hs
@@ -38,8 +38,9 @@
 
 clientLoop :: (HandleLike h, MonadBaseControl IO (HandleMonad h)) =>
 	h -> String -> Int -> FilePath -> (XmlNode -> FilePath) ->
+	Pipe XmlNode XmlNode (HandleMonad h) () ->
 	Pipe XmlNode XmlNode (HandleMonad h) ()
-clientLoop h hn pn pt gp = (await >>=) . maybe (return ()) $ \n -> do
+clientLoop h hn pn pt gp p = (await >>=) . maybe (return ()) $ \n -> do
 	r <- lift . request h $ post hn pn (pt ++ "/" ++ gp n)
 		(Nothing, LBS.fromChunks [xmlString [n]])
 	return ()
@@ -47,7 +48,8 @@
 		=$= xmlEvent
 		=$= convert fromJust
 		=$= void (xmlNode [])
-	clientLoop h hn pn pt gp
+		=$= p
+	clientLoop h hn pn pt gp p
 
 checkReply :: MonadBase IO m => (XmlNode -> Bool) -> TChan (Maybe XmlNode) ->
 	Pipe XmlNode (XmlNode, Bool) m ()
diff --git a/src/Network/XmlPush/HttpPush/Tls.hs b/src/Network/XmlPush/HttpPush/Tls.hs
--- a/src/Network/XmlPush/HttpPush/Tls.hs
+++ b/src/Network/XmlPush/HttpPush/Tls.hs
@@ -40,7 +40,9 @@
 
 type TlsArgsCl = TC.TlsArgs
 
-tlsArgsCl :: String -> [Cl.CipherSuite] -> CertificateStore ->
+tlsArgsCl :: String ->
+	(XmlNode -> Maybe (SignedCertificate -> Bool)) ->
+	[Cl.CipherSuite] -> CertificateStore ->
 	[(CertSecretKey, CertificateChain)] -> TlsArgsCl
 tlsArgsCl = TC.TlsArgs
 
@@ -77,7 +79,7 @@
 	Maybe h -> Maybe h ->
 	HttpPushTlsArgs h -> HandleMonad h (HttpPushTls h)
 makeHttpPushTls mch msh (HttpPushTlsArgs (HttpPushArgs gc gs hi gp wr)
-	(TC.TlsArgs dn cs ca kcs) (TS.TlsArgs gn cc cs' mca' kcs')) = do
+	(TC.TlsArgs dn cc' cs ca kcs) (TS.TlsArgs gn cc cs' mca' kcs')) = do
 	vch <- liftBase . atomically $ newTVar mch
 	vsh <- liftBase . atomically $ newTVar msh
 	case hi of
@@ -86,17 +88,18 @@
 		_ -> return ()
 	v <- liftBase . atomically $ newTVar False
 	vhi <- liftBase . atomically $ newTVar hi
-	(ci, co) <- clientC vch vhi gp cs ca kcs
+	(ci, co) <- clientC vch vhi cc' gp cs ca kcs
 	(si, so) <- talk wr vsh gn cc cs' mca' kcs' vch vhi gc gs
 	return $ HttpPushTls v ci co si so
 
 clientC :: (ValidateHandle h, MonadBaseControl IO (HandleMonad h)) =>
 	TVar (Maybe h) -> TVar (Maybe (String, Int, FilePath)) ->
+	(XmlNode -> Maybe (SignedCertificate -> Bool)) ->
 	(XmlNode -> FilePath) ->
 	[Cl.CipherSuite] -> CertificateStore ->
 	[(CertSecretKey, CertificateChain)] ->
 	HandleMonad h (TChan (XmlNode, Bool), TChan (Maybe XmlNode))
-clientC vh vhi gp cs ca kcs = do
+clientC vh vhi cc gp cs ca kcs = do
 	inc <- liftBase $ atomically newTChan
 	otc <- liftBase $ atomically newTChan
 	(g :: SystemRNG) <- liftBase $ cprgCreate <$> createEntropyPool
@@ -116,7 +119,7 @@
 			runPipe_ $ fromTChan otc
 				=$= filter isJust
 				=$= convert fromJust
-				=$= clientLoop t hn pn pt gp
+				=$= clientLoop t hn pn pt gp (checkCertCl t cc)
 				=$= convert (, False)
 				=$= toTChan inc
 	return (inc, otc)
@@ -170,6 +173,17 @@
 	unless (ck c) $ error "checkCert: bad certificate"
 	yield n
 	checkCert t cc
+
+checkCertCl :: (ValidateHandle h, CPRG g) => Cl.TlsHandle h g ->
+	(XmlNode -> Maybe (SignedCertificate -> Bool)) ->
+	Pipe XmlNode XmlNode (Cl.TlsM h g) ()
+checkCertCl t cc = (await >>=) . maybe (return ()) $ \n -> do
+	lift $ hlDebug t "medium" "begin checkCertCl"
+	let ck = maybe (const True) id $ cc n
+	c <- lift $ Cl.getCertificate t
+	unless (ck c) $ error "checkCert: bad certificate"
+	yield n
+	checkCertCl t cc
 
 checkName :: HandleLike h => Sv.TlsHandle h g -> (XmlNode -> Maybe String) ->
 	Pipe XmlNode XmlNode (Sv.TlsM h g) ()
diff --git a/src/Network/XmlPush/Tls/Client.hs b/src/Network/XmlPush/Tls/Client.hs
--- a/src/Network/XmlPush/Tls/Client.hs
+++ b/src/Network/XmlPush/Tls/Client.hs
@@ -5,9 +5,11 @@
 import Data.X509
 import Data.X509.CertificateStore
 import Network.PeyoTLS.Client
+import Text.XML.Pipe
 
 data TlsArgs = TlsArgs {
 	serverName :: String,
+	checkCertificate :: XmlNode -> Maybe (SignedCertificate -> Bool),
 	cipherSuites :: [CipherSuite],
 	certificateAuthorities :: CertificateStore,
 	keyChains :: [(CertSecretKey, CertificateChain)]
diff --git a/src/Network/XmlPush/Xmpp/Tls.hs b/src/Network/XmlPush/Xmpp/Tls.hs
--- a/src/Network/XmlPush/Xmpp/Tls.hs
+++ b/src/Network/XmlPush/Xmpp/Tls.hs
@@ -56,7 +56,7 @@
 	MonadError (HandleMonad h), Error (ErrorType (HandleMonad h))
 	) => One h -> XmppTlsArgs h -> HandleMonad h (XmppTls h)
 makeXmppTls (One h)
-	(XmppTlsArgs (XmppArgs ms me ps you inr wr) (TlsArgs dn cs ca kcs)) = do
+	(XmppTlsArgs (XmppArgs ms me ps you inr wr) (TlsArgs dn _ cs ca kcs)) = do
 	nr <- liftBase $ atomically newTChan
 	wc <- liftBase $ atomically newTChan
 	(g :: SystemRNG) <- liftBase $ cprgCreate <$> createEntropyPool
diff --git a/xml-push.cabal b/xml-push.cabal
--- a/xml-push.cabal
+++ b/xml-push.cabal
@@ -2,7 +2,7 @@
 cabal-version:	>= 1.8
 
 name:		xml-push
-version:	0.0.0.8
+version:	0.0.0.9
 stability:	Experimenmtal
 author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>
 maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>
@@ -100,7 +100,7 @@
 source-repository	this
     type:	git
     location:	git://github.com/YoshikuniJujo/xml-push.git
-    tag:	xml-push-0.0.0.8
+    tag:	xml-push-0.0.0.9
 
 library
     hs-source-dirs:	src