Ejabberd: error in simple module to handle offline messages - push-notification

I have an Ejabberd 17.01 installation where I need to push a notification in case a recipient is offline. This seems the be a common task and solutions using a customized Ejabberd module can be found everywhere. However, I just don't get it running. First, here's me script:
-module(mod_offline_push).
-behaviour(gen_mod).
-export([start/2, stop/1]).
-export([push_message/3]).
-include("ejabberd.hrl").
-include("logger.hrl").
-include("jlib.hrl").
start(Host, _Opts) ->
?INFO_MSG("mod_offline_push loading", []),
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_message, 10),
ok.
stop(Host) ->
?INFO_MSG("mod_offline_push stopping", []),
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_message, 10),
ok.
push_message(From, To, Packet) ->
?INFO_MSG("mod_offline_push -> push_message", [To]),
Type = fxml:get_tag_attr_s(<<"type">>, Packet), % Supposedly since 16.04
%Type = xml:get_tag_attr_s(<<"type">>, Packet), % Supposedly since 13.XX
%Type = xml:get_tag_attr_s("type", Packet),
%Type = xml:get_tag_attr_s(list_to_binary("type"), Packet),
?INFO_MSG("mod_offline_push -> push_message", []),
ok.
The problem is the line Type = ... line in method push_message; without that line the last info message is logged (so the hook definitely works). When browsing online, I can find all kinds of function calls to extract elements from Packet. As far as I understand it changed over time with new releases. But it's not good, all variants lead in some kind of error. The current way returns:
2017-01-25 20:38:08.701 [error] <0.21678.0>#ejabberd_hooks:run1:332 {function_clause,[{fxml,get_tag_attr_s,[<<"type">>,{message,<<>>,normal,<<>>,{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>},[],[{text,<<>>,<<"sfsdfsdf">>}],undefined,[],#{}}],[{file,"src/fxml.erl"},{line,169}]},{mod_offline_push,push_message,3,[{file,"mod_offline_push.erl"},{line,33}]},{ejabberd_hooks,safe_apply,3,[{file,"src/ejabberd_hooks.erl"},{line,382}]},{ejabberd_hooks,run1,3,[{file,"src/ejabberd_hooks.erl"},{line,329}]},{ejabberd_sm,route,3,[{file,"src/ejabberd_sm.erl"},{line,126}]},{ejabberd_local,route,3,[{file,"src/ejabberd_local.erl"},{line,110}]},{ejabberd_router,route,3,[{file,"src/ejabberd_router.erl"},{line,87}]},{ejabberd_c2s,check_privacy_route,5,[{file,"src/ejabberd_c2s.erl"},{line,1886}]}]}
running hook: {offline_message_hook,[{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>},{message,<<>>,normal,<<>>,{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>},[],[{text,<<>>,<<"sfsdfsdf">>}],undefined,[],#{}}]}
I'm new Ejabberd and Erlang, so I cannot really interpret the error, but the Line 33 as mentioned in {mod_offline_push,push_message,3,[{file,"mod_offline_push.erl"}, {line,33}]} is definitely the line calling get_tag_attr_s.
UPDATE 2017/01/27: Since this cost me a lot of headache -- and I'm still not perfectly happy -- I post here my current working module in the hopes it might help others. My setup is Ejabberd 17.01 running on Ubuntu 16.04. Most stuff I tried and failed with seem to for older versions of Ejabberd:
-module(mod_fcm_fork).
-behaviour(gen_mod).
%% public methods for this module
-export([start/2, stop/1]).
-export([push_notification/3]).
%% included for writing to ejabberd log file
-include("ejabberd.hrl").
-include("logger.hrl").
-include("xmpp_codec.hrl").
%% Copied this record definition from jlib.hrl
%% Including "xmpp_codec.hrl" and "jlib.hrl" resulted in errors ("XYZ already defined")
-record(jid, {user = <<"">> :: binary(),
server = <<"">> :: binary(),
resource = <<"">> :: binary(),
luser = <<"">> :: binary(),
lserver = <<"">> :: binary(),
lresource = <<"">> :: binary()}).
start(Host, _Opts) ->
?INFO_MSG("mod_fcm_fork loading", []),
% Providing the most basic API to the clients and servers that are part of the Inets application
inets:start(),
% Add hook to handle message to user who are offline
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_notification, 10),
ok.
stop(Host) ->
?INFO_MSG("mod_fcm_fork stopping", []),
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_notification, 10),
ok.
push_notification(From, To, Packet) ->
% Generate JID of sender and receiver
FromJid = lists:concat([binary_to_list(From#jid.user), "#", binary_to_list(From#jid.server), "/", binary_to_list(From#jid.resource)]),
ToJid = lists:concat([binary_to_list(To#jid.user), "#", binary_to_list(To#jid.server), "/", binary_to_list(To#jid.resource)]),
% Get message body
MessageBody = Packet#message.body,
% Check of MessageBody is not empty
case MessageBody/=[] of
true ->
% Get first element (no idea when this list can have more elements)
[First | _ ] = MessageBody,
% Get message data and convert to string
MessageBodyText = binary_to_list(First#text.data),
send_post_request(FromJid, ToJid, MessageBodyText);
false ->
?INFO_MSG("mod_fcm_fork -> push_notification: MessageBody is empty",[])
end,
ok.
send_post_request(FromJid, ToJid, MessageBodyText) ->
%?INFO_MSG("mod_fcm_fork -> send_post_request -> MessageBodyText = ~p", [Demo]),
Method = post,
PostURL = gen_mod:get_module_opt(global, ?MODULE, post_url,fun(X) -> X end, all),
% Add data as query string. Not nice, query body would be preferable
% Problem: message body itself can be in a JSON string, and I couldn't figure out the correct encoding.
URL = lists:concat([binary_to_list(PostURL), "?", "fromjid=", FromJid,"&tojid=", ToJid,"&body=", edoc_lib:escape_uri(MessageBodyText)]),
Header = [],
ContentType = "application/json",
Body = [],
?INFO_MSG("mod_fcm_fork -> send_post_request -> URL = ~p", [URL]),
% ADD SSL CONFIG BELOW!
%HTTPOptions = [{ssl,[{versions, ['tlsv1.2']}]}],
HTTPOptions = [],
Options = [],
httpc:request(Method, {URL, Header, ContentType, Body}, HTTPOptions, Options),
ok.

Actually it fails with second arg Packet you pass to fxml:get_tag_attr_s in push_message function
{message,<<>>,normal,<<>>,
{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,
<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},
{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,
<<"xxx.xxx.xxx.xxx">>,<<>>},
[],
[{text,<<>>,<<"sfsdfsdf">>}],
undefined,[],#{}}
because it is not xmlel
Looks like it is record "message" defined in tools/xmpp_codec.hrl
with <<>> id and type 'normal'
xmpp_codec.hrl
-record(message, {id :: binary(),
type = normal :: 'chat' | 'error' | 'groupchat' | 'headline' | 'normal',
lang :: binary(),
from :: any(),
to :: any(),
subject = [] :: [#text{}],
body = [] :: [#text{}],
thread :: binary(),
error :: #error{},
sub_els = [] :: [any()]}).
Include this file and use just
Type = Packet#message.type
or, if you expect binary value
Type = erlang:atom_to_binary(Packet#message.type, utf8)

The newest way to do that seems to be with xmpp:get_type/1:
Type = xmpp:get_type(Packet),
It returns an atom, in this case normal.

Related

How to make a request to an IPv6 address using the http-client package in haskell?

I've been trying to make a request to an IPv6 address using the parseRequest function from Network.HTTP.Client (https://hackage.haskell.org/package/http-client-0.7.10/docs/Network-HTTP-Client.html) package as follows:
request <- parseRequest "http://[2001:0db8:85a3:0000:0000:8a2e:0370:7334]"
Instead of parsing it as an address/addrInfo, it is parsed as a hostname and throws the error: does not exist (Name or service not known). As a next step, I tried pointing a domain to the same IPv6 address and then using the domain name in parseRequest, then it successfully resolves that into the IPv6 address and makes the request. Is there some other way I can directly use the IPv6 address to make the request using the http-client package?
PS: I also tried without square brackets around the IP address, in this case the error is Invalid URL:
request <- parseRequest "http://2001:0db8:85a3:0000:0000:8a2e:0370:7334"
More context:
For an IPv4 address, the getAddrInfo function generates the address as:
AddrInfo {addrFlags = [AI_NUMERICHOST], addrFamily = AF_INET, addrSocketType = Stream, addrProtocol = 6, addrAddress = 139.59.90.1:80, addrCanonName = Nothing}
whereas for IPv6 address(inside the square brackets format):
AddrInfo {addrFlags = [AI_ADDRCONFIG], addrFamily = AF_UNSPEC, addrSocketType = Stream, addrProtocol = 6, addrAddress = 0.0.0.0:0, addrCanonName = Nothing}
and the error prints as:
(ConnectionFailure Network.Socket.getAddrInfo (called with preferred socket type/protocol: AddrInfo {addrFlags = [AI_ADDRCONFIG], addrFamily = AF_UNSPEC, addrSocketType = Stream, addrProtocol = 6, addrAddress = 0.0.0.0:0, addrCanonName = Nothing}, host name: Just "[2001:0db8:85a3:0000:0000:8a2e:0370:7334]", service name: Just "80"): does not exist (Name or service not known))
When a literal IPv6 address is used in a URL, it should be surrounded by square brackets (as per RFC 2732) so the colons in the literal address aren't misinterpreted as some kind of port designation.
When a literal IPv6 address is resolved using the C library function getaddrinfo (or the equivalent Haskell function getAddrInfo), these functions are not required to handle these extra square brackets, and at least on Linux they don't.
Therefore, it's the responsibility of the HTTP client library to remove the square brackets from the hostname extracted from the URL before resolving the literal IPv6 address using getaddrinfo, and the http-client package doesn't do this, at least as of version 0.7.10. So, this is a bug, and I can see you've appropriately filed a bug report.
Unfortunately, I don't see an easy way to work around the issue. You can manipulate the Request after parsing to remove the square brackets from the host field, like so:
{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Network.HTTP.Client
import Network.HTTP.Types.Status (statusCode)
main :: IO ()
main = do
manager <- newManager defaultManagerSettings
request <- parseRequest "http://[::1]"
let request' = request { host = removeBrackets (host request) }
response <- httpLbs request' manager
print response
removeBrackets :: ByteString -> ByteString
removeBrackets bs =
case BS.stripPrefix "[" bs >>= BS.stripSuffix "]" of
Just bs' -> bs'
Nothing -> bs
The problem with this is that it also removes the square brackets from the value in the Host header, so the HTTP request will contain the header:
Host: ::1
instead of the correct
Host: [::1]
which may or may not cause problems, depending on the web server at the other end.
You could try using a patched http-client package. The following patch against version 0.7.10 seems to work, but I didn't test it very extensively:
diff --git a/Network/HTTP/Client/Connection.hs b/Network/HTTP/Client/Connection.hs
index 0e329cd..719822e 100644
--- a/Network/HTTP/Client/Connection.hs
+++ b/Network/HTTP/Client/Connection.hs
## -15,6 +15,7 ## module Network.HTTP.Client.Connection
import Data.ByteString (ByteString, empty)
import Data.IORef
+import Data.List (stripPrefix, isSuffixOf)
import Control.Monad
import Network.HTTP.Client.Types
import Network.Socket (Socket, HostAddress)
## -158,8 +159,12 ## withSocket :: (Socket -> IO ())
withSocket tweakSocket hostAddress' host' port' f = do
let hints = NS.defaultHints { NS.addrSocketType = NS.Stream }
addrs <- case hostAddress' of
- Nothing ->
- NS.getAddrInfo (Just hints) (Just host') (Just $ show port')
+ Nothing -> do
+ let port'' = Just $ show port'
+ case ip6Literal host' of
+ Just lit -> NS.getAddrInfo (Just hints { NS.addrFlags = [NS.AI_NUMERICHOST] })
+ (Just lit) port''
+ Nothing -> NS.getAddrInfo (Just hints) (Just host') port''
Just ha ->
return
[NS.AddrInfo
## -173,6 +178,11 ## withSocket tweakSocket hostAddress' host' port' f = do
E.bracketOnError (firstSuccessful addrs $ openSocket tweakSocket) NS.close f
+ where
+ ip6Literal h = case stripPrefix "[" h of
+ Just rest | "]" `isSuffixOf` rest -> Just (init rest)
+ _ -> Nothing
+
openSocket tweakSocket addr =
E.bracketOnError
(NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)

swi prolog 8.0.2 : gziped http

I tried to make work a piece of code that opens an http connection.
Nevertheless, web page may transfered as plain text or gziped.
As a result, the code with pragmatism tries to open as plain text and if it fails and receives an exception, tries as if it is gzip encoded.
URL is the sole variable to ground.
Try with URL = 'http://releases.llvm.org/6.0.0/tools/clang/docs/ClangCommandLineReference.html' for instance.
user::catch(
(
user::http_open(URL, DataStream, []),
user::load_html(stream(DataStream), Terms, []),
user::close(DataStream)
),
_
,
(
user::open_any(URL, read, GZipDataStream, CloseIt, [encoding(gzip), string(atom)]),
/*user::http:encoding_filter(gzip, DataStream, GZipDataStream),*/
user::load_html(stream(GZipDataStream), Terms, []),
user::close_any(CloseIt)
)
)
Infortunately, the recovery part of catch doesn't work.
Any suggestion, please ?
The user:: prefixes in the goals suggests that the code you posted is a fragment of Logtalk. If so, it's misusing Logtalk source code and creating a dependency on the SWI-Prolog autoloading mechanism. The code can be rewritten for clarity and resilience. Doing that and fixing the bug in it (library(zlib) must be loaded to make avaialble the http:encoding_filter/3 filter) results in the following solution:
:- use_module(library(http/http_open), []).
:- use_module(library(sgml), []).
:- use_module(library(iostream), []).
:- use_module(library(zlib), []).
:- object(html).
:- public(get_url/2).
% override ambiguous meta-predicate template
:- meta_predicate(sgml:load_html(*,*,*)).
get_url(URL, Terms) :-
catch(
setup_call_cleanup(
http:http_open(URL, DataStream, []),
sgml:load_html(stream(DataStream), Terms, []),
close(DataStream)
),
_,
setup_call_cleanup(
iostream:open_any(URL, read, DataStream, CloseIt, [string(atom)]),
sgml:load_html(stream(DataStream), Terms, []),
iostream:close_any(CloseIt)
)
).
:- end_object.
The setup_call_cleanup/3 calls ensure that the opened streams are closed in case of error.
Assuming the object above is saved in a html.lgt file, the following sample call shows it working for the URL you posted:
?- {html}.
...
% (0 warnings)
true.
?- html::get_url('http://releases.llvm.org/6.0.0/tools/clang/docs/ClangCommandLineReference.html', Terms).
Terms = [element(html, [xmlns='http://www.w3.org/1999/xhtml'], [element(head, [], [element(meta, ['http-equiv'='Content-Type', content='text/html; charset=utf-8'], []), element(title, [], ['Clang command line argument reference — Clang 6 documentation']), element(link, [... = ...|...], []), element(link, [...|...], []), element(..., ..., ...)|...]), element(body, [role=document], [' ', element(div, [... = ...|...], [element(..., ..., ...)|...]), '\n ', element(..., ..., ...)|...])])].

Function clause error Erlang

I am trying to understand process communication in erlang. Here I have a master process and five friends process. If a friend sends a message to any of the other 5 they have to reply back. But the master should be aware of all this. I am pasting the code below.
-module(prog).
-import(lists,[append/2,concat/1]).
-import(maps,[from_lists/1,find/2,get/2,update/3]).
-import(string,[equal/2]).
-import(file,[consult/1]).
-export([create_process/1,friends/4, master/1, main/0,prnt/1]).
%% CREATE PROCESS
create_process([])->ok;
create_process([H|T])->
{A,B} = H,
Pid = spawn(prog,friends,[B,self(),0,A]),
register(A,Pid),
create_process(T).
%% FRIENDS PROCESS
friends(Msg, M_pid, State, Self_name)->
S = lists:concat([Self_name," state =",State,"\n"]),
io:fwrite(S),
if
State == 0 ->
timer:sleep(500),
io:fwrite("~p~n",[Self_name]),
lists:foreach(fun(X) -> whereis(X)!{Self_name,"intro",self()} end, Msg),
friends(Msg, M_pid, State + 1, Self_name);
State > 0 ->
receive
{Process_name, Process_msg, Process_id} ->
I = equal(Process_msg,"intro"),
R = equal(Process_msg,"reply"),
XxX = lists:concat([Self_name," recieved ",Process_msg," from ",Process_name,"\n"]),
io:fwrite(XxX),
if
I == true ->
io:fwrite("~p~n",[whereis(Process_name)]),
M_pid!{lists:concat([Self_name," received intro message from ", Process_name , "[",Process_id,"]"]), self()},
io:fwrite(I),
whereis(Process_name)!{Self_name, "reply",self()},
friends(Msg, M_pid, State + 1, Self_name);
R == true ->
M_pid!{lists:concat([Self_name," received reply message from ", Process_name , "[",Process_id,"]"]), self()},
io:fwrite(R),
friends(Msg, M_pid, State + 1, Self_name)
end
after
1000->
io:fwrite(lists:concat([Self_name," has received no calls for 1 second, ending..."]))
end
end.
master(State)->
receive
{Process_message, Process_id} ->
io:fwrite(Process_message),
master(State+1)
after
2000->
ok
end.
main() ->
B = [{john, [jill,joe,bob]},
{jill, [bob,joe,bob]},
{sue, [jill,jill,jill,bob,jill]},
{bob, [john]},
{joe, [sue]}],
create_process(B),
io:fwrite("~p~n",[whereis(sue)]),
master(0).
I think the line in friends() function,
M_pid!{lists:concat([Self_name," received intro message from ", Process_name , "[",Process_id,"]"]), self()}
is the cause of error but I cannot understand why. M_pid is known and I am concatenating all the info and sending it to master but I am confused why it isnt working.
The error I am getting is as follows:
Error in process <0.55.0> with exit value: {function_clause,[{lists,thing_to_list,
[<0.54.0>],
[{file,"lists.erl"},{line,603}]},
{lists,flatmap,2,[{file,"lists.erl"},{line,1250}]},
{lists,flatmap,2,[{file,"lists.erl"},{line,1250}]},
{prog,friends,4,[{file,"prog.erl"},{line,45}]}]}
I dont know what is causing the error. Sorry for asking noob questions and thanks for your help.
An example of what Dogbert discovered:
-module(my).
-compile(export_all).
go() ->
Pid = spawn(my, nothing, []),
lists:concat(["hello", Pid]).
nothing() -> nothing.
In the shell:
2> c(my).
my.erl:2: Warning: export_all flag enabled - all functions will be exported
{ok,my}
3> my:go().
** exception error: no function clause matching
lists:thing_to_list(<0.75.0>) (lists.erl, line 603)
in function lists:flatmap/2 (lists.erl, line 1250)
in call from lists:flatmap/2 (lists.erl, line 1250)
4>
But:
-module(my).
-compile(export_all).
go() ->
Pid = spawn(my, nothing, []),
lists:concat(["hello", pid_to_list(Pid)]).
nothing() -> nothing.
In the shell:
4> c(my).
my.erl:2: Warning: export_all flag enabled - all functions will be exported
{ok,my}
5> my:go().
"hello<0.83.0>"
From the erl docs:
concat(Things) -> string()
Things = [Thing]
Thing = atom() | integer() | float() | string()
The list that you feed concat() must contain either atoms, integers, floats, or strings. A pid is neither an atom, integer, float, nor string, so a pid cannot be used with concat(). However, pid_to_list() returns a string:
pid_to_list(Pid) -> string()
Pid = pid()
As you can see, a pid has its own type: pid().
I ran your code.
Where you went wrong was to pass Process_id(which is of type pid()) to lists:concat/1.
Let us try to understand this error:
{function_clause,[{lists,thing_to_list,
[<0.84.0>],
[{file,"lists.erl"},{line,603}]},
{lists,flatmap,2,[{file,"lists.erl"},{line,1250}]},
{lists,flatmap,2,[{file,"lists.erl"},{line,1250}]},
{prog,friends,4,[{file,"prog.erl"},{line,39}]}]}
It states the function lists:thing_to_list/1 has no definition(see the word function_clause in the error log) which accepts an argument of type pid() as denoted here by [<0.84.0>].
Strings are represented as lists in erlang, which is why we use lists:concat/1.
As #7stud pointed out these are the valid types which can be passed to lists:concat/1 as per the documentation:
atom() | integer() | float() | string()
There are 2 occurrences of the following line. Fix them and you are good to go:
Incorrect Code:
M_pid!{lists:concat([Self_name," received intro message from ", Process_name , "[",Process_id,"]"]), self()},
Corrected Code
M_pid!{lists:concat([Self_name," received intro message from ", Process_name , "[",pid_to_list(Process_id),"]"]), self()},
Notice the use of the function erlang:pid_to_list/1. As per the documentation the function accepts type pid() and returns it as string().

How do I make a simple GET request in OCaml?

I'm trying to do something that should be simple: make a GET request to a url. However, when I search for examples of how to do this I often wind up with near-gibberish like this.
Does anyone know how to make a simple HTTP request using OCaml? I'm an OCaml newbie with some Haskell exp.
NOTE:
A solution using the lowest possible level OCaml would be ideal. I've seen the Cohttp library used, but I'm more interested in a native (?) HTTP OCaml lib or something along those lines.
In response to #antron, a solution using the lowest possible level native OCaml would be much appreciated. I'm led to believe that this will involve the Unix library. But if there is another solution that does not involve 3rd party libraries it would be just as welcome.
Use the Cohttp library. See the Client example.
The relevant line is:
Cohttp_lwt_unix.Client.get (Uri.of_string "http://www.reddit.com/")
This gives you a pair of (response, body) inside the Lwt monad. response is basically a record, and body is a stream. The rest of the example is just printing some interesting bits of those.
Perhaps the most basic way to send a GET request in OCaml is to use the Unix library and the basic input/output routines from Pervasives.
Here is a very simple example:
let ip = Unix.((gethostbyname "caml.inria.fr").h_addr_list.(0))
let addr = Unix.ADDR_INET (ip, 80)
let sock = Unix.(socket PF_INET SOCK_STREAM 0)
let _ = Unix.connect sock addr
let in_ch = Unix.in_channel_of_descr sock
let out_ch = Unix.out_channel_of_descr sock
let _ =
output_string out_ch
"GET /pub/docs/manual-ocaml/index.html HTTP/1.1\r\n\
Host: caml.inria.fr\r\n\
User-Agent: OCaml\r\n\
Connection: close\r\n\
\r\n";
flush out_ch
let _ =
try
while true do
print_string (input_line in_ch)
done
with End_of_file ->
Unix.close sock
The Unix. prefixes are not necessary if one puts open Unix at the top of the file, but I preferred to leave them in for clarity.
The program can be compiled to byte code with ocamlc unix.cma -o get get.ml.
I agree with #ChriS' suggestion to read Leroy and Rémy's Unix system programming in OCaml (I've included a link to the online version); it's a great book.
For low level Unix programming in OCaml (even if you don't know much about it), I recommend the excellent book Unix System Programming in OCaml. It will tell you how to write the client you want.
For those searching a quite independent solution, I found one which should at least work on any Unix* like OS.
From Rosetta Code:
let try_finalise f x finally y =
let res = try f x with e -> finally y; raise e in
finally y;
res
let rec restart_on_EINTR f x =
try f x with Unix.Unix_error (Unix.EINTR, _, _) -> restart_on_EINTR f x
let double_fork_treatment server service (client_descr, _ as client) =
let treat () =
match Unix.fork () with
| 0 ->
if Unix.fork () <> 0 then exit 0;
Unix.close server; service client; exit 0
| k ->
ignore (restart_on_EINTR (Unix.waitpid []) k)
in
try_finalise treat () Unix.close client_descr
let install_tcp_server_socket addr =
let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
try
Unix.bind s addr;
Unix.listen s 10;
s
with e -> Unix.close s; raise e
let tcp_server treat_connection addr =
ignore (Sys.signal Sys.sigpipe Sys.Signal_ignore);
let server_sock = install_tcp_server_socket addr in
while true do
let client = restart_on_EINTR Unix.accept server_sock in
treat_connection server_sock client
done
let server () =
let port = 8080 in
let host = (Unix.gethostbyname (Unix.gethostname())).Unix.h_addr_list.(0) in
let addr = Unix.ADDR_INET (host, port) in
let treat sock (client_sock, client_addr as client) =
let service (s, _) =
let response = "\
HTTP/1.1 200 OK\r\n\
Content-Type: text/html; charset=UTF-8\r\n\r\n\
<html><head><title>Goodbye, world!</title>\
<style>body { background-color: #0FF }\
h1 { font-size:3em; color: black; }</style></head>\
<body><h1>Goodbye, world!</h1></body></html>\r\n"
in
Unix.write s response 0 (String.length response);
in
double_fork_treatment sock service client
in
tcp_server treat addr
let _ =
Unix.handle_unix_error server ()
It's not a one liner but it's relative straight forward.

Error attempting to decode with wreq

I'm trying really hard to understand how to use lenses and wreq and its turning out to really slow me down.
The error seems to be claiming there's some mismatched type here. I'm not sure exactly how to handle that though. I'm still fairly new to haskell and these lenses are pretty confusing. However, wreq seems to be cleaner, which is why I chose to use it. Can anyone help me understand what the error is, and how to fix it? I seem to run into alot of these type errors. I am aware that Maybe TestInfo won't be returned by my code at the moment. That's ok. That error know how to handle. This error however, I don't.
Here is my code:
Module TestInformation:
{-# LANGUAGE OverloadedStrings #-}
module TestInformation where
import Auth
import Network.Wreq
import Control.Lens
import Data.Aeson
import Data.Aeson.Lens (_String)
type TestNumber = String
data TestInfo = TestInfo {
TestId :: Int,
TestName :: String,
}
instance FromJSON TestInfo
getTestInfo :: Key -> TestNumber -> Maybe TestInfo
getTestInfo key test =
decode (res ^. responseBody . _String)
where opts = defaults & auth ?~ oauth2Bearer key
res = getWith opts ("http://testsite.com/v1/tests/" ++ test)
Module Auth:
module Auth where
import qualified Data.ByteString as B
type Key = B.ByteString
The error:
GHCi, version 7.10.1: http://www.haskell.org/ghc/ :? for help
[1 of 2] Compiling Auth ( Auth.hs, interpreted )
[2 of 2] Compiling TestInformation ( TestInformation.hs, interpreted )
TestInformation.hs:36:18:
Couldn't match type ‘Response body10’
with ‘IO (Response Data.ByteString.Lazy.Internal.ByteString)’
Expected type: (body10
-> Const Data.ByteString.Lazy.Internal.ByteString body10)
-> IO (Response Data.ByteString.Lazy.Internal.ByteString)
-> Const
Data.ByteString.Lazy.Internal.ByteString
(IO (Response Data.ByteString.Lazy.Internal.ByteString))
Actual type: (body10
-> Const Data.ByteString.Lazy.Internal.ByteString body10)
-> Response body10
-> Const Data.ByteString.Lazy.Internal.ByteString (Response body10)
In the first argument of ‘(.)’, namely ‘responseBody’
In the second argument of ‘(^.)’, namely ‘responseBody . _String’
TestInformation.hs:36:33:
Couldn't match type ‘Data.ByteString.Lazy.Internal.ByteString’
with ‘Data.Text.Internal.Text’
Expected type: (Data.ByteString.Lazy.Internal.ByteString
-> Const
Data.ByteString.Lazy.Internal.ByteString
Data.ByteString.Lazy.Internal.ByteString)
-> body10 -> Const Data.ByteString.Lazy.Internal.ByteString body10
Actual type: (Data.Text.Internal.Text
-> Const
Data.ByteString.Lazy.Internal.ByteString Data.Text.Internal.Text)
-> body10 -> Const Data.ByteString.Lazy.Internal.ByteString body10
In the second argument of ‘(.)’, namely ‘_String’
In the second argument of ‘(^.)’, namely ‘responseBody . _String’
Failed, modules loaded: Auth.
Leaving GHCi.
This type checks for me:
getTestInfo :: Key -> TestNumber -> IO (Maybe TestInfo)
getTestInfo key test = do
res <- getWith opts ("http://testsite.com/v1/tests/" ++ test)
return $ decode (res ^. responseBody)
where opts = defaults & auth ?~ oauth2Bearer key
getWith is an IO action, so to get its return value you need to use the monadic binding operator <-.
Full program: http://lpaste.net/133443 http://lpaste.net/133498

Resources