Below is the code snippet I am using to decrypt some XML which is encrypted before. If it is not encrypted (plain text), then I don't need to decrypt and process it, and I want to return it as it is.
It is not returning anything at all. Please help me to make it work.
Updated code :
pop_offline_messages(Ls, LUser, LServer, odbc) ->
EUser = ejabberd_odbc:escape(LUser),
case odbc_queries:get_and_del_spool_msg_t(LServer,
EUser)
of
{atomic, {selected, [<<"username">>, <<"xml">>], Rs}} ->
Ls ++
lists:flatmap(fun ([_, XML]) ->
?INFO_MSG("decrypted message from mod_offline ~p ",[XML]),
Top = case str:str(XML, <<"message">>) of
Top >= 1 -> XML;
Top == 0 -> crypto:aes_cfb_128_decrypt(<<"abcdefghabcdefgh">>,<<"12345678abcdefgh">>,base64:decode(XML))
end,
case xml_stream:parse_element(XML) of
{error, _Reason} ->
[];
El ->
case offline_msg_to_route(LServer, El) of
error ->
[];
RouteMsg ->
[RouteMsg]
end
end
end,
Rs);
_ -> Ls
end;
If it is "not returning anything", it is either because you don't execute it or you don't store the result. I suggest you change your code to:
Result = case str:str(XML, <<"message">>) of
1 -> XML;
_ -> crypto:aes_cfb_128_decrypt(<<"abcdefghabcdefgh">>,<<"12345678abcdefgh">>,base64:decode(XML))
end,
io:format("~p~n",[result]),
...
because with this current snippet version, the result of the case is not used, so lost as soon as evaluated.
Related
Previously asked similar question but somehow I'm not finding my way out, attempting again with another example.
The code as a starting point (a bit trimmed) is available at https://ideone.com/zkQcIU.
(it has some issue recognizing Microsoft.FSharp.Core.Result type, not sure why)
Essentially all operations have to be pipelined with the previous function feeding the result to the next one. The operations have to be async and they should return error to the caller in case an exception occurred.
The requirement is to give the caller either result or fault. All functions return a Tuple populated with either Success type Article or Failure with type Error object having descriptive code and message returned from the server.
Will appreciate a working example around my code both for the callee and the caller in an answer.
Callee Code
type Article = {
name: string
}
type Error = {
code: string
message: string
}
let create (article: Article) : Result<Article, Error> =
let request = WebRequest.Create("http://example.com") :?> HttpWebRequest
request.Method <- "GET"
try
use response = request.GetResponse() :?> HttpWebResponse
use reader = new StreamReader(response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
Ok ((new DataContractJsonSerializer(typeof<Article>)).ReadObject(memoryStream) :?> Article)
with
| :? WebException as e ->
use reader = new StreamReader(e.Response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
Error ((new DataContractJsonSerializer(typeof<Error>)).ReadObject(memoryStream) :?> Error)
Rest of the chained methods - Same signature and similar bodies. You can actually reuse the body of create for update, upload, and publish to be able to test and compile code.
let update (article: Article) : Result<Article, Error>
// body (same as create, method <- PUT)
let upload (article: Article) : Result<Article, Error>
// body (same as create, method <- PUT)
let publish (article: Article) : Result<Article, Error>
// body (same as create, method < POST)
Caller Code
let chain = create >> Result.bind update >> Result.bind upload >> Result.bind publish
match chain(schemaObject) with
| Ok article -> Debug.WriteLine(article.name)
| Error error -> Debug.WriteLine(error.code + ":" + error.message)
Edit
Based on the answer and matching it with Scott's implementation (https://i.stack.imgur.com/bIxpD.png), to help in comparison and in better understanding.
let bind2 (switchFunction : 'a -> Async<Result<'b, 'c>>) =
fun (asyncTwoTrackInput : Async<Result<'a, 'c>>) -> async {
let! twoTrackInput = asyncTwoTrackInput
match twoTrackInput with
| Ok s -> return! switchFunction s
| Error err -> return Error err
}
Edit 2 Based on F# implementation of bind
let bind3 (binder : 'a -> Async<Result<'b, 'c>>) (asyncResult : Async<Result<'a, 'c>>) = async {
let! result = asyncResult
match result with
| Error e -> return Error e
| Ok x -> return! binder x
}
Take a look at the Suave source code, and specifically the WebPart.bind function. In Suave, a WebPart is a function that takes a context (a "context" is the current request and the response so far) and returns a result of type Async<context option>. The semantics of chaining these together are that if the async returns None, the next step is skipped; if it returns Some value, the next step is called with value as the input. This is pretty much the same semantics as the Result type, so you could almost copy the Suave code and adjust it for Result instead of Option. E.g., something like this:
module AsyncResult
let bind (f : 'a -> Async<Result<'b, 'c>>) (a : Async<Result<'a, 'c>>) : Async<Result<'b, 'c>> = async {
let! r = a
match r with
| Ok value ->
let next : Async<Result<'b, 'c>> = f value
return! next
| Error err -> return (Error err)
}
let compose (f : 'a -> Async<Result<'b, 'e>>) (g : 'b -> Async<Result<'c, 'e>>) : 'a -> Async<Result<'c, 'e>> =
fun x -> bind g (f x)
let (>>=) a f = bind f a
let (>=>) f g = compose f g
Now you can write your chain as follows:
let chain = create >=> update >=> upload >=> publish
let result = chain(schemaObject) |> Async.RunSynchronously
match result with
| Ok article -> Debug.WriteLine(article.name)
| Error error -> Debug.WriteLine(error.code + ":" + error.message)
Caution: I haven't been able to verify this code by running it in F# Interactive, since I don't have any examples of your create/update/etc. functions. It should work, in principle — the types all fit together like Lego building blocks, which is how you can tell that F# code is probably correct — but if I've made a typo that the compiler would have caught, I don't yet know about it. Let me know if that works for you.
Update: In a comment, you asked whether you need to have both the >>= and >=> operators defined, and mentioned that you didn't see them used in the chain code. I defined both because they serve different purposes, just like the |> and >> operators serve different purposes. >>= is like |>: it passes a value into a function. While >=> is like >>: it takes two functions and combines them. If you would write the following in a non-AsyncResult context:
let chain = step1 >> step2 >> step3
Then that translates to:
let asyncResultChain = step1AR >=> step2AR >=> step3AR
Where I'm using the "AR" suffix to indicate versions of those functions that return an Async<Result<whatever>> type. On the other hand, if you had written that in a pass-the-data-through-the-pipeline style:
let result = input |> step1 |> step2 |> step3
Then that would translate to:
let asyncResult = input >>= step1AR >>= step2AR >>= step3AR
So that's why you need both the bind and compose functions, and the operators that correspond to them: so that you can have the equivalent of either the |> or the >> operators for your AsyncResult values.
BTW, the operator "names" that I picked (>>= and >=>), I did not pick randomly. These are the standard operators that are used all over the place for the "bind" and "compose" operations on values like Async, or Result, or AsyncResult. So if you're defining your own, stick with the "standard" operator names and other people reading your code won't be confused.
Update 2: Here's how to read those type signatures:
'a -> Async<Result<'b, 'c>>
This is a function that takes type A, and returns an Async wrapped around a Result. The Result has type B as its success case, and type C as its failure case.
Async<Result<'a, 'c>>
This is a value, not a function. It's an Async wrapped around a Result where type A is the success case, and type C is the failure case.
So the bind function takes two parameters:
a function from A to an async of (either B or C)).
a value that's an async of (either A or C)).
And it returns:
a value that's an async of (either B or C).
Looking at those type signatures, you can already start to get an idea of what the bind function will do. It will take that value that's either A or C, and "unwrap" it. If it's C, it will produce an "either B or C" value that's C (and the function won't need to be called). If it's A, then in order to convert it to an "either B or C" value, it will call the f function (which takes an A).
All this happens within an async context, which adds an extra layer of complexity to the types. It might be easier to grasp all this if you look at the basic version of Result.bind, with no async involved:
let bind (f : 'a -> Result<'b, 'c>) (a : Result<'a, 'c>) =
match a with
| Ok val -> f val
| Error err -> Error err
In this snippet, the type of val is 'a, and the type of err is 'c.
Final update: There was one comment from the chat session that I thought was worth preserving in the answer (since people almost never follow chat links). Developer11 asked,
... if I were to ask you what Result.bind in my example code maps to your approach, can we rewrite it as create >> AsyncResult.bind update? It worked though. Just wondering i liked the short form and as you said they have a standard meaning? (in haskell community?)
My reply was:
Yes. If the >=> operator is properly written, then f >=> g will always be equivalent to f >> bind g. In fact, that's precisely the definition of the compose function, though that might not be immediately obvious to you because compose is written as fun x -> bind g (f x) rather than as f >> bind g. But those two ways of writing the compose function would be exactly equivalent. It would probably be very instructive for you to sit down with a piece of paper and draw out the function "shapes" (inputs & outputs) of both ways of writing compose.
Why do you want to use Railway Oriented Programming here? If you just want to run a sequence of operations and return information about the first exception that occurs, then F# already provides a language support for this using exceptions. You do not need Railway Oriented Programming for this. Just define your Error as an exception:
exception Error of code:string * message:string
Modify the code to throw the exception (also note that your create function takes article but does not use it, so I deleted that):
let create () = async {
let ds = new DataContractJsonSerializer(typeof<Error>)
let request = WebRequest.Create("http://example.com") :?> HttpWebRequest
request.Method <- "GET"
try
use response = request.GetResponse() :?> HttpWebResponse
use reader = new StreamReader(response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
return ds.ReadObject(memoryStream) :?> Article
with
| :? WebException as e ->
use reader = new StreamReader(e.Response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
return raise (Error (ds.ReadObject(memoryStream) :?> Error)) }
And then you can compose functions just by sequencing them in async block using let! and add exception handling:
let main () = async {
try
let! created = create ()
let! updated = update created
let! uploaded = upload updated
Debug.WriteLine(uploaded.name)
with Error(code, message) ->
Debug.WriteLine(code + ":" + message) }
If you wanted more sophisticated exception handling, then Railway Oriented Programming might be useful and there is certainly a way of integrating it with async, but if you just want to do what you described in your question, then you can do that much more easily with just standard F#.
I have a recursive function that contains a series of matches that either make the recursive call back to the function, or make a call to failwith.
This is basically a hybrid implementation of the recursive descent parser descibed in Don Syme's Expert F# book (page 180) and the parsing example shown here: http://fsharpforfunandprofit.com/posts/pattern-matching-command-line/
Here is a snippet of my own code.
let rec parseTokenListRec tokenList optionsSoFar =
match tokenList with
| [] -> optionsSoFar
| SOURCE::t ->
match t with
| VALUE x::tt -> parseTokenListRec (returnNonValueTail t) {optionsSoFar with Source = (returnConcatHeadValues t)}
| _ -> failwith "Expected a value after the source argument."
| REGISTRY::t ->
...
A full code listing can be found at http://fssnip.net/nU
The way the code is currently written, when the function has finished working its way through the tokenList, it will return the optionsSoFar record that has been compiled via the object expression {optionsSoFar with Source = (returnConcatHeadValues t)}, or it will throw an exception if an invalid argument is found.
I want to refactor this so that the function does not rely on an exception, but will always return a value of some sort that can be handled by the calling function. The idea I have is to return a discriminated union rather than a record.
This discriminated union would be something like
type Result =
|Success of Options
|Failure of string
The problem I had when I tried to refactor the code was that I couldn't figure out how to get the success value of the DU to initialize via an object expression. Is this possible?
The examples I've looked at on MSDN (http://msdn.microsoft.com/en-us/library/vstudio/dd233237(v=vs.100).aspx), fsharpforfunandprofit (http://fsharpforfunandprofit.com/posts/discriminated-unions/) and elsewhere haven't quite cleared this up for me.
I'm worried that I'm not making any sense here. I'm happy to clarify if needed.
If I understand it correctly, in you current solution, the type of optionsSoFar is Options. The code becomes trickier if you change the type of optionsSoFar to your newly defined Result.
However, I think you do not need to do that - you can keep optionsSoFar : Options and change the function to return Result. This works because you never need to call the function recursively after it fails:
let rec parseTokenListRec tokenList optionsSoFar =
match tokenList with
| [] -> Success optionsSoFar
| SOURCE::t ->
match t with
| VALUE x::tt ->
{optionsSoFar with Source = (returnConcatHeadValues t)}
|> parseTokenListRec (returnNonValueTail t)
| _ -> Failure "Expected a value after the source argument."
| REGISTRY::t -> ...
If you actually wanted to update Source in a Result value, then I'd probably write something like:
module Result =
let map f = function
| Success opt -> f opt
| Failure msg -> Failure msg
Then you could write a transformation as follows:
resultSoFar
|> Result.map (fun opts -> {opts with Source = returnConcatHeadValues t})
|> parseTokenListRec (returnNonValueTail t)
downloadCSVFile ::String-> IO (Bool,String)
downloadCSVFile company_code = do
let a="http://ichart.finance.yahoo.com/table.csv?s=" ++ company_code
let b=simpleHTTP $ getRequest a
src <- ( b >>= getResponseBody)
rcode <- fmap rspCode <$> b
h <- fmap findHeader HdrLocation b
case rcode of
Left err -> return (False, "Connection error: " ++ show err)
Right (2,_,_) -> return (True,src)
Right (4,_,_) -> return (False,"Invalid URL/The requested page does not exist..")
Right (5,_,_) -> return (False, "Internal error in the server on trying to process the request")
Right (3,_,_) ->
case h of
Nothing -> return (False, "Error : " )
Just url -> downloadCSVFile a
Please help me to resolve the following error and help me to check whether I've included all the condition in the "case" statement or not:
You've got several problems in your code. The first is your return type. You're trying to encode the notion of failure or success using a tuple and a string. Instead, you could use the Either type to handle this much more elegantly
downloadCSVFile :: String -> IO (Either String String)
downloadCSVFile company_code = do
let url = "http://ichart.finance.yahoo.com/table.csv?s=" ++ company_code
Next, you use let b = simpleHTTP $ getRequest a. You're assigning an IO action inside an IO function, when instead you should be extracting the result using <-
response <- simpleHTTP $ getRequest url
This lets you write the next few lines without duplicate fmaps (<$> is the infix form of fmap, so you're fmap-ing multiple times unnecessarily)
src <- getResponseBody response
let rcode = fmap rspCode response
header = fmap findHeader HdrLocation response
And now we come across what seems to be the culprit. Your use of fmap findHeader HdrLocation response is incorrect. What you meant was fmap (findHeader HdrLocation) response, the parentheses are very important here.
Since we're now using the Either type, we have to change our case statement a bit, but it's certainly cleaner now. We use the convention Left for errors and Right for success. This is exactly how the Network.HTTP library works with the Result type.
case rcode of
Left err -> return $ Left $ "Connection error: " ++ show err
Right (2, _, _) -> return $ Right src
Right (4, _, _) -> return $ Left "Invalid URL..."
Right (5, _, _) -> return $ Left "Internal error in the server..."
Right (3, _, _) ->
case header of
Nothing -> return $ Left "Error"
Just url' -> downloadCSVFile $ fromJust $ parseURI url
To sum up, the real problem was with the line
h <- fmap findHeader HdrLocation <$> b
for its lack of parentheses that would have made it correct. We also looked into using do notation to our advantage to avoid superfluous fmaps, and also assuring the correct behavior of the program. By defining b = simpleHTTP $ getRequest a, you were assigning b to that action, but not to it's result. Depending on the compiler or platform, that could mean that every time you used b, it could be trying to download that URL again. That is obviously bad, since any one of them could fail, it eats up bandwidth, and hits the yahoo server harder than need be. Finally, we examined how we can use the Either data type for more elegant error handling. It's certainly possible that you might want to add another case to case rcode of in which you accidentally return (True, "Some error message") instead of (False, "Some error message"), in which case you could crash your program! By delimiting ourselves with Left and Right, we remove another point of failure.
I'm using a 3rd party vendor's API in F#. On initialization the API returns a C# object that is nested msg container. It is populated with status messages and may include errors message. The vendor provides a C# sample parsing routine which I have ported F#.
The code sample loops through a nested msg container extracting fatal and nonfatal errors, and then return a List of tuples of type BBResponseType * string
Response Enum:
type BBResponseType =
| Status = 0
| Data = 1
| Error = 2
| FatalError = -1
My port to F# looks like this:
member private this.ProcessStatusMsg(eventObj: Blpapi.Event) =
let responseLst = List<(BBResponseType * string)>()
for msg in eventObj do
if msg.MessageType.Equals(SUBSTARTED) then
if msg.GetElement(EXCEPTIONS).NumValues > 0 then // <- check for errors/exceptions
let e = msg.GetElement(EXCEPTIONS)
for i in 0..e.NumValues-1 do
let error = e.GetValueAsElement(i)
let field = error.GetElementAsString(FieldID)
let reason = error.GetElement(REASON)
let message = sprintf "Subscription Started w/errors( Field: %s \n Reason: %s)" field (reason.GetElementAsString(DESCRIPTION))
responseLst.Add(BBResponseType.Error, message)
else
let message = sprintf "Subscription Started"
responseLst.Add(BBResponseType.Status, message)
if msg.MessageType.Equals(SUBSCFAILURE) then // <- check for subscriptions failure
if msg.HasElement(REASON) then
let reason = msg.GetElement(REASON)
let desc = reason.GetElementAsString(DESCRIPTION)
let message = sprintf "Real-time Subscription Failure: %s" desc
responseLst.Add(BBResponseType.FatalError, message)
else
let message = sprintf "Subscription Failure: (reason unknown) "
responseLst.Add(BBResponseType.FatalError, message)
responseLst
After I finished it, I looked at it and thought, "Wow, that's about as non-functional as you can get and still code in F#."
It does seem a lot clearer and succinct than the C# version, but I was thinking that there must be a better way to do all this without using so many loops and if/then's.
How can I do a better job of parsing these nested structures using pattern matching and recursion?
Few pointers:
Instead of returning a List of tuple return a seq of tuple - using the seq { } computation expression for creating sequence.
Extract the if/else parts as a function of type Message -> (BBResponseType * string) and use this function inside the seq expression
Inside this new function (which transforms the Message to tuple) use pattern matching to figure out what kind of (BBResponseType * string) to return.
To complement #Ankur's answer:
member private this.ProcessStatusMsg(eventObj: Blpapi.Event) =
// 0. Define a parameterized active pattern to turn if/else into pattern matching
let (|Element|_|) e msg =
if msg.HasElement(e) then
Some <| msg.GetElement(e)
else None
// 1. Wrapping the whole method body in a sequence expression
seq {
for msg in eventObj do
// 2. Extracting if/else part and using it in sequence expression
match msg.MessageType with
// 3. Using pattern matching to figure out what kind (BBResponseType * string) to return
| SUBSTARTED ->
match msg with
// 4. Use active pattern to pattern match on message directly
| Element EXCEPTIONS e when e.NumValues > 0 ->
for i in 0..e.NumValues-1 do
let error = e.GetValueAsElement(i)
let field = error.GetElementAsString(FieldID)
let reason = error.GetElement(REASON)
let message = sprintf "Subscription Started w/errors( Field: %s \n Reason: %s)" field (reason.GetElementAsString(DESCRIPTION))
yield (BBResponseType.Error, message)
| _ ->
let message = sprintf "Subscription Started"
yield (BBResponseType.Status, message)
| SUBSCFAILURE ->
match msg with
| Element REASON reason ->
let desc = reason.GetElementAsString(DESCRIPTION)
let message = sprintf "Real-time Subscription Failure: %s" desc
yield (BBResponseType.FatalError, message)
| _ ->
let message = sprintf "Subscription Failure: (reason unknown) "
yield (BBResponseType.FatalError, message)
// There are probably more cases, processing them here
| _ -> ()
}
Point 1, 2 and 3 in comments are from the other answer. I added point 0 and 4 to use active patterns for easy pattern matching.
My code for display all days in this year.
I don't understand why if NewSec =< EndSec -> init:stop() end did not execute the first time in run_calendar?
I expect init:stop() could be executed first time but it is not.
What is wrong?
Code:
-module(cal).
-export([main/0]).
main() ->
StartSec = calendar:datetime_to_gregorian_seconds({{2009,1,1},{0,0,0}}),
EndSec = calendar:datetime_to_gregorian_seconds({{2009,12,31},{0,0,0}}),
run_calendar(StartSec,EndSec).
run_calendar(CurSec, EndSec) ->
{Date,_Time} = calendar:gregorian_seconds_to_datetime(CurSec),
io:format("~p~n", [Date]),
NewSec = CurSec + 60*60*24,
if NewSec =< EndSec -> init:stop() end,
run_calendar(NewSec, EndSec).
Result:
wk# erlc cal.erl
wk# erl -noshell -s cal main
{2009,1,1}
{2009,1,2}
{2009,1,3}
{2009,1,4}
{2009,1,5}
...
{2009,12,22}
{2009,12,23}
{2009,12,24}
{2009,12,25}
{2009,12,26}
{2009,12,27}
{2009,12,28}
{2009,12,29}
{2009,12,30}
{2009,12,31}
wk#
I believe that init:stop() is an asynchronous process that will attempt to shut down the runtime smoothly. According to the docs, "All applications are taken down smoothly, all code is unloaded, and all ports are closed before the system terminates."
It probably takes a while to actually stop, because you have an actively running process. If you change "init:stop()" to "exit(stop)", it will terminate immediately:
3> cal:main().
{2009,1,1}
** exception exit: stop
in function cal:run_calendar/2
Init:stop is asynchronous and it will take time to quit. An alternate way would be to wrap up the test in the call itself and use pattern matching to terminate the loop:
-module(cal).
-export([main/0]).
main() ->
StartSec = calendar:datetime_to_gregorian_seconds({{2009,1,1},{0,0,0}}),
EndSec = calendar:datetime_to_gregorian_seconds({{2009,12,31},{0,0,0}}),
run_calendar(false, StartSec, EndSec).
run_calendar(true, _StartSec, _EndSec) ->
finished;
run_calendar(false, CurSec, EndSec) ->
{Date,_Time} = calendar:gregorian_seconds_to_datetime(CurSec),
io:format("~p~n", [Date]),
NewSec = CurSec + 60*60*24,
run_calendar(NewSec =< EndSec, NewSec, EndSec).
(or something similar, hopefully you get the idea)
You have a mistake in your if statement
You said
if NewSec =< EndSec -> init:stop() end,
This is incorrect. You have to write something like:
if
A =< B -> do something ...;
true -> do something else
end
The if syntax is
if
Condition1 -> Actions1;
Condition2 -> Actions2;
...
end
One of these conditions must always be true.
Why is this?
Erlang is a functional language, not a statement language. In an functional
language every expression must have a value. if is an expression, so it must have a value.
The value of (if 2 > 1 -> 3 end) is 3 but what is the value of
(if 1 > 2 -> 3 end) - answer it has no value - but it must have a value
everything must have a value.
In a statement language everything is evaluated for its side effect -so this would
be a valid construction.
In Erlang you will generate an exception.
So your code generates an exception - which you don't trap so you don't see it and
init:stop() never gets called ...