From 7124d1e1a1a4e04f4fb23fb2a2d02a82fd6b5426 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 19 Nov 2008 22:51:24 +0000 Subject: [PATCH] Typed wrappers for file/gif and almost all of net/*. svn: r12518 --- collects/typed/file/gif.ss | 17 ++++++++ collects/typed/net/base64.ss | 13 ++++++ collects/typed/net/cgi.ss | 27 +++++++++++++ collects/typed/net/cookie.ss | 23 +++++++++++ collects/typed/net/dns.ss | 10 +++++ collects/typed/net/ftp.ss | 16 ++++++++ collects/typed/net/gifwrite.ss | 4 ++ collects/typed/net/head.ss | 31 ++++++++++++++ collects/typed/net/imap.ss | 55 +++++++++++++++++++++++++ collects/typed/net/mime.ss | 71 +++++++++++++++++++++++++++++++++ collects/typed/net/nntp.ss | 31 ++++++++++++++ collects/typed/net/pop3.ss | 38 ++++++++++++++++++ collects/typed/net/qp.ss | 10 +++++ collects/typed/net/sendmail.ss | 12 ++++++ collects/typed/net/sendurl.ss | 9 +++++ collects/typed/net/smtp.ss | 11 +++++ collects/typed/net/uri-codec.ss | 15 +++++++ collects/typed/net/url.ss | 59 +++++++++++++++++++++++++++ 18 files changed, 452 insertions(+) create mode 100644 collects/typed/file/gif.ss create mode 100644 collects/typed/net/base64.ss create mode 100644 collects/typed/net/cgi.ss create mode 100644 collects/typed/net/cookie.ss create mode 100644 collects/typed/net/dns.ss create mode 100644 collects/typed/net/ftp.ss create mode 100644 collects/typed/net/gifwrite.ss create mode 100644 collects/typed/net/head.ss create mode 100644 collects/typed/net/imap.ss create mode 100644 collects/typed/net/mime.ss create mode 100644 collects/typed/net/nntp.ss create mode 100644 collects/typed/net/pop3.ss create mode 100644 collects/typed/net/qp.ss create mode 100644 collects/typed/net/sendmail.ss create mode 100644 collects/typed/net/sendurl.ss create mode 100644 collects/typed/net/smtp.ss create mode 100644 collects/typed/net/uri-codec.ss create mode 100644 collects/typed/net/url.ss diff --git a/collects/typed/file/gif.ss b/collects/typed/file/gif.ss new file mode 100644 index 0000000000..3a17435eb0 --- /dev/null +++ b/collects/typed/file/gif.ss @@ -0,0 +1,17 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/opaque-type GIF-Stream gif-stream? file/gif) + +(require/typed/provide file/gif + [gif-start ( Output-Port Number Number Number (U #f (Listof (Vectorof Number))) -> Void )] + [gif-add-image ( GIF-Stream Number Number Number Number Boolean (U #f Number) String -> Void )] + [gif-add-control ( GIF-Stream Symbol Boolean Number (U #f Number) -> Void)] + [gif-add-loop-control ( GIF-Stream Number -> Void )] + [gif-add-comment ( GIF-Stream String -> Void )] + [gif-end ( GIF-Stream -> Void )] + [quantize ( String -> (values String (Listof (Vectorof Number)) (U #f (Vectorof Number))))]) + +(provide gif-stream? GIF-Stream) + \ No newline at end of file diff --git a/collects/typed/net/base64.ss b/collects/typed/net/base64.ss new file mode 100644 index 0000000000..13061e4ea5 --- /dev/null +++ b/collects/typed/net/base64.ss @@ -0,0 +1,13 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/typed/provide net/base64 + [base64-encode-stream (case-lambda (Input-Port Output-Port -> Void) + (Input-Port Output-Port Bytes -> Void))] + [base64-decode-stream (Input-Port Output-Port -> Void)] + [base64-encode (Bytes -> Bytes)] + [base64-decode (Bytes -> Bytes)]) + +(provide base64-encode-stream base64-decode-stream base64-encode base64-decode) + \ No newline at end of file diff --git a/collects/typed/net/cgi.ss b/collects/typed/net/cgi.ss new file mode 100644 index 0000000000..7287e6f073 --- /dev/null +++ b/collects/typed/net/cgi.ss @@ -0,0 +1,27 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require-typed-struct cgi-error () net/cgi) +(require-typed-struct incomplete-%-suffix ([chars : (Listof Char)]) net/cgi) +(require-typed-struct invalid-%-suffix ([char : Char]) net/cgi) + +(require/typed/provide net/cgi + [get-bindings (-> (Listof (cons (U Symbol String) String)))] + [get-bindings/post (-> (Listof (Pair (U Symbol String) String)))] + [get-bindings/get (-> (Listof (Pair (U Symbol String) String)) )] + [output-http-headers (-> Void)] + [generate-html-output (case-lambda (String (Listof String) -> Void) + (String (Listof String) String String String String String -> Void))] + [generate-error-output ((Listof String) -> (U))] + [bindings-as-html ((Listof (cons (U Symbol String) String)) -> (Listof String))] + [extract-bindings ((U Symbol String) (Listof (cons (U Symbol String) String)) -> ( Listof String))] + [extract-binding/single ((U Symbol String) (Listof (Pair (U Symbol String) String)) -> String)] + [get-cgi-method (-> (U "GET" "POST"))] + [string->html (String -> String)] + [generate-link-text (String String -> String)]) + +(provide + (struct-out cgi-error) + (struct-out incomplete-%-suffix) + (struct-out invalid-%-suffix)) \ No newline at end of file diff --git a/collects/typed/net/cookie.ss b/collects/typed/net/cookie.ss new file mode 100644 index 0000000000..f2ff60224c --- /dev/null +++ b/collects/typed/net/cookie.ss @@ -0,0 +1,23 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/opaque-type Cookie cookie? net/cookie) + +(require/typed/provide net/cookie + [set-cookie (String String -> Cookie)] + [cookie:add-comment (Cookie String -> Cookie)] + [cookie:add-domain (Cookie String -> Cookie)] + [cookie:add-max-age (Cookie Number -> Cookie)] + [cookie:add-path (Cookie String -> Cookie)] + [cookie:secure (Cookie Boolean -> Cookie)] + [cookie:version (Cookie Number -> Cookie)] + + [print-cookie (Cookie -> String)] + + [get-cookie (String String -> (Listof String))] + [get-cookie/single (String String -> (Option String))]) + +(require-typed-struct cookie-error () net/cookie) + +(provide Cookie cookie? (struct-out cookie-error)) \ No newline at end of file diff --git a/collects/typed/net/dns.ss b/collects/typed/net/dns.ss new file mode 100644 index 0000000000..24ef679f81 --- /dev/null +++ b/collects/typed/net/dns.ss @@ -0,0 +1,10 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/typed/provide net/dns + [dns-get-address (String String -> String)] + [dns-get-name (String String -> String)] + [dns-get-mail-exchanger (String String -> String )] + [dns-find-nameserver (-> (Option String))]) + diff --git a/collects/typed/net/ftp.ss b/collects/typed/net/ftp.ss new file mode 100644 index 0000000000..041befc0d5 --- /dev/null +++ b/collects/typed/net/ftp.ss @@ -0,0 +1,16 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/opaque-type FTP-Connection ftp-connection? net/ftp) + +(require/typed/provide net/ftp + [ftp-cd (FTP-Connection String -> Void)] + [ftp-establish-connection (String Number String String -> FTP-Connection)] + [ftp-close-connection (FTP-Connection -> Void)] + [ftp-directory-list (FTP-Connection -> (Listof (List (U "-" "d" "l") String String)))] + [ftp-download-file (FTP-Connection Path String -> Void)] + [ftp-make-file-seconds (String -> Number)]) + +(provide ftp-connection? FTP-Connection) + diff --git a/collects/typed/net/gifwrite.ss b/collects/typed/net/gifwrite.ss new file mode 100644 index 0000000000..cfe9167c5b --- /dev/null +++ b/collects/typed/net/gifwrite.ss @@ -0,0 +1,4 @@ +#lang typed-scheme + +(require typed/file/gif) +(provide (all-from-out typed/file/gif)) diff --git a/collects/typed/net/head.ss b/collects/typed/net/head.ss new file mode 100644 index 0000000000..958eea1ef7 --- /dev/null +++ b/collects/typed/net/head.ss @@ -0,0 +1,31 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/typed/provide net/head + [empty-header String] + [validate-header (String -> Void)] + [extract-field (Bytes (U Bytes String) -> (Option Bytes))] + [remove-field (String String -> String)] + [insert-field (String String String -> String)] + [replace-field (String String String -> String)] + [extract-all-fields ((U String Bytes) -> (Listof (cons (U String Bytes) (U Bytes String))))] + [append-headers (String String -> String)] + [standard-message-header (String (Listof String) (Listof String) (Listof String) String -> String)] + [data-lines->data ((Listof String) -> String)] + [extract-addresses (String Symbol -> (U (Listof String) (Listof (Listof String))))] + [assemble-address-field ((Listof String) -> String)]) + +(provide + empty-header + validate-header + extract-field + remove-field + insert-field + replace-field + extract-all-fields + append-headers + standard-message-header + data-lines->data + extract-addresses + assemble-address-field) \ No newline at end of file diff --git a/collects/typed/net/imap.ss b/collects/typed/net/imap.ss new file mode 100644 index 0000000000..a4639fad19 --- /dev/null +++ b/collects/typed/net/imap.ss @@ -0,0 +1,55 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/opaque-type IMAP-Connection imap-connection? net/imap) + +(define-type-alias bstring (U String Bytes)) + +(require/typed/provide net/imap + [imap-port-number (Number -> Void)] + + [imap-connect (String String String String -> (values IMAP-Connection Number Number))] + [imap-connect* (Number Number String String String -> (values IMAP-Connection Number Number))] + [imap-disconnect (IMAP-Connection -> Void)] + [imap-force-disconnect (IMAP-Connection -> Void)] + [imap-reselect (IMAP-Connection String -> (values Number Number))] + [imap-examine (IMAP-Connection String -> (values Number Number))] + [imap-noop (IMAP-Connection -> (values Number Number))] + [imap-status (IMAP-Connection String (Listof Symbol) -> (Listof (Listof Number)))] + [imap-poll (IMAP-Connection -> Void)] + + [imap-new? (IMAP-Connection -> Boolean)] + [imap-messages (IMAP-Connection -> Number)] + [imap-recent (IMAP-Connection -> Number)] + [imap-uidnext (IMAP-Connection -> (Option Number))] + [imap-uidvalidity (IMAP-Connection -> (Option Number))] + [imap-unseen (IMAP-Connection -> (Option Number))] + [imap-reset-new! (IMAP-Connection -> Void)] + + [imap-get-expunges (IMAP-Connection -> (Listof Number))] + [imap-pending-expunges? (IMAP-Connection -> Boolean)] + [imap-get-updates (IMAP-Connection -> (Listof (cons Number (Listof (Pair Any Any)))))] + [imap-pending-updates? (IMAP-Connection -> Boolean)] + + [imap-get-messages + (IMAP-Connection (Listof Number) Symbol -> (Listof (Listof (U Number String String (Listof Symbol)))))] + [imap-copy (IMAP-Connection (Listof Number) String -> Void)] + [imap-append (IMAP-Connection String String -> Void)] + [imap-store (IMAP-Connection Symbol (Listof Number) Symbol -> Void)] + [imap-flag->symbol (Symbol -> Symbol)] + [symbol->imap-flag (Symbol -> Symbol)] + [imap-expunge (IMAP-Connection -> Void)] + + [imap-mailbox-exists? (IMAP-Connection String -> Boolean)] + [imap-create-mailbox (IMAP-Connection String -> Void)] + + [imap-list-child-mailboxes + (case-lambda (IMAP-Connection bstring -> (Listof (cons (Listof Symbol) (cons String '())))) + (IMAP-Connection bstring (Option bstring) -> (Listof (List (Listof Symbol) String))))] + [imap-mailbox-flags (IMAP-Connection String -> (Listof Symbol))] + [imap-get-hierarchy-delimiter (IMAP-Connection -> String)]) + +(provide + imap-connection? + IMAP-Connection) \ No newline at end of file diff --git a/collects/typed/net/mime.ss b/collects/typed/net/mime.ss new file mode 100644 index 0000000000..167f000335 --- /dev/null +++ b/collects/typed/net/mime.ss @@ -0,0 +1,71 @@ +#lang typed-scheme + +(require typed/private/utils) +;; -- basic mime structures -- +(require-typed-struct disposition + ([type : Symbol] + [filename : String] + [creation : String] + [modification : String] + [read : String] + [size : Number] + [params : Any]) + net/mime) +(require-typed-struct entity ([type : (U Symbol String)] + [subtype : (U Symbol String)] + [charset : (U Symbol String)] + [encoding : Symbol] + [disposition : disposition ] + [params : (Listof (cons Symbol String))] + [id : String] + [description : String] + [other : String] + [fields : Any] + [parts : (Listof String) ] + [body : (Output-Port -> Void)]) + net/mime) +(require-typed-struct message + ([version : String] [entity : entity] [fields : (Listof Symbol)]) + net/mime) + + +;; -- exceptions raised -- +(require/typed mime-error? (Any -> Boolean : (Opaque mime-error?)) net/mime) +(require/typed unexpected-termination? (Any -> Boolean :(Opaque unexpected-termination?)) net/mime) +(require/typed unexpected-termination-msg ((Opaque unexpected-termination?) -> message) net/mime) +(require/typed missing-multipart-boundary-parameter? (Any -> Boolean : (Opaque missing-multipart-boundary-parameter?)) net/mime) +(require/typed malformed-multipart-entity? (Any -> Boolean : (Opaque malformed-multipart-entity?)) net/mime) +(require/typed malformed-multipart-entity-msg ((Opaque malformed-multipart-entity?)-> message) net/mime) +(require/typed empty-mechanism? (Any -> Boolean : (Opaque empty-mechanism?)) net/mime) +(require/typed empty-type? (Any -> Boolean : (Opaque empty-type?)) net/mime) +(require/typed empty-subtype? (Any -> Boolean : (Opaque empty-subtype?)) net/mime) +(require/typed empty-disposition-type? (Any -> Boolean : (Opaque empty-disposition-type?)) net/mime) + + +;; -- mime methods -- +(require/typed/provide net/mime + [mime-analyze ((U Bytes Input-Port) Any -> message)]) + +(provide + ;; -- exceptions raised -- + mime-error? + unexpected-termination? + unexpected-termination-msg + missing-multipart-boundary-parameter? + malformed-multipart-entity? + malformed-multipart-entity-msg + empty-mechanism? + empty-type? + empty-subtype? + empty-disposition-type? + + ;; -- basic mime structures -- + message + entity + + disposition + + ;; -- mime methods -- + mime-analyze +) + diff --git a/collects/typed/net/nntp.ss b/collects/typed/net/nntp.ss new file mode 100644 index 0000000000..04468077f1 --- /dev/null +++ b/collects/typed/net/nntp.ss @@ -0,0 +1,31 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require-typed-struct communicator ([sender : Number] [receiver : Number] [server : String] [port : Number]) + net/nntp) + +(require/typed/provide net/nntp + [connect-to-server (case-lambda (String -> communicator) (String Number -> communicator))] + [disconnect-from-server (communicator -> Void)] + [authenticate-user (communicator String String -> Void)] + [open-news-group (communicator String -> (values Number Number Number))] + [head-of-message (communicator Number -> (Listof String))] + [body-of-message (communicator Number -> (Listof String))] + [newnews-since (communicator Number -> (Listof String))] + [generic-message-command (communicator Number -> (Listof String))] + [make-desired-header (String -> String)] ;;-> Regexp + [extract-desired-headers ((Listof String) (Listof String) -> (Listof String))]) ;;2nd: Of Regexp +#| +;; requires structure inheritance +(require-typed-struct nntp ()] +(require-typed-struct unexpected-response ([code : Number] [text : String])] +(require-typed-struct bad-status-line ([line : String])] +(require-typed-struct premature-close ([communicator : communicator])] +(require-typed-struct bad-newsgroup-line ([line : String])] +(require-typed-struct non-existent-group ([group : String])] +(require-typed-struct article-not-in-group ([article : Number])] +(require-typed-struct no-group-selected ()] +(require-typed-struct article-not-found ([article : Number])] +(require-typed-struct authentication-rejected ()] +|# diff --git a/collects/typed/net/pop3.ss b/collects/typed/net/pop3.ss new file mode 100644 index 0000000000..8ecaa8f528 --- /dev/null +++ b/collects/typed/net/pop3.ss @@ -0,0 +1,38 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require-typed-struct communicator ([sender : Number] [receiver : Number] [server : String] [port : Number] [state : Symbol])net/pop3) + +(require/typed/provide net/pop3 + [connect-to-server ( case-lambda (String -> (Opaque communicator?)) (String Number -> (Opaque communicator?)) )] + + [disconnect-from-server ( (Opaque communicator?) -> Void )] + [authenticate/plain-text ( String String (Opaque communicator?) -> Void )] + [get-mailbox-status ( (Opaque communicator?) -> (values Number Number) )] + [get-message/complete ( (Opaque communicator?) Number -> (values (Listof String)(Listof String)) )] + [get-message/headers ( (Opaque communicator?) Number -> (Listof String) )] + [get-message/body ( (Opaque communicator?) Number -> (Listof String) )] + [delete-message ( (Opaque communicator?) Number -> Void )] + [get-unique-id/single ( (Opaque communicator?) Number -> String )] + [get-unique-id/all ( (Opaque communicator?) -> (Listof (cons Number String)) )] + + [make-desired-header ( String -> String )];-> Regexp + [extract-desired-headers ( (Listof String)(Listof String)-> (Listof String) )];2nd:of Regexp + ) +(provide (struct-out communicator)) + +#| +(require-typed-struct pop3 ()] +(require-typed-struct cannot-connect ()] +(require-typed-struct username-rejected ()] +(require-typed-struct password-rejected ()] +(require-typed-struct not-ready-for-transaction ([ communicator : (Opaque communicator?) ])net/pop3) +(require-typed-struct not-given-headers ([ communicator : (Opaque communicator?) ] [message : String])] +(require-typed-struct illegal-message-number ([communicator : (Opaque communicator?)] [message : String])] +(require-typed-struct cannot-delete-message ([communicator : (Opaque communicator?)] [message : String])] +(require-typed-struct disconnect-not-quiet ([communicator : (Opaque communicator?)])] +(require-typed-struct malformed-server-response ([communicator : (Opaque communicator?)])net/pop3) +|# + + \ No newline at end of file diff --git a/collects/typed/net/qp.ss b/collects/typed/net/qp.ss new file mode 100644 index 0000000000..092ccdde3a --- /dev/null +++ b/collects/typed/net/qp.ss @@ -0,0 +1,10 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/typed/provide net/qp + [qp-encode ( String -> String )] + [qp-decode ( String -> String )] + [qp-encode-stream (case-lambda (Input-Port Output-Port -> Void) (Input-Port Output-Port String -> Void) )] + [qp-decode-stream ( Input-Port Output-Port -> Void )]) + \ No newline at end of file diff --git a/collects/typed/net/sendmail.ss b/collects/typed/net/sendmail.ss new file mode 100644 index 0000000000..1dd748d8be --- /dev/null +++ b/collects/typed/net/sendmail.ss @@ -0,0 +1,12 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/typed/provide net/sendmail + [send-mail-message/port + (String String (Listof String) (Listof String) (Listof String) String * -> Output-Port)] + [send-mail-message + (String String (Listof String) (Listof String) (Listof String) (Listof String) String * -> Output-Port)]) + +(provide send-mail-message/port send-mail-message #;no-mail-recipients) + \ No newline at end of file diff --git a/collects/typed/net/sendurl.ss b/collects/typed/net/sendurl.ss new file mode 100644 index 0000000000..205096db36 --- /dev/null +++ b/collects/typed/net/sendurl.ss @@ -0,0 +1,9 @@ +#lang typed-scheme +(require/typed net/sendurl + [send-url (String -> Void)] + [unix-browser-list (Listof Symbol)] + [browser-preference? (String -> Boolean)] + [external-browser (-> (U Symbol #f (Pair String String)))]) + +(provide send-url unix-browser-list browser-preference? external-browser) + \ No newline at end of file diff --git a/collects/typed/net/smtp.ss b/collects/typed/net/smtp.ss new file mode 100644 index 0000000000..4923a4b116 --- /dev/null +++ b/collects/typed/net/smtp.ss @@ -0,0 +1,11 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/typed/provide net/smtp + [smtp-send-message (String String (Listof String) String (Listof String) -> Void)] + [smtp-sending-end-of-message (Parameter (-> Any))]) + +(provide smtp-send-message smtp-sending-end-of-message) + + \ No newline at end of file diff --git a/collects/typed/net/uri-codec.ss b/collects/typed/net/uri-codec.ss new file mode 100644 index 0000000000..bfbc991191 --- /dev/null +++ b/collects/typed/net/uri-codec.ss @@ -0,0 +1,15 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require/typed/provide net/uri-codec + [uri-encode ( String -> String )] + [uri-decode ( String -> String )] + + [form-urlencoded-encode ( String -> String )] + [form-urlencoded-decode ( String -> String )] + + [alist->form-urlencoded ( (Listof (cons Symbol String)) -> String )] + [form-urlencoded->alist ( String -> (Listof (cons Symbol String)) )] + [current-alist-separator-mode (Parameter Symbol)]) + \ No newline at end of file diff --git a/collects/typed/net/url.ss b/collects/typed/net/url.ss new file mode 100644 index 0000000000..86add4fef6 --- /dev/null +++ b/collects/typed/net/url.ss @@ -0,0 +1,59 @@ +#lang typed-scheme + +(require typed/private/utils) + +(require-typed-struct path/param ([path : (U String 'up 'same)] [param : (Listof String)]) net/url) + +(require-typed-struct url ([scheme : (Option String)] + [user : (Option String)] + [host : (Option String)] + [port : (Option Integer)] + [path-absolute? : Boolean] + [path : (Listof path/param)] + [query : (Listof (Pair Symbol (Option String)))] + [fragment : (Option String)]) + net/url) + +(require/opaque-type URL-Exception url-exception? net/url) + +(define-type-alias PortT (case-lambda (url -> Input-Port) (url (Listof String)-> Input-Port))) +(define-type-alias PortT/String (case-lambda (url String -> Input-Port) (url String (Listof String)-> Input-Port))) + +(require/typed/provide net/url + + [path->url (Path -> url)] + [url->path (case-lambda (url -> Path) (url (U 'unix 'windows) -> Path))] + + [file-url-path-convention-type (Parameter (U 'unix 'windows))] + + [get-pure-port PortT] + [head-pure-port PortT] + [delete-pure-port PortT] + + [get-impure-port PortT] + [head-impure-port PortT] + [delete-impure-port PortT] + + [post-pure-port PortT/String] + [put-pure-port PortT/String] + + [post-impure-port PortT/String] + [put-impure-port PortT/String] + + [display-pure-port (Input-Port -> Void)] + [purify-port (Input-Port -> String)] + + [call/input-url (case-lambda [url url (Input-Port -> Any) -> Any])] ;;FIXME - need polymorphism + + [current-proxy-servers (Parameter (Listof (List String String Integer)))] + + [netscape/string->url (String -> url)] + [string->url (String -> url)] + [url->string (url -> String)] + [combine-url/relative (url String -> url)]) + +(provide + URL-Exception + url-exception? + (struct-out url) + (struct-out path/param))