1: open System.Net
  2: open System
  3: open System.IO
  4: open System.Text
  5: open Renci.SshNet
  6: open System.Xml
  7: 
  8: 
  9: let getRes_request = "<soapenv:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/2001/XMLSchema' xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' xmlns:arg='http://www.medcomp.medicina.unipd.it/Argot2'>" +
 10:                      "  <soapenv:Header/>" +
 11:                      "   <soapenv:Body>" +
 12:                      "      <arg:GetResults soapenv:encodingStyle='http://schemas.xmlsoap.org/soap/encoding/'>" +
 13:                      "         <job_id xsi:type='xsd:int'>job_id_val</job_id>" +
 14:                      "      </arg:GetResults>" +
 15:                      "   </soapenv:Body>" +
 16:                      "</soapenv:Envelope>"
 17: 
 18: let runArgot2_request = "<soapenv:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/2001/XMLSchema' xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' xmlns:arg='http://www.medcomp.medicina.unipd.it/Argot2'>" +
 19:                         "   <soapenv:Header/>" +
 20:                         "   <soapenv:Body>" +
 21:                         "      <arg:RunArgot2 soapenv:encodingStyle='http://schemas.xmlsoap.org/soap/encoding/'>" +
 22:                         "         <out_blast_tab xsi:type='xsd:string'>out_blast_tab_val</out_blast_tab>" +
 23:                         "         <out_hmm_tab xsi:type='xsd:string'>out_hmm_tab_val</out_hmm_tab>" +
 24:                         "         <inf_content xsi:type='xsd:float'>inf_content_val</inf_content>" +
 25:                         "         <int_confidence xsi:type='xsd:float'>int_confidence_val</int_confidence>" +
 26:                         "         <totalScore xsi:type='xsd:float'>totalScore_val</totalScore>" +
 27:                         "         <example xsi:type='xsd:Bool'>True</example>" +
 28:                         "      </arg:RunArgot2>" +
 29:                         "   </soapenv:Body>" +
 30:                         "</soapenv:Envelope>"
 31: 
 32: type MaybeBuilder() =
 33:     member this.Bind(p, rest) = match p with
 34:                                 | None -> None
 35:                                 | Some a -> rest a
 36:     member this.Return(x) = Some x
 37:     member this.Zero(x) = Some x
 38: // end type MaybeBuilder
 39: 
 40: let maybe = new MaybeBuilder()
 41: 
 42: 
 43: let fetchUrl (url: Uri) (name: String) : Async<unit> =
 44:     async {
 45:         let webClient = new WebClient()
 46:         webClient.DownloadFile (url, name)
 47:     }
 48: // end fetchUrl
 49: 
 50: let uploadZIP (name: string) (where: string) : Async<unit> =
 51:     async {
 52:         use sftp = new SftpClient("147.162.241.42", <username>, <password>)
 53:         sftp.Connect()
 54:         let fileStream = File.OpenRead name
 55:         printf "Uploading %s to %s ... " name where
 56:         sftp.UploadFile (fileStream, where)
 57:         printfn "OK"
 58:     }
 59: // end uploadZIP
 60: 
 61: type Either<'a,'b> = Choice<'b,'a>
 62: 
 63: let Right x: Either<'a,'b> = Choice1Of2 x
 64: 
 65: let Left  x: Either<'a,'b> = Choice2Of2 x
 66: 
 67: let (|Right|Left|) = function
 68:                      | Choice1Of2 x -> Right x
 69:                      | Choice2Of2 x -> Left x
 70: 
 71: 
 72: let sendReq (url: string) (files: (string * string) list) (action: string) (xml: string) : Either<string, XmlNodeList> =
 73:     // Create & configure HTTP web request
 74:     let req = HttpWebRequest.Create(url) :?> HttpWebRequest
 75:     req.ProtocolVersion <- HttpVersion.Version10
 76:     req.Method <- "POST"
 77:     req.KeepAlive <- false
 78:     req.Timeout <- 18000
 79:     req.ReadWriteTimeout <- 18000
 80:     req.Headers.Add ("SOAPAction: " + action)
 81: 
 82:     // Encode body with POST data as array of bytes
 83:     let xmlBytes = Encoding.ASCII.GetBytes xml
 84:     req.ContentType <- "text/xml;charset=UTF-8"
 85:     req.ContentLength <- int64 xmlBytes.Length
 86:     let reqStream = req.GetRequestStream()
 87:     reqStream.Write(xmlBytes, 0, xmlBytes.Length)
 88:     reqStream.Close()
 89: 
 90:     // Obtain response and download the resulting page
 91:     try
 92:         let resp = req.GetResponse()
 93:         let stream = resp.GetResponseStream()
 94:         let reader = new StreamReader(stream)
 95: 
 96:         let xdoc = new XmlDocument()
 97:         xdoc.LoadXml(reader.ReadToEnd())
 98:         Right (xdoc.SelectNodes("//return").Item(0).ChildNodes)
 99:     with
100:         | :? System.Net.WebException as exn ->
101:             Left ("An exception occurred: " + exn.Message)
102: // end sendReq
103: 
104: type ResultsInfo = {
105:     file_url: string;
106:     file_size: float;
107:     warning: string option
108: }
109: 
110: exception Argot2Error of string
111: 
112: let correct (txt: string): (string option) =
113:     if txt.Equals("") then
114:         None
115:     else
116:         Some txt
117: // end correct
118: 
119: let getResults' (job_id: int) : ResultsInfo =
120:     let xml = getRes_request
121:     let xml1 = xml.Replace("job_id_val", job_id.ToString())
122:     let url = "http://www.medcomp.medicina.unipd.it/Argot2/soap_api.php"
123: 
124:     let nodes_opt = sendReq url [] "http://www.medcomp.medicina.unipd.it/Argot2/soap_api.php#GetResults" xml1
125: 
126:     match nodes_opt with
127:     | Left err ->
128:         raise(Argot2Error err)
129:     | Right nodes ->
130:         { file_url=nodes.Item(0).InnerText; file_size=float(nodes.Item(1).InnerText); warning=correct (nodes.Item(2).InnerText) }
131: // end getResults
132: 
133: let rec getResults (n: int) (max_retries: int) (job_id: int) : Async<ResultsInfo option> =
134:     async {
135:         let res = getResults' job_id
136: 
137:         if res.file_size > 0.0 then
138:             return (Some (res: ResultsInfo))
139:         else if res.file_size < 0.0 then
140:             return (None: ResultsInfo option)
141:         else
142:             printfn "%d. %s (%3.3fMB)" n res.file_url res.file_size
143:             match res.warning with
144:             | Some warn ->
145:                 printfn "%s\n" warn
146:             | None ->
147:                 ()
148:             do! Async.Sleep 5000
149:             return! getResults (n + 1) max_retries job_id
150:     }
151: // end getResults
152: 
153: type JobsInfo = {
154:     job_id: int;
155:     error: string option
156: }
157: 
158: type Microsoft.FSharp.Control.Async with
159:     static member Raise (e : #exn) =
160:         Async.FromContinuations(fun (_, econt, _) -> econt e)
161: 
162: let runArgot2 (out_blast_tab: string) (out_hmm_tab: string) (inf_content: float) (int_confidence: float) (totalScore: float) : Async<JobsInfo> =
163:     async {
164:         let xml = runArgot2_request
165:         let xml1 = xml.Replace("out_blast_tab_val", out_blast_tab)
166:                       .Replace("out_hmm_tab_val", out_hmm_tab)
167:                       .Replace("inf_content_val", inf_content.ToString())
168:                       .Replace("int_confidence_val", int_confidence.ToString())
169:                       .Replace("totalScore_val", totalScore.ToString())
170:         let url = "http://www.medcomp.medicina.unipd.it/Argot2/soap_api.php"
171: 
172:         let nodes_opt = sendReq url [] "http://www.medcomp.medicina.unipd.it/Argot2/soap_api.php#RunArgot2" xml1
173: 
174:         match nodes_opt with
175:         | Left err ->
176:             return! Async.Raise <| (Argot2Error err)
177:         | Right nodes ->
178:             if nodes.Item(1).InnerText.Equals("") then
179:                 return { job_id=int(nodes.Item(0).InnerText); error=correct (nodes.Item(1).InnerText) }
180:             else
181:                return! Async.Raise <| (Argot2Error (nodes.Item(1).InnerText))
182:     }
183: // end runArgot2
184: 
185: [<EntryPoint>]
186: let main args =
187:     try
188:         // side effects => exception 
189:         Async.RunSynchronously (uploadZIP @"../../out_blast_tab_small.zip" "out_blast_tab_small.zip")
190:         // side effects => exception (whenever run in parallel gives a "closed channel" exception!)
191:         Async.RunSynchronously (uploadZIP @"../../out_hmm_tab_small.zip" "out_hmm_tab_small.zip")
192: 
193:         // side effects => exception
194:         let job_id = Async.RunSynchronously (runArgot2 "out_blast_tab_small.zip" "out_hmm_tab_small.zip" 0.0 0.0 0.0)
195: 
196:         // no side effects => maybe monad (plus Async exceptions)
197:         let res = maybe {
198:             let! res = Async.RunSynchronously (getResults 0 3 job_id.job_id)
199: 
200:             let urls = [ (fetchUrl (Uri res.file_url) "argot2_results.zip") ]
201:             let urls = match res.warning with
202:                        | Some warn ->
203:                            (fetchUrl (Uri warn) "argot2_warnings.log") :: urls
204:                        | None ->
205:                             urls
206: 
207:             urls |> Async.Parallel |> Async.RunSynchronously |> ignore
208:         }
209: 
210:         printfn "Done!"
211:         0
212:     with
213:     | exn ->
214:         printfn "An exception occurred: %s" exn.Message
215:         1
216: // end main