Commit 2a8bcf00 authored by Erin van der Veen's avatar Erin van der Veen

Use consistent style for Web and Currency

There was mixed indentation, lines ending with whitespace and tabs
within a single line.

These should now be removed.
parent f40a4e38
Pipeline #47297 passed with stages
in 8 minutes and 55 seconds
......@@ -4,21 +4,21 @@ import iTasks
from iTasks.Internal.Generic.Hash import generic gHash
//* Money (ISO4217 currency codes are used)
:: EUR = EUR !Int //Euros (amount in cents)
:: USD = USD !Int //Dollars (amount in cents)
:: EUR = EUR !Int //Euros (amount in cents)
:: USD = USD !Int //Dollars (amount in cents)
instance toString EUR, USD
instance + EUR, USD
instance - EUR, USD
instance == EUR, USD
instance < EUR, USD
instance toInt EUR, USD
instance zero EUR, USD
instance toString EUR, USD
instance + EUR, USD
instance - EUR, USD
instance == EUR, USD
instance < EUR, USD
instance toInt EUR, USD
instance zero EUR, USD
derive JSONEncode EUR, USD
derive JSONDecode EUR, USD
derive gDefault EUR, USD
derive gEq EUR, USD
derive gText EUR, USD
derive gEditor EUR, USD
derive gHash EUR, USD
derive JSONEncode EUR, USD
derive JSONDecode EUR, USD
derive gDefault EUR, USD
derive gEq EUR, USD
derive gText EUR, USD
derive gEditor EUR, USD
derive gHash EUR, USD
......@@ -84,10 +84,10 @@ instance zero USD
where
zero = USD 0
derive JSONEncode EUR, USD
derive JSONDecode EUR, USD
derive gDefault EUR, USD
derive gEq EUR, USD
derive gHash EUR, USD
derive JSONEncode EUR, USD
derive JSONDecode EUR, USD
derive gDefault EUR, USD
derive gEq EUR, USD
derive gHash EUR, USD
decFormat x = toString (x / 100) +++ "." +++ lpad (toString (x rem 100)) 2 '0'
......@@ -12,14 +12,14 @@ from Text.HTML import class html
//* Uniform resource locators
:: URL = URL !String
instance toString URL
instance html URL
instance toString URL
instance html URL
derive gEditor URL
derive gText URL
derive JSONEncode URL
derive JSONDecode URL
derive gDefault URL
derive gDefault URL
derive gEq URL
derive gHash URL
......
......@@ -15,7 +15,7 @@ import qualified Data.Map as DM
import Data.Map.GenJSON, Data.Functor
import qualified Data.List as DL
gText{|URL|} _ val = [maybe "" toString val]
gText{|URL|} _ val = [maybe "" toString val]
gEditor{|URL|} ViewValue
= mapEditorWrite (const ?None)
......@@ -46,22 +46,22 @@ where
KEEPALIVE_TIME :== {tv_sec=5, tv_nsec=0}
:: HttpConnState
= Idle String Timespec
| ReadingRequest HttpReqState
= Idle String Timespec
| ReadingRequest HttpReqState
| AwaitingResponse String Int Bool
:: HttpReqState =
{ request :: HTTPRequest
, method_done :: Bool
, headers_done :: Bool
, data_done :: Bool
, error :: Bool
}
{ request :: HTTPRequest
, method_done :: Bool
, headers_done :: Bool
, data_done :: Bool
, error :: Bool
}
derive class iTask HttpConnState, HttpReqState, HTTPRequest, HTTPResponse, HTTPMethod, HTTPProtocol, HTTPUpload
serveWebService :: Int (HTTPRequest -> Task HTTPResponse) -> Task ()
serveWebService port handler
serveWebService port handler
= withShared []
\io ->
manageConnections io -&&- handleRequests io
......@@ -70,13 +70,13 @@ where
manageConnections io
= tcplisten port False (currentTimespec |*< io)
{ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
onConnect connId client_name (now,io)
onConnect connId client_name (now,io)
= (Ok (Idle client_name now), ?None, [], False)
onData data l=:(Idle client_name last) (now,io)
onData data l=:(Idle client_name last) (now,io)
# request = {newHTTPRequest & client_name = client_name, server_port = port}
# (request, method_done, headers_done, data_done, error) = http_addRequestData request False False False data
# (request, method_done, headers_done, data_done, error) = http_addRequestData request False False False data
# reqs = {HttpReqState|request=request,method_done=method_done,headers_done=headers_done,data_done=data_done,error=error}
= whileReadingRequest data reqs now io
onData data l=:(ReadingRequest {HttpReqState|request, method_done, headers_done, data_done}) (now,io)
......@@ -89,8 +89,8 @@ where
(?None,_) = (Ok l, ?None, [], False)
(?Just response,io)
//Add keep alive header if necessary
# response = if keepalive {HTTPResponse|response & rsp_headers = [("Connection","Keep-Alive"):response.HTTPResponse.rsp_headers]} response
# reply = encodeResponse True response
# response = if keepalive {HTTPResponse|response & rsp_headers = [("Connection","Keep-Alive"):response.HTTPResponse.rsp_headers]} response
# reply = encodeResponse True response
= (Ok (Idle client_name now), ?Just io, [reply], keepalive)
onShareChange l=:(Idle client_name last) (now,_) //Close idle connections if the keepalive time passed
......@@ -106,49 +106,52 @@ where
| not reqs.HttpReqState.headers_done
//Without headers we can't do anything yet
= (Ok (ReadingRequest reqs), ?None, [], False)
| not reqs.HttpReqState.data_done
| not reqs.HttpReqState.data_done
//For now only support full requests
= (Ok (ReadingRequest reqs), ?None, [], False)
//Queue request to get a response
# request = http_parseArguments reqs.HttpReqState.request
# request = http_parseArguments reqs.HttpReqState.request
//Determine if a persistent connection was requested
# keepalive = isKeepAlive request
# keepalive = isKeepAlive request
//Add the request to be handled and wait
# (reqId,io) = addRequest request io
= (Ok (AwaitingResponse request.client_name reqId keepalive), ?Just io, [], False)
onDisconnect l _ = (Ok l, ?None)
onDisconnect l _ = (Ok l, ?None)
isKeepAlive request = maybe (request.HTTPRequest.req_version == "HTTP/1.1") (\h -> (toLowerCase h == "keep-alive")) ('DM'.get "Connection" request.HTTPRequest.req_headers)
encodeResponse autoContentLength response=:{rsp_headers, rsp_data}
# rsp_headers = addDefault rsp_headers "Server" "iTasks HTTP Server"
# rsp_headers = addDefault rsp_headers "Content-Type" "text/html"
# rsp_headers = if autoContentLength
(addDefault rsp_headers "Content-Length" (toString (size rsp_data)))
rsp_headers
# rsp_headers =
if autoContentLength
(addDefault rsp_headers "Content-Length" (toString (size rsp_data)))
rsp_headers
= toString {HTTPResponse|response & rsp_headers = rsp_headers}
where
addDefault headers hdr val = if (isNone ('DL'.lookup hdr headers)) [(hdr,val):headers] headers
handleRequests io
= forever (
(watch io @ listRequests) //Watch for unhandled requests
>>* [OnValue (ifValue (not o isEmpty) (createResponses io))] //Handle the new requests and store responses
= forever (
//Watch for unhandled requests
(watch io @ listRequests)
//Handle the new requests and store responses
>>* [OnValue (ifValue (not o isEmpty) (createResponses io))]
)
createResponses slist requests
= allTasks [handler req \\ (_,req) <- requests]
createResponses slist requests
= allTasks [handler req \\ (_,req) <- requests]
>>- \responses ->
upd (addResponses [(reqId,rsp) \\ (reqId,_) <- requests & rsp <- responses]) slist
@! ()
where
addResponses [] list = list
addResponses [(reqId,rsp):rest] list = addResponses rest (addResponse reqId rsp list)
//The data structure shared between the management of connections and the actual processing of requests
:: ConnectionList :== [(Int,Either HTTPRequest HTTPResponse)]
:: RequestId :== Int
:: RequestId :== Int
addRequest :: HTTPRequest ConnectionList -> (RequestId,ConnectionList)
addRequest req list = addRequest` 0 req list
......@@ -162,28 +165,29 @@ listRequests list = [(i,req) \\ (i,Left req) <- list]
addResponse :: RequestId HTTPResponse ConnectionList -> ConnectionList
addResponse reqId rsp [] = []
addResponse reqId rsp [x=:(i,_):xs]
| i == reqId = [(i,Right rsp):xs]
| otherwise = [x:addResponse reqId rsp xs]
| i == reqId = [(i,Right rsp):xs]
| otherwise = [x:addResponse reqId rsp xs]
getResponse :: RequestId ConnectionList -> (?HTTPResponse,ConnectionList)
getResponse reqId [] = (?None,[])
getResponse reqId [x=:(i,Right rsp):xs]
| i == reqId = (?Just rsp,xs)
| otherwise = let (mbrsp,xs`) = getResponse reqId xs in (mbrsp,[x:xs])
| i == reqId = (?Just rsp,xs)
| otherwise = let (mbrsp,xs`) = getResponse reqId xs in (mbrsp,[x:xs])
getResponse reqId [x:xs] = let (mbrsp,xs`) = getResponse reqId xs in (mbrsp,[x:xs])
serveFile :: [FilePath] HTTPRequest -> Task HTTPResponse
serveFile [] req = return (notFoundResponse req)
serveFile [d:ds] req=:{HTTPRequest|req_path}
= try (importTextFile (d +++ filePath) @ toResponse)
(\(FileException _ _) -> serveFile ds req)
= try
(importTextFile (d +++ filePath) @ toResponse)
(\(FileException _ _) -> serveFile ds req)
where
//Translate a URL path to a filesystem path
filePath = ((replaceSubString "/" {pathSeparator}) o (replaceSubString ".." "")) (urlDecode req_path)
mimeType = extensionToMimeType (takeExtension filePath)
toResponse content
= {HTTPResponse|okResponse
toResponse content =
{HTTPResponse|okResponse
& rsp_headers =
[("Content-Type", mimeType)
,("Content-Length", toString (size content))]
......@@ -192,32 +196,32 @@ where
callHTTP :: !HTTPMethod !URI !String !(HTTPResponse -> (MaybeErrorString a)) -> Task a | iTask a
callHTTP method url=:{URI|uriScheme,uriRegName= ?Just uriRegName,uriPort,uriPath,uriQuery,uriFragment} data parseFun
= tcpconnect uriRegName port ?None (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
@? taskResult
= tcpconnect uriRegName port ?None (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onShareChange=onShareChange,onDisconnect=onDisconnect,onDestroy= \s->(Ok s, [])}
@? taskResult
where
port = fromMaybe 80 uriPort
path = uriPath +++ maybe "" (\q -> ("?"+++q)) uriQuery +++ maybe "" (\f -> ("#"+++f)) uriFragment
//VERY SIMPLE HTTP 1.1 Request
req = toString method +++ " " +++ path +++ " HTTP/1.1\r\nHost:"+++uriRegName+++"\r\nConnection: close\r\n\r\n"+++data
onConnect _ _ _
= (Ok (Left []),?None,[req],False)
onData data (Left acc) _
= (Ok (Left (acc ++ [data])),?None,[],False)
onShareChange acc _
= (Ok acc,?None,[],False)
onDisconnect (Left acc) _
= case parseResponse (concat acc) of
port = fromMaybe 80 uriPort
path = uriPath +++ maybe "" (\q -> ("?"+++q)) uriQuery +++ maybe "" (\f -> ("#"+++f)) uriFragment
//VERY SIMPLE HTTP 1.1 Request
req = toString method +++ " " +++ path +++ " HTTP/1.1\r\nHost:"+++uriRegName+++"\r\nConnection: close\r\n\r\n"+++data
onConnect _ _ _
= (Ok (Left []),?None,[req],False)
onData data (Left acc) _
= (Ok (Left (acc ++ [data])),?None,[],False)
onShareChange acc _
= (Ok acc,?None,[],False)
onDisconnect (Left acc) _
= case parseResponse (concat acc) of
?None = (Error "Invalid response",?None)
?Just rsp = case parseFun rsp of
Ok a = (Ok (Right a),?None)
Error e = (Error e,?None)
taskResult (Value (Right a) _) = Value a True
taskResult _ = NoValue
taskResult (Value (Right a) _) = Value a True
taskResult _ = NoValue
callHTTP _ url _ _
= throw ("Invalid url: " +++ toString url)
= throw ("Invalid url: " +++ toString url)
callRPCHTTP :: !HTTPMethod !URI ![(String,String)] !(HTTPResponse -> a) -> Task a | iTask a
callRPCHTTP method url params transformResult
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment