Unable to understand a crash while adding a field in vcard in ejabberd - ejabberd

I am trying to add a new field in the vcard as “Abc” . For this I added an xml for this “Abc” field in xmpp_codec.spec file. And referenced it in the #vcard_temp. I placed the xmpp_codec.erl,xmpp_codec.hrl, xep0054.erl files thus generated after ‘make spec’ in their respective directories.
But when I try to add a value of this field by sending this iq
<<"<iq id='D2sPz-22' type='set'><vCard xmlns='vcard-temp'><N><GIVEN>byname</GIVEN></N><Abc>10</Abc><FN>byname </FN><NICKNAME>byname</NICKNAME></vCard></iq>">>
I get this error
[error] Hook vcard_iq_set crashed when running mod_avatar:vcard_iq_convert/1:
** Reason = {error,{badrecord,vcard_temp},[{mod_avatar,convert_avatar,[{file,"src/mod_avatar.erl"},{line,320}],3},{mod_avatar,vcard_iq_convert,[{file,"src/mod_avatar.erl"},{line,110}],1},{ejabberd_hooks,safe_apply,[{file,"src/ejabberd_hooks.erl"},{line,380}],4},{ejabberd_hooks,run_fold1,[{file,"src/ejabberd_hooks.erl"},{line,364}],4},{mod_vcard,process_sm_iq,[{file,"src/mod_vcard.erl"},{line,210}],1},{gen_iq_handler,process_iq,[{file,"src/gen_iq_handler.erl"},{line,132}],3},{gen_iq_handler,process_iq,[{file,"src/gen_iq_handler.erl"},{line,111}],4},{ejabberd_sm,route,[{file,"src/ejabberd_sm.erl"},{line,143}],1}]}
** Arguments = [{iq,<<"D2sPz-22">>,set,<<"en">>,{jid,<<"dgNW1Udm4Us">>,<<"example.com">>,<<"Smack">>,<<"dgnw1udm4us">>,<<“example.com">>,<<"Smack">>},{jid,<<"dgNW1Udm4Us">>,<<"example.com">>,<<>>,<<"dgNW1Udm4Us">>,<<"example.com">>,<<>>},[{vcard_temp,undefined,<<"myname ">>,{vcard_name,undefined,<<"myname">>,undefined,undefined,undefined},<<"myname">>,undefined,undefined,[],[],[],[],undefined,undefined,undefined,undefined,undefined,undefined,undefined,undefined,[],undefined,undefined,undefined,undefined,undefined,undefined,undefined,undefined,undefined,undefined,<<"10">>}],#{ip => {}}}]
06:47:47.776 [debug] SQL: "begin;"
06:47:47.776 [debug] SQL: "UPDATE vcard SET vcard='<vCard xmlns=''vcard-temp''><N><GIVEN>myname</GIVEN></N><FN>myname </FN><NICKNAME>myname</NICKNAME><Abc>10</Abc></vCard>' WHERE username='dgNW1Udm4Us'"
06:47:47.777 [debug] SQL: "UPDATE vcard_search SET username='dgNW1Udm4Us', fn='myname ', lfn='myname ', family='', lfamily='', given='myname', lgiven='myname', middle='', lmiddle='', nickname='myname', lnickname='myname', bday='', lbday='', ctry='', lctry='', locality='', llocality='', email='', lemail='', orgname='', lorgname='', orgunit='', lorgunit='', abc='', labc='' WHERE lusername='dgNW1Udm4Us'"
In mod_avtar.erl around line 320 is this function
convert_avatar(LUser, LServer, VCard) ->
case get_converting_rules(LServer) of
[] ->
pass;
Rules ->
case VCard#vcard_temp.photo of
#vcard_photo{binval = Data} when is_binary(Data) ->
convert_avatar(LUser, LServer, Data, Rules);
_ ->
pass
end
end.
And line 320 is case VCard#vcard_temp.photo of inside this function.
And I’m unable to understand this error as since I haven’t changed the #vcard_photo record, why does it says that vcard_temp is a bad record?
EDIT
This is the #vcard_temp record generated after adding the xml and making the spec
-record(vcard_temp, {version :: 'undefined' | binary(),
fn :: 'undefined' | binary(),
n :: 'undefined' | #vcard_name{},
nickname :: 'undefined' | binary(),
photo :: 'undefined' | #vcard_photo{},
bday :: 'undefined' | binary(),
adr = [] :: [#vcard_adr{}],
label = [] :: [#vcard_label{}],
tel = [] :: [#vcard_tel{}],
email = [] :: [#vcard_email{}],
jabberid :: 'undefined' | binary(),
mailer :: 'undefined' | binary(),
tz :: 'undefined' | binary(),
geo :: 'undefined' | #vcard_geo{},
title :: 'undefined' | binary(),
role :: 'undefined' | binary(),
logo :: 'undefined' | #vcard_logo{},
org :: 'undefined' | #vcard_org{},
categories = [] :: [binary()],
note :: 'undefined' | binary(),
prodid :: 'undefined' | binary(),
rev :: 'undefined' | binary(),
sort_string :: 'undefined' | binary(),
sound :: 'undefined' | #vcard_sound{},
uid :: 'undefined' | binary(),
url :: 'undefined' | binary(),
class :: 'confidential' | 'private' | 'public' | 'undefined',
key :: 'undefined' | #vcard_key{},
desc :: 'undefined' | binary(),
abc :: 'undefined' | binary()}).
-type vcard_temp() :: #vcard_temp{}.


If you modified a library that re-defines a record (in this case the vcard_temp record), you better recompile ejabberd, to ensure all the code uses the new record definition.
Also, it's worth checking if the old vcard_temp record definition is still being used somewhere. If you use SQL storage for mod_vcard, probably nnot, but better make sure.

Related

F# error FS0588: The block following this 'let' is unfinished. Every code block is an expression and must have a result

I am tasked with finishing an interpreter in F#, but I'm having some trouble, as I im getting the error: error FS0588: The block following this 'let' is unfinished. Every code block is an expression and must have a result. 'let' cannot be the final code element in a block. Consider giving this block an explicit result.
Its been a long time since last time I programmed I F#.
The following is my code. I have a helper function inside my eval function, called OperateAux. It gets called in the pattern matching, when it matches e with OPERATE. It should then call OperateAux, and calculate the given expression. The error I'm getting is at line: let OperateAux (op:BINOP) (e1:EXP) (e2:EXP) : VALUE =
so I guess somehow my helper function isn't finished, I just cant figure out where.
let rec eval (vtab : SymTab) (e : EXP) : VALUE =
match e with
| CONSTANT n -> n
| VARIABLE v -> lookup v vtab
| OPERATE (op, e1, e2) -> OperateAux op e1 e2//(eval vtab e1) (eval vtab e2)
| LET_IN (var, e1, e2) -> failwith "case for LET_IN not handled"
| OVER (rop, var, e1, e2, e3) -> failwith "case for OVER not handled"
let OperateAux (op:BINOP) (e1:EXP) (e2:EXP) : VALUE =
let (INT e1) = eval vtab e1
let (INT e2) = eval vtab e2
match op with
| BPLUS -> (e1+e2)
| BMINUS -> (e1-e2)
| BTIMES -> (e1*e2)
| _ -> ()
Here is some types, I'm not sure if they are relevant for this question, but for good measure I'll show them.
type VALUE = INT of int
type BINOP = BPLUS | BMINUS | BTIMES
type RANGEOP = RSUM | RPROD | RMAX | RARGMAX
type EXP =
| CONSTANT of VALUE
| VARIABLE of string
| OPERATE of BINOP * EXP * EXP
| LET_IN of string * EXP * EXP
| OVER of RANGEOP * string * EXP * EXP * EXP
(* A list mapping variable names to their values. *)
type SymTab = (string * VALUE) list

Nevermind, I figured it out. You have to "initialise" your helper function before actually calling it. So the helper function operateAux should come before the pattern matching which calls it.

Proper JsonObjCodec with Fleece for Complex, Nested Discriminated Unions

I have the following DU which is composed of other DUs or/and Records.
type BiometricRules =
| Age of Comparator * AgeMeasure
| Glycemia of Comparator * BiometricMeasure
| Biometric of BiometricType * Comparator * BiometricMeasure
| Sex of SexMeasure
| MedicalCondition of MedicalCondition
| Score of ScoreType * Comparator * ScoreMeasure
While trying to deserialize and serialize with Fleece, I have written the following JsonObjCodec.
with
static member JsonObjCodec =
Age <!> jreq "Age" (function Age (comp, ageMeasure) -> Some (comp |> string, ageMeasure |> string) | _ -> None)
<|> (Glycemia <!> jreq "Glycemia" (function Glycemia (comp, bioMeasure) -> Some (comp |> string, bioMeasure) | _ -> None))
<|> (Biometric <!> jreq "BiometricRule" (function Biometric (bt, comp, bm) -> Some (bt |> string, comp |> string, bm) | _ -> None))
<|> (Sex <!> jreq "Sex" (function Sex s -> Some (s |> string) | _ -> None))
<|> (BiometricRules.MedicalCondition <!> jreq "MedicalCondition" (function BiometricRules.MedicalCondition x -> Some (x) | _ -> None))
<|> (Score <!> jreq "Score" (function Score (st, comp, scoreMeasure) -> Some (st |> string, comp |> string, scoreMeasure) | _ -> None))
For unknown reason it does not compile with error No overloads match for method 'Map'. All the nested DUs or Records have either a JsonObjCodec or static FromString and ToString methods defined.
Any solution with respect to how I could solve this via Fleece would be appreciated. The library is already deeply used in the project, so changing it would involve too much refactoring.
Below I copy pasted the definition of the other DU and Records, as reference:
type Comparator =
| GreaterThan
| LowerThan
| LowerThanOrEqual
| GreaterThanOrEqual
| EqualTo
with
override this.ToString() =
match this with
| GreaterThan -> ">"
| LowerThan -> "<"
| LowerThanOrEqual -> "<="
| GreaterThanOrEqual -> ">="
| EqualTo -> "="
static member FromString s =
match s with
| ">" -> GreaterThan
| "<" -> LowerThan
| ">=" -> GreaterThanOrEqual
| "<=" -> LowerThanOrEqual
| "=" -> EqualTo
| _ -> failwith "Not a valid comparator."
type AgeMeasure =
| Years of decimal
| Months of decimal
| Weeks of decimal
with
override this.ToString() =
match this with
| Years y -> string y + " years"
| Months m -> string m + " months"
| Weeks w -> string w + " weeks"
static member FromString (s: string) =
match s with
| _ when s.EndsWith("years") -> Years (Decimal.Parse(s.Replace("years", "")))
| _ when s.EndsWith("months") -> Months (Decimal.Parse(s.Replace("months", "")))
| _ when s.EndsWith("weeks") -> Weeks (Decimal.Parse(s.Replace("weeks", "")))
type BiometricMeasure = {
Value: decimal
UoM: string option
} with
static member JsonObjCodec =
fun va uom -> {
Value = va
UoM = if uom = "NA" then None else Some uom
}
<!> jreq "Value" (Some << fun bm -> bm.Value)
<*> jreq "UoM" (Some << fun bm -> if bm.UoM |> Option.isNone then "NA" else bm.UoM |> Option.get)
type BiometricType =
| SBP
| DBP
| Glycemia
| Specified of string
with
override this.ToString() =
match this with
| SBP -> "SBP"
| DBP -> "DBP"
| Glycemia -> "Glycemia"
| Specified s -> s
static member FromString s =
match s with
| "SBP" -> SBP
| "DBP" -> DBP
| "Glycemia" -> Glycemia
| _ -> Specified s
type SexMeasure =
| Female
| Male
| Other of string
with
override this.ToString() =
match this with
| Female -> "Female"
| Male -> "Male"
| Other s -> s
static member FromString (s: string) =
match s.ToLower() with
| "Female" -> Female
| "Male" -> Male
| other -> Other other
type MedicalCondition =
| ICD of ICD
| Other of string
with
static member JsonObjCodec =
ICD <!> jreq "MedicalCondition" (function ICD v -> Some v | _ -> None)
<|> (Other <!> jreq "MedicalCondition" (function Other v -> Some v | _ -> None))
type ScoreType =
| BMI
| Other of string
with
override this.ToString() =
match this with
| BMI -> "BMI"
| Other s -> s
static member FromString s =
match s with
| "BMI" -> BMI
| _ -> Other s
type ScoreMeasure = decimal
Libraries Used:
<PackageReference Update="FSharp.Core" Version="4.7" />
<PackageReference Include="FSharpPlus" Version="1.1.1" />
<PackageReference Include="Newtonsoft.Json" Version="12.0.3" />
<PackageReference Include="Fleece.NewtonsoftJson" Version="0.8.0" />
<PackageReference Include="FSharp.Data" Version="3.3.3" />

The Problem
Fleece provides Json codecs, not string codecs, so defining ToString and FromString is not the way to go, unless you need them for other stuff.
The solution
Define ToJson and OfJson for your internal DUs. Then remove all the |> string fragments in JsonObjCodec body.
Here's a quick and dirty example (I advise error handling to be improved) for Comparator :
static member ToJson x = JString (string x)
static member OfJson x =
match x with
| JString x -> Ok (Comparator.FromString x)
| _ -> Error (Uncategorized "JString expected")
Alternative solution
Leave all your internal DUs like this, but add the missing "parse" section in your JsonObjCodec:
...
with
static member JsonObjCodec =
(fun (a, b) -> Age (Comparator.FromString a, AgeMeasure.FromString b)) <!> jreq "Age" (function Age (comp, ageMeasure) -> Some (comp |> string, ageMeasure |> string) | _ -> None)
<|> ...
this becomes a bit verbose but will do the job.
Tips
Instead of using the <|> operator to add codecs, you colud use the jchoice combinator, it will read better.
If you really need your String / FromString methods I would suggest renaming FromString to Parse or renaming it to TryParse and returning an option type. This way you can take advantage of FSharpPlus tryParse function.
Also, if you are using the string/parse pattern everywhere it might worth to create a codec combinator that works from transforming to/from strings. This is not an easy task but it might worth the mental effort.
For debugging stuff like this purpose, try not to open the namespace FSharpPlus as it contains generic definitions of operators like <|>, <!> and <*>, this way you'll get better compile error messages.

Why is this considered a type mismatch (or error)?

This is the code I have which results in the error that follows:
import Prelude hiding (div)
data Expr = Expr Op Int Int deriving (Show)
data Op = Add | Sub | Mul | Div deriving (Show)
evaluate :: (Num a) => Expr -> a
evaluate (Expr Add a b) = a + b
--evaluate (Expr Sub a b) = sub a b
--evaluate (Expr Mul a b) = mul a b
--evaluate (Expr Div a b) = div a b
Error message:
exprs.hs:8:27: error:
• Couldn't match expected type ‘a’ with actual type ‘Int’
‘a’ is a rigid type variable bound by
the type signature for:
evaluate :: forall a. Num a => Expr -> a
at exprs.hs:7:1-32
• In the expression: a + b
In an equation for ‘evaluate’: evaluate (Expr Add a b) = a + b
• Relevant bindings include
evaluate :: Expr -> a (bound at exprs.hs:8:1)
|
8 | evaluate (Expr Add a b) = a + b
| ^^^^^
Failed, 0 modules loaded.
However, the (+) function has type (Num a) => a -> a -> a, and
the pattern I'm matching in the function evaluate has two Ints (a & b) which are both part of the Num typeclass. Since the result of calling (+) on a & b will be of type Int (from the Num typeclass) and that is also what I'm declaring the type of the output of my evaluate function to be, why is GHCi giving me this error?
Note that, if I change the type declaration of evaluate to
evaluate :: Expr -> Int
then this error does not come up.

evaluate :: (Num a) => Expr -> a
states that for any type a which has a Num instance, evaluate can return a value of type a given an Expr value. However given the definition of Expr, you can only ever return an Int, and the compiler is therefore rejecting your definition.
If it were allowed you would be able to do:
evaluate (Expr Add 2 3) :: Double
which your definition cannot satisfy.
You can use your definition if you allow Expr to be parameterised by the expression type:
data Expr a = Expr Op a a deriving (Show)
evaluate :: (Num a) => Expr a -> a
evaluate (Expr Add a b) = a + b
...

OCaml error : "the variant type has no constructor ::"

I'm studying OCaml right now, and after I do this,
type aexp =
| Const of int
| Var of string
| Power of string * int
| Times of aexp list
| Sum of aexp list
let rec diff : aexp * string -> aexp
=fun (aexp,x) -> match aexp with
|Const a -> Const 0
|Var "x" -> Const 1
|Power ("x", a) -> (match a with
|2 -> Times[Const 2; Var "x"]
|1 -> Const 1
|0 -> Const 0
|_ -> Times[Const a; Power ("x", a-1)])
|Times [l] -> (match l with
|h::t -> (match t with
|Var "x" -> h
|Power ("x",a) -> Times [Times [h;Const a];diff(Power ("x",a),x)]))
I get an error:
File "", line 11, characters 3-5:
Error: The variant type aexp has no constructor ::
I learned that :: is concatenation of single element to a list or another element of a list.
It worked with my other codes that used list.
Why isn't it working here?

Your pattern Times [l] matches a node Times with exactly one element named l. You wanted to write Times l, that matches a node Times with a list of any number of elements, bound to l in the body of the clause.
Note that in OCaml you can use nested pattern-matching, such as:
| Times (Var "x" :: _) -> h
| Times (Power ("x",a) :: _ ) -> ...
| ...

OCaml : Raise an error inside a match with structure

In OCaml, I have a list of strings that contains names of towns (Something like "1-New York; 2-London; 3-Paris"). I need to ask the user to type a number (if they want London they have to type 2).
I want to raise an exception message saying that the town is not valid, if the person types for example "4", in the example.
I tried this, but it doesn't work :
let chosenTown = match int_of_string (input_line stdin) with
| x > (length listOfTowns) -> raise (Err "Not a valid town")
What's the good way to code "if the chosen number is bigger than the length of the list then raise the error" ??

Pattern can't contain arbitrary expressions. It can be a constant, a constructor name, record field inside curly braces, list, array, etc.
But patterns can be guarded, e.g.
match int_of_string (input_line stding) with
| x when x >= length listOfTowns ->
invalid_arg "the number is too large"
| x -> List.nth listOfTowns x

To complete the answer, patter matching relies on unification and does not expect assertion (it is not the equivalent of a switch in C or so).
The idea is that you provide different "shapes" (patterns) that your term (the thing you match on) could have.
For a list for instance:
match l with
| e :: e' :: r -> (*...*)
| e :: r -> (*...*)
| [] -> (*...*)
It also had a binding effect, if you pass on, say, [1] (a very small list indeed), it won't match e :: e' :: r, but will match e :: r and then e = 1 and r = [].
As ivg said, you can add conditions, as booleans this time, thanks to the keyword when.
However, when manipulating lists like this, I would go for a recursive function:
let rec find_town n l =
match l with
| t :: _ when n = 1 -> t
| _ :: r -> find_town (n-1) r
| [] -> raise (Err "Not a valid town")
This is basically writing again List.nth but changing the exception that it raises.