{-# LANGUAGE NamedFieldPuns #-} module BaseXClient.Session where import BaseXClient.Query (Query(..)) import BaseXClient.Utils import Control.Applicative import Control.Exception import Data.ByteString.Lazy.UTF8 (fromString) import qualified Data.Digest.Pure.MD5 as MD5 import Data.List import Network import System.IO data Result = Result { content :: String , info :: String } deriving Show connect :: String -> PortNumber -> String -> String -> IO Handle connect host port user pass = do session <- connectTo host $ PortNumber port hSetEncoding session utf8 hSetBuffering session $ BlockBuffering $ Just 4096 resp <- readString session let (code, nonce) = case elemIndex ':' resp of Just i -> let (realm, ':' : nonce') = splitAt i resp in (intercalate ":" [user, realm, pass], nonce') Nothing -> (pass, nonce) writeStrings session [user, md5 $ md5 code ++ nonce] ok session <$$> \b -> if b then session else error "Access denied." where md5 = show . MD5.md5 . fromString execute :: String -> Handle -> IO Result execute cmd session = do writeString session cmd content <- readString session info <- readString session result <- ok session <$$> \b -> if b then Result { content, info } else error info evaluate result query :: String -> Handle -> IO Query query q session = do ident <- exec 0 [q] session return Query { session, ident } create, add, replace, store :: String -> String -> Handle -> IO String create = sendInput 8 add = sendInput 9 replace = sendInput 12 store = sendInput 13 sendInput :: Int -> String -> String -> Handle -> IO String sendInput code arg input = exec code [arg, input] close :: Handle -> IO () close session = do writeString session "exit" hClose session