{-# LINE 1 "SAML2/XML/LibXML2.hsc" #-} module SAML2.XML.LibXML2 ( Doc , fromXmlTrees , C14NMode(..) , c14n ) where import Control.Exception (bracket) import Control.Monad ((<=<)) import Data.Bits ((.|.)) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Unsafe as BSU import Data.Maybe (fromMaybe) import Data.String.Unicode (unicodeCharToUtf8') import Data.Word (Word8) import Foreign.C.Error (throwErrnoIf, throwErrnoIfNull) import Foreign.C.String (CString, withCString) import Foreign.C.Types (CInt(..)) import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr) import Foreign.Marshal (alloca, withArray0, withMany, maybeWith) import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr) import Foreign.Storable (peek, peekByteOff) import qualified Text.XML.HXT.Core as HXT import qualified Text.XML.HXT.DOM.ShowXml as HXTS type XMLChar = Word8 {-# LINE 32 "SAML2/XML/LibXML2.hsc" #-} data XMLDoc data XMLXPathContext data XMLXPathObject data XMLNodeSet foreign import ccall unsafe "libxml/parser.h xmlReadMemory" xmlReadMemory :: CString -> CInt -> CString -> CString -> CInt -> IO (Ptr XMLDoc) foreign import ccall unsafe "libxml/tree.h &xmlFreeDoc" xmlFreeDoc :: FunPtr ((Ptr XMLDoc) -> IO ()) foreign import ccall unsafe "libxml/xpath.h xmlXPathNewContext" xmlXPathNewContext :: Ptr XMLDoc -> IO (Ptr XMLXPathContext) foreign import ccall unsafe "libxml/xpath.h xmlXPathFreeContext" xmlXPathFreeContext :: Ptr XMLXPathContext -> IO () foreign import ccall unsafe "libxml/xpath.h xmlXPathEval" xmlXPathEval :: Ptr XMLChar -> Ptr XMLXPathContext -> IO (Ptr XMLXPathObject) foreign import ccall unsafe "libxml/xpath.h xmlXPathFreeObject" xmlXPathFreeObject :: Ptr XMLXPathObject -> IO () foreign import ccall unsafe "libxml/c14n.h xmlC14NDocDumpMemory" xmlC14NDocDumpMemory :: Ptr XMLDoc -> Ptr XMLNodeSet -> CInt -> Ptr (Ptr XMLChar) -> CInt -> Ptr (Ptr XMLChar) -> IO CInt foreign import ccall unsafe "xmlFree_stub" xmlFree :: Ptr a -> IO () newtype Doc = Doc{ Doc -> ForeignPtr XMLDoc unDoc :: ForeignPtr XMLDoc } newDoc :: Ptr XMLDoc -> IO Doc newDoc :: Ptr XMLDoc -> IO Doc newDoc = (ForeignPtr XMLDoc -> Doc) -> IO (ForeignPtr XMLDoc) -> IO Doc forall a b. (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ForeignPtr XMLDoc -> Doc Doc (IO (ForeignPtr XMLDoc) -> IO Doc) -> (Ptr XMLDoc -> IO (ForeignPtr XMLDoc)) -> Ptr XMLDoc -> IO Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . FinalizerPtr XMLDoc -> Ptr XMLDoc -> IO (ForeignPtr XMLDoc) forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a) newForeignPtr FinalizerPtr XMLDoc xmlFreeDoc fromBytes :: BS.ByteString -> IO Doc fromBytes :: ByteString -> IO Doc fromBytes ByteString s = do Ptr XMLDoc d <- ByteString -> (CStringLen -> IO (Ptr XMLDoc)) -> IO (Ptr XMLDoc) forall a. ByteString -> (CStringLen -> IO a) -> IO a BSU.unsafeUseAsCStringLen ByteString s ((CStringLen -> IO (Ptr XMLDoc)) -> IO (Ptr XMLDoc)) -> (CStringLen -> IO (Ptr XMLDoc)) -> IO (Ptr XMLDoc) forall a b. (a -> b) -> a -> b $ \(Ptr CChar p, Int l) -> String -> IO (Ptr XMLDoc) -> IO (Ptr XMLDoc) forall a. String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNull String "xmlReadMemory" (IO (Ptr XMLDoc) -> IO (Ptr XMLDoc)) -> IO (Ptr XMLDoc) -> IO (Ptr XMLDoc) forall a b. (a -> b) -> a -> b $ Ptr CChar -> CInt -> Ptr CChar -> Ptr CChar -> CInt -> IO (Ptr XMLDoc) xmlReadMemory Ptr CChar p (Int -> CInt forall a b. (Integral a, Num b) => a -> b fromIntegral Int l) Ptr CChar forall a. Ptr a nullPtr Ptr CChar forall a. Ptr a nullPtr (CInt 2 CInt -> CInt -> CInt forall a. Bits a => a -> a -> a .|. CInt 4 CInt -> CInt -> CInt forall a. Bits a => a -> a -> a .|. CInt 8 CInt -> CInt -> CInt forall a. Bits a => a -> a -> a .|. CInt 2048 CInt -> CInt -> CInt forall a. Bits a => a -> a -> a .|. CInt 65536) {-# LINE 71 "SAML2/XML/LibXML2.hsc" #-} newDoc d fromXmlTrees :: HXT.XmlTrees -> IO Doc fromXmlTrees :: XmlTrees -> IO Doc fromXmlTrees = ByteString -> IO Doc fromBytes (ByteString -> IO Doc) -> (XmlTrees -> ByteString) -> XmlTrees -> IO Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString BSL.toStrict (ByteString -> ByteString) -> (XmlTrees -> ByteString) -> XmlTrees -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . (Char -> StringFct) -> (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> ByteString HXTS.xshow' Char -> StringFct cq Char -> StringFct aq Char -> StringFct unicodeCharToUtf8' where cq :: Char -> StringFct cq Char '&' = (String "&" String -> StringFct forall a. [a] -> [a] -> [a] ++) cq Char '<' = (String "<" String -> StringFct forall a. [a] -> [a] -> [a] ++) cq Char '>' = (String ">" String -> StringFct forall a. [a] -> [a] -> [a] ++) cq Char '\13' = (String "
" String -> StringFct forall a. [a] -> [a] -> [a] ++) cq Char c = (Char cChar -> StringFct forall a. a -> [a] -> [a] :) aq :: Char -> StringFct aq Char '"' = (String """ String -> StringFct forall a. [a] -> [a] -> [a] ++) aq Char '\9' = (String "	" String -> StringFct forall a. [a] -> [a] -> [a] ++) aq Char '\10' = (String "
" String -> StringFct forall a. [a] -> [a] -> [a] ++) aq Char c = Char -> StringFct cq Char c withXMLXPathNodeList :: Ptr XMLDoc -> String -> (Ptr XMLNodeSet -> IO a) -> IO a withXMLXPathNodeList :: forall a. Ptr XMLDoc -> String -> (Ptr XMLNodeSet -> IO a) -> IO a withXMLXPathNodeList Ptr XMLDoc d String s Ptr XMLNodeSet -> IO a f = IO (Ptr XMLXPathContext) -> (Ptr XMLXPathContext -> IO ()) -> (Ptr XMLXPathContext -> IO a) -> IO a forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket (Ptr XMLDoc -> IO (Ptr XMLXPathContext) xmlXPathNewContext Ptr XMLDoc d) Ptr XMLXPathContext -> IO () xmlXPathFreeContext ((Ptr XMLXPathContext -> IO a) -> IO a) -> (Ptr XMLXPathContext -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ \Ptr XMLXPathContext c -> String -> (Ptr CChar -> IO a) -> IO a forall a. String -> (Ptr CChar -> IO a) -> IO a withCString String s ((Ptr CChar -> IO a) -> IO a) -> (Ptr CChar -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ \Ptr CChar p -> IO (Ptr XMLXPathObject) -> (Ptr XMLXPathObject -> IO ()) -> (Ptr XMLXPathObject -> IO a) -> IO a forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket (String -> IO (Ptr XMLXPathObject) -> IO (Ptr XMLXPathObject) forall a. String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNull String "xmlXPathEval" (IO (Ptr XMLXPathObject) -> IO (Ptr XMLXPathObject)) -> IO (Ptr XMLXPathObject) -> IO (Ptr XMLXPathObject) forall a b. (a -> b) -> a -> b $ Ptr XMLChar -> Ptr XMLXPathContext -> IO (Ptr XMLXPathObject) xmlXPathEval ((Ptr CChar -> Ptr XMLChar forall a b. Ptr a -> Ptr b castPtr :: CString -> Ptr Word8) Ptr CChar p) Ptr XMLXPathContext c) Ptr XMLXPathObject -> IO () xmlXPathFreeObject ((Ptr XMLXPathObject -> IO a) -> IO a) -> (Ptr XMLXPathObject -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ Ptr XMLNodeSet -> IO a f (Ptr XMLNodeSet -> IO a) -> (Ptr XMLXPathObject -> IO (Ptr XMLNodeSet)) -> Ptr XMLXPathObject -> IO a forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< (\Ptr XMLXPathObject hsc_ptr -> Ptr XMLXPathObject -> Int -> IO (Ptr XMLNodeSet) forall b. Ptr b -> Int -> IO (Ptr XMLNodeSet) forall a b. Storable a => Ptr b -> Int -> IO a peekByteOff Ptr XMLXPathObject hsc_ptr Int 8) {-# LINE 94 "SAML2/XML/LibXML2.hsc" #-} data C14NMode = C14N_1_0 | C14N_EXCLUSIVE_1_0 | C14N_1_1 c14nmode :: C14NMode -> CInt c14nmode :: C14NMode -> CInt c14nmode C14NMode C14N_1_0 = CInt 0 {-# LINE 102 "SAML2/XML/LibXML2.hsc" #-} c14nmode C14N_EXCLUSIVE_1_0 = 1 {-# LINE 103 "SAML2/XML/LibXML2.hsc" #-} c14nmode C14N_1_1 = 2 {-# LINE 104 "SAML2/XML/LibXML2.hsc" #-} c14n :: C14NMode -> Maybe [String] -> Bool -> Maybe String -> Doc -> IO BS.ByteString c14n :: C14NMode -> Maybe [String] -> Bool -> Maybe String -> Doc -> IO ByteString c14n C14NMode m Maybe [String] i Bool c Maybe String s Doc d = ForeignPtr XMLDoc -> (Ptr XMLDoc -> IO ByteString) -> IO ByteString forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr (Doc -> ForeignPtr XMLDoc unDoc Doc d) ((Ptr XMLDoc -> IO ByteString) -> IO ByteString) -> (Ptr XMLDoc -> IO ByteString) -> IO ByteString forall a b. (a -> b) -> a -> b $ \Ptr XMLDoc dp -> (String -> (Ptr CChar -> IO ByteString) -> IO ByteString) -> [String] -> ([Ptr CChar] -> IO ByteString) -> IO ByteString forall a b res. (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res withMany String -> (Ptr CChar -> IO ByteString) -> IO ByteString forall a. String -> (Ptr CChar -> IO a) -> IO a withCString ([String] -> Maybe [String] -> [String] forall a. a -> Maybe a -> a fromMaybe [] Maybe [String] i) (([Ptr CChar] -> IO ByteString) -> IO ByteString) -> ([Ptr CChar] -> IO ByteString) -> IO ByteString forall a b. (a -> b) -> a -> b $ \[Ptr CChar] il -> ([Ptr CChar] -> (Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString) -> Maybe [Ptr CChar] -> (Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString forall a b c. (a -> (Ptr b -> IO c) -> IO c) -> Maybe a -> (Ptr b -> IO c) -> IO c maybeWith (Ptr CChar -> [Ptr CChar] -> (Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b withArray0 Ptr CChar forall a. Ptr a nullPtr) ([Ptr CChar] il [Ptr CChar] -> Maybe [String] -> Maybe [Ptr CChar] forall a b. a -> Maybe b -> Maybe a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Maybe [String] i) ((Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString) -> (Ptr (Ptr CChar) -> IO ByteString) -> IO ByteString forall a b. (a -> b) -> a -> b $ \Ptr (Ptr CChar) ip -> (String -> (Ptr XMLNodeSet -> IO ByteString) -> IO ByteString) -> Maybe String -> (Ptr XMLNodeSet -> IO ByteString) -> IO ByteString forall a b c. (a -> (Ptr b -> IO c) -> IO c) -> Maybe a -> (Ptr b -> IO c) -> IO c maybeWith (Ptr XMLDoc -> String -> (Ptr XMLNodeSet -> IO ByteString) -> IO ByteString forall a. Ptr XMLDoc -> String -> (Ptr XMLNodeSet -> IO a) -> IO a withXMLXPathNodeList Ptr XMLDoc dp) Maybe String s ((Ptr XMLNodeSet -> IO ByteString) -> IO ByteString) -> (Ptr XMLNodeSet -> IO ByteString) -> IO ByteString forall a b. (a -> b) -> a -> b $ \Ptr XMLNodeSet sn -> (Ptr (Ptr XMLChar) -> IO ByteString) -> IO ByteString forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca ((Ptr (Ptr XMLChar) -> IO ByteString) -> IO ByteString) -> (Ptr (Ptr XMLChar) -> IO ByteString) -> IO ByteString forall a b. (a -> b) -> a -> b $ \Ptr (Ptr XMLChar) p -> do CInt r <- (CInt -> Bool) -> String -> IO CInt -> IO CInt forall a. (a -> Bool) -> String -> IO a -> IO a throwErrnoIf (CInt -> CInt -> Bool forall a. Ord a => a -> a -> Bool < CInt 0) String "xmlC14NDocDumpMemory" (IO CInt -> IO CInt) -> IO CInt -> IO CInt forall a b. (a -> b) -> a -> b $ Ptr XMLDoc -> Ptr XMLNodeSet -> CInt -> Ptr (Ptr XMLChar) -> CInt -> Ptr (Ptr XMLChar) -> IO CInt xmlC14NDocDumpMemory Ptr XMLDoc dp Ptr XMLNodeSet sn (C14NMode -> CInt c14nmode C14NMode m) ((Ptr (Ptr CChar) -> Ptr (Ptr XMLChar) forall a b. Ptr a -> Ptr b castPtr :: Ptr CString -> Ptr (Ptr Word8)) Ptr (Ptr CChar) ip) (Int -> CInt forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> CInt) -> Int -> CInt forall a b. (a -> b) -> a -> b $ Bool -> Int forall a. Enum a => a -> Int fromEnum Bool c) Ptr (Ptr XMLChar) p Ptr XMLChar pp <- Ptr (Ptr XMLChar) -> IO (Ptr XMLChar) forall a. Storable a => Ptr a -> IO a peek Ptr (Ptr XMLChar) p Ptr XMLChar -> Int -> IO () -> IO ByteString BSU.unsafePackCStringFinalizer Ptr XMLChar pp (CInt -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral CInt r) (Ptr XMLChar -> IO () forall a. Ptr a -> IO () xmlFree Ptr XMLChar pp)