{-# 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