From bd5cec4495792198cb3270f5baeac3a362af606c Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Mar 2017 10:28:24 +0100 Subject: [PATCH] add requestL --- cloogle.icl | 77 +++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 60 insertions(+), 17 deletions(-) diff --git a/cloogle.icl b/cloogle.icl index b6adaf3..874d177 100644 --- a/cloogle.icl +++ b/cloogle.icl @@ -9,6 +9,7 @@ import Data.Maybe from Data.Func import $ from Text import class Text(..), instance Text String, instance + String +import Text.URI import Control.Applicative import qualified Control.Monad as CM @@ -73,8 +74,32 @@ where = (Error $ server_name + " hung up during transmission.", chan, w) = receiveRest {resp & rsp_data=resp.rsp_data + toString (fromJust newresp)} chan w +import StdMisc +import StdDebug + +doRequestL :: HTTPRequest Int *World -> *(MaybeErrorString HTTPResponse, *World) +doRequestL req 0 w = (Error "Maximal redirect numbe exceeded", w) +doRequestL req maxRedirects w +| not (trace_tn $ toString req) = undef +# (er, w) = doRequest req w +| isError er = (er, w) +# resp = fromOk er +| isMember resp.HTTPResponse.rsp_code [301, 302, 303, 307, 308] + = case lookup "Location" resp.HTTPResponse.rsp_headers of + Nothing = (Error $ "Redirect given but no Location header", w) + Just loc = case parseURI loc of + Nothing = (Error $ "Redirect URI couldn't be parsed", w) + Just uri = doRequestL {req + & server_name = maybe loc id uri.uriRegName + , server_port = maybe 80 id uri.uriPort + , req_path = uri.uriPath + , req_query = maybe "" ((+++) "?") uri.uriQuery + } (maxRedirects-1) w += (er, w) + shorten :: String *World -> (String, *World) shorten s w +# s = if (startsWith "http://" s) s (if (startsWith "https://" s) s ("http://" + s)) # data = "type=regular&url="+urlEncode s+"&token=a" # (mer, w) = doRequest { newHTTPRequest @@ -91,6 +116,18 @@ shorten s w # resp = fromOk mer = (resp.rsp_data, w) +cloogle :: String *World -> (String, *World) +cloogle data w +# (mer, w) = doRequestL + { newHTTPRequest + & req_path = "/api.php" + , req_query = "?str=" + urlEncode data + , server_name = "cloogle.org" + , server_port = 80} 10 w +| isError mer = ("request failed: " + fromError mer, w) +# resp = fromOk mer += (resp.rsp_data, w) + send :: [String] TCP_DuplexChannel *World -> (TCP_DuplexChannel, *World) send [] chan w = (chan, w) send [msg:msgs] {sChannel,rChannel} w @@ -121,17 +158,21 @@ process io chan w # (w, toSend) = case cmd of ["stop":_] = (w, Nothing) ["ping":xs] = (w, Just [msg $ "pong " +++ join " " xs]) + ["query":xs] + # (s, w) = cloogle (join " " xs) w + = (w, Just [msg s]) ["short"] = (w, Just [msg $ "short requires an url argument"]) ["short":xs] # (s, w) = shorten (join " " xs) w = (w, Just [msg s]) ["help"] = (w, Just [msg "type !help cmd for command specific help" - ,msg "available commands: help, short, ping"]) + ,msg "available commands: help, ping, query, short"]) ["help":c:_] = (w, case c of "help" = Just [msg "help [CMD] - I will print general help or the help of CMD"] - "short" = Just [msg "short URL - I will give the url to https://cloo.gl shortening service and post back the result"] "ping" = Just [msg "ping [TXT] - I will reply with pong and the optionar TXT"] + "query" = Just [msg "query QUERY - I will send QUERY to cloogle and post the results"] + "short" = Just [msg "short URL - I will give the url to https://cloo.gl shortening service and post back the result"] _ = Just [msg "Unknown command"]) [c:_] = (w, Just [msg $ join " " ["unknown command: " , c, ", type !help to get help"]]) | isNothing toSend = (io, chan, w) @@ -144,18 +185,20 @@ process io chan w = process io chan w = process io chan w -Start :: *World -> *World -Start w -# (io, w) = stdio w -# (ip, w) = lookupIPAddress SERVER w -| isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n" -# (Just ip) = ip -# (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w -| rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n" -| rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n" -# chan = fromJust chan -# (chan, w) = send commands chan w -# (io, chan, w) = process io chan w -# ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w -# (_, w) = fclose io w -= closeChannel sChannel (closeRChannel rChannel w) +Start :: *World -> (String, *World) +Start w = cloogle "Monad" w +//Start :: *World -> *World +//Start w +//# (io, w) = stdio w +//# (ip, w) = lookupIPAddress SERVER w +//| isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n" +//# (Just ip) = ip +//# (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w +//| rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n" +//| rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n" +//# chan = fromJust chan +//# (chan, w) = send commands chan w +//# (io, chan, w) = process io chan w +//# ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w +//# (_, w) = fclose io w +//= closeChannel sChannel (closeRChannel rChannel w) -- 2.20.1