module Network.Aeson.Client where
import Data.Aeson hiding (Result)
import Data.Attoparsec.ByteString (parseWith, IResult(..))
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromMaybe)
import Network.Http.Client
import OpenSSL (withOpenSSL)
import System.IO (hFlush, hPutStrLn, stderr)
import qualified System.IO.Streams as Streams
apiGet :: FromJSON a =>
Maybe (B.ByteString, B.ByteString)
-> B.ByteString
-> B.ByteString
-> [(B.ByteString, Maybe B.ByteString)] -> IO (Maybe a)
apiGet mbasic base uri parameters = withOpenSSL $ do
let url = B.concat [uri, queryString parameters]
q <- buildRequest $ do
http GET url
maybe (return ()) (uncurry setAuthorizationBasic) mbasic
c <- establishConnection base
sendRequest c q emptyBody
receiveResponse' c
apiPost :: FromJSON a =>
Maybe (B.ByteString, B.ByteString)
-> B.ByteString
-> B.ByteString
-> [(B.ByteString, Maybe B.ByteString)] -> LB.ByteString -> IO (Maybe a)
apiPost mbasic base uri parameters body = withOpenSSL $ do
let url = B.concat [uri, queryString parameters]
q <- buildRequest $ do
http POST url
maybe (return ()) (uncurry setAuthorizationBasic) mbasic
setContentLength (fromIntegral $ LB.length body)
setContentType "application/json"
c <- establishConnection base
body' <- Streams.fromLazyByteString body
sendRequest c q (inputStreamBody body')
receiveResponse' c
apiDelete :: FromJSON a =>
Maybe (B.ByteString, B.ByteString)
-> B.ByteString
-> B.ByteString
-> [(B.ByteString, Maybe B.ByteString)] -> IO (Result a)
apiDelete mbasic base uri parameters = withOpenSSL $ do
let url = B.concat [uri, queryString parameters]
q <- buildRequest $ do
http DELETE url
maybe (return ()) (uncurry setAuthorizationBasic) mbasic
c <- establishConnection base
sendRequest c q emptyBody
r <- receiveResponse c $ \p' i -> do
case getStatusCode p' of
204 -> return Ok
_ -> do
x <- Streams.read i
let more = Streams.read i >>= return . fromMaybe ""
p <- parseWith more json $ fromMaybe "" x
case p of
Done _ value -> do
case fromJSON value of
Success value' -> do
return $ Value value'
_ -> return JsonFailure
_ -> return ParseFailure
closeConnection c
return r
data Result a =
Ok
| Value a
| JsonFailure
| ParseFailure
deriving Show
apiPut ::
Maybe (B.ByteString, B.ByteString)
-> B.ByteString
-> B.ByteString
-> [(B.ByteString, Maybe B.ByteString)]
-> LB.ByteString
-> IO ()
apiPut mbasic base uri parameters body = withOpenSSL $ do
let url = B.concat [uri, queryString parameters]
q <- buildRequest $ do
http PUT url
setContentLength (fromIntegral $ LB.length body)
setContentType "application/json"
maybe (return ()) (uncurry setAuthorizationBasic) mbasic
c <- establishConnection base
body' <- Streams.fromLazyByteString body
sendRequest c q (inputStreamBody body')
apiPatch ::
Maybe (B.ByteString, B.ByteString)
-> B.ByteString
-> B.ByteString
-> [(B.ByteString, Maybe B.ByteString)]
-> LB.ByteString
-> IO ()
apiPatch mbasic base uri parameters body = withOpenSSL $ do
let url = B.concat [uri, queryString parameters]
q <- buildRequest $ do
http PATCH url
setContentLength (fromIntegral $ LB.length body)
setContentType "application/json"
maybe (return ()) (uncurry setAuthorizationBasic) mbasic
c <- establishConnection base
body' <- Streams.fromLazyByteString body
sendRequest c q (inputStreamBody body')
receiveResponse' :: FromJSON a => Connection -> IO (Maybe a)
receiveResponse' c = do
r <- receiveResponse c $ \_ i -> do
x <- Streams.read i
let more = Streams.read i >>= return . fromMaybe ""
p <- parseWith more json $ fromMaybe "" x
case p of
Done _ value -> do
case fromJSON value of
Success value' -> do
return $ Just value'
_ -> return Nothing
_ -> return Nothing
closeConnection c
return r
queryString :: [(B.ByteString, Maybe B.ByteString)] -> B.ByteString
queryString [] = ""
queryString xs = B.cons '?' . B.intercalate "&" . map f $ xs
where f (a, Just b) = B.concat [a, "=", b]
f (a, _) = a
debug :: Show a => a -> IO ()
debug s = do
hPutStrLn stderr $ show s
hFlush stderr